The following snippet is from "Advanced perl programming" by Sriram
Srinivasan. A test program is also attached.
If I print any other list element, it works fine but for
the first element ( $array[1] ), it gives a warning. What's on??
Perl version is 5.6.0 on RH Linux 7.
/home/atul/myperl> ./tst.pl
Use of uninitialized value in seek at /home/atul/myperl/TieFile.pm line 27.
#!/usr/bin/perl -w
/home/atul/myperl>
----------------- Example Program ( tst.pl ) ----------------
#!/usr/bin/perl -w
use lib qw(/home/atul/myperl); # so it can find module
use TieFile;
my @array;
tie @array, 'TieFile', 'tst.pl'; # read the program file itself as data
print "$array[1]";
----------------- Example Program ( tst.pl ) ----------------
--------------------- CUT HERE --------------------
package TieFile;
use Symbol;
use strict;
# The object constructed in TIEARRAY is an array, and these are the
# fields
my $F_OFFSETS = 0; # List of file seek offsets (for each line)
my $F_FILEHANDLE = 1; # Open filehandle
sub TIEARRAY {
my ($pkg, $filename) = @_;
my $fh = gensym;
open ($fh, $filename) || die "Could not open file: $!\n";
bless [ [0], # 0th line is at offset 0
$fh
], $pkg;
}
sub FETCH {
my ($obj, $index) = @_;
# Have we already read this line?
my $rl_offsets = $obj->[$F_OFFSETS];
my $fh = $obj->[$F_FILEHANDLE];
if ($index > @$rl_offsets) {
$obj->read_until ($index);
} else {
# seek to the appropriate file offset
seek ($fh, $rl_offsets->[$index], 0);
}
return (scalar <$fh>); # Return a single line, by evaluating <$fh>
}
sub STORE {
die "Sorry. Cannot update file using package TieFile\n";
}
sub DESTROY {
my ($obj) = @_;
# close the filehandle
close($obj->[$F_FILEHANDLE]);
}
sub read_until {
my ($obj, $index) = @_;
my $rl_offsets = $obj->[$F_OFFSETS];
my $last_index = @$rl_offsets - 1;
my $last_offset = $rl_offsets->[$last_index];
my $fh = $obj->[$F_FILEHANDLE];
seek ($fh, $last_offset, 0);
my $buf;
while (defined($buf = <$fh>)) {
$last_offset += length($buf);
$last_index++;
push (@$rl_offsets, $last_offset);
last if $last_index > $index;
}
}
1;
--------------------- CUT HERE --------------------
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
