package Tie::File::Custom;
use strict;
use warnings;
use Carp;
sub TIEHANDLE {
my ($class, $file) = @_;
my $self = {};
bless $self, $class;
open ($self->{FH}, '<', $file) or croak "Error opening file : $!";
$self->$_() for qw(LINES BUFF NL);
return $self;
}
sub READLINE {
my $self = shift;
my $fh = $self->{FH};
my $lines;
# We already have data in our window
if ( $self->{WINDOW} ) {
$lines = $self->{WINDOW} =~ s/($self->{NL})/$1/gs;
if ( $lines >= $self->{LINES} ) {
(my $data, $self->{WINDOW}) = $self->SPLIT();
return $data;
}
# The window isn't a complete line but we are out of file
return delete $self->{WINDOW} if eof $fh;
}
# We don't have anything and we can't get anything
return undef if eof $fh && ! $self->{WINDOW};
# We need to get more into our window
local $/ = \$self->{BUFF};
while ( ! eof $fh ) {
$self->{WINDOW} .= <$fh>;
$lines = $self->{WINDOW} =~ s/($self->{NL})/$1/gs;
last if $lines >= $self->{LINES}
}
# We need to check if we got here because we have enough lines or ran out of file
if ( $lines >= $self->{LINES} ) {
(my $data, $self->{WINDOW}) = $self->SPLIT();
return $data;
}
return delete $self->{WINDOW};
}
# We really should be more efficient about this
# We should also have lots of tests to fix edge cases
sub SPLIT {
my $self = shift;
my @part = split /($self->{NL})/, $self->{WINDOW};
my $data = join '', @part[ 0 .. ( $self->{LINES} * 2 ) - 1 ];
my $rest = join '', @part[ $self->{LINES} * 2 .. $#part ];
return ($data, $rest);
}
sub LINES { $_[0]->{LINES} = $_[1] || $_[0]->{LINES} || 1; $_[0]->{LINES} }
sub BUFF { $_[0]->{BUFF} = $_[1] || $_[0]->{BUFF} || 8192; $_[0]->{BUFF} }
sub NL { $_[0]->{NL} = $_[1] || $_[0]->{NL} || "\n"; $_[0]->{NL} }
sub CHOMP { $_[1] =~ s/$_[0]->{NL}$// }
"This Statement is false";
####
#!/usr/bin/perl
use strict;
use warnings;
use Tie::File::Custom;
tie *fh, 'Tie::File::Custom', 'file.txt' or die "Unable to tie : $!";
(tied *fh)->LINES( 2 ); # Return 2 lines at a time
(tied *fh)->BUFF( 100 ); # Read 100 bytes at a time since we expect short lines
while ( ) {
print $_, "-\n";
}
####
#!/usr/bin/perl
use strict;
use warnings;
use Tie::File::Custom;
tie *fh, 'Tie::File::Custom', 'num.dat' or die "Unable to tie : $!";
(tied *fh)->NL( "\n\\d+\n" ); # Lines with numbers by themselves are record terminators
while ( ) {
(tied *fh)->CHOMP( $_ );
print "$_\n";
}