9 use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
12 #Give a hoot don't pollute, do not export more than needed by default
21 IsisDB - Read CDS/ISIS database
26 my $isis = new IsisDB(
27 isisdb => './cds/cds',
32 This module will read CDS/ISIS databases and create hash values out of it.
33 It can be used as perl-only alternative to OpenIsis module.
39 # my $ORDN; # Nodes Order
40 # my $ORDF; # Leafs Order
41 # my $N; # Number of Memory buffers for nodes
42 # my $K; # Number of buffers for first level index
43 # my $LIV; # Current number of Index Levels
44 # my $POSRX; # Pointer to Root Record in N0x
45 # my $NMAXPOS; # Next Available position in N0x
46 # my $FMAXPOS; # Next available position in L0x
47 # my $ABNORMAL; # Formal BTree normality indicator
56 my $f = shift || die "Read32 needs file handle";
57 read($$f,$b,4) || die "can't read 4 bytes from $$f from position ".tell($f);
58 return unpack("l",$b);
63 Open CDS/ISIS database
65 my $isis = new IsisDB(
66 isisdb => './cds/cds',
71 Options are described below:
77 Prefix path to CDS/ISIS. It should contain full or relative path to database
78 and common prefix of C<.FDT>, C<.MST>, C<.CNT>, C<.XRF> and C<.MST> files.
82 Boolean flag to specify if field definition table should be read. It's off
87 Dump a C<lot> of debugging output.
91 It will also set C<$isis-E<gt>{'maxmfn'}> which is maximum MFN stored in database.
100 $self->{isisdb} = {@_}->{isisdb} || croak "new needs database name as argument!";
102 $self->{debug} = {@_}->{debug};
104 # if you want to read .FDT file use read_fdt argument when creating class!
105 if ({@_}->{read_fdt} && -e $self->{isisdb}.".FDT") {
107 # read the $db.FDT file for tags
110 open(fileFDT, $self->{isisdb}.".FDT") || croak "can't read '$self->{isisdb}.FDT': $!";
115 my $name=substr($_,0,30);
116 my $tag=substr($_,50,3);
121 $self->{'TagName'}->{$tag}=$name;
132 # Get the Maximum MFN from $db.MST
134 open(fileMST,$self->{isisdb}.".MST") || croak "can't read '$self->{isisdb}.MST': $!";
136 # MST format: (* = 32 bit signed)
138 # NXTMFN* MFN to be assigned to the next record created
139 # NXTMFB* last block allocated to master file
140 # NXTMFP offset to next available position in last block
141 # MFTYPE always 0 for user db file (1 for system)
143 $self->{'NXTMFN'}=$self->Read32(\*fileMST) || carp "NXTNFN is zero";
146 $self->{'maxmfn'} = $self->{'NXTMFN'} - 1;
150 # Get the index information from $db.CNT
152 open(fileCNT, $self->{isisdb}.".CNT") || croak "can't read '$self->{isisdb}.CNT': $!";
154 # There is two 26 Bytes fixed lenght records
156 # 0: IDTYPE BTree type 16
157 # 2: ORDN Nodes Order 16
158 # 4: ORDF Leafs Order 16
159 # 6: N Number of Memory buffers for nodes 16
160 # 8: K Number of buffers for first level index 16
161 # 10: LIV Current number of Index Levels 16
162 # 12: POSRX* Pointer to Root Record in N0x 32
163 # 16: NMAXPOS* Next Available position in N0x 32
164 # 20: FMAXPOS* Next available position in L0x 32
165 # 24: ABNORMAL Formal BTree normality indicator 16
171 my @flds = qw(ORDN ORDF N K LIV POSRX NMAXPOS FMAXPOS ABNORMAL);
173 my $buff = shift || return;
174 my @arr = unpack("ssssssllls", $buff);
176 my $IDTYPE = shift @arr;
178 $self->{$IDTYPE}->{$_} = abs(shift @arr);
183 read(fileCNT, $buff, 26);
184 $self->unpack_cnt($buff);
186 read(fileCNT, $buff, 26);
187 $self->unpack_cnt($buff);
192 print Dumper($self) if ($self->{debug});
194 $self ? return $self : return undef;
199 Read record with selected MFN
201 my $rec = $isis->GetMFN(55);
203 Returns hash with keys which are field names and values are unpacked values
211 my $mfn = shift || croak "GetMFN needs MFN as argument!";
213 print "GetMFN: $mfn\n" if ($self->{debug});
215 open(fileXRF, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!";
218 my $mfnpos=($mfn+int(($mfn-1)/127))*4;
220 print "seeking to $mfnpos in file '$self->{isisdb}.XRF'\n" if ($self->{debug});
221 seek(fileXRF,$mfnpos,0);
223 # read XRFMFB abd XRFMFP
224 my $pointer=$self->Read32(\*fileXRF);
226 my $XRFMFB = int($pointer/2048);
227 my $XRFMFP = $pointer - ($XRFMFB*2048);
229 print "XRFMFB: $XRFMFB XRFMFP: $XRFMFP\n" if ($self->{debug});
231 # XXX fix this to be more readable!!
232 # e.g. (XRFMFB - 1) * 512 + XRFMFP
234 my $offset = $pointer;
235 my $offset2=int($offset/2048)-1;
236 my $offset22=int($offset/4096);
237 my $offset3=$offset-($offset22*4096);
239 $offset3=$offset3-2048;
241 my $offset4=($offset2*512)+$offset3;
243 print "$offset - $offset2 - $offset3 - $offset4\n" if ($self->{debug});
247 # Get Record Information
249 open(fileMST, $self->{isisdb}.".MST") || croak "can't open '$self->{isisdb}.MST': $!";
251 seek(fileMST,$offset4,0);
253 my $value=$self->Read32(\*fileMST);
256 print ("Error: The MFN:".$mfn." is not found in MST(".$value.")");
257 return -1; # XXX deleted record?
260 # $MFRL=$self->Read16($fileMST);
261 # $MFBWB=$self->Read32($fileMST);
262 # $MFBWP=$self->Read16($fileMST);
263 # $BASE=$self->Read16($fileMST);
264 # $NVF=$self->Read16($fileMST);
265 # $STATUS=$self->Read16($fileMST);
268 read(fileMST, $buff, 14);
270 my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);
272 print "MFRL: $MFRL MFBWB: $MFBWB MFBWP: $MFBWP BASE: $BASE NVF: $NVF STATUS: $STATUS\n" if ($self->{debug});
274 # Get Directory Format
280 for (my $i = 0 ; $i < $NVF ; $i++) {
282 # $TAG=$self->Read16($fileMST);
283 # $POS=$self->Read16($fileMST);
284 # $LEN=$self->Read16($fileMST);
286 read(fileMST, $buff, 6);
287 my ($TAG,$POS,$LEN) = unpack("sss", $buff);
289 print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});
291 # The TAG does not exists in .FDT so we set it to 0.
293 # XXX This is removed from perl version; .FDT file is updated manually, so
294 # you will often have fields in .MST file which aren't in .FDT. On the other
295 # hand, IsisMarc doesn't use .FDT files at all!
297 #if (! $self->{TagName}->{$TAG}) {
306 # Get Variable Fields
308 delete $self->{record};
310 for (my $i = 0 ; $i < $NVF ; $i++) {
312 read(fileMST,$rec,$FieldLEN[$i]);
313 push @{$self->{record}->{$FieldTAG[$i]}}, $rec;
317 # The record is marked for deletion
322 print Dumper($self) if ($self->{debug});
324 return $self->{'record'};
329 Dump ascii output of selected MFN
331 print $isis->to_ascii(55);
338 my $mfn = shift || croak "need MFN";
340 my $rec = $self->GetMFN($mfn);
344 foreach my $f (sort keys %{$rec}) {
345 $out .= "\n$f\t".join("\n$f\t",@{$self->{record}->{$f}});
353 ################# old cruft which is not ported from php to perl
357 # Load the dictionary from the $db.L0x files.
362 $fileL01=fopen($self->{isisdb}.".L01","r");
368 $POS=$self->Read32($fileL01);
369 $OCK=$self->Read16($fileL01);
370 $IT=$self->Read16($fileL01);
371 $PS=$self->Read32($fileL01);
372 print "<br>PS:".$PS." ".$self->{ORDF}->{1}." ";
373 for ($i=0;$i<$OCK;$i++)
375 $KEY=fread($fileL01,10);
379 $INFO1=$self->Read32($fileL01);
380 $INFO2=$self->Read32($fileL01);
382 #L01Key->{$key}=array($INFO1,$INFO2);
386 $offset=($PS-1)*(12+$self->{ORDF}->{1}*18*2);
387 fseek($fileL01,$offset);
389 } While (!feof($fileL01));
394 # self function search through the tree and returns an array of pointers to IFP
395 # The function must be recursive
397 sub SearchTree($search,$fileNB,$PUNT)
399 $offset=(($PUNT-1)*(8+2*$self->{ORDN}->{1}*14));
403 fseek($fileNB,$offset);
405 $POS=$self->Read32($fileNB);
406 $OCK=$self->Read16($fileNB);
407 $IT=$self->Read16($fileNB);
409 #print "<br>".$POS." - ".$OCK." - ".$IT;
413 for ($i=0;$i<$OCK;$i++)
415 $KEY=fread($fileNB,10);
417 $PUNT=$self->Read32($fileNB);
419 #print " ## ".chop($KEY)."(".$PUNT."-".$OLDPUNT.") ## ";
421 If (strcmp($search,chop($KEY))<0)
431 # Search ISIS for record containing search
432 # Return a sorted array of MFN
437 $search=strtoupper($search);
438 #print "Searching....".$search." - ".$self->{POSRX}->{1}."<br>";
445 $fileN01=fopen($self->{isisdb}.".N01","r");
446 $offset=(($self->{POSRX}->{1}-1)*(8+2*$self->{ORDN}->{1}*14));
452 fseek($fileN01,$offset);
454 $POS=$self->Read32($fileN01);
455 $OCK=$self->Read16($fileN01);
456 $IT=$self->Read16($fileN01);
458 #print "<br>".$POS." - ".$OCK." - ".$IT;
461 for ($i=0;$i<$OCK;$i++)
463 $KEY=fread($fileN01,10);
465 $PUNT=$self->Read32($fileN01);
467 #print " ## ".chop($KEY)."(".$PUNT."-".$OLDPUNT.") ## ";
469 If (strcmp($search,chop($KEY))<0)
475 $offset=(($OLDPUNT-1)*(8+2*$self->{ORDN}->{1}*14));
476 } while ($OLDPUNT>0);
482 # Now look for records in .L01 file
483 $fileL01=fopen($self->{isisdb}.".L01","r");
486 $offset=(-$OLDPUNT-1)*(12+$self->{ORDF}->{1}*18*2);
487 fseek($fileL01,$offset);
489 $POS=$self->Read32($fileL01);
490 $OCK=$self->Read16($fileL01);
491 $IT=$self->Read16($fileL01);
492 $PS=$self->Read32($fileL01);
493 #print "<br>POS:".$POS." ".$self->{ORDF}->{1}." ";
494 for ($i=0;$i<$OCK;$i++)
496 $KEY=fread($fileL01,10);
500 $INFO1=$self->Read32($fileL01);
501 $INFO2=$self->Read32($fileL01);
503 If (strcmp($search,chop($KEY))==0)
511 #print $INFO1."--".$INFO2;
513 # Now look in .IFP for the MFN
514 $fileIFP=fopen($self->{isisdb}.".IFP","r");
516 $offset=($INFO1-1)*512+($INFO2*4);
517 fseek($fileIFP,$offset);
519 $IFPBLK=$self->Read32($fileIFP);
521 $IFPNXTB=$self->Read32($fileIFP);
522 $IFPNXTP=$self->Read32($fileIFP);
523 $IFPTOTP=$self->Read32($fileIFP);
524 $IFPSEGP=$self->Read32($fileIFP);
525 $IFPSEGC=$self->Read32($fileIFP);
528 #print "<br>IFP:".$IFPBLK." # ".$IFPNXTB." - ".$IFPNXTP." - ".$IFPTOTP." - ".$IFPSEGP." - ".$IFPSEGC;
531 $offset=($INFO1-1)*512+24+($INFO2*4);
532 fseek($fileIFP,$offset);
538 for ($i=0;$i<$IFPSEGP;$i++)
540 $B1=$self->Read8($fileIFP);
541 $B2=$self->Read8($fileIFP);
542 $B3=$self->Read8($fileIFP);
543 $B4=$self->Read8($fileIFP);
544 $B5=$self->Read8($fileIFP);
545 $B6=$self->Read8($fileIFP);
546 $B7=$self->Read8($fileIFP);
547 $B8=$self->Read8($fileIFP);
549 $PMFN=$B1*65536+$B2*256+$B3;
558 $self->{MFNArray}->{$l}=$PMFN;
565 #print "<br>".$PMFN."-".$PTAG." - ".$POCC." - ".$PCNT;
566 #print "@@".$j."@@@@";
569 if ($IFPNXTB==0 && $IFPNXTP==0)
573 $offset=($INFO1-1+$k)*512;
574 fseek($fileIFP,$offset);
575 $B=$self->Read32($fileIFP);
576 #print "<br>-".$B."-<br>";
581 $offset=($IFPNXTB-1)*512;
582 fseek($fileIFP,$offset);
584 $OLDIFPNXTB=$IFPNXTB;
585 $OLDIFPNXTP=$IFPNXTP;
587 $IFPBLK=$self->Read32($fileIFP);
589 $IFPNXTB=$self->Read32($fileIFP);
590 $IFPNXTP=$self->Read32($fileIFP);
591 $IFPTOTP=$self->Read32($fileIFP);
592 $IFPSEGP=$self->Read32($fileIFP);
593 $IFPSEGC=$self->Read32($fileIFP);
596 $offset=($OLDIFPNXTB-1)*512+24+($OLDIFPNXTP*4);
597 fseek($fileIFP,$offset);
599 $j=24+($OLDIFPNXTP*4);
613 # XXX porting from php left-over:
615 # do I *REALLY* need those methods, or should I use
616 # $self->{something} directly?
618 # Probably direct usage is better!
623 return $self->{FieldName};
628 return $self->{TagName};
633 return $self->{FieldTAG};
638 return $self->{NXTMFN};
643 return $self->{MFNArray};
649 $B1=ord(fread($fileNB,1));
650 $B2=ord(fread($fileNB,1));
651 $B3=ord(fread($fileNB,1));
652 $B4=ord(fread($fileNB,1));
656 $value=$B1+$B2*256+$B3*65536+$B4*16777216;
659 $value=$self->Not8($B1)+$self->Not8($B2)*256+$self->Not8($B3)*65536+$self->Not8($B4)*16777216;
662 # print "(".$B1.",".$B2.",".$B3.",".$B4.":".$value.")";
669 $B1=ord(fread($fileNB,1));
670 $B2=ord(fread($fileNB,1));
671 $B3=ord(fread($fileNB,1));
673 $value=$B1+$B2*256+$B3*65536;
675 # print "(".$B1.",".$B2.",".$B3.":".$value.")";
682 $B1=ord(fread($fileNB,1));
683 $B2=ord(fread($fileNB,1));
686 # print "(".$B1.",".$B2.":".$value.")";
693 $B1=ord(fread($fileNB,1));
696 # print "(".$value.")";
703 $value=decbin($value);
704 if (strlen($value)<8)
707 for($i=0;$i<(8-strlen($value));$i++)
711 $value=$buffer.$value;
713 $value=ereg_replace("0","3",$value);
714 $value=ereg_replace("1","0",$value);
715 $value=ereg_replace("3","1",$value);
716 $value=bindec($value);
728 This module has been very lightly tested. Use with caution and report bugs.
735 http://www.rot13.org/~dpavlin/
737 This module is based heavily on code from LIBISIS.PHP - Library to read ISIS files V0.1.1
738 written in php and (c) 2000 Franck Martin - <franck@sopac.org> released under LGPL.
742 This program is free software; you can redistribute
743 it and/or modify it under the same terms as Perl itself.
745 The full text of the license can be found in the
746 LICENSE file included with this module.
751 L<http://www.openisis.org|OpenIsis>, perl(1).