File Coverage

blib/lib/File/Append/TempFile.pm

Criterion	Covered	Total	%
statement	77	101	76.2
branch	20	42	47.6
condition	4	12	33.3
subroutine	13	14	92.8
pod	9	9	100.0
total	123	178	69.1

package File::Append::TempFile;

use 5.006;
use strict;
use warnings;

=head1 NAME

File::Append::TempFile - Perl extension for appending data to files

=head1 SYNOPSIS

  use File::Append::TempFile;

  $f = new File::Append::TempFile();
  $f->begin_work('/etc/hosts') or die "Appending: ".$f->err();
  $f->add_line("127.0.0.2 localhvost\n");
  $f->commit();

  $f->begin_work('/etc/hosts') or die "Appending: ".$f->err();
  $f->add_line("...\n");
  $f->rollback();

=head1 DESCRIPTION

The C module provides an OOP interface to appending
data to files using a temporary file, in order to ensure the atomicity of
the updates.

An append session is initiated by invoking the C method and
passing it the name of the file.  At this point, a temporary file is
created in the same directory as the original file and the original's
contents is copied to the temporary.  More data is added to the temporary
file using the C method.  When done appending, the C
method will atomically move the temporary file over the original.
If something goes wrong, the C method will remove the temporary
file without affecting the original in any way.

=cut

use Fcntl;

our @ISA = qw();

our $VERSION = '0.05';

our $debug = 0;

my %tempfiles;

=head1 METHODS

The C class defines the following methods:

=over 4

=item new ()

Create a new C object.  No file processing is
done at this point.

=cut

sub new
{
	my $proto = shift;
	my $class = ref $proto || $proto;
	my $self;

	$self = { 'fname' => undef, 'tmpfname' => undef, 'f' => undef,
	    'err' => undef, 'debug' => undef };
	bless $self, $class;
	$tempfiles{$self} = $self;
	return $self;
}

=item err ( [MESSAGE] )

Set or obtain an error message describing the last error that occurred
during the processing of the current C object.

=cut

sub err($ $)
{
	my ($self, $err) = @_;

	$self->{'err'} = $err if @_ > 1;
	return $self->{'err'};
}

=item diag ([FLAG])

Set or obtain the diagnostic output flag.  If it is set, the methods
will display diagnostic information on the standard error stream.

=cut

sub diag($ $)
{
	my ($self, $debug) = @_;

	$self->{'debug'} = $debug if @_ > 1;
	return $self->{'debug'};
}

=item begin_work (FILENAME)

Creates a temporary file in the same directory as the specified one and
copies the original's contents over to the new file.  Further data may
be added using the C method and then either stored as the
original with the C method, or discarded with the C
method.

=cut

sub begin_work($ $)
{
	my ($self, $fname) = @_;
	my ($tmpfname, $orig, $f);
	my @stat;

	if ($self->{'f'}) {
		return undef unless $self->rollback();
	}
	$self->{'fname'} = $self->{'tmpfname'} = $self->{'f'} = undef;

	if (!open($orig, '<', $fname)) {
		$self->err("Opening $fname: $!");
		return undef;
	}
	@stat = stat $orig;
	$tmpfname = sprintf '%s.%05d.%04d', $fname, $$, int rand 10000;
	if (!sysopen($f, $tmpfname, O_WRONLY | O_EXCL | O_CREAT, 0600)) {
		$self->err("Creating temporary file $tmpfname: $!");
		return undef;
	}
	return undef unless $self->do_copy($orig, $f);
	close $orig;

	$self->{'fname'} = $fname;
	$self->{'tmpfname'} = $tmpfname;
	$self->{'f'} = $f;
	$self->{'stat'} = [ @stat ];
	return 1;
}

=item add_line (DATA)

Append data to the temporary file.  This does not affect the original in
any way until C is invoked.

=cut

sub add_line($ $)
{
	my ($self, $line) = @_;
	my $f = $self->{'f'};

	if (!defined($f)) {
		$self->err("Cannot add_line() to an unopened tempfile");
		return undef;
	}
	$self->debug("RDBG about to add a line to $self->{tmpfname} for $self->{fname}\n");
	if (!(print $f $line)) {
		$self->err("Could not add to the tempfile: $!");
		return undef;
	}
	return 1;
}

