/[Biblio-Isis]/trunk/lib/Biblio/Isis.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Biblio/Isis.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2 by dpavlin, Tue Dec 28 01:41:45 2004 UTC revision 10 by dpavlin, Wed Dec 29 16:04:07 2004 UTC
# Line 7  use Data::Dumper; Line 7  use Data::Dumper;
7  BEGIN {  BEGIN {
8          use Exporter ();          use Exporter ();
9          use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);          use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
10          $VERSION     = 0.01;          $VERSION     = 0.03;
11          @ISA         = qw (Exporter);          @ISA         = qw (Exporter);
12          #Give a hoot don't pollute, do not export more than needed by default          #Give a hoot don't pollute, do not export more than needed by default
13          @EXPORT      = qw ();          @EXPORT      = qw ();
# Line 66  Open CDS/ISIS database Line 66  Open CDS/ISIS database
66          isisdb => './cds/cds',          isisdb => './cds/cds',
67          read_fdt => 1,          read_fdt => 1,
68          debug => 1,          debug => 1,
69            include_deleted => 1,
70   );   );
71    
72  Options are described below:  Options are described below:
# Line 86  by default. Line 87  by default.
87    
88  Dump a C<lot> of debugging output.  Dump a C<lot> of debugging output.
89    
90    =item include_deleted
91    
92    Don't skip logically deleted records.
93    
94  =back  =back
95    
96  It will also set C<$isis-E<gt>{'maxmfn'}> which is maximum MFN stored in database.  It will also set C<$isis-E<gt>{'maxmfn'}> which is maximum MFN stored in database.
# Line 97  sub new { Line 102  sub new {
102          my $self = {};          my $self = {};
103          bless($self, $class);          bless($self, $class);
104    
105          $self->{isisdb} = {@_}->{isisdb} || croak "new needs database name as argument!";          croak "new needs database name (isisdb) as argument!" unless ({@_}->{isisdb});
106    
107          $self->{debug} = {@_}->{debug};          foreach my $v (qw{isisdb debug include_deleted}) {
108                    $self->{$v} = {@_}->{$v};
109            }
110    
111          # if you want to read .FDT file use read_fdt argument when creating class!          # if you want to read .FDT file use read_fdt argument when creating class!
112          if ({@_}->{read_fdt} && -e $self->{isisdb}.".FDT") {          if ({@_}->{read_fdt} && -e $self->{isisdb}.".FDT") {
# Line 173  sub new { Line 180  sub new {
180                  my $buff = shift || return;                  my $buff = shift || return;
181                  my @arr = unpack("ssssssllls", $buff);                  my @arr = unpack("ssssssllls", $buff);
182    
183                    print "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'});
184    
185                  my $IDTYPE = shift @arr;                  my $IDTYPE = shift @arr;
186                  foreach (@flds) {                  foreach (@flds) {
187                          $self->{$IDTYPE}->{$_} = abs(shift @arr);                          $self->{$IDTYPE}->{$_} = abs(shift @arr);
# Line 191  sub new { Line 200  sub new {
200    
201          print Dumper($self) if ($self->{debug});          print Dumper($self) if ($self->{debug});
202    
203            # open files for later
204            open($self->{'fileXRF'}, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!";
205    
206            open($self->{'fileMST'}, $self->{isisdb}.".MST") || croak "can't open '$self->{isisdb}.MST': $!";
207    
208          $self ? return $self : return undef;          $self ? return $self : return undef;
209  }  }
210    
211  =head2 GetMFN  =head2 fetch
212    
213  Read record with selected MFN  Read record with selected MFN
214    
215    my $rec = $isis->GetMFN(55);    my $rec = $isis->fetch(55);
216    
217  Returns hash with keys which are field names and values are unpacked values  Returns hash with keys which are field names and values are unpacked values
218  for that field.  for that field.
219    
220  =cut  =cut
221    
222  sub GetMFN {  sub fetch {
223          my $self = shift;          my $self = shift;
224    
225          my $mfn = shift || croak "GetMFN needs MFN as argument!";          my $mfn = shift || croak "fetch needs MFN as argument!";
   
         print "GetMFN: $mfn\n" if ($self->{debug});  
226    
227          open(fileXRF, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!";          print "fetch: $mfn\n" if ($self->{debug});
228    
229          # XXX check this?          # XXX check this?
230          my $mfnpos=($mfn+int(($mfn-1)/127))*4;          my $mfnpos=($mfn+int(($mfn-1)/127))*4;
231    
232          print "seeking to $mfnpos in file '$self->{isisdb}.XRF'\n" if ($self->{debug});          print "seeking to $mfnpos in file '$self->{isisdb}.XRF'\n" if ($self->{debug});
233          seek(fileXRF,$mfnpos,0);          seek($self->{'fileXRF'},$mfnpos,0);
234    
235          # read XRFMFB abd XRFMFP          # read XRFMFB abd XRFMFP
236          my $pointer=$self->Read32(\*fileXRF);          my $pointer=$self->Read32(\*{$self->{'fileXRF'}});
237    
238          my $XRFMFB = int($pointer/2048);          my $XRFMFB = int($pointer/2048);
239          my $XRFMFP = $pointer - ($XRFMFB*2048);          my $XRFMFP = $pointer - ($XRFMFB*2048);
# Line 242  sub GetMFN { Line 254  sub GetMFN {
254    
255          print "$offset - $offset2 - $offset3 - $offset4\n" if ($self->{debug});          print "$offset - $offset2 - $offset3 - $offset4\n" if ($self->{debug});
256    
         close(fileXRF);  
   
257          # Get Record Information          # Get Record Information
258    
259          open(fileMST, $self->{isisdb}.".MST") || croak "can't open '$self->{isisdb}.MST': $!";          seek($self->{'fileMST'},$offset4,0);
260    
261          seek(fileMST,$offset4,0);          my $value=$self->Read32(\*{$self->{'fileMST'}});
   
         my $value=$self->Read32(\*fileMST);  
262    
263          if ($value!=$mfn) {          if ($value!=$mfn) {
264  print ("Error: The MFN:".$mfn." is not found in MST(".$value.")");      print ("Error: The MFN:".$mfn." is not found in MST(".$value.")");    
# Line 265  print ("Error: The MFN:".$mfn." is not f Line 273  print ("Error: The MFN:".$mfn." is not f
273  #       $STATUS=$self->Read16($fileMST);  #       $STATUS=$self->Read16($fileMST);
274    
275          my $buff;          my $buff;
276          read(fileMST, $buff, 14);          read($self->{'fileMST'}, $buff, 14);
277    
278          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);
279    
280          print "MFRL: $MFRL MFBWB: $MFBWB MFBWP: $MFBWP BASE: $BASE NVF: $NVF STATUS: $STATUS\n" if ($self->{debug});          print "MFRL: $MFRL MFBWB: $MFBWB MFBWP: $MFBWP BASE: $BASE NVF: $NVF STATUS: $STATUS\n" if ($self->{debug});
281    
282            # delete old record
283            delete $self->{record};
284    
285            if (! $self->{'include_deleted'} && $MFRL < 0) {
286                    print "## logically deleted record $mfn, skipping...\n" if ($self->{debug});
287                    return;
288            }
289    
290          # Get Directory Format          # Get Directory Format
291    
292          my @FieldPOS;          my @FieldPOS;
293          my @FieldLEN;          my @FieldLEN;
294          my @FieldTAG;          my @FieldTAG;
295    
296            read($self->{'fileMST'}, $buff, 6 * $NVF);
297    
298            my $fld_len = 0;
299    
300          for (my $i = 0 ; $i < $NVF ; $i++) {          for (my $i = 0 ; $i < $NVF ; $i++) {
301    
302  #               $TAG=$self->Read16($fileMST);  #               $TAG=$self->Read16($fileMST);
303  #               $POS=$self->Read16($fileMST);  #               $POS=$self->Read16($fileMST);
304  #               $LEN=$self->Read16($fileMST);  #               $LEN=$self->Read16($fileMST);
305    
306                  read(fileMST, $buff, 6);                  my ($TAG,$POS,$LEN) = unpack("sss", substr($buff,$i * 6, 6));
                 my ($TAG,$POS,$LEN) = unpack("sss", $buff);  
307    
308                  print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});                  print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});
309    
# Line 301  print ("Error: The MFN:".$mfn." is not f Line 320  print ("Error: The MFN:".$mfn." is not f
320                  push @FieldTAG,$TAG;                  push @FieldTAG,$TAG;
321                  push @FieldPOS,$POS;                  push @FieldPOS,$POS;
322                  push @FieldLEN,$LEN;                  push @FieldLEN,$LEN;
323    
324                    $fld_len += $LEN;
325          }          }
326    
327          # Get Variable Fields          # Get Variable Fields
328    
329          delete $self->{record};          read($self->{'fileMST'},$buff,$fld_len);
330    
331          for (my $i = 0 ; $i < $NVF ; $i++) {          for (my $i = 0 ; $i < $NVF ; $i++) {
332                  my $rec;                  # skip zero-sized fields
333                  read(fileMST,$rec,$FieldLEN[$i]);                  next if ($FieldLEN[$i] == 0);
                 push @{$self->{record}->{$FieldTAG[$i]}}, $rec;  
         }  
         close(fileMST);  
334    
335          # The record is marked for deletion                  push @{$self->{record}->{$FieldTAG[$i]}}, substr($buff,$FieldPOS[$i],$FieldLEN[$i]);
         if ($STATUS==1) {  
                 return -1;  
336          }          }
337            close(fileMST);
338    
339          print Dumper($self) if ($self->{debug});          print Dumper($self) if ($self->{debug});
340    
# Line 337  sub to_ascii { Line 354  sub to_ascii {
354    
355          my $mfn = shift || croak "need MFN";          my $mfn = shift || croak "need MFN";
356    
357          my $rec = $self->GetMFN($mfn);          my $rec = $self->fetch($mfn);
   
 print STDERR Dumper($rec);  
358    
359          my $out = "0\t$mfn";          my $out = "0\t$mfn";
360    
# Line 352  print STDERR Dumper($rec); Line 367  print STDERR Dumper($rec);
367          return $out;          return $out;
368  }  }
369    
 ################# old cruft which is not ported from php to perl  
   
 =begin php  
   
   # Load the dictionary from the $db.L0x files.  
   # Not usefull Yet  
     
   sub LoadDictionary()  
   {  
     $fileL01=fopen($self->{isisdb}.".L01","r");  
     rewind($fileL01);    
   
     do  
     {  
   
       $POS=$self->Read32($fileL01);  
       $OCK=$self->Read16($fileL01);  
       $IT=$self->Read16($fileL01);  
       $PS=$self->Read32($fileL01);  
 print "<br>PS:".$PS." ".$self->{ORDF}->{1}." ";  
       for ($i=0;$i<$OCK;$i++)  
       {  
         $KEY=fread($fileL01,10);  
         
         print $KEY." ### ";  
   
         $INFO1=$self->Read32($fileL01);  
         $INFO2=$self->Read32($fileL01);  
   
         #L01Key->{$key}=array($INFO1,$INFO2);  
       }  
       
       rewind($fileL01);  
       $offset=($PS-1)*(12+$self->{ORDF}->{1}*18*2);  
       fseek($fileL01,$offset);  
   
     } While (!feof($fileL01));  
   
     fclose($fileL01);  
   }  
   
   # self function search through the tree and returns an array of pointers to IFP  
   # The function must be recursive  
   
   sub SearchTree($search,$fileNB,$PUNT)  
   {        
       $offset=(($PUNT-1)*(8+2*$self->{ORDN}->{1}*14));  
   
         rewind($fileNB1);  
   
         fseek($fileNB,$offset);  
   
         $POS=$self->Read32($fileNB);  
         $OCK=$self->Read16($fileNB);  
         $IT=$self->Read16($fileNB);  
   
 #print "<br>".$POS." - ".$OCK." - ".$IT;  
   
         $OLDPUNT=$POS;  
         $j=0;  
         for ($i=0;$i<$OCK;$i++)  
         {  
           $KEY=fread($fileNB,10);  
         
           $PUNT=$self->Read32($fileNB);  
   
 #print " ## ".chop($KEY)."(".$PUNT."-".$OLDPUNT.") ## ";  
   
           If (strcmp($search,chop($KEY))<0)  
           {  
             break;  
           }  
           $OLDPUNT=$PUNT;    
         }          
 #print $OLDPUNT;  
         Return $OLDPUNT;  
   }  
   
   # Search ISIS for record containing search  
   # Return a sorted array of MFN  
   
   sub Search($search)  
   {  
   
   $search=strtoupper($search);  
 #print "Searching....".$search." - ".$self->{POSRX}->{1}."<br>";  
     # first search .x01  
       
   
     # Search in .N01    
   
   
     $fileN01=fopen($self->{isisdb}.".N01","r");  
     $offset=(($self->{POSRX}->{1}-1)*(8+2*$self->{ORDN}->{1}*14));  
   
       do  
       {  
         rewind($fileN01);  
   
         fseek($fileN01,$offset);  
   
         $POS=$self->Read32($fileN01);  
         $OCK=$self->Read16($fileN01);  
         $IT=$self->Read16($fileN01);  
   
 #print "<br>".$POS." - ".$OCK." - ".$IT;  
   
         $OLDPUNT=$POS;  
         for ($i=0;$i<$OCK;$i++)  
         {  
           $KEY=fread($fileN01,10);  
         
           $PUNT=$self->Read32($fileN01);  
   
 #print " ## ".chop($KEY)."(".$PUNT."-".$OLDPUNT.") ## ";  
   
           If (strcmp($search,chop($KEY))<0)  
           {  
             break;  
           }  
           $OLDPUNT=$PUNT;    
         }  
         $offset=(($OLDPUNT-1)*(8+2*$self->{ORDN}->{1}*14));        
       } while ($OLDPUNT>0);  
 #print $OLDPUNT;  
   
   
     fclose($fileN01);  
   
     # Now look for records in .L01 file  
     $fileL01=fopen($self->{isisdb}.".L01","r");  
     rewind($fileL01);  
   
     $offset=(-$OLDPUNT-1)*(12+$self->{ORDF}->{1}*18*2);  
     fseek($fileL01,$offset);  
   
     $POS=$self->Read32($fileL01);  
     $OCK=$self->Read16($fileL01);  
     $IT=$self->Read16($fileL01);  
     $PS=$self->Read32($fileL01);  
 #print "<br>POS:".$POS." ".$self->{ORDF}->{1}." ";  
     for ($i=0;$i<$OCK;$i++)  
     {  
       $KEY=fread($fileL01,10);  
         
 #print $KEY." ### ";  
   
       $INFO1=$self->Read32($fileL01);  
       $INFO2=$self->Read32($fileL01);  
   
       If (strcmp($search,chop($KEY))==0)  
       {  
         break;  
       }  
     }      
   
     fclose($fileL01);  
   
 #print $INFO1."--".$INFO2;  
   
     # Now look in .IFP for the MFN  
     $fileIFP=fopen($self->{isisdb}.".IFP","r");  
     rewind($fileIFP);  
     $offset=($INFO1-1)*512+($INFO2*4);  
     fseek($fileIFP,$offset);    
   
     $IFPBLK=$self->Read32($fileIFP);  
   
     $IFPNXTB=$self->Read32($fileIFP);  
     $IFPNXTP=$self->Read32($fileIFP);  
     $IFPTOTP=$self->Read32($fileIFP);  
     $IFPSEGP=$self->Read32($fileIFP);  
     $IFPSEGC=$self->Read32($fileIFP);  
   
   
 #print "<br>IFP:".$IFPBLK." # ".$IFPNXTB." - ".$IFPNXTP." - ".$IFPTOTP." - ".$IFPSEGP." - ".$IFPSEGC;  
   
     rewind($fileIFP);  
     $offset=($INFO1-1)*512+24+($INFO2*4);  
     fseek($fileIFP,$offset);      
       
     $j=24+($INFO2*4);  
     $k=0;  
     $l=1;  
     $OLDPMFN="";  
     for ($i=0;$i<$IFPSEGP;$i++)  
     {  
       $B1=$self->Read8($fileIFP);  
       $B2=$self->Read8($fileIFP);  
       $B3=$self->Read8($fileIFP);  
       $B4=$self->Read8($fileIFP);  
       $B5=$self->Read8($fileIFP);  
       $B6=$self->Read8($fileIFP);  
       $B7=$self->Read8($fileIFP);  
       $B8=$self->Read8($fileIFP);  
   
       $PMFN=$B1*65536+$B2*256+$B3;  
       $PTAG=$B4*256+$B5;  
       $POCC=$B6;  
       $PCNT=$B7*256+$B8;  
   
       if ($OLDPMFN!=$PMFN)  
       {  
         if ($PMFN!=0)  
         {  
           $self->{MFNArray}->{$l}=$PMFN;  
           $OLDPMFN=$PMFN;  
           $l+=1;  
         }  
       }  
   
       $j=$j+8;  
 #print "<br>".$PMFN."-".$PTAG." - ".$POCC." - ".$PCNT;  
 #print "@@".$j."@@@@";  
       if ($j>=504)  
       {  
         if ($IFPNXTB==0 && $IFPNXTP==0)  
         {  
           $k=$k+1;  
           rewind($fileIFP);  
           $offset=($INFO1-1+$k)*512;    
           fseek($fileIFP,$offset);        
           $B=$self->Read32($fileIFP);  
 #print "<br>-".$B."-<br>";  
           $j=0;  
         } else  
         {  
           rewind($fileIFP);  
           $offset=($IFPNXTB-1)*512;    
           fseek($fileIFP,$offset);  
   
           $OLDIFPNXTB=$IFPNXTB;  
           $OLDIFPNXTP=$IFPNXTP;  
   
           $IFPBLK=$self->Read32($fileIFP);  
   
           $IFPNXTB=$self->Read32($fileIFP);  
           $IFPNXTP=$self->Read32($fileIFP);  
           $IFPTOTP=$self->Read32($fileIFP);  
           $IFPSEGP=$self->Read32($fileIFP);  
           $IFPSEGC=$self->Read32($fileIFP);  
   
           rewind($fileIFP);  
           $offset=($OLDIFPNXTB-1)*512+24+($OLDIFPNXTP*4);  
           fseek($fileIFP,$offset);      
       
           $j=24+($OLDIFPNXTP*4);  
           $k=0;  
           $j=0;  
         }  
       }  
   
     }      
     fclose($fileIFP);  
     return $l-1;  
   }  
   
 =cut  
   
370  #  #
371  # XXX porting from php left-over:  # XXX porting from php left-over:
372  #  #
# Line 620  print "<br>PS:".$PS." ".$self->{ORDF}->{ Line 376  print "<br>PS:".$PS." ".$self->{ORDF}->{
376  # Probably direct usage is better!  # Probably direct usage is better!
377  #  #
378    
379  sub GetFieldName {  sub TagName {
         my $self = shift;  
         return $self->{FieldName};  
 }  
   
 sub GetTagName {  
380          my $self = shift;          my $self = shift;
381          return $self->{TagName};          return $self->{TagName};
382  }  }
383    
384  sub GetFieldTag {  sub NextMFN {
         my $self = shift;  
         return $self->{FieldTAG};  
 }  
   
 sub GetNextMFN {  
385          my $self = shift;          my $self = shift;
386          return $self->{NXTMFN};          return $self->{NXTMFN};
387  }  }
388    
 sub GetMFNArray {  
         my $self = shift;  
         return $self->{MFNArray};  
 }  
 =begin php  
   
   sub Read32($fileNB)  
   {  
     $B1=ord(fread($fileNB,1));  
     $B2=ord(fread($fileNB,1));  
     $B3=ord(fread($fileNB,1));  
     $B4=ord(fread($fileNB,1));  
   
     if ($B4<=128)  
     {  
       $value=$B1+$B2*256+$B3*65536+$B4*16777216;  
     } else  
     {  
       $value=$self->Not8($B1)+$self->Not8($B2)*256+$self->Not8($B3)*65536+$self->Not8($B4)*16777216;  
       $value=-($value+1);  
     }  
 #    print "(".$B1.",".$B2.",".$B3.",".$B4.":".$value.")";  
   
     return $value;    
   }  
   
   sub Read24($fileNB)  
   {  
     $B1=ord(fread($fileNB,1));  
     $B2=ord(fread($fileNB,1));  
     $B3=ord(fread($fileNB,1));  
   
     $value=$B1+$B2*256+$B3*65536;  
   
 #    print "(".$B1.",".$B2.",".$B3.":".$value.")";  
   
     return $value;    
   }  
   
   sub Read16($fileNB)  
   {  
     $B1=ord(fread($fileNB,1));  
     $B2=ord(fread($fileNB,1));  
   
     $value=$B1+$B2*256;  
 #    print "(".$B1.",".$B2.":".$value.")";  
   
     return $value;    
   }  
   
   sub Read8($fileNB)  
   {  
     $B1=ord(fread($fileNB,1));  
   
     $value=$B1;  
 #    print "(".$value.")";  
   
     return $value;    
   }  
   
   sub Not8($value)  
   {  
     $value=decbin($value);  
     if (strlen($value)<8)  
     {  
       $buffer="";  
       for($i=0;$i<(8-strlen($value));$i++)  
       {  
         $buffer.="0";  
       }  
       $value=$buffer.$value;  
     }  
     $value=ereg_replace("0","3",$value);  
     $value=ereg_replace("1","0",$value);  
     $value=ereg_replace("3","1",$value);  
     $value=bindec($value);  
     return $value;  
   }  
 }  
   
 =cut  
   
389  1;  1;
 __END__  
390    
391  =head1 BUGS  =head1 BUGS
392    
Legend:
Removed from v.2  
changed lines
  Added in v.10
  ViewVC Help
Powered by ViewVC 1.1.26