/[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 1 by dpavlin, Tue Dec 28 00:43:04 2004 UTC revision 7 by dpavlin, Wed Dec 29 15:10:34 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.02;
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 68  Open CDS/ISIS database Line 68  Open CDS/ISIS database
68          debug => 1,          debug => 1,
69   );   );
70    
71    Options are described below:
72    
73    =over 5
74    
75  =item isisdb  =item isisdb
76    
77  Prefix path to CDS/ISIS. It should contain full or relative path to database  Prefix path to CDS/ISIS. It should contain full or relative path to database
# Line 82  by default. Line 86  by default.
86    
87  Dump a C<lot> of debugging output.  Dump a C<lot> of debugging output.
88    
89    =back
90    
91    It will also set C<$isis-E<gt>{'maxmfn'}> which is maximum MFN stored in database.
92    
93  =cut  =cut
94    
95  sub new {  sub new {
# Line 91  sub new { Line 99  sub new {
99    
100          $self->{isisdb} = {@_}->{isisdb} || croak "new needs database name as argument!";          $self->{isisdb} = {@_}->{isisdb} || croak "new needs database name as argument!";
101    
102          $self->{debug} = {@_}->{debug} || 1;    # XXX remove debug always!          $self->{debug} = {@_}->{debug};
103    
104          # 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!
105          if ({@_}->{read_fdt} && -e $self->{isisdb}.".FDT") {          if ({@_}->{read_fdt} && -e $self->{isisdb}.".FDT") {
# Line 134  sub new { Line 142  sub new {
142          seek(fileMST,4,0);          seek(fileMST,4,0);
143          $self->{'NXTMFN'}=$self->Read32(\*fileMST) || carp "NXTNFN is zero";          $self->{'NXTMFN'}=$self->Read32(\*fileMST) || carp "NXTNFN is zero";
144    
145            # save maximum MFN
146            $self->{'maxmfn'} = $self->{'NXTMFN'} - 1;
147    
148          close(fileMST);          close(fileMST);
149    
150          # Get the index information from $db.CNT          # Get the index information from $db.CNT
# Line 180  sub new { Line 191  sub new {
191    
192          print Dumper($self) if ($self->{debug});          print Dumper($self) if ($self->{debug});
193    
194            # open files for later
195            open($self->{'fileXRF'}, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!";
196    
197            open($self->{'fileMST'}, $self->{isisdb}.".MST") || croak "can't open '$self->{isisdb}.MST': $!";
198    
199          $self ? return $self : return undef;          $self ? return $self : return undef;
200  }  }
201    
202    =head2 fetch
203    
204  # Get a record from the MFN  Read record with selected MFN
 # Return the number of fields in the record.  
 # Return -1 if the record is marked for deletion  
 # The record is then extracted with call to GETs  
205    
206  sub GetMFN {    my $rec = $isis->fetch(55);
207          my $self = shift;  
208    Returns hash with keys which are field names and values are unpacked values
209    for that field.
210    
211    =cut
212    
213          my $mfn = shift || croak "GetMFN needs MFN as argument!";  sub fetch {
214            my $self = shift;
215    
216          print "GetMFN: $mfn\n" if ($self->{debug});          my $mfn = shift || croak "fetch needs MFN as argument!";
217    
218          open(fileXRF, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!";          print "fetch: $mfn\n" if ($self->{debug});
219    
220          # XXX check this?          # XXX check this?
221          my $mfnpos=($mfn+int(($mfn-1)/127))*4;          my $mfnpos=($mfn+int(($mfn-1)/127))*4;
222    
223          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});
224          seek(fileXRF,$mfnpos,0);          seek($self->{'fileXRF'},$mfnpos,0);
225    
226          # read XRFMFB abd XRFMFP          # read XRFMFB abd XRFMFP
227          my $pointer=$self->Read32(\*fileXRF);          my $pointer=$self->Read32(\*{$self->{'fileXRF'}});
228    
229          my $XRFMFB = int($pointer/2048);          my $XRFMFB = int($pointer/2048);
230          my $XRFMFP = $pointer - ($XRFMFB*2048);          my $XRFMFP = $pointer - ($XRFMFB*2048);
# Line 226  sub GetMFN { Line 245  sub GetMFN {
245    
246          print "$offset - $offset2 - $offset3 - $offset4\n" if ($self->{debug});          print "$offset - $offset2 - $offset3 - $offset4\n" if ($self->{debug});
247    
         close(fileXRF);  
   
248          # Get Record Information          # Get Record Information
249    
250          open(fileMST, $self->{isisdb}.".MST") || croak "can't open '$self->{isisdb}.MST': $!";          seek($self->{'fileMST'},$offset4,0);
251    
252          seek(fileMST,$offset4,0);          my $value=$self->Read32(\*{$self->{'fileMST'}});
   
         my $value=$self->Read32(\*fileMST);  
253    
254          if ($value!=$mfn) {          if ($value!=$mfn) {
255  print ("Error: The MFN:".$mfn." is not found in MST(".$value.")");      print ("Error: The MFN:".$mfn." is not found in MST(".$value.")");    
# Line 249  print ("Error: The MFN:".$mfn." is not f Line 264  print ("Error: The MFN:".$mfn." is not f
264  #       $STATUS=$self->Read16($fileMST);  #       $STATUS=$self->Read16($fileMST);
265    
266          my $buff;          my $buff;
267          read(fileMST, $buff, 14);          read($self->{'fileMST'}, $buff, 14);
268    
269          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);
270    
# Line 267  print ("Error: The MFN:".$mfn." is not f Line 282  print ("Error: The MFN:".$mfn." is not f
282  #               $POS=$self->Read16($fileMST);  #               $POS=$self->Read16($fileMST);
283  #               $LEN=$self->Read16($fileMST);  #               $LEN=$self->Read16($fileMST);
284    
285                  read(fileMST, $buff, 6);                  read($self->{'fileMST'}, $buff, 6);
286                  my ($TAG,$POS,$LEN) = unpack("sss", $buff);                  my ($TAG,$POS,$LEN) = unpack("sss", $buff);
287    
288                  print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});                  print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});
# Line 289  print ("Error: The MFN:".$mfn." is not f Line 304  print ("Error: The MFN:".$mfn." is not f
304    
305          # Get Variable Fields          # Get Variable Fields
306    
307            delete $self->{record};
308    
309          for (my $i = 0 ; $i < $NVF ; $i++) {          for (my $i = 0 ; $i < $NVF ; $i++) {
310                  my $rec;                  my $rec;
311                  read(fileMST,$rec,$FieldLEN[$i]);                  read($self->{'fileMST'},$rec,$FieldLEN[$i]);
312                  $self->{record}->{$FieldTAG[$i]} = $rec;                  push @{$self->{record}->{$FieldTAG[$i]}}, $rec;
313          }          }
314          close(fileMST);          close(fileMST);
315    
# Line 303  print ("Error: The MFN:".$mfn." is not f Line 320  print ("Error: The MFN:".$mfn." is not f
320    
321          print Dumper($self) if ($self->{debug});          print Dumper($self) if ($self->{debug});
322    
323          return $NVF;          return $self->{'record'};
324  }  }
325    
326  =begin php  =head2 to_ascii
327    
328    # Load the dictionary from the $db.L0x files.  Dump ascii output of selected MFN
329    # Not usefull Yet  
330        print $isis->to_ascii(55);
   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;  
   }  
