--- p5-Palm-1.4.0-snapshot/Palm/PDB.pm.orig Mon Nov 10 02:40:25 2003 +++ p5-Palm-1.4.0-snapshot/Palm/PDB.pm Wed Nov 10 21:54:40 2004 @@ -449,6 +449,48 @@ =cut #' +# _open +sub _open +{ + my($self, $mode, $fname) = @_; + + my $handle; + + if (ref($fname)) + { + # Already a filehandle + if (ref($fname) eq 'GLOB' + or UNIVERSAL::isa($fname,"IO::Seekable")) + { + $handle = $fname; + } + # Probably a reference to a SCALAR + else + { + unless (eval 'open $handle, $mode, $fname') + { + if ($@ ne '') + { + die "Open of \"$fname\" unsupported: $@\n"; + } + else + { + die "Can't open \"$fname\": $!\n"; + } + } + } + } + else + { + # Before 5.6.0 "autovivified file handles" don't exist + eval 'use IO::File; $handle = new IO::File' if $] < 5.006; + open $handle, "$mode $fname" + or die "Can't open \"$fname\": $!\n"; + } + + return $handle; +} + # Load sub Load { @@ -456,14 +498,14 @@ my $fname = shift; # Filename to read from my $buf; # Buffer into which to read stuff - # Open database file - open PDB, "< $fname" or die "Can't open \"$fname\": $!\n"; - binmode PDB; # Read as binary file under MS-DOS + my $handle = $self->_open('<', $fname); + + binmode $handle; # Read as binary file under MS-DOS # Get the size of the file. It'll be useful later - seek PDB, 0, 2; # 2 == SEEK_END. Seek to the end. - $self->{_size} = tell PDB; - seek PDB, 0, 0; # 0 == SEEK_START. Rewind to the beginning. + seek $handle, 0, 2; # 2 == SEEK_END. Seek to the end. + $self->{_size} = tell $handle; + seek $handle, 0, 0; # 0 == SEEK_START. Rewind to the beginning. # Read header my $name; @@ -479,7 +521,7 @@ my $creator; my $uniqueIDseed; - read PDB, $buf, $HeaderLen; # Read the PDB header + read $handle, $buf, $HeaderLen; # Read the PDB header # Split header into its component fields ($name, $attributes, $version, $ctime, $mtime, $baktime, @@ -563,7 +605,7 @@ ## Read record/resource index # Read index header - read PDB, $buf, $RecIndexHeaderLen; + read $handle, $buf, $RecIndexHeaderLen; my $next_index; my $numrecs; @@ -574,9 +616,9 @@ # Read the index itself if ($self->{attributes}{resource} || $self->{'attributes'}{'ResDB'}) { - &_load_rsrc_index($self, \*PDB); + &_load_rsrc_index($self, $handle); } else { - &_load_rec_index($self, \*PDB); + &_load_rec_index($self, $handle); } # Read the two NUL bytes @@ -584,27 +626,27 @@ # spec. The Right Thing to do is to ignore them, and use the # specified or calculated offsets, if they're sane. Sane == # appears later than the current position. -# read PDB, $buf, 2; +# read $handle, $buf, 2; # $self->{"2NULs"} = $buf; # Read AppInfo block, if it exists if ($self->{_appinfo_offset} != 0) { - &_load_appinfo_block($self, \*PDB); + &_load_appinfo_block($self, $handle); } # Read sort block, if it exists if ($self->{_sort_offset} != 0) { - &_load_sort_block($self, \*PDB); + &_load_sort_block($self, $handle); } # Read record/resource list if ($self->{attributes}{resource} || $self->{'attributes'}{'ResDB'}) { - &_load_resources($self, \*PDB); + &_load_resources($self, $handle); } else { - &_load_records($self, \*PDB); + &_load_records($self, $handle); } # These keys were needed for parsing the file, but are not @@ -616,8 +658,6 @@ delete $self->{_size}; $self->{'dirty'} = 0; - - close PDB; } # _load_rec_index @@ -745,7 +785,7 @@ # Seek to the right place, if necessary if (tell($fh) != $pdb->{_appinfo_offset}) { - seek PDB, $pdb->{_appinfo_offset}, 0; + seek $fh, $pdb->{_appinfo_offset}, 0; } # There's nothing that explicitly gives the size of the @@ -800,7 +840,7 @@ # Seek to the right place, if necessary if (tell($fh) != $pdb->{_sort_offset}) { - seek PDB, $pdb->{_sort_offset}, 0; + seek $fh, $pdb->{_sort_offset}, 0; } # There's nothing that explicitly gives the size of the sort @@ -860,7 +900,7 @@ # Seek to the right place, if necessary if (tell($fh) != $pdb->{_index}[$i]{offset}) { - seek PDB, $pdb->{_index}[$i]{offset}, 0; + seek $fh, $pdb->{_index}[$i]{offset}, 0; } # Compute the length of the record: the last record @@ -922,7 +962,7 @@ # Seek to the right place, if necessary if (tell($fh) != $pdb->{_index}[$i]{offset}) { - seek PDB, $pdb->{_index}[$i]{offset}, 0; + seek $fh, $pdb->{_index}[$i]{offset}, 0; } # Compute the length of the resource: the last @@ -996,9 +1036,10 @@ my $fname = shift; # Output file name my @record_data; + my $handle = $self->_open('>', $fname); + # Open file - open OFILE, "> $fname" or die "Can't write to \"$fname\": $!\n"; - binmode OFILE; # Write as binary file under MS-DOS + binmode $handle; # Write as binary file under MS-DOS # Get AppInfo block my $appinfo_block = $self->PackAppInfoBlock; @@ -1153,13 +1194,13 @@ $self->{uniqueIDseed}; ; - print OFILE "$header"; + print $handle "$header"; # Write index header my $index_header; $index_header = pack "N n", 0, ($#record_data+1); - print OFILE "$index_header"; + print $handle "$index_header"; # Write index my $rec_offset; # Offset of next record/resource @@ -1193,7 +1234,7 @@ $type, $id, $rec_offset; - print OFILE "$index_data"; + print $handle "$index_data"; $rec_offset += length($data); } @@ -1223,7 +1264,7 @@ ($id >> 16) & 0xff, ($id >> 8) & 0xff, $id & 0xff; - print OFILE "$index_data"; + print $handle "$index_data"; $rec_offset += length($data); } @@ -1232,16 +1273,16 @@ # Write the two NULs if (length($self->{"2NULs"}) == 2) { - print OFILE $self->{"2NULs"}; + print $handle $self->{"2NULs"}; } else { - print OFILE "\0\0"; + print $handle "\0\0"; } # Write AppInfo block - print OFILE $appinfo_block unless $appinfo_offset == 0; + print $handle $appinfo_block unless $appinfo_offset == 0; # Write sort block - print OFILE $sort_block unless $sort_offset == 0; + print $handle $sort_block unless $sort_offset == 0; # Write record/resource list my $record; @@ -1262,10 +1303,8 @@ ($attributes, $id, $data) = @{$record}; } - print OFILE $data; + print $handle $data; } - - close OFILE; } =head2 new_Record