/[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 33 by dpavlin, Wed Jan 5 21:23:04 2005 UTC trunk/lib/Biblio/Isis.pm revision 44 by dpavlin, Thu Jul 6 11:02:37 2006 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.09;          $VERSION     = 0.13;
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    
# Line 81  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 147  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                  croak "missing ",uc($ext)," file in ",$self->{isisdb} unless ($self->{$ext."_file"});                  unless ($self->{$ext."_file"}) {
151                            carp "missing ",uc($ext)," file in ",$self->{isisdb};
152                            return;
153                    }
154          }          }
155    
156          print STDERR "## using files: ",join(" ",@isis_files),"\n" if ($self->{debug});          print STDERR "## using files: ",join(" ",@isis_files),"\n" if ($self->{debug});
# Line 192  sub new { Line 195  sub new {
195          # NXTMFB*       last block allocated to master file          # NXTMFB*       last block allocated to master file
196          # NXTMFP        offset to next available position in last block          # NXTMFP        offset to next available position in last block
197          # MFTYPE        always 0 for user db file (1 for system)          # MFTYPE        always 0 for user db file (1 for system)
198          seek($self->{'fileMST'},4,0) || carp "can't seek to offset 0 in MST: $!";          seek($self->{'fileMST'},4,0) || croak "can't seek to offset 0 in MST: $!";
199    
200          my $buff;          my $buff;
201    
202          read($self->{'fileMST'}, $buff, 4) || carp "can't read NXTMFN from MST: $!";          read($self->{'fileMST'}, $buff, 4) || croak "can't read NXTMFN from MST: $!";
203          $self->{'NXTMFN'}=unpack("V",$buff) || carp "NXTNFN is zero";          $self->{'NXTMFN'}=unpack("V",$buff) || croak "NXTNFN is zero";
204    
205          print STDERR Dumper($self),"\n" if ($self->{debug});          print STDERR Dumper($self),"\n" if ($self->{debug});
206    
# Line 221  sub count { Line 224  sub count {
224          return $self->{'NXTMFN'} - 1;          return $self->{'NXTMFN'} - 1;
225  }  }
226    
 =head2 read_cnt  
   
 Read content of C<.CNT> file and return hash containing it.  
   
   print Dumper($isis->read_cnt);  
   
 This function is not used by module (C<.CNT> files are not required for this  
 module to work), but it can be useful to examine your index (while debugging  
 for example).  
   
 =cut  
   
 sub read_cnt  {  
         my $self = shift;  
   
         croak "missing CNT file in ",$self->{isisdb} unless ($self->{cnt_file});  
   
         # Get the index information from $db.CNT  
     
         open(my $fileCNT, $self->{cnt_file}) || carp "can't read '$self->{cnt_file}': $!";  
         binmode($fileCNT);  
   
         my $buff;  
   
         read($fileCNT, $buff, 26) || carp "can't read first table from CNT: $!";  
         $self->unpack_cnt($buff);  
   
         read($fileCNT, $buff, 26) || carp "can't read second table from CNT: $!";  
         $self->unpack_cnt($buff);  
   
         close($fileCNT);  
   
         return $self->{cnt};  
 }  
   
 =head2 unpack_cnt  
   
 Unpack one of two 26 bytes fixed length record in C<.CNT> file.  
   
 Here is definition of record:  
   
  off key        description                             size  
   0: IDTYPE     BTree type                              s  
   2: ORDN       Nodes Order                             s  
   4: ORDF       Leafs Order                             s  
   6: N          Number of Memory buffers for nodes      s  
   8: K          Number of buffers for first level index s  
  10: LIV        Current number of Index Levels          s  
  12: POSRX      Pointer to Root Record in N0x           l  
  16: NMAXPOS    Next Available position in N0x          l  
  20: FMAXPOS    Next available position in L0x          l  
  24: ABNORMAL   Formal BTree normality indicator        s  
  length: 26 bytes  
   
 This will fill C<$self> object under C<cnt> with hash. It's used by C<read_cnt>.  
   
 =cut  
   
 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("vvvvvvVVVv", $buff);  
   
         print STDERR "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'});  
   
         my $IDTYPE = shift @arr;  
         foreach (@flds) {  
                 $self->{cnt}->{$IDTYPE}->{$_} = abs(shift @arr);  
         }  
 }  
   
