major improvments and new version:
[Biblio-Isis] / IsisDB.pm
index 6f31967..222e122 100644 (file)
--- a/IsisDB.pm
+++ b/IsisDB.pm
@@ -9,7 +9,7 @@ use Data::Dumper;
 BEGIN {
        use Exporter ();
        use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-       $VERSION     = 0.07;
+       $VERSION     = 0.08;
        @ISA         = qw (Exporter);
        #Give a hoot don't pollute, do not export more than needed by default
        @EXPORT      = qw ();
@@ -296,7 +296,7 @@ sub fetch {
 
        # is mfn allready in memory?
        my $old_mfn = $self->{'current_mfn'} || -1;
-       return if ($mfn == $old_mfn);
+       return $self->{record} if ($mfn == $old_mfn);
 
        print STDERR "## fetch: $mfn\n" if ($self->{debug});
 
@@ -308,14 +308,26 @@ sub fetch {
 
        my $buff;
 
+       # delete old record
+       delete $self->{record};
+
        # read XRFMFB abd XRFMFP
        read($self->{'fileXRF'}, $buff, 4);
        my $pointer=unpack("l",$buff) || carp "pointer is null";
 
+       # check for logically deleted record
+       if ($pointer < 0) {
+               print STDERR "## record $mfn is logically deleted\n" if ($self->{debug});
+               $self->{deleted} = $mfn;
+
+               return unless $self->{include_deleted};
+
+               $pointer = abs($pointer);
+       }
+
        my $XRFMFB = int($pointer/2048);
        my $XRFMFP = $pointer - ($XRFMFB*2048);
 
-
        # (XRFMFB - 1) * 512 + XRFMFP
        # why do i have to do XRFMFP % 1024 ?
 
@@ -334,30 +346,16 @@ sub fetch {
 
        if ($value!=$mfn) {
                carp "Error: MFN ".$mfn." not found in MST(".$value.")";    
-               #return;                # XXX deleted record?
+               #return;
        }
 
-#      $MFRL=$self->Read16($fileMST);
-#      $MFBWB=$self->Read32($fileMST);
-#      $MFBWP=$self->Read16($fileMST);
-#      $BASE=$self->Read16($fileMST);
-#      $NVF=$self->Read16($fileMST);
-#      $STATUS=$self->Read16($fileMST);
-
        read($self->{'fileMST'}, $buff, 14);
 
        my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);
 
        print STDERR "## MFRL: $MFRL MFBWB: $MFBWB MFBWP: $MFBWP BASE: $BASE NVF: $NVF STATUS: $STATUS\n" if ($self->{debug});
 
-       # delete old record
-       delete $self->{record};
-
-       ## FIXME this is a bug
-       if (! $self->{'include_deleted'} && $MFRL < 0) {
-               print "## logically deleted record $mfn, skipping...\n" if ($self->{debug});
-               return;
-       }
+       warn "MFRL $MFRL is not even number" unless ($MFRL % 2 == 0);
 
        warn "BASE is not 18+6*NVF" unless ($BASE == 18 + 6 * $NVF);
 
@@ -373,10 +371,6 @@ sub fetch {
 
        for (my $i = 0 ; $i < $NVF ; $i++) {
 
-#              $TAG=$self->Read16($fileMST);
-#              $POS=$self->Read16($fileMST);
-#              $LEN=$self->Read16($fileMST);
-
                my ($TAG,$POS,$LEN) = unpack("sss", substr($buff,$i * 6, 6));
 
                print STDERR "## TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});
@@ -413,7 +407,7 @@ sub fetch {
 
        $self->{'current_mfn'} = $mfn;
 
-       print Dumper($self),"\n" if ($self->{debug});
+       print STDERR Dumper($self),"\n" if ($self->{debug});
 
        return $self->{'record'};
 }