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]

Reply via email to