/[Biblio-Isis]/trunk/IsisDB.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/IsisDB.pm

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

revision 10 by dpavlin, Wed Dec 29 16:04:07 2004 UTC revision 11 by dpavlin, Wed Dec 29 17:03:52 2004 UTC
# 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 89  Dump a C<lot> of debugging output. Line 94  Dump a C<lot> of debugging output.
94    
95  =item include_deleted  =item include_deleted
96    
97  Don't skip logically deleted records.  Don't skip logically deleted records in ISIS.
98    
99  =back  =back
100    
# Line 147  sub new { Line 152  sub new {
152          # NXTMFP        offset to next available position in last block          # NXTMFP        offset to next available position in last block
153          # MFTYPE        always 0 for user db file (1 for system)          # MFTYPE        always 0 for user db file (1 for system)
154          seek(fileMST,4,0);          seek(fileMST,4,0);
155          $self->{'NXTMFN'}=$self->Read32(\*fileMST) || carp "NXTNFN is zero";  
156            my $buff;
157    
158            read(fileMST, $buff, 4);
159            $self->{'NXTMFN'}=unpack("l",$buff) || carp "NXTNFN is zero";
160    
161          # save maximum MFN          # save maximum MFN
162          $self->{'maxmfn'} = $self->{'NXTMFN'} - 1;          $self->{'maxmfn'} = $self->{'NXTMFN'} - 1;
# Line 188  sub new { Line 197  sub new {
197                  }                  }
198          }          }
199    
         my $buff;  
200          read(fileCNT, $buff, 26);          read(fileCNT, $buff, 26);
201          $self->unpack_cnt($buff);          $self->unpack_cnt($buff);
202    
# Line 232  sub fetch { Line 240  sub fetch {
240          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});
241          seek($self->{'fileXRF'},$mfnpos,0);          seek($self->{'fileXRF'},$mfnpos,0);
242    
243            my $buff;
244    
245          # read XRFMFB abd XRFMFP          # read XRFMFB abd XRFMFP
246          my $pointer=$self->Read32(\*{$self->{'fileXRF'}});          read($self->{'fileXRF'}, $buff, 4);
247            my $pointer=unpack("l",$buff) || carp "pointer is null";
248    
249          my $XRFMFB = int($pointer/2048);          my $XRFMFB = int($pointer/2048);
250          my $XRFMFP = $pointer - ($XRFMFB*2048);          my $XRFMFP = $pointer - ($XRFMFB*2048);
# Line 258  sub fetch { Line 269  sub fetch {
269    
270          seek($self->{'fileMST'},$offset4,0);          seek($self->{'fileMST'},$offset4,0);
271    
272          my $value=$self->Read32(\*{$self->{'fileMST'}});          read($self->{'fileMST'}, $buff, 4);
273            my $value=unpack("l",$buff);
274    
275          if ($value!=$mfn) {          if ($value!=$mfn) {
276  print ("Error: The MFN:".$mfn." is not found in MST(".$value.")");      print ("Error: The MFN:".$mfn." is not found in MST(".$value.")");    
# Line 272  print ("Error: The MFN:".$mfn." is not f Line 284  print ("Error: The MFN:".$mfn." is not f
284  #       $NVF=$self->Read16($fileMST);  #       $NVF=$self->Read16($fileMST);
285  #       $STATUS=$self->Read16($fileMST);  #       $STATUS=$self->Read16($fileMST);
286    
         my $buff;  
287          read($self->{'fileMST'}, $buff, 14);          read($self->{'fileMST'}, $buff, 14);
288    
289          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);

Legend:
Removed from v.10  
changed lines
  Added in v.11

  ViewVC Help
Powered by ViewVC 1.1.26