From 5a6197e3a595e08faff9a7f4a139a982e73b4b89 Mon Sep 17 00:00:00 2001 From: Dobrica Pavlinusic Date: Wed, 5 Jan 2005 21:23:04 +0000 Subject: [PATCH] - make filehandles locally scoped - changed unpack to portable big-endian (so that it works on little-endian machines; tested with PearPC and OpenDarwin) - added carps where missing - added binmode when opening files - any argument to 002_isis.t will show debugging output git-svn-id: file:///home/dpavlin/svn/Biblio-Isis/trunk@33 4670fa4d-42ec-0310-ab5b-a66af6943492 --- IsisDB.pm | 46 ++++++++++++++++++++++++---------------------- t/002_isis.t | 3 +++ 2 files changed, 27 insertions(+), 22 deletions(-) diff --git a/IsisDB.pm b/IsisDB.pm index 75d4e5f..5a25d5b 100644 --- a/IsisDB.pm +++ b/IsisDB.pm @@ -158,9 +158,10 @@ sub new { # read the $db.FDT file for tags my $fieldzone=0; - 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}': $!"; + binmode($fileFDT); - while () { + while (<$fileFDT>) { chomp; if ($fieldzone) { my $name=substr($_,0,30); @@ -177,12 +178,13 @@ sub new { } } - close(fileFDT); + close($fileFDT); } # Get the Maximum MFN from $db.MST open($self->{'fileMST'}, $self->{mst_file}) || croak "can't open '$self->{mst_file}': $!"; + binmode($self->{'fileMST'}); # MST format: (* = 32 bit signed) # CTLMFN* always 0 @@ -190,20 +192,18 @@ sub new { # NXTMFB* last block allocated to master file # NXTMFP offset to next available position in last block # MFTYPE always 0 for user db file (1 for system) - seek($self->{'fileMST'},4,0); + seek($self->{'fileMST'},4,0) || carp "can't seek to offset 0 in MST: $!"; my $buff; - read($self->{'fileMST'}, $buff, 4); - $self->{'NXTMFN'}=unpack("l",$buff) || carp "NXTNFN is zero"; - - - + read($self->{'fileMST'}, $buff, 4) || carp "can't read NXTMFN from MST: $!"; + $self->{'NXTMFN'}=unpack("V",$buff) || carp "NXTNFN is zero"; print STDERR Dumper($self),"\n" if ($self->{debug}); # open files for later open($self->{'fileXRF'}, $self->{xrf_file}) || croak "can't open '$self->{xrf_file}': $!"; + binmode($self->{'fileXRF'}); $self ? return $self : return undef; } @@ -240,17 +240,18 @@ sub read_cnt { # Get the index information from $db.CNT - 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}': $!"; + binmode($fileCNT); my $buff; - read(fileCNT, $buff, 26); + read($fileCNT, $buff, 26) || carp "can't read first table from CNT: $!"; $self->unpack_cnt($buff); - read(fileCNT, $buff, 26); + read($fileCNT, $buff, 26) || carp "can't read second table from CNT: $!"; $self->unpack_cnt($buff); - close(fileCNT); + close($fileCNT); return $self->{cnt}; } @@ -284,7 +285,7 @@ sub unpack_cnt { my @flds = qw(ORDN ORDF N K LIV POSRX NMAXPOS FMAXPOS ABNORMAL); my $buff = shift || return; - my @arr = unpack("ssssssllls", $buff); + my @arr = unpack("vvvvvvVVVv", $buff); print STDERR "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'}); @@ -334,16 +335,17 @@ sub fetch { # read XRFMFB abd XRFMFP read($self->{'fileXRF'}, $buff, 4); - my $pointer=unpack("l",$buff) || carp "pointer is null"; + my $pointer=unpack("V",$buff) || carp "pointer is null"; # check for logically deleted record - if ($pointer < 0) { + if ($pointer & 0x80000000) { print STDERR "## record $mfn is logically deleted\n" if ($self->{debug}); $self->{deleted} = $mfn; return unless $self->{include_deleted}; - $pointer = abs($pointer); + # abs + $pointer = ($pointer ^ 0xffffffff) + 1; } my $XRFMFB = int($pointer/2048); @@ -358,10 +360,10 @@ sub fetch { # Get Record Information - seek($self->{'fileMST'},$blk_off,0); + seek($self->{'fileMST'},$blk_off,0) || croak "can't seek to $blk_off: $!"; - read($self->{'fileMST'}, $buff, 4); - my $value=unpack("l",$buff); + read($self->{'fileMST'}, $buff, 4) || croak "can't read 4 bytes at offset $blk_off from MST file: $!"; + my $value=unpack("V",$buff); print STDERR "## offset for rowid $value is $blk_off (blk $XRFMFB off $XRFMFP)\n" if ($self->{debug}); @@ -378,7 +380,7 @@ sub fetch { read($self->{'fileMST'}, $buff, 14); - my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff); + my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("vVvvvv", $buff); print STDERR "## MFRL: $MFRL MFBWB: $MFBWB MFBWP: $MFBWP BASE: $BASE NVF: $NVF STATUS: $STATUS\n" if ($self->{debug}); @@ -398,7 +400,7 @@ sub fetch { for (my $i = 0 ; $i < $NVF ; $i++) { - my ($TAG,$POS,$LEN) = unpack("sss", substr($buff,$i * 6, 6)); + my ($TAG,$POS,$LEN) = unpack("vvv", substr($buff,$i * 6, 6)); print STDERR "## TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug}); diff --git a/t/002_isis.t b/t/002_isis.t index 6594491..ec2d510 100755 --- a/t/002_isis.t +++ b/t/002_isis.t @@ -9,6 +9,7 @@ use Test::More tests => 110; BEGIN { use_ok( 'IsisDB' ); } +my $debug = shift @ARGV; my $isis; sub test_data { @@ -124,6 +125,7 @@ sub test_data { $isis = IsisDB->new ( isisdb => './data/winisis/BIBL', include_deleted => 1, + debug => $debug, ); print Dumper($isis); @@ -166,6 +168,7 @@ cmp_ok($isis->{deleted}, '==', 3, "MFN 3 is deleted"); $isis = IsisDB->new ( isisdb => './data/winisis/BIBL', + debug => $debug, ); ok(! $isis->fetch(3), "deleted not found"); -- 2.20.1