/[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 15 by dpavlin, Wed Dec 29 22:46:40 2004 UTC revision 16 by dpavlin, Thu Dec 30 17:16:34 2004 UTC
# Line 7  use Data::Dumper; Line 7  use Data::Dumper;
7  BEGIN {  BEGIN {
8          use Exporter ();          use Exporter ();
9          use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);          use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
10          $VERSION     = 0.05;          $VERSION     = 0.06;
11          @ISA         = qw (Exporter);          @ISA         = qw (Exporter);
12          #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
13          @EXPORT      = qw ();          @EXPORT      = qw ();
# Line 210  sub new { Line 210  sub new {
210                  my $buff = shift || return;                  my $buff = shift || return;
211                  my @arr = unpack("ssssssllls", $buff);                  my @arr = unpack("ssssssllls", $buff);
212    
213                  print "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'});                  print STDERR "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'});
214    
215                  my $IDTYPE = shift @arr;                  my $IDTYPE = shift @arr;
216                  foreach (@flds) {                  foreach (@flds) {
# Line 227  sub new { Line 227  sub new {
227    
228          close(fileCNT);          close(fileCNT);
229    
230          print Dumper($self),"\n" if ($self->{debug});          print STDERR Dumper($self),"\n" if ($self->{debug});
231    
232          # open files for later          # open files for later
233          open($self->{'fileXRF'}, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!";          open($self->{'fileXRF'}, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!";
# Line 258  sub fetch { Line 258  sub fetch {
258    
259          my $mfn = shift || croak "fetch needs MFN as argument!";          my $mfn = shift || croak "fetch needs MFN as argument!";
260    
261          print "fetch: $mfn\n" if ($self->{debug});          # is mfn allready in memory?
262            my $old_mfn = $self->{'current_mfn'} || -1;
263            return if ($mfn == $old_mfn);
264    
265            print STDERR "## fetch: $mfn\n" if ($self->{debug});
266    
267          # XXX check this?          # XXX check this?
268          my $mfnpos=($mfn+int(($mfn-1)/127))*4;          my $mfnpos=($mfn+int(($mfn-1)/127))*4;
269    
270          print "seeking to $mfnpos in file '$self->{isisdb}.XRF'\n" if ($self->{debug});          print STDERR "## seeking to $mfnpos in file '$self->{isisdb}.XRF'\n" if ($self->{debug});
271          seek($self->{'fileXRF'},$mfnpos,0);          seek($self->{'fileXRF'},$mfnpos,0);
272    
273          my $buff;          my $buff;
# Line 275  sub fetch { Line 279  sub fetch {
279          my $XRFMFB = int($pointer/2048);          my $XRFMFB = int($pointer/2048);
280          my $XRFMFP = $pointer - ($XRFMFB*2048);          my $XRFMFP = $pointer - ($XRFMFB*2048);
281    
         print "XRFMFB: $XRFMFB XRFMFP: $XRFMFP\n" if ($self->{debug});  
282    
283          # XXX fix this to be more readable!!          # (XRFMFB - 1) * 512 + XRFMFP
284          # e.g. (XRFMFB - 1) * 512 + XRFMFP          # why do i have to do XRFMFP % 1024 ?
285    
286          my $offset = $pointer;          my $blk_off = (($XRFMFB - 1) * 512) + ($XRFMFP % 1024);
         my $offset2=int($offset/2048)-1;  
         my $offset22=int($offset/4096);  
         my $offset3=$offset-($offset22*4096);  
         if ($offset3>512) {  
                 $offset3=$offset3-2048;  
         }  
         my $offset4=($offset2*512)+$offset3;  
287    
288          print "$offset - $offset2 - $offset3 - $offset4\n" if ($self->{debug});          print STDERR "## pointer: $pointer XRFMFB: $XRFMFB XRFMFP: $XRFMFP offset: $blk_off\n" if ($self->{'debug'});
289    
290          # Get Record Information          # Get Record Information
291    
292          seek($self->{'fileMST'},$offset4,0);          seek($self->{'fileMST'},$blk_off,0);
293    
294          read($self->{'fileMST'}, $buff, 4);          read($self->{'fileMST'}, $buff, 4);
295          my $value=unpack("l",$buff);          my $value=unpack("l",$buff);
296    
297            print STDERR "## offset for rowid $value is $blk_off (blk $XRFMFB off $XRFMFP)\n" if ($self->{debug});
298    
299          if ($value!=$mfn) {          if ($value!=$mfn) {
300  print ("Error: The MFN:".$mfn." is not found in MST(".$value.")");                      carp "Error: MFN ".$mfn." not found in MST(".$value.")";    
301                  return -1;      # XXX deleted record?                  #return;                # XXX deleted record?
302          }          }
303    
304  #       $MFRL=$self->Read16($fileMST);  #       $MFRL=$self->Read16($fileMST);
# Line 314  print ("Error: The MFN:".$mfn." is not f Line 312  print ("Error: The MFN:".$mfn." is not f
312    
313          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);          my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff);
314    
315          print "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});
316    
317          # delete old record          # delete old record
318          delete $self->{record};          delete $self->{record};
319    
320            ## FIXME this is a bug
321          if (! $self->{'include_deleted'} && $MFRL < 0) {          if (! $self->{'include_deleted'} && $MFRL < 0) {
322                  print "## logically deleted record $mfn, skipping...\n" if ($self->{debug});                  print "## logically deleted record $mfn, skipping...\n" if ($self->{debug});
323                  return;                  return;
324          }          }
325    
326            warn "BASE is not 18+6*NVF" unless ($BASE == 18 + 6 * $NVF);
327    
328          # Get Directory Format          # Get Directory Format
329    
330          my @FieldPOS;          my @FieldPOS;
# Line 332  print ("Error: The MFN:".$mfn." is not f Line 333  print ("Error: The MFN:".$mfn." is not f
333    
334          read($self->{'fileMST'}, $buff, 6 * $NVF);          read($self->{'fileMST'}, $buff, 6 * $NVF);
335    
336          my $fld_len = 0;          my $rec_len = 0;
337    
338          for (my $i = 0 ; $i < $NVF ; $i++) {          for (my $i = 0 ; $i < $NVF ; $i++) {
339    
# Line 342  print ("Error: The MFN:".$mfn." is not f Line 343  print ("Error: The MFN:".$mfn." is not f
343    
344                  my ($TAG,$POS,$LEN) = unpack("sss", substr($buff,$i * 6, 6));                  my ($TAG,$POS,$LEN) = unpack("sss", substr($buff,$i * 6, 6));
345    
346                  print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});                  print STDERR "## TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug});
347    
348                  # The TAG does not exists in .FDT so we set it to 0.                  # The TAG does not exists in .FDT so we set it to 0.
349                  #                  #
# Line 358  print ("Error: The MFN:".$mfn." is not f Line 359  print ("Error: The MFN:".$mfn." is not f
359                  push @FieldPOS,$POS;                  push @FieldPOS,$POS;
360                  push @FieldLEN,$LEN;                  push @FieldLEN,$LEN;
361    
362                  $fld_len += $LEN;                  $rec_len += $LEN;
363          }          }
364    
365          # Get Variable Fields          # Get Variable Fields
366    
367          read($self->{'fileMST'},$buff,$fld_len);          read($self->{'fileMST'},$buff,$rec_len);
368    
369            print STDERR "## rec_len: $rec_len poc: ",tell($self->{'fileMST'})."\n" if ($self->{debug});
370    
371          for (my $i = 0 ; $i < $NVF ; $i++) {          for (my $i = 0 ; $i < $NVF ; $i++) {
372                  # skip zero-sized fields                  # skip zero-sized fields
# Line 373  print ("Error: The MFN:".$mfn." is not f Line 376  print ("Error: The MFN:".$mfn." is not f
376          }          }
377          close(fileMST);          close(fileMST);
378    
379            $self->{'current_mfn'} = $mfn;
380    
381          print Dumper($self),"\n" if ($self->{debug});          print Dumper($self),"\n" if ($self->{debug});
382    
383          return $self->{'record'};          return $self->{'record'};
# Line 467  sub to_hash { Line 472  sub to_hash {
472          my $mfn = shift || confess "need mfn!";          my $mfn = shift || confess "need mfn!";
473    
474          # init record to include MFN as field 000          # init record to include MFN as field 000
475          my $rec = { '000' => $mfn };          my $rec = { '000' => [ $mfn ] };
476    
477          my $row = $self->fetch($mfn);          my $row = $self->fetch($mfn);
478    

Legend:
Removed from v.15  
changed lines
  Added in v.16

  ViewVC Help
Powered by ViewVC 1.1.26