331    
332  =cut  =cut
333    
334    sub to_ascii {
335            my $self = shift;
336    
337            my $mfn = shift || croak "need MFN";
338    
339            my $rec = $self->fetch($mfn);
340    
341            my $out = "0\t$mfn";
342    
343            foreach my $f (sort keys %{$rec}) {
344                    $out .= "\n$f\t".join("\n$f\t",@{$self->{record}->{$f}});
345            }
346    
347            $out .= "\n";
348    
349            return $out;
350    }
351    
352  #  #
353  # XXX porting from php left-over:  # XXX porting from php left-over:
354  #  #
# Line 572  print "<br>PS:".$PS." ".$self->{ORDF}->{ Line 358  print "<br>PS:".$PS." ".$self->{ORDF}->{
358  # Probably direct usage is better!  # Probably direct usage is better!
359  #  #
360    
361  sub GetFieldName {  sub TagName {
         my $self = shift;  
         return $self->{FieldName};  
 }  
   
 sub GetTagName {  
362          my $self = shift;          my $self = shift;
363          return $self->{TagName};          return $self->{TagName};
364  }  }
365    
366  sub GetFieldTag {  sub NextMFN {
         my $self = shift;  
         return $self->{FieldTAG};  
 }  
   
 sub GetNextMFN {  
367          my $self = shift;          my $self = shift;
368          return $self->{NXTMFN};          return $self->{NXTMFN};
369  }  }
370    
 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  
   
371  1;  1;
 __END__  
372    
373  =head1 BUGS  =head1 BUGS
374    
Legend:
Removed from v.1  
changed lines
  Added in v.7
  ViewVC Help
Powered by ViewVC 1.1.26