/[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 12 by dpavlin, Wed Dec 29 20:10:11 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.04;
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 22  IsisDB - Read CDS/ISIS database Line 22  IsisDB - Read CDS/ISIS database
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
24    
25    use IsisDB    use IsisDB;
26    
27    my $isis = new IsisDB(    my $isis = new IsisDB(
28          isisdb => './cds/cds',          isisdb => './cds/cds',
29    );    );
30    
31      for(my $mfn = 1; $mfn <= $isis->{'maxmfn'}; $mfn++) {
32            print $isis->to_ascii($mfn),"\n";
33      }
34    
35  =head1 DESCRIPTION  =head1 DESCRIPTION
36    
37  This module will read CDS/ISIS databases and create hash values out of it.  This module will read CDS/ISIS databases and create hash values out of it.
38  It can be used as perl-only alternative to OpenIsis module.  It can be used as perl-only alternative to OpenIsis module.
39    
40    This will module will always be slower that OpenIsis module which use C
41    library. However, since it's written in perl, it's platform independent (so
42    you don't need C compiler), and can be easily modified.
43    
44    Unique feature of this module is ability to C<include_deleted> records.
45    It will also skip zero sized fields (OpenIsis has a bug in XS bindings, so
46    fields which are zero sized will be filled with random junk from memory).
47    
48  =head1 METHODS  =head1 METHODS
49    
50  =cut  =cut
# Line 50  It can be used as perl-only alternative Line 63  It can be used as perl-only alternative
63  # some binary reads  # some binary reads
64  #  #
65    
 sub Read32 {  
         my $self = shift;  
   
         my $f = shift || die "Read32 needs file handle";  
         read($$f,$b,4) || die "can't read 4 bytes from $$f from position ".tell($f);  
         return unpack("l",$b);  
 }  
   
66  =head2 new  =head2 new
67    
68  Open CDS/ISIS database  Open CDS/ISIS database
# Line 65  Open CDS/ISIS database Line 70  Open CDS/ISIS database
70   my $isis = new IsisDB(   my $isis = new IsisDB(
71          isisdb => './cds/cds',          isisdb => './cds/cds',
72          read_fdt => 1,          read_fdt => 1,
73            include_deleted => 1,
74            hash_filter => sub {
75                    my $v = shift;
76                    $v =~ s#foo#bar#g;
77            },
78          debug => 1,          debug => 1,
79   );   );
80    
81    Options are described below:
82    
83    =over 5
84    
85  =item isisdb  =item isisdb
86    
87  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 78  and common prefix of C<.FDT>, C<.MST>, C Line 92  and common prefix of C<.FDT>, C<.MST>, C
92  Boolean flag to specify if field definition table should be read. It's off  Boolean flag to specify if field definition table should be read. It's off
93  by default.  by default.
94    
95    =item include_deleted
96    
97    Don't skip logically deleted records in ISIS.
98    
99    =item hash_filter
100    
101    Filter code ref which will be used before data is converted to hash.
102    
103  =item debug  =item debug
104    
105  Dump a C<lot> of debugging output.  Dump a B<lot> of debugging output.
106    
107    =back
108    
109    It will also set C<$isis-E<gt>{'maxmfn'}> which is maximum MFN stored in database.
110    
111  =cut  =cut
112    
# Line 89  sub new { Line 115  sub new {
115          my $self = {};          my $self = {};
116          bless($self, $class);          bless($self, $class);
117    
118          $self->{isisdb} = {@_}->{isisdb} || croak "new needs database name as argument!";          croak "new needs database name (isisdb) as argument!" unless ({@_}->{isisdb});
119    
120          $self->{debug} = {@_}->{debug} || 1;    # XXX remove debug always!          foreach my $v (qw{isisdb debug include_deleted hash_filter}) {
121                    $self->{$v} = {@_}->{$v};
122            }
123    
124          # 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!
125          if ({@_}->{read_fdt} && -e $self->{isisdb}.".FDT") {          if ({@_}->{read_fdt} && -e $self->{isisdb}.".FDT") {
# Line 132  sub new { Line 160  sub new {
160          # NXTMFP        offset to next available position in last block          # NXTMFP        offset to next available position in last block
161          # MFTYPE        always 0 for user db file (1 for system)          # MFTYPE        always 0 for user db file (1 for system)
162          seek(fileMST,4,0);          seek(fileMST,4,0);
163          $self->{'NXTMFN'}=$self->Read32(\*fileMST) || carp "NXTNFN is zero";  
164            my $buff;
165    
166            read(fileMST, $buff, 4);
167            $self->{'NXTMFN'}=unpack("l",$buff) || carp "NXTNFN is zero";
168    
169            # save maximum MFN
170            $self->{'maxmfn'} = $self->{'NXTMFN'} - 1;
171    
172          close(fileMST);          close(fileMST);
173    
# Line 162  sub new { Line 197  sub new {
197                  my $buff = shift || return;                  my $buff = shift || return;
198                  my @arr = unpack("ssssssllls", $buff);                  my @arr = unpack("ssssssllls", $buff);
199    
200                    print "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'});
201    
202                  my $IDTYPE = shift @arr;                  my $IDTYPE = shift @arr;
203                  foreach (@flds) {                  foreach (@flds) {
204                          $self->{$IDTYPE}->{$_} = abs(shift @arr);                          $self->{$IDTYPE}->{$_} = abs(shift @arr);
205                  }                  }
206          }          }
207    
         my $buff;  
208          read(fileCNT, $buff, 26);          read(fileCNT, $buff, 26);
209          $self->unpack_cnt($buff);          $self->unpack_cnt($buff);
210    
# Line 180  sub new { Line 216  sub new {
216    
217          print Dumper($self) if ($self->{debug});          print Dumper($self) if ($self->{debug});
218    
219            # open files for later
220            open($self->{'fileXRF'}, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!";
221    
222            open($self->{'fileMST'}, $self->{isisdb}.".MST") || croak "can't open '$self->{isisdb}.MST': $!";
223    
224          $self ? return $self : return undef;          $self ? return $self : return undef;
225  }  }
226    
227    =head2 fetch
228    
229  # 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  
230    
231  sub GetMFN {    my $rec = $isis->fetch(55);
232          my $self = shift;  
233    Returns hash with keys which are field names and values are unpacked values
234    for that field (like C<^asometing^bsomething else>)
235    
236          my $mfn = shift || croak "GetMFN needs MFN as argument!";  =cut
237    
238          print "GetMFN: $mfn\n" if ($self->{debug});  sub fetch {
239            my $self = shift;
240    
241          open(fileXRF, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!";          my $mfn = shift || croak "fetch needs MFN as argument!";
242    
243            print "fetch: $mfn\n" if ($self->{debug});
244    
245          # XXX check this?          # XXX check this?
246          my $mfnpos=($mfn+int(($mfn-1)/127))*4;          my $mfnpos=($mfn+int(($mfn-1)/127))*4;
247    
248          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});
249          seek(fileXRF,$mfnpos,0);          seek($self->{'fileXRF'},$mfnpos,0);
250    
251            my $buff;
252    
253          # read XRFMFB abd XRFMFP          # read XRFMFB abd XRFMFP
254          my $pointer=$self->Read32(\*fileXRF);          read($self->{'fileXRF'}, $buff, 4);
255            my $pointer=unpack("l",$buff) || carp "pointer is null";
256    
257          my $XRFMFB = int($pointer/2048);          my $XRFMFB = int($pointer/2048);
258          my $XRFMFP = $pointer - ($XRFMFB*2048);          my $XRFMFP = $pointer - ($XRFMFB*2048);
# Line 226  sub GetMFN { Line 273  sub GetMFN {
273    
274          print "$offset - $offset2 - $offset3 - $offset4\n" if ($self->{debug});          print "$offset - $offset2 - $offset3 - $offset4\n" if ($self->{debug});
275    
         close(fileXRF);  
   
276          # Get Record Information          # Get Record Information
277    
278          open(fileMST, $self->{isisdb}.".MST") || croak "can't open '$self->{isisdb}.MST': $!";          seek($self->{'fileMST'},$offset4,0);
   
         seek(fileMST,$offset4,0);  
279    
280          my $value=$self->Read32(\*fileMST);          read($self->{'fileMST'}, $buff, 4);
281            my $value=unpack("l",$buff);
282    
283          if ($value!=$mfn) {          if ($value!=$mfn) {
284  print ("Error: The MFN:".$mfn." is not found in MST(".$value.")");      print ("Error: The MFN:".$mfn." is not found in MST(".$value.")");    
# Line 248  print ("Error: The MFN:".$mfn." is not f Line 292  print ("Error: The MFN:".$mfn." is not f
292  #       $NVF=$self->Read16($fileMST);  #       $NVF=$self->Read16($fileMST);
293  #       $STATUS=$self->Read16($fileMST);  #       $STATUS=$self->Read16($fileMST);
294    
295          my $buff;          read($self->{'fileMST'}, $buff, 14);
         read(fileMST, $buff, 14);  
296    
297          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);
298    
299          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});
300    
301            # delete old record
302            delete $self->{record};
303    
304            if (! $self->{'include_deleted'} && $MFRL < 0) {
305                    print "## logically deleted record $mfn, skipping...\n" if ($self->{debug});
306                    return;
307            }
308    
309          # Get Directory Format          # Get Directory Format
310    
311          my @FieldPOS;          my @FieldPOS;
312          my @FieldLEN;          my @FieldLEN;
313          my @FieldTAG;          my @FieldTAG;
314    
315            read($self->{'fileMST'}, $buff, 6 * $NVF);
316    
317            my $fld_len = 0;
318    
319          for (my $i = 0 ; $i < $NVF ; $i++) {          for (my $i = 0 ; $i < $NVF ; $i++) {
320    
321  #               $TAG=$self->Read16($fileMST);  #               $TAG=$self->Read16($fileMST);
322  #               $POS=$self->Read16($fileMST);  #               $POS=$self->Read16($fileMST);
323  #               $LEN=$self->Read16($fileMST);  #               $LEN=$self->Read16($fileMST);
324    
325                  read(fileMST, $buff, 6);                  my ($TAG,$POS,$LEN) = unpack("sss", substr($buff,$i * 6, 6));
                 my ($TAG,$POS,$LEN) = unpack("sss", $buff);  
326    
327                  print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});                  print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});
328    
# Line 285  print ("Error: The MFN:".$mfn." is not f Line 339  print ("Error: The MFN:".$mfn." is not f
339                  push @FieldTAG,$TAG;                  push @FieldTAG,$TAG;
340                  push @FieldPOS,$POS;                  push @FieldPOS,$POS;
341                  push @FieldLEN,$LEN;                  push @FieldLEN,$LEN;
342    
343                    $fld_len += $LEN;
344          }          }
345    
346          # Get Variable Fields          # Get Variable Fields
347    
348            read($self->{'fileMST'},$buff,$fld_len);
349    
350          for (my $i = 0 ; $i < $NVF ; $i++) {          for (my $i = 0 ; $i < $NVF ; $i++) {
351                  my $rec;                  # skip zero-sized fields
352                  read(fileMST,$rec,$FieldLEN[$i]);                  next if ($FieldLEN[$i] == 0);
                 $self->{record}->{$FieldTAG[$i]} = $rec;  
         }  
         close(fileMST);  
353    
354          # The record is marked for deletion                  push @{$self->{record}->{$FieldTAG[$i]}}, substr($buff,$FieldPOS[$i],$FieldLEN[$i]);
         if ($STATUS==1) {  
                 return -1;  
355          }          }
356            close(fileMST);
357    
358          print Dumper($self) if ($self->{debug});          print Dumper($self) if ($self->{debug});
359    
360          return $NVF;          return $self->{'record'};
361  }  }
362    
363  =begin php  =head2 to_ascii
   
   # 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));  
