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"; }