/[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 3 by dpavlin, Tue Dec 28 01:48:44 2004 UTC revision 8 by dpavlin, Wed Dec 29 15:17:59 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 191  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 GetMFN  =head2 fetch
203    
204  Read record with selected MFN  Read record with selected MFN
205    
206    my $rec = $isis->GetMFN(55);    my $rec = $isis->fetch(55);
207    
208  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
209  for that field.  for that field.
210    
211  =cut  =cut
212    
213  sub GetMFN {  sub fetch {
214          my $self = shift;          my $self = shift;
215    
216          my $mfn = shift || croak "GetMFN needs MFN as argument!";          my $mfn = shift || croak "fetch needs MFN as argument!";
217    
218          print "GetMFN: $mfn\n" if ($self->{debug});          print "fetch: $mfn\n" if ($self->{debug});
   
         open(fileXRF, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!";  
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 242  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 265  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 277  print ("Error: The MFN:".$mfn." is not f Line 276  print ("Error: The MFN:".$mfn." is not f
276          my @FieldLEN;          my @FieldLEN;
277          my @FieldTAG;          my @FieldTAG;
278    
279            read($self->{'fileMST'}, $buff, 6 * $NVF);
280    
281            my $fld_len = 0;
282    
283          for (my $i = 0 ; $i < $NVF ; $i++) {          for (my $i = 0 ; $i < $NVF ; $i++) {
284    
285  #               $TAG=$self->Read16($fileMST);  #               $TAG=$self->Read16($fileMST);
286  #               $POS=$self->Read16($fileMST);  #               $POS=$self->Read16($fileMST);
287  #               $LEN=$self->Read16($fileMST);  #               $LEN=$self->Read16($fileMST);
288    
289                  read(fileMST, $buff, 6);                  my ($TAG,$POS,$LEN) = unpack("sss", substr($buff,$i * 6, 6));
                 my ($TAG,$POS,$LEN) = unpack("sss", $buff);  
290    
291                  print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});                  print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});
292    
# Line 301  print ("Error: The MFN:".$mfn." is not f Line 303  print ("Error: The MFN:".$mfn." is not f
303                  push @FieldTAG,$TAG;                  push @FieldTAG,$TAG;
304                  push @FieldPOS,$POS;                  push @FieldPOS,$POS;
305                  push @FieldLEN,$LEN;                  push @FieldLEN,$LEN;
306    
307                    $fld_len += $LEN;
308          }          }
309    
310          # Get Variable Fields          # Get Variable Fields
311    
312          delete $self->{record};          delete $self->{record};
313    
314            read($self->{'fileMST'},$buff,$fld_len);
315    
316          for (my $i = 0 ; $i < $NVF ; $i++) {          for (my $i = 0 ; $i < $NVF ; $i++) {
317                  my $rec;                  push @{$self->{record}->{$FieldTAG[$i]}}, substr($buff,$FieldPOS[$i],$FieldLEN[$i]);
                 read(fileMST,$rec,$FieldLEN[$i]);  
                 push @{$self->{record}->{$FieldTAG[$i]}}, $rec;  
318          }          }
319          close(fileMST);          close(fileMST);
320    
# Line 337  sub to_ascii { Line 341  sub to_ascii {
341    
342          my $mfn = shift || croak "need MFN";          my $mfn = shift || croak "need MFN";
343    
344          my $rec = $self->GetMFN($mfn);          my $rec = $self->fetch($mfn);
345    
346          my $out = "0\t$mfn";          my $out = "0\t$mfn";
347    
# Line 350  sub to_ascii { Line 354  sub to_ascii {
354          return $out;          return $out;
355  }  }
356    
 ################# 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  
   
357  #  #
358  # XXX porting from php left-over:  # XXX porting from php left-over:
359  #  #
# Line 618  print "<br>PS:".$PS." ".$self->{ORDF}->{ Line 363  print "<br>PS:".$PS." ".$self->{ORDF}->{
363  # Probably direct usage is better!  # Probably direct usage is better!
364  #  #
365    
366  sub GetFieldName {  sub TagName {
         my $self = shift;  
         return $self->{FieldName};  
 }  
   
 sub GetTagName {  
367          my $self = shift;          my $self = shift;
368          return $self->{TagName};          return $self->{TagName};
369  }  }
370    
371  sub GetFieldTag {  sub NextMFN {
         my $self = shift;  
         return $self->{FieldTAG};  
 }  
   
 sub GetNextMFN {  
372          my $self = shift;          my $self = shift;
373          return $self->{NXTMFN};          return $self->{NXTMFN};
374  }  }
375    
 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  
   
376  1;  1;
 __END__  
377    
378  =head1 BUGS  =head1 BUGS
379    
Legend:
Removed from v.3  
changed lines
  Added in v.8
  ViewVC Help
Powered by ViewVC 1.1.26