364    
365      fclose($fileL01);  Dump ascii output of selected MFN
   }  
   
   # self function search through the tree and returns an array of pointers to IFP  
   # The function must be recursive  
366    
367    sub SearchTree($search,$fileNB,$PUNT)    print $isis->to_ascii(55);
   {        
       $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;  
   }  
368    
369    # Search ISIS for record containing search  =cut
   # Return a sorted array of MFN  
370    
371    sub Search($search)  sub to_ascii {
372    {          my $self = shift;
373    
374    $search=strtoupper($search);          my $mfn = shift || croak "need MFN";
 #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;  
   }  
375    
376  =cut          my $rec = $self->fetch($mfn);
377    
378  #          my $out = "0\t$mfn";
 # XXX porting from php left-over:  
 #  
 # do I *REALLY* need those methods, or should I use  
 # $self->{something} directly?  
 #  
 # Probably direct usage is better!  
 #  
379    
380  sub GetFieldName {          foreach my $f (sort keys %{$rec}) {
381          my $self = shift;                  $out .= "\n$f\t".join("\n$f\t",@{$self->{record}->{$f}});
382          return $self->{FieldName};          }
 }  
383    
384  sub GetTagName {          $out .= "\n";
         my $self = shift;  
         return $self->{TagName};  
 }  
385    
386  sub GetFieldTag {          return $out;
         my $self = shift;  
         return $self->{FieldTAG};  
387  }  }
388    
389  sub GetNextMFN {  =head2 to_hash
         my $self = shift;  
         return $self->{NXTMFN};  
 }  
