/[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

trunk/IsisDB.pm revision 18 by dpavlin, Thu Dec 30 22:40:53 2004 UTC trunk/Isis.pm revision 36 by dpavlin, Thu Jan 6 20:48:07 2005 UTC
# Line 1  Line 1 
1  package IsisDB;  package Biblio::Isis;
2  use strict;  use strict;
3    
4  use Carp;  use Carp;
# Line 9  use Data::Dumper; Line 9  use Data::Dumper;
9  BEGIN {  BEGIN {
10          use Exporter ();          use Exporter ();
11          use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);          use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
12          $VERSION     = 0.07;          $VERSION     = 0.10;
13          @ISA         = qw (Exporter);          @ISA         = qw (Exporter);
14          #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
15          @EXPORT      = qw ();          @EXPORT      = qw ();
# Line 20  BEGIN { Line 20  BEGIN {
20    
21  =head1 NAME  =head1 NAME
22    
23  IsisDB - Read CDS/ISIS, WinISIS and IsisMarc database  Biblio::Isis - Read CDS/ISIS, WinISIS and IsisMarc database
24    
25  =head1 SYNOPSIS  =head1 SYNOPSIS
26    
27    use IsisDB;    use Biblio::Isis;
28    
29    my $isis = new IsisDB(    my $isis = new Biblio::Isis(
30          isisdb => './cds/cds',          isisdb => './cds/cds',
31    );    );
32    
33    for(my $mfn = 1; $mfn <= $isis->{'maxmfn'}; $mfn++) {    for(my $mfn = 1; $mfn <= $isis->count; $mfn++) {
34          print $isis->to_ascii($mfn),"\n";          print $isis->to_ascii($mfn),"\n";
35    }    }
36    
37  =head1 DESCRIPTION  =head1 DESCRIPTION
38    
39  This module will read ISIS databases created by DOS CDS/ISIS, WinIsis or  This module will read ISIS databases created by DOS CDS/ISIS, WinIsis or
40  IsisMarc. It can be used as perl-only alternative to OpenIsis module.  IsisMarc. It can be used as perl-only alternative to OpenIsis module which
41    seems to depriciate it's old C<XS> bindings for perl.
42    
43  It can create hash values from data in ISIS database (using C<to_hash>),  It can create hash values from data in ISIS database (using C<to_hash>),
44  ASCII dump (using C<to_ascii>) or just hash with field names and packed  ASCII dump (using C<to_ascii>) or just hash with field names and packed
# Line 50  fields which are zero sized will be fill Line 51  fields which are zero sized will be fill
51  It also has support for identifiers (only if ISIS database is created by  It also has support for identifiers (only if ISIS database is created by
52  IsisMarc), see C<to_hash>.  IsisMarc), see C<to_hash>.
53    
54  This will module will always be slower than OpenIsis module which use C  This module will always be slower than OpenIsis module which use C
55  library. However, since it's written in perl, it's platform independent (so  library. However, since it's written in perl, it's platform independent (so
56  you don't need C compiler), and can be easily modified. I hope that it  you don't need C compiler), and can be easily modified. I hope that it
57  creates data structures which are easier to use than ones created by  creates data structures which are easier to use than ones created by
# Line 80  rarely an issue). Line 81  rarely an issue).
81    
82  Open ISIS database  Open ISIS database
83    
84   my $isis = new IsisDB(   my $isis = new Biblio::Isis(
85          isisdb => './cds/cds',          isisdb => './cds/cds',
86          read_fdt => 1,          read_fdt => 1,
87          include_deleted => 1,          include_deleted => 1,
# Line 122  Dump a B<lot> of debugging output. Line 123  Dump a B<lot> of debugging output.
123    
124  =back  =back
125    
 It will also set C<$isis-E<gt>{'maxmfn'}> which is maximum MFN stored in database.  
   
126  =cut  =cut
127    
128  sub new {  sub new {
# Line 148  sub new { Line 147  sub new {
147          push @must_exist, "fdt" if ($self->{read_fdt});          push @must_exist, "fdt" if ($self->{read_fdt});
148    
149          foreach my $ext (@must_exist) {          foreach my $ext (@must_exist) {
150                  confess "missing ",uc($ext)," file in ",$self->{isisdb} unless ($self->{$ext."_file"});                  croak "missing ",uc($ext)," file in ",$self->{isisdb} unless ($self->{$ext."_file"});
151          }          }
152    
153          print STDERR "## using files: ",join(" ",@isis_files),"\n" if ($self->{debug});          print STDERR "## using files: ",join(" ",@isis_files),"\n" if ($self->{debug});
# Line 159  sub new { Line 158  sub new {
158                  # read the $db.FDT file for tags                  # read the $db.FDT file for tags
159                  my $fieldzone=0;                  my $fieldzone=0;
160    
161                  open(fileFDT, $self->{fdt_file}) || croak "can't read '$self->{fdt_file}': $!";                  open(my $fileFDT, $self->{fdt_file}) || croak "can't read '$self->{fdt_file}': $!";
162                    binmode($fileFDT);
163    
164                  while (<fileFDT>) {                  while (<$fileFDT>) {
165                          chomp;                          chomp;
166                          if ($fieldzone) {                          if ($fieldzone) {
167                                  my $name=substr($_,0,30);                                  my $name=substr($_,0,30);
# Line 178  sub new { Line 178  sub new {
178                          }                          }
179                  }                  }
180                                    
181                  close(fileFDT);                  close($fileFDT);
182          }          }
183    
184          # Get the Maximum MFN from $db.MST          # Get the Maximum MFN from $db.MST
185    
186          open($self->{'fileMST'}, $self->{mst_file}) || croak "can't open '$self->{mst_file}': $!";          open($self->{'fileMST'}, $self->{mst_file}) || croak "can't open '$self->{mst_file}': $!";
187            binmode($self->{'fileMST'});
188    
189          # MST format:   (* = 32 bit signed)          # MST format:   (* = 32 bit signed)
190          # CTLMFN*       always 0          # CTLMFN*       always 0
# Line 191  sub new { Line 192  sub new {
192          # NXTMFB*       last block allocated to master file          # NXTMFB*       last block allocated to master file
193          # NXTMFP        offset to next available position in last block          # NXTMFP        offset to next available position in last block
194          # MFTYPE        always 0 for user db file (1 for system)          # MFTYPE        always 0 for user db file (1 for system)
195          seek($self->{'fileMST'},4,0);          seek($self->{'fileMST'},4,0) || croak "can't seek to offset 0 in MST: $!";
196    
197          my $buff;          my $buff;
198    
199          read($self->{'fileMST'}, $buff, 4);          read($self->{'fileMST'}, $buff, 4) || croak "can't read NXTMFN from MST: $!";
200          $self->{'NXTMFN'}=unpack("l",$buff) || carp "NXTNFN is zero";          $self->{'NXTMFN'}=unpack("V",$buff) || croak "NXTNFN is zero";
   
         # save maximum MFN  
         $self->{'maxmfn'} = $self->{'NXTMFN'} - 1;  
   
   
   
201    
202          print STDERR Dumper($self),"\n" if ($self->{debug});          print STDERR Dumper($self),"\n" if ($self->{debug});
203    
204          # open files for later          # open files for later
205          open($self->{'fileXRF'}, $self->{xrf_file}) || croak "can't open '$self->{xrf_file}': $!";          open($self->{'fileXRF'}, $self->{xrf_file}) || croak "can't open '$self->{xrf_file}': $!";
206            binmode($self->{'fileXRF'});
207    
208          $self ? return $self : return undef;          $self ? return $self : return undef;
209  }  }
210    
211  =head2 read_cnt  =head2 count
212    
213  This function is not really used by module, but can be useful to find info  Return number of records in database
 about your index (if debugging it for example).  
214    
215    print Dumper($isis->read_cnt);    print $isis->count;
216    
217  =cut  =cut
218    
219  sub read_cnt  {  sub count {
220          my $self = shift;          my $self = shift;
221            return $self->{'NXTMFN'} - 1;
         confess "missing CNT file in ",$self->{isisdb} unless ($self->{cnt_file});  
   
         # Get the index information from $db.CNT  
     
         open(fileCNT, $self->{cnt_file}) || croak "can't read '$self->{cnt_file}': $!";  
   
         # There is two 26 Bytes fixed lenght records  
   
         #  0: IDTYPE    BTree type                              16  
         #  2: ORDN      Nodes Order                             16  
         #  4: ORDF      Leafs Order                             16  
         #  6: N         Number of Memory buffers for nodes      16  
         #  8: K         Number of buffers for first level index 16  
         # 10: LIV       Current number of Index Levels          16  
         # 12: POSRX*    Pointer to Root Record in N0x           32  
         # 16: NMAXPOS*  Next Available position in N0x          32  
         # 20: FMAXPOS*  Next available position in L0x          32  
         # 24: ABNORMAL  Formal BTree normality indicator        16  
         # length: 26 bytes  
   
         sub unpack_cnt {  
                 my $self = shift;  
   
                 my @flds = qw(ORDN ORDF N K LIV POSRX NMAXPOS FMAXPOS ABNORMAL);  
   
                 my $buff = shift || return;  
                 my @arr = unpack("ssssssllls", $buff);  
   
                 print STDERR "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'});  
   
                 my $IDTYPE = shift @arr;  
                 foreach (@flds) {  
                         $self->{cnt}->{$IDTYPE}->{$_} = abs(shift @arr);  
                 }  
         }  
   
         my $buff;  
   
         read(fileCNT, $buff, 26);  
         $self->unpack_cnt($buff);  
   
         read(fileCNT, $buff, 26);  
         $self->unpack_cnt($buff);  
   
         close(fileCNT);  
   
         return $self->{cnt};  
222  }  }
223    
224  =head2 fetch  =head2 fetch
# Line 296  sub fetch { Line 244  sub fetch {
244    
245          # is mfn allready in memory?          # is mfn allready in memory?
246          my $old_mfn = $self->{'current_mfn'} || -1;          my $old_mfn = $self->{'current_mfn'} || -1;
247          return if ($mfn == $old_mfn);          return $self->{record} if ($mfn == $old_mfn);
248    
249          print STDERR "## fetch: $mfn\n" if ($self->{debug});          print STDERR "## fetch: $mfn\n" if ($self->{debug});
250    
# Line 308  sub fetch { Line 256  sub fetch {
256    
257          my $buff;          my $buff;
258    
259            # delete old record
260            delete $self->{record};
261    
262          # read XRFMFB abd XRFMFP          # read XRFMFB abd XRFMFP
263          read($self->{'fileXRF'}, $buff, 4);          read($self->{'fileXRF'}, $buff, 4);
264          my $pointer=unpack("l",$buff) || carp "pointer is null";          my $pointer=unpack("V",$buff) || croak "pointer is null";
265    
266            # check for logically deleted record
267            if ($pointer & 0x80000000) {
268                    print STDERR "## record $mfn is logically deleted\n" if ($self->{debug});
269                    $self->{deleted} = $mfn;
270    
271                    return unless $self->{include_deleted};
272    
273                    # abs
274                    $pointer = ($pointer ^ 0xffffffff) + 1;
275            }
276    
277          my $XRFMFB = int($pointer/2048);          my $XRFMFB = int($pointer/2048);
278          my $XRFMFP = $pointer - ($XRFMFB*2048);          my $XRFMFP = $pointer - ($XRFMFB*2048);
279    
   
280          # (XRFMFB - 1) * 512 + XRFMFP          # (XRFMFB - 1) * 512 + XRFMFP
281          # why do i have to do XRFMFP % 1024 ?          # why do i have to do XRFMFP % 1024 ?
282    
283          my $blk_off = (($XRFMFB - 1) * 512) + ($XRFMFP % 1024);          my $blk_off = (($XRFMFB - 1) * 512) + ($XRFMFP % 512);
284    
285          print STDERR "## pointer: $pointer XRFMFB: $XRFMFB XRFMFP: $XRFMFP offset: $blk_off\n" if ($self->{'debug'});          print STDERR "## pointer: $pointer XRFMFB: $XRFMFB XRFMFP: $XRFMFP offset: $blk_off\n" if ($self->{'debug'});
286    
287          # Get Record Information          # Get Record Information
288    
289          seek($self->{'fileMST'},$blk_off,0);          seek($self->{'fileMST'},$blk_off,0) || croak "can't seek to $blk_off: $!";
290    
291          read($self->{'fileMST'}, $buff, 4);          read($self->{'fileMST'}, $buff, 4) || croak "can't read 4 bytes at offset $blk_off from MST file: $!";
292          my $value=unpack("l",$buff);          my $value=unpack("V",$buff);
293    
294          print STDERR "## offset for rowid $value is $blk_off (blk $XRFMFB off $XRFMFP)\n" if ($self->{debug});          print STDERR "## offset for rowid $value is $blk_off (blk $XRFMFB off $XRFMFP)\n" if ($self->{debug});
295    
296          if ($value!=$mfn) {          if ($value!=$mfn) {
297                  carp "Error: MFN ".$mfn." not found in MST(".$value.")";                      if ($value == 0) {
298                  #return;                # XXX deleted record?                          print STDERR "## record $mfn is physically deleted\n" if ($self->{debug});
299          }                          $self->{deleted} = $mfn;
300                            return;
301                    }
302    
303  #       $MFRL=$self->Read16($fileMST);                  carp "Error: MFN ".$mfn." not found in MST file, found $value";    
304  #       $MFBWB=$self->Read32($fileMST);                  return;
305  #       $MFBWP=$self->Read16($fileMST);          }
 #       $BASE=$self->Read16($fileMST);  
 #       $NVF=$self->Read16($fileMST);  
 #       $STATUS=$self->Read16($fileMST);  
306    
307          read($self->{'fileMST'}, $buff, 14);          read($self->{'fileMST'}, $buff, 14);
308    
309          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("vVvvvv", $buff);
310    
311          print STDERR "## MFRL: $MFRL MFBWB: $MFBWB MFBWP: $MFBWP BASE: $BASE NVF: $NVF STATUS: $STATUS\n" if ($self->{debug});          print STDERR "## MFRL: $MFRL MFBWB: $MFBWB MFBWP: $MFBWP BASE: $BASE NVF: $NVF STATUS: $STATUS\n" if ($self->{debug});
312    
313          # delete old record          warn "MFRL $MFRL is not even number" unless ($MFRL % 2 == 0);
         delete $self->{record};  
   
         ## FIXME this is a bug  
         if (! $self->{'include_deleted'} && $MFRL < 0) {  
                 print "## logically deleted record $mfn, skipping...\n" if ($self->{debug});  
                 return;  
         }  
314    
315          warn "BASE is not 18+6*NVF" unless ($BASE == 18 + 6 * $NVF);          warn "BASE is not 18+6*NVF" unless ($BASE == 18 + 6 * $NVF);
316    
# Line 373  sub fetch { Line 326  sub fetch {
326    
327          for (my $i = 0 ; $i < $NVF ; $i++) {          for (my $i = 0 ; $i < $NVF ; $i++) {
328    
329  #               $TAG=$self->Read16($fileMST);                  my ($TAG,$POS,$LEN) = unpack("vvv", substr($buff,$i * 6, 6));
 #               $POS=$self->Read16($fileMST);  
 #               $LEN=$self->Read16($fileMST);  
   
                 my ($TAG,$POS,$LEN) = unpack("sss", substr($buff,$i * 6, 6));  
330    
331                  print STDERR "## TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});                  print STDERR "## TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});
332    
# Line 413  sub fetch { Line 362  sub fetch {
362    
363          $self->{'current_mfn'} = $mfn;          $self->{'current_mfn'} = $mfn;
364    
365          print Dumper($self),"\n" if ($self->{debug});          print STDERR Dumper($self),"\n" if ($self->{debug});
366    
367          return $self->{'record'};          return $self->{'record'};
368  }  }
369    
370  =head2 to_ascii  =head2 to_ascii
371    
372  Dump ASCII output of record with specified MFN  Returns ASCII output of record with specified MFN
373    
374    print $isis->to_ascii(42);    print $isis->to_ascii(42);
375    
376  It outputs something like this:  This outputs something like this:
377    
378    210   ^aNew York^cNew York University press^dcop. 1988    210   ^aNew York^cNew York University press^dcop. 1988
379    990   2140    990   2140
# Line 461  Read record with specified MFN and conve Line 410  Read record with specified MFN and conve
410    
411    my $hash = $isis->to_hash($mfn);    my $hash = $isis->to_hash($mfn);
412    
413  It has ability to convert characters (using C<hash_filter> from ISIS  It has ability to convert characters (using C<hash_filter>) from ISIS
414  database before creating structures enabling character re-mapping or quick  database before creating structures enabling character re-mapping or quick
415  fix-up of data.  fix-up of data.
416    
# Line 520  sub to_hash { Line 469  sub to_hash {
469                          my $val;                          my $val;
470    
471                          # has identifiers?                          # has identifiers?
472                          ($val->{'i1'},$val->{'i2'}) = ($1,$2) if ($l =~ s/^([01 #])([01 #])//);                          ($val->{'i1'},$val->{'i2'}) = ($1,$2) if ($l =~ s/^([01 #])([01 #])\^/\^/);
473    
474                          # has subfields?                          # has subfields?
475                          if ($l =~ m/\^/) {                          if ($l =~ m/\^/) {
# Line 553  sub tag_name { Line 502  sub tag_name {
502          return $self->{'TagName'}->{$tag} || $tag;          return $self->{'TagName'}->{$tag} || $tag;
503  }  }
504    
505    
506    =head2 read_cnt
507    
508    Read content of C<.CNT> file and return hash containing it.
509    
510      print Dumper($isis->read_cnt);
511    
512    This function is not used by module (C<.CNT> files are not required for this
513    module to work), but it can be useful to examine your index (while debugging
514    for example).
515    
516    =cut
517    
518    sub read_cnt  {
519            my $self = shift;
520    
521            croak "missing CNT file in ",$self->{isisdb} unless ($self->{cnt_file});
522    
523            # Get the index information from $db.CNT
524      
525            open(my $fileCNT, $self->{cnt_file}) || croak "can't read '$self->{cnt_file}': $!";
526            binmode($fileCNT);
527    
528            my $buff;
529    
530            read($fileCNT, $buff, 26) || croak "can't read first table from CNT: $!";
531            $self->unpack_cnt($buff);
532    
533            read($fileCNT, $buff, 26) || croak "can't read second table from CNT: $!";
534            $self->unpack_cnt($buff);
535    
536            close($fileCNT);
537    
538            return $self->{cnt};
539    }
540    
541    =head2 unpack_cnt
542    
543    Unpack one of two 26 bytes fixed length record in C<.CNT> file.
544    
545    Here is definition of record:
546    
547     off key        description                             size
548      0: IDTYPE     BTree type                              s
549      2: ORDN       Nodes Order                             s
550      4: ORDF       Leafs Order                             s
551      6: N          Number of Memory buffers for nodes      s
552      8: K          Number of buffers for first level index s
553     10: LIV        Current number of Index Levels          s
554     12: POSRX      Pointer to Root Record in N0x           l
555     16: NMAXPOS    Next Available position in N0x          l
556     20: FMAXPOS    Next available position in L0x          l
557     24: ABNORMAL   Formal BTree normality indicator        s
558     length: 26 bytes
559    
560    This will fill C<$self> object under C<cnt> with hash. It's used by C<read_cnt>.
561    
562    =cut
563    
564    sub unpack_cnt {
565            my $self = shift;
566    
567            my @flds = qw(ORDN ORDF N K LIV POSRX NMAXPOS FMAXPOS ABNORMAL);
568    
569            my $buff = shift || return;
570            my @arr = unpack("vvvvvvVVVv", $buff);
571    
572            print STDERR "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'});
573    
574            my $IDTYPE = shift @arr;
575            foreach (@flds) {
576                    $self->{cnt}->{$IDTYPE}->{$_} = abs(shift @arr);
577            }
578    }
579    
580  1;  1;
581    
582  =head1 BUGS  =head1 BUGS
583    
584  This module has been very lightly tested. Use with caution and report bugs.  Some parts of CDS/ISIS documentation are not detailed enough to exmplain
585    some variations in input databases which has been tested with this module.
586    When I was in doubt, I assumed that OpenIsis's implementation was right
587    (except for obvious bugs).
588    
589    However, every effort has been made to test this module with as much
590    databases (and programs that create them) as possible.
591    
592    I would be very greatful for success or failure reports about usage of this
593    module with databases from programs other than WinIsis and IsisMarc. I had
594    tested this against ouput of one C<isis.dll>-based application, but I don't
595    know any details about it's version.
596    
597  =head1 AUTHOR  =head1 AUTHOR
598    
Legend:
Removed from v.18  
changed lines
  Added in v.36
  ViewVC Help
Powered by ViewVC 1.1.26