- 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

diff --git a/IsisDB.pm b/IsisDB.pm
index 75d4e5f..5a25d5b 100644 (file)
--- a/IsisDB.pm
+++ b/IsisDB.pm
@@ -158,9 +158,10 @@ sub new {
                # read the $db.FDT file for tags
                my $fieldzone=0;
 
                # 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 (<fileFDT>) {
+               while (<$fileFDT>) {

                        chomp;
                        if ($fieldzone) {
                                my $name=substr($_,0,30);
                        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}': $!";
        }
 
        # 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
 
        # 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)
        # 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;
 
 
        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}': $!";
 
        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;
 }
 
        $self ? return $self : return undef;
 }


@@ -240,17 +240,18 @@ sub read_cnt  {
 
        # Get the index information from $db.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;
 
 
        my $buff;
 

-       read(fileCNT, $buff, 26);
+       read($fileCNT, $buff, 26) || carp "can't read first table from CNT: $!";

        $self->unpack_cnt($buff);
 
        $self->unpack_cnt($buff);
 

-       read(fileCNT, $buff, 26);
+       read($fileCNT, $buff, 26) || carp "can't read second table from CNT: $!";

        $self->unpack_cnt($buff);
 
        $self->unpack_cnt($buff);
 

-       close(fileCNT);
+       close($fileCNT);

 
        return $self->{cnt};
 }
 
        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 @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'});
 
 
        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);
 
        # 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
 
        # 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};
 
                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);
        }
 
        my $XRFMFB = int($pointer/2048);


@@ -358,10 +360,10 @@ sub fetch {
 
        # Get Record Information
 
 
        # 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});
 
 
        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);
 
 
        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});
 
 
        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++) {
 
 
        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});
 
 
                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 (executable)
--- a/t/002_isis.t
+++ b/t/002_isis.t
@@ -9,6 +9,7 @@ use Test::More tests => 110;
 
 BEGIN { use_ok( 'IsisDB' ); }
 
 
 BEGIN { use_ok( 'IsisDB' ); }
 

+my $debug = shift @ARGV;

 my $isis;
 
 sub test_data {
 my $isis;
 
 sub test_data {


@@ -124,6 +125,7 @@ sub test_data {
 $isis = IsisDB->new (
        isisdb => './data/winisis/BIBL',
        include_deleted => 1,
 $isis = IsisDB->new (
        isisdb => './data/winisis/BIBL',
        include_deleted => 1,

+       debug => $debug,

 );
 
 print Dumper($isis);
 );
 
 print Dumper($isis);


@@ -166,6 +168,7 @@ cmp_ok($isis->{deleted}, '==', 3, "MFN 3 is deleted");
 
 $isis = IsisDB->new (
        isisdb => './data/winisis/BIBL',
 
 $isis = IsisDB->new (
        isisdb => './data/winisis/BIBL',

+       debug => $debug,

 );
 
 ok(! $isis->fetch(3), "deleted not found");
 );
 
 ok(! $isis->fetch(3), "deleted not found");