390    
391  sub GetMFNArray {  Read mfn and convert it to hash
         my $self = shift;  
         return $self->{MFNArray};  
 }  
 =begin php  
392    
393    sub Read32($fileNB)    my $hash = $isis->to_hash($mfn);
   {  
     $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.")";  
394    
395      return $value;    It has ability to convert characters (using C<hash_filter> from ISIS
396    }  database before creating structures enabling character remapping or quick
397    fixup of data.
398    
399    This function returns hash which is like this:
400    
401      $hash = {
402        '210' => [
403                   {
404                     'c' => 'New York University press',
405                     'a' => 'New York',
406                     'd' => 'cop. 1988'
407                   }
408                 ],
409        '990' => [
410                   '2140',
411                   '88',
412                   'HAY'
413                 ],
414      };
415    
416    sub Read24($fileNB)  You can later use that has to produce any output from ISIS data.
   {  
     $B1=ord(fread($fileNB,1));  
     $B2=ord(fread($fileNB,1));  
     $B3=ord(fread($fileNB,1));  
417    
418      $value=$B1+$B2*256+$B3*65536;  =cut
419    
420  #    print "(".$B1.",".$B2.",".$B3.":".$value.")";  sub to_hash {
421            my $self = shift;
422    
423      return $value;            my $mfn = shift || confess "need mfn!";
   }  
424    
425    sub Read16($fileNB)          my $rec;
426    {          my $row = $self->fetch($mfn);
     $B1=ord(fread($fileNB,1));  
     $B2=ord(fread($fileNB,1));  
427    
428      $value=$B1+$B2*256;          foreach my $k (keys %{$row}) {
429  #    print "(".$B1.",".$B2.":".$value.")";                  foreach my $l (@{$row->{$k}}) {
430    
431      return $value;                            # filter output
432    }                          $l = $self->{'hash_filter'}->($l) if ($self->{'hash_filter'});
433    
434                            # has subfields?
435                            my $val;
436                            if ($l =~ m/\^/) {
437                                    foreach my $t (split(/\^/,$l)) {
438                                            next if (! $t);
439                                            $val->{substr($t,0,1)} = substr($t,1);
440                                    }
441                            } else {
442                                    $val = $l;
443                            }
444    
445    sub Read8($fileNB)                          push @{$rec->{$k}}, $val;
446    {                  }
447      $B1=ord(fread($fileNB,1));          }
448    
449      $value=$B1;          return $rec;
450  #    print "(".$value.")";  }
451    
452      return $value;    #
453    }  # XXX porting from php left-over:
454    #
455    # do I *REALLY* need those methods, or should I use
456    # $self->{something} directly?
457    #
458    # Probably direct usage is better!
459    #
460    
461    sub Not8($value)  sub TagName {
462    {          my $self = shift;
463      $value=decbin($value);          return $self->{TagName};
     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;  
   }  
464  }  }
465    
466  =cut  sub NextMFN {
467            my $self = shift;
468            return $self->{NXTMFN};
469    }
470    
471  1;  1;
 __END__  
472    
473  =head1 BUGS  =head1 BUGS
474    
Legend:
Removed from v.1  
changed lines
  Added in v.12
  ViewVC Help
Powered by ViewVC 1.1.26