/[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 32 by dpavlin, Wed Jan 5 15:46:26 2005 UTC revision 33 by dpavlin, Wed Jan 5 21:23:04 2005 UTC
# Line 158  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 177  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 190  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) || carp "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) || carp "can't read NXTMFN from MST: $!";
200          $self->{'NXTMFN'}=unpack("l",$buff) || carp "NXTNFN is zero";          $self->{'NXTMFN'}=unpack("V",$buff) || carp "NXTNFN is zero";
   
   
   
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  }  }
# Line 240  sub read_cnt  { Line 240  sub read_cnt  {
240    
241          # Get the index information from $db.CNT          # Get the index information from $db.CNT
242        
243          open(fileCNT, $self->{cnt_file}) || croak "can't read '$self->{cnt_file}': $!";          open(my $fileCNT, $self->{cnt_file}) || carp "can't read '$self->{cnt_file}': $!";
244            binmode($fileCNT);
245    
246          my $buff;          my $buff;
247    
248          read(fileCNT, $buff, 26);          read($fileCNT, $buff, 26) || carp "can't read first table from CNT: $!";
249          $self->unpack_cnt($buff);          $self->unpack_cnt($buff);
250    
251          read(fileCNT, $buff, 26);          read($fileCNT, $buff, 26) || carp "can't read second table from CNT: $!";
252          $self->unpack_cnt($buff);          $self->unpack_cnt($buff);
253    
254          close(fileCNT);          close($fileCNT);
255    
256          return $self->{cnt};          return $self->{cnt};
257  }  }
# Line 284  sub unpack_cnt { Line 285  sub unpack_cnt {
285          my @flds = qw(ORDN ORDF N K LIV POSRX NMAXPOS FMAXPOS ABNORMAL);          my @flds = qw(ORDN ORDF N K LIV POSRX NMAXPOS FMAXPOS ABNORMAL);
286    
287          my $buff = shift || return;          my $buff = shift || return;
288          my @arr = unpack("ssssssllls", $buff);          my @arr = unpack("vvvvvvVVVv", $buff);
289    
290          print STDERR "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'});          print STDERR "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'});
291    
# Line 334  sub fetch { Line 335  sub fetch {
335    
336          # read XRFMFB abd XRFMFP          # read XRFMFB abd XRFMFP
337          read($self->{'fileXRF'}, $buff, 4);          read($self->{'fileXRF'}, $buff, 4);
338          my $pointer=unpack("l",$buff) || carp "pointer is null";          my $pointer=unpack("V",$buff) || carp "pointer is null";
339    
340          # check for logically deleted record          # check for logically deleted record
341          if ($pointer < 0) {          if ($pointer & 0x80000000) {
342                  print STDERR "## record $mfn is logically deleted\n" if ($self->{debug});                  print STDERR "## record $mfn is logically deleted\n" if ($self->{debug});
343                  $self->{deleted} = $mfn;                  $self->{deleted} = $mfn;
344    
345                  return unless $self->{include_deleted};                  return unless $self->{include_deleted};
346    
347                  $pointer = abs($pointer);                  # abs
348                    $pointer = ($pointer ^ 0xffffffff) + 1;
349          }          }
350    
351          my $XRFMFB = int($pointer/2048);          my $XRFMFB = int($pointer/2048);
# Line 358  sub fetch { Line 360  sub fetch {
360    
361          # Get Record Information          # Get Record Information
362    
363          seek($self->{'fileMST'},$blk_off,0);          seek($self->{'fileMST'},$blk_off,0) || croak "can't seek to $blk_off: $!";
364    
365          read($self->{'fileMST'}, $buff, 4);          read($self->{'fileMST'}, $buff, 4) || croak "can't read 4 bytes at offset $blk_off from MST file: $!";
366          my $value=unpack("l",$buff);          my $value=unpack("V",$buff);
367    
368          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});
369    
# Line 378  sub fetch { Line 380  sub fetch {
380    
381          read($self->{'fileMST'}, $buff, 14);          read($self->{'fileMST'}, $buff, 14);
382    
383          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("vVvvvv", $buff);
384    
385          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});
386    
# Line 398  sub fetch { Line 400  sub fetch {
400    
401          for (my $i = 0 ; $i < $NVF ; $i++) {          for (my $i = 0 ; $i < $NVF ; $i++) {
402    
403                  my ($TAG,$POS,$LEN) = unpack("sss", substr($buff,$i * 6, 6));                  my ($TAG,$POS,$LEN) = unpack("vvv", substr($buff,$i * 6, 6));
404    
405                  print STDERR "## TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});                  print STDERR "## TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});
406    

Legend:
Removed from v.32  
changed lines
  Added in v.33

  ViewVC Help
Powered by ViewVC 1.1.26