=item commit ()

Replace the original file with the temporary copy, to which data may have
been added using C.

B This method uninitializes the C object,
that is, removes B association between it and the original file and
even file name!  The next method invoked on this C
object should be C.

=cut

sub commit($)
{
	my ($self) = @_;

	if (!defined($self->{'f'}) || !defined($self->{'tmpfname'}) ||
	    !defined($self->{'fname'})) {
		$self->err("Cannot commit an unopened tempfile");
		return undef;
	}
	$self->debug("RDBG about to commit $self->{tmpfname} to $self->{fname}\n");

	# Fix stuff up
	if (defined($self->{'stat'})) {
		# Mode
		if (!chmod($self->{'stat'}->[2], $self->{'tmpfname'})) {
			$self->err("Could not chmod $self->{stat}->[2] ".
			    $self->{'tmpfname'}.": $!");
			return undef;
		}
		# Owner & group
		if (!chown($self->{'stat'}->[4], $self->{'stat'}->[5],
		    $self->{'tmpfname'})) {
			$self->err("Could not chown $self->{stat}->[4], ".
			    $self->{'stat'}->[5].", $self->{tmpfname}: $!");
			return undef;
		}
	}

	if (!rename($self->{'tmpfname'}, $self->{'fname'})) {
		$self->err("Renaming $self->{tmpfname} to $self->{fname}: $!");
		return undef;
	}
	close $self->{'f'};
	$self->debug("RDBG successfully committed $self->{tmpfname} to $self->{fname}\n");
	$self->{'fname'} = $self->{'tmpfname'} = $self->{'f'} = undef;
	return 1;
}

=item rollback ()

Discard all the changes made to the temporary copy and remove it.  This
does not affect the original file in any way.

B This method uninitializes the C object,
that is, removes B association between it and the original file and
even file name!  The next method invoked on this C
object should be C.

=cut

sub rollback($)
{
	my ($self) = @_;

	$self->debug(ref($self)."->rollback() for $self->{fname}\n");
	if (defined($self->{'tmpfname'})) {
		$self->debug("RDBG removing $self->{tmpfname}\n");
		if (!unlink($self->{'tmpfname'})) {
			$self->err("Removing $self->{tmpfname}: $!");
			return undef;
		}
		undef $self->{'tmpname'};
	}
	if (defined($self->{'f'})) {
		$self->debug("RDBG closing the file\n");
		close $self->{'f'};
		undef $self->{'f'};
	}
	undef $self->{'fname'};
	$self->debug("RDBG rollback seems complete\n");
	return 1;
}

=back

There are also several methods used internally by the
C routines:

=over 4

=item debug (MESSAGE)

Display a diagnostic message to the standard error stream if the output
of diagnostic messages has been enabled.

=cut

sub debug($ $)
{
	my ($self, $msg) = @_;

	if ($self->{'debug'} || $debug) {
		print STDERR $msg;
	}
}

=item do_copy (ORIG TEMP)

Actually perform the copying of the original file data into the temporary
file at C time.  This allows derived classes to modify
the file structure if needed.

The two parameters are the file handles for the original and the
temporary file.

=cut

sub do_copy($ $ $)
{
	my ($self, $orig, $f) = @_;

	while (<$orig>) {
		print $f $_;
	}
	return 1;
}

END
{
	print STDERR "RDBG File::Append::TempFile END block\n" if $debug;
	print STDERR "RDBG ".keys(%tempfiles)."\n" if $debug;
	foreach (keys %tempfiles) {
		$tempfiles{$_}->rollback() if $tempfiles{$_}->{'tmpfname'};
	}
}

=back

=head1 SEE ALSO

The C website:

  http://devel.ringlet.net/sysutils/file-append-tempfile/

=head1 BUGS

=over 4

=item * Note that the original file may have changed between C
and C - those changes B be lost!

=back

=head1 AUTHOR

Peter Pentchev, [e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Peter Pentchev.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.7 or,
at your option, any later version of Perl 5 you may have available.

$Ringlet: TempFile.pm 1635 2007-12-27 14:06:01Z roam $

=cut

1;