package File::RoundRobin;
use 5.006;
use strict;
use warnings;
=head1 NAME
File::RoundRobin - Round Robin text files
=head1 VERSION
Version 0.06
=cut
our $VERSION = '0.06';
local $|=1;
=head1 SYNOPSIS
This module implements a Round-Robin text file.
The text file will not grow beyond the size we specify.
The benefit of using this module is that you can log a certain amount of
information without having to care about filling your hard drive or setting up a
log-rotate mechanism.
Example :
use File::RoundRobin;
my $rrfile = File::RoundRobin->new(
path => '/tmp/sample.txt',
size => '100M',
mode => 'new',
) // die $@;
$rrfile->print("foo bar");
or
my $rrfile = File::RoundRobin->new(path => '/tmp/sample.txt', mode => 'read');
while (my $line = $rrfile->readline() ) {
print $line;
}
When you write into the Round-Robin file, if it filled the maximum allowed space it
will write over the old data, while always preserving the most recent data.
=head1 ERROR HANDLING and DEBUGGING
In case an error occures, the error will be stored in $@
Starting with version 0.5 the module no longer dies on errors, instead returns
undef or 0 (c<new()> will return undef, c<write()> will return 0) and the actual
error message is available in $@.
=head1 TIE INTERFACE
This module implements the TIEHANDLE interface and the objects an be used as normal
file handles.
=over 4
=item 1. Write example :
local *FH;
tie *FH, 'File::RoundRobin', path => 'test.txt',size => '10M';
my $fh = *FH;
...
print $fh "foo bar";
...
close($fh);
=item 2. Read example :
local *FH;
tie *FH, 'File::RoundRobin', path => 'test.txt',mode => 'read';
$fh = *FH;
while ( my $line = readline($fh) ) {
print $line;
}
close($fh);
=back
=head1 UTILITIES
=head2 rrcat
The package comes with a simple utility B<rrcat> that let's you create and read RoundRobin files from command line
Usage :
To print the content of a file :
$ rrcat <filename>
To write into a file (reads from stdin):
$ rrcat <size> <filename>
Size can be specified in any of the forms accepted by File::RoundRobin (see C<new> method)
=head2 rrtail
The package comes with a simple utility B<rrtail> that let's you tail RoundRobin files from command line
Usage :
To a file you can run :
Print the last 10 lines
$ rrtail <filename>
Print the last 100 lines :
$ rrtail -n 100 <filename>
Print the content as it's written :
$ rrtail -f <filename>
=head1 SUBROUTINES/METHODS
=head2 new
Returns a new File::RoundRobin object.
Files can be opened in three ways: I<new file>, I<read>, I<append>
=head3 write
In I<new file> mode any existing data will be lost and the file will be overwritten
Arguments :
=over 4
=item * path = path where to create the file
=item * size = the maximum size the file is allowed to grow to. Example : 100K or 100Kb, 10M or 10Mb, 1G or 1Gb
=back
Example :
my $rrfile = File::RoundRobin->new(
path => '/tmp/sample.txt',
size => '100M',
);
=head3 read
Arguments :
=over 4
=item * path = path where to create the file
=item * mode = must be C<read>
=back
Example :
my $rrfile = File::RoundRobin->new(path => '/tmp/sample.txt', mode => 'read') || die $@;
=head3 append
In I<append> mode all existing data will preserved and we can continue writing the file from where we left off
Arguments :
=over 4
=item * path = path where to create the file
=item * mode = must be C<append>
=back
Example :
my $rrfile = File::RoundRobin->new(path => '/tmp/sample.txt', mode => 'append') || die $@;
=cut
sub new {
my $class = shift;
my %params = (
mode => 'new',
@_
);
$params{size} = convert_size($params{size});
if ($params{mode} eq "new" && ! defined $params{size}) {
$@ = "You must specify the file size" ;
return;
}
my ($fh,$size,$start_point,$headers_size,$read_only) = open_file(%params);
return undef unless $fh;
my $self = {
_fh_ => $fh,
_data_length_ => $size,
_file_length_ => $size + $headers_size,
_write_start_point_ => $start_point,
_read_start_point_ => $start_point,
_headers_size_ => $headers_size,
_read_only_ => $read_only,
_autoflush_ => $params{autoflush} || 1,
};
bless $self, $class;
return $self;
}
=head2 read
Reads the $length craracters form the file beginning with $offset and returns the result
Usage :
#reads the next 10 characted from the file
my $buffer = $rrfile->read(10);
or
#reads the first 10 characters starting with character 90 after the current position
my $buffer = $rrfile->read(10,90);
Arguments :
=over 4
=item * I<length> = how many bytes to read
=item * I<offset> = offset from which to start reading
=back
=cut
sub read {
my $self = shift;
my $length = shift || 1;
my $offset = shift || 0;
if ($self->{_write_start_point_} == $self->{_read_start_point_}) {
if ($self->{_read_started_}) {
return undef;
}
else {
$self->{_read_started_} = 1;
}
}
my $to_eof = ($self->{_write_start_point_} > $self->{_read_start_point_}) ?
$self->{_write_start_point_} - $self->{_read_start_point_} :
($self->{_write_start_point_} - $self->{_headers_size_}) + ($self->{_file_length_} - $self->{_read_start_point_});
$length = $to_eof > $length ? $length : $to_eof;
return undef unless $length;
$self->jump($offset) if ($offset);
my ($buffer1,$buffer2);
my $bytes = CORE::sysread($self->{_fh_},$buffer1,$length);
$self->{_read_start_point_} += $bytes;
CORE::sysseek($self->{_fh_},$self->{_read_start_point_},0);
if ($bytes < $length) {
$length -= $bytes;
if ($self->{_write_start_point_} - $self->{_headers_size_} < $length) {
$length = $self->{_write_start_point_} - $self->{_headers_size_};
}
CORE::sysseek($self->{_fh_},$self->{_headers_size_},0);
$bytes = CORE::sysread($self->{_fh_},$buffer2,$length);
$self->{_read_start_point_} = $self->{_headers_size_} + $bytes;
CORE::sysseek($self->{_fh_},$self->{_read_start_point_},0);
}
return $buffer2 ? $buffer1 . $buffer2 : $buffer1;
}
=head2 write
Writes the given text into the file
Usage :
$rrfile->write("foo bar");
Arguments :
=over 4
=item * I<buffer> = the actual content we want to write
=item * I<length> = the length of the content we want to write (defaults to C<length($buffer)>)
=item * I<offset> = offset from which to start writing
=back
=cut
sub write {
my $self = shift;
my $buffer = shift;
my $length = shift || length($buffer);
my $offset = shift || 0;
if ( $self->{_read_only_} ) {
$@ = "File is read only!";
return 0;
}
$self->jump($offset) if $offset;
$self->{_write_start_point_} = $self->{_read_start_point_};
my $fh = $self->{_fh_};
my $start_pos = 0;
while ($self->{_write_start_point_} + $length > $self->{_file_length_}) {
my $bytes_to_write = $self->{_file_length_} - $self->{_write_start_point_};
CORE::syswrite($fh,substr($buffer,$start_pos,$bytes_to_write));
$start_pos += $bytes_to_write;
$length -= $bytes_to_write;
$self->{_write_start_point_} = $self->{_headers_size_};
CORE::sysseek($fh,$self->{_write_start_point_},0);
}
CORE::syswrite($fh,substr($buffer,$start_pos,$length));
$self->{_write_start_point_} += $length;
$self->{_read_start_point_} = $self->{_write_start_point_};
$self->update_headers() unless $self->{_autoflush_} == 0;
return ($self->{_write_start_point_} == CORE::tell($fh)) ? 1 : 0;
}
=head2 print
Writes the given text into the file
Usage :
$rrfile->print("foo bar");
Arguments :
=over 4
=item * I<buffer> = the actual content we want to write
=back
=cut
*print = \&write;
=head2 close
Close the Round-Robin file
Usage :
$rrfile->close();
=cut
sub close {
my $self = shift;
my $fh = $self->{_fh_};
return if $self->{_closed_};
if (! $self->{_read_only_}) {
$self->update_headers();
}
$self->{_closed_} = 1;
return CORE::close($fh);
}
=head2 eof
Return true if you reached the end of file, false otherwise
Usage :
my $bool = $rrfile->eof();
=cut
sub eof {
my $self = shift;
return 1 if ($self->{_write_start_point_} == $self->{_read_start_point_} && defined $self->{_read_started_} );
return 0;
}
=head2 autoflush
Turns on/off the autoflush feature
Usage :
my $autoflush = $rrfile->autoflush();
or
$rrfile->autoflush(1); #enables autoflush
$rrfile->autoflush(0); #disables autoflush
=cut
sub autoflush {
my $self = shift;
if ( scalar(@_) ) {
$self->{_autoflush_} = $_[0];
}
return $self->{_autoflush_};
}
=head1 Private methods
Don't call this methods manually, or you might get unexpected results!
=head2 open_file
Has two modes :
=over 4
=item 1. In append mode it opens an existing file
=item 2. In new mode it creates a new file
=back
=cut
sub open_file {
my %params = @_;
if (! defined($params{path}) ) {
$@ = "You myst specifi the name of the file!";
}
if (-d $params{path}) {
$@ = "Path is a directory!";
}
my ($fh,$size,$start_point,$version,$headers_size,$read_only);
if ($params{mode} eq "new") {
if (! defined $params{size} ) {
$! = "You must specify the size of the file!";
return;
}
$size = $params{size};
if (! open($fh,"+>",$params{path}) ) {
$@ = $!;
return;
}
CORE::binmode($fh,":unix");
#version number
CORE::syswrite($fh,"1"."\x00");
#file size
CORE::syswrite($fh,$params{size} ."\x00");
#where is the start of the file
$start_point = length($params{size}) * 2 + 2 + 2;
CORE::syswrite($fh,("0" x (length($params{size}) - length($start_point) )) . $start_point ."\x00");
$headers_size = length($params{size}) * 2 + 2 + 2;
$read_only = 0;
}
else {
if ($params{mode} eq "append") {
if (! open($fh,"+<",$params{path}) ) {
$@ = $!;
return;
}
CORE::binmode($fh,":unix");
CORE::sysseek($fh,0,0);
$read_only = 0;
}
elsif ($params{mode} eq "read") {
if (! open($fh,"<",$params{path}) ) {
$@ = $!;
return;
}
CORE::binmode($fh,":unix");
$read_only = 1;
}
else {
$@ = "Invalid open mode! Use one of new,read,append!";
return;
}
my $start_section;
CORE::sysread($fh,$start_section,4096);
($version, $size, $start_point) = split("\x00", $start_section);
CORE::sysseek($fh,0,0);
#make sure this looks like a File::RoundRobin file
if (! $version || $version ne "1" || int($size || '') == 0 || int($start_point || '') == 0 ) {
$@ = "File does not look like a File::RoundRobin file - missing headers";
return;
}
$headers_size = length($version) + length($size) + length($start_point) +3;
# +3 because of the 3 \x00 chars we use to separate headder info
CORE::sysseek($fh,$start_point + 0,0);
}
return ($fh,$size + 0,$start_point + 0,$headers_size + 0,$read_only);
}
=head2 update_headers
Update the start point in the headers section after a write command
=cut
sub update_headers {
my $self = shift;
my $fh = $self->{_fh_};
CORE::sysseek($fh,0, 0);
my $headers = '';
#version
$headers .= "1\x00";
#file size
$headers .= $self->{_data_length_} ."\x00";
#start pos
$headers .= ("0" x (length($self->{_data_length_}) - length($self->{_write_start_point_}) )) . $self->{_write_start_point_} ."\x00";
CORE::syswrite($fh,$headers);
#go back to the previous position
CORE::sysseek($fh,$self->{_write_start_point_}, 0);
}
=head2 refresh
Re-reads the headers from the file. Useful for tail
=cut
sub refresh {
my $self = shift;
my $fh = $self->{_fh_};
my $pos = $self->tell();
CORE::sysseek($fh,0,0);
local $/ = "\x00";
#skip the first part of the header
my $version = <$fh>;
my $size = <$fh>;
my $start_point = <$fh>;
my $headers_size = length($version) + length($size) + length($start_point);
$size =~ s/\x00//g;
$start_point =~ s/\x00//g;
$self->{_headers_size_} = $headers_size;
$self->{_read_start_point_} = $start_point + 0;
$self->{_data_length_} = $size + 0;
$self->{_file_length_} = $size + $headers_size;
CORE::sysseek($fh,$start_point,0);
}
=head2 sync_markers
Sets the write market to the same position as the read marker
=cut
sub sync_markers {
my $self = shift;
$self->{_write_start_point_} = $self->{_read_start_point_};
$self->{_read_started_} = 0;
}
=head2 jump
Advance the read start position pointer by $offset bytes
=cut
sub jump {
my $self = shift;
my $offset = shift || 0;
if ($offset) {
if ($offset + $self->{_read_start_point_} > $self->{_file_length_}) {
$self->{_read_start_point_} = $self->{_headers_size_} + (($offset + $self->{_read_start_point_}) % $self->{_file_length_} )
}
else {
$self->{_start_point_} += $offset;
}
}
CORE::sysseek($self->{_fh_},$self->{_read_start_point_},0);
}
=head2 seek
Move the read/write start position to the given position
Arguments :
=over 4
=item * I<position> = The position to which we want to move to offset
=item * I<whence> = From where should we start counting the position :
=back
=over 8
=item * 0 = from the beginning of the file
=item * 1 = from the current position
=item * 2 = from the end of the file (I<position> must be negative)
=back
Usage :
$rrfile->seek(10,0);
=cut
sub seek {
my $self = $_[0];
my $position = $_[1];
my $whence = $_[2] || 0;
#$position = $position % $self->{_data_length_};
if ($whence == 0) {
my $start_pos = $self->{_write_start_point_};
if ($self->{_write_start_point_} + $position > $self->{_file_length_}) {
$position -= $self->{_file_length_} - $self->{_write_start_point_};
$start_pos = $self->{_headers_size_};
}
if ( CORE::sysseek($self->{_fh_},$start_pos + $position,0) ) {
$self->{_read_start_point_} = $start_pos + $position;
return 1;
}
}
elsif ($whence == 1) {
my $start_pos = $self->{_read_start_point_};
if ($self->{_read_start_point_} + $position > $self->{_file_length_}) {
$position -= $self->{_file_length_} - $self->{_read_start_point_};
$start_pos = $self->{_headers_size_};
}
if ( CORE::sysseek($self->{_fh_},$start_pos + $position,1) ) {
$self->{_read_start_point_} = $start_pos + $position;
return 1;
}
}
elsif ($whence == 2 ) {
if ($position > 0) {
$@ = "Attempt to seek beyond the end of file!";
warn $@;
return 0;
}
my $start_pos = $self->{_write_start_point_};
if ($self->{_write_start_point_} + $position < $self->{_headers_size_}) {
$position = -$position;
$position -= $self->{_write_start_point_} - $self->{_headers_size_};
$start_pos = $self->{_file_length_};
}
#don't go in cicles
if ($self->{_read_start_point_} < $self->{_write_start_point_} &&
$self->{_read_start_point_} + $position >= $self->{_write_start_point_}){
return 0;
}
if ( CORE::sysseek($self->{_fh_},$start_pos,0) ) {
if ( CORE::sysseek($self->{_fh_},$position,1) ) {
$self->{_read_start_point_} = $start_pos + $position;
return 1;
}
}
}
else {
$@ = "Unknown seek mode!";
warn $@;
}
return 0;
}
=head2 tell
Return the difference between the current read position and the last write position
Example :
my $pos = $rrfile->tell();
=cut
sub tell {
my $self = shift;
my $offset;
if ($self->{_read_start_point_} >= $self->{_write_start_point_}) {
$offset = $self->{_read_start_point_} - $self->{_write_start_point_};
}
else {
$offset = ($self->{_file_length_} - $self->{_write_start_point_}) +
($self->{_read_start_point_} - $self->{_headers_size_});
}
return $offset % $self->{_data_length_};
}
=head2 convert_size
Converts the size from a human readable form into bytes
Example of acceptable formats :
=over 4
=item * 1000
=item * 120K or 120Kb
=item * 15M or 15Mb
=item * 1G or 1Gb
=back
=cut
sub convert_size {
my $size = shift;
return undef unless defined $size;
return $size if $size =~ /^\d+$/;
my %sizes = (
'K' => 10**3,
'M' => 10**6,
'G' => 10**9,
);
if ($size =~ /^(\d+(?:\.\d+)?)(K|M|G)b?$/i ) {
return $1 * $sizes{uc($2)};
}
else {
$@ = "Broke size format in ".__PACKAGE__."->convert_size(). See pod for accepted formats";
return undef;
}
}
=head1 TIE INTERFACE IMPLEMENTATION
This module implements the TIEHANDLE interface and the objects an be used as normal
file handles.
See SYNOPSYS for more details on this
=cut
sub TIEHANDLE {
my $class = shift;
return $class->new(@_);
}
sub READ {
my ($self,$buffer,$length,$offet) = @_;
my $content = $self->read($length,$offet);
$_[1] = $content;
return length($content || '');
}
sub READLINE {
my $self = shift;
my $buffer;
while (my $char = $self->read(1)) {
$buffer .= $char;
last if ($char =~ /[\n\r]/);
}
return $buffer;
}
sub GETC {
my $self = shift;
return $self->read(1,0);
}
sub WRITE {
my ($self,$buffer,$length,$offet) = @_;
return $self->write($buffer,$length,$offet);
}
sub PRINT {
my ($self,@data) = @_;
return $self->write($_) foreach @data;
}
sub PRINTF {
my ($self,$format,@data) = @_;
return $self->write(sprintf($format,@data));
}
# binmode does nothing, this is a text file
sub BINMODE {
my $self = shift;
CORE::binmode($self->{_fh_},@_);
}
sub EOF {
my $self = shift;
return $self->eof();
}
sub FILENO {
my $self = shift;
return CORE::fileno($self->{_fh_});
}
sub SEEK {
my ($self,$position,$whence) = @_;
return $self->seek($position,$whence);
}
sub TELL {
my $self = shift;
return $self->tell();
}
sub OPEN {
my ($self, $mode, @params) = @_;
die "You cannot use the tie interface to open a file, use File::RoundRobin->new() instead!";
}
sub CLOSE {
my $self = shift;
$self->close();
}
# Does nothing
sub UNTIE {
my $self = shift;
return 0
}
DESTROY {
my $self = shift;
$self->close();
}
=head1 AUTHOR
Gligan Calin Horea, C<< <horea at gligan.ro> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-file-roundrobin at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-RoundRobin>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc File::RoundRobin
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker (report bugs here)
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-RoundRobin>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/File-RoundRobin>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/File-RoundRobin>
=item * Search CPAN
L<http://search.cpan.org/dist/File-RoundRobin/>
=back
=head1 LICENSE AND COPYRIGHT
Copyright 2012 Gligan Calin Horea.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1; # End of File::RoundRobin