227  =head2 fetch  =head2 fetch
228    
229  Read record with selected MFN  Read record with selected MFN
# Line 335  sub fetch { Line 264  sub fetch {
264    
265          # read XRFMFB abd XRFMFP          # read XRFMFB abd XRFMFP
266          read($self->{'fileXRF'}, $buff, 4);          read($self->{'fileXRF'}, $buff, 4);
267          my $pointer=unpack("V",$buff) || carp "pointer is null";          my $pointer=unpack("V",$buff);
268            if (! $pointer) {
269                    if ($self->{include_deleted}) {
270                            return;
271                    } else {
272                            warn "pointer for MFN $mfn is null\n";
273                            return;
274                    }
275            }
276    
277          # check for logically deleted record          # check for logically deleted record
278          if ($pointer & 0x80000000) {          if ($pointer & 0x80000000) {
# Line 464  sub to_ascii { Line 401  sub to_ascii {
401    
402          my $mfn = shift || croak "need MFN";          my $mfn = shift || croak "need MFN";
403    
404          my $rec = $self->fetch($mfn);          my $rec = $self->fetch($mfn) || return;
405    
406          my $out = "0\t$mfn";          my $out = "0\t$mfn";
407    
# Line 532  sub to_hash { Line 469  sub to_hash {
469          # init record to include MFN as field 000          # init record to include MFN as field 000
470          my $rec = { '000' => [ $mfn ] };          my $rec = { '000' => [ $mfn ] };
471    
472          my $row = $self->fetch($mfn);          my $row = $self->fetch($mfn) || return;
473    
474          foreach my $k (keys %{$row}) {          foreach my $k (keys %{$row}) {
475                  foreach my $l (@{$row->{$k}}) {                  foreach my $l (@{$row->{$k}}) {
476    
477                          # filter output                          # filter output
478                          $l = $self->{'hash_filter'}->($l) if ($self->{'hash_filter'});                          if ($self->{'hash_filter'}) {
479                                    $l = $self->{'hash_filter'}->($l);
480                                    next unless defined($l);
481                            }
482    
483                          my $val;                          my $val;
484    
# Line 576  sub tag_name { Line 516  sub tag_name {
516          return $self->{'TagName'}->{$tag} || $tag;          return $self->{'TagName'}->{$tag} || $tag;
517  }  }
518    
519    
520    =head2 read_cnt
521    
522    Read content of C<.CNT> file and return hash containing it.
523    
524      print Dumper($isis->read_cnt);
525    
526    This function is not used by module (C<.CNT> files are not required for this
527    module to work), but it can be useful to examine your index (while debugging
528    for example).
529    
530    =cut
531    
532    sub read_cnt  {
533            my $self = shift;
534    
535            croak "missing CNT file in ",$self->{isisdb} unless ($self->{cnt_file});
536    
537            # Get the index information from $db.CNT
538      
539            open(my $fileCNT, $self->{cnt_file}) || croak "can't read '$self->{cnt_file}': $!";
540            binmode($fileCNT);
541    
542            my $buff;
543    
544            read($fileCNT, $buff, 26) || croak "can't read first table from CNT: $!";
545            $self->unpack_cnt($buff);
546    
547            read($fileCNT, $buff, 26) || croak "can't read second table from CNT: $!";
548            $self->unpack_cnt($buff);
549    
550            close($fileCNT);
551    
552            return $self->{cnt};
553    }
554    
555    =head2 unpack_cnt
556    
557    Unpack one of two 26 bytes fixed length record in C<.CNT> file.
558    
559    Here is definition of record:
560    
561     off key        description                             size
562      0: IDTYPE     BTree type                              s
563      2: ORDN       Nodes Order                             s
564      4: ORDF       Leafs Order                             s
565      6: N          Number of Memory buffers for nodes      s
566      8: K          Number of buffers for first level index s
567     10: LIV        Current number of Index Levels          s
568     12: POSRX      Pointer to Root Record in N0x           l
569     16: NMAXPOS    Next Available position in N0x          l
570     20: FMAXPOS    Next available position in L0x          l
571     24: ABNORMAL   Formal BTree normality indicator        s
572     length: 26 bytes
573    
574    This will fill C<$self> object under C<cnt> with hash. It's used by C<read_cnt>.
575    
576    =cut
577    
578    sub unpack_cnt {
579            my $self = shift;
580    
581            my @flds = qw(ORDN ORDF N K LIV POSRX NMAXPOS FMAXPOS ABNORMAL);
582    
583            my $buff = shift || return;
584            my @arr = unpack("vvvvvvVVVv", $buff);
585    
586            print STDERR "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'});
587    
588            my $IDTYPE = shift @arr;
589            foreach (@flds) {
590                    $self->{cnt}->{$IDTYPE}->{$_} = abs(shift @arr);
591            }
592    }
593    
594  1;  1;
595    
596  =head1 BUGS  =head1 BUGS
Legend:
Removed from v.33  
changed lines
  Added in v.44
  ViewVC Help
Powered by ViewVC 1.1.26