File Coverage

blib/lib/IO/File/AtomicChange.pm

Criterion	Covered	Total	%
statement	77	92	83.7
branch	24	44	54.5
condition	3	3	100.0
subroutine	17	20	85.0
pod	2	8	25.0
total	123	167	73.6

package IO::File::AtomicChange;

use strict;
use warnings;

our $VERSION = '0.07_02';

use base qw(IO::File);
use Carp;
use File::Temp qw(:mktemp);
use File::Copy;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new();
    $self->_temp_file("");
    $self->_target_file("");
    $self->_backup_dir("");
    $self->open(@_) if @_;
    $self;
}

sub _accessor {
    my($self, $tag, $val) = @_;
    ${*$self}{$tag} = $val if $val;
    return ${*$self}{$tag};
}
sub _temp_file   { return shift->_accessor("io_file_atomicchange_temp", @_) }
sub _target_file { return shift->_accessor("io_file_atomicchange_path", @_) }
sub _backup_dir  { return shift->_accessor("io_file_atomicchange_back", @_) }

sub DESTROY {
    carp "[CAUTION] disposed object without closing file handle." unless $_[0]->_closed;
}

sub open {
    my ($self, $path, $mode, $opt) = @_;
    ref($self) or $self = $self->new;

    # Because we do rename(2) atomically, temporary file must be in same
    # partion with target file.
    my $temp = mktemp("${path}.XXXXXX");
    $self->_temp_file($temp);
    $self->_target_file($path);

    copy_preserving_attr($path, $temp) if -f $path;
    if (exists $opt->{backup_dir}) {
        unless (-d $opt->{backup_dir}) {
            croak "no such directory: $opt->{backup_dir}";
        }
        $self->_backup_dir($opt->{backup_dir});
    }

    $self->SUPER::open($temp, $mode) ? $self : undef;
}

sub _closed {
    my $self = shift;
    my $tag = "io_file_atomicchange_closed";

    my $oldval = ${*$self}{$tag};
    ${*$self}{$tag} = shift if @_;
    return $oldval;
}

sub close {
    my ($self, $die) = @_;
    $self->sync() or croak "sync: $!";
    unless ($self->_closed(1)) {
        if ($self->SUPER::close()) {

            $self->backup if ($self->_backup_dir && -f $self->_target_file);

            rename($self->_temp_file, $self->_target_file)
                or ($die ? croak "close (rename) atomic file: $!\n" : return);
        } else {
            $die ? croak "close atomic file: $!\n" : return;
        }
    }
    1;
}

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

    my($mode, $uid, $gid) = (stat($self->_target_file))[2,4,5];
    chown $uid, $gid, $self->_temp_file;
    chmod $mode,      $self->_temp_file;
}

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

    require Path::Class;
    require POSIX;
    require Time::HiRes;

    my $basename = Path::Class::file($self->_target_file)->basename;

    my $backup_file;
    my $n = 0;
    while ($n < 7) {
        $backup_file = sprintf("%s/%s_%s.%d_%d%s",
                               $self->_backup_dir,
                               $basename,
                               POSIX::strftime("%Y-%m-%d_%H%M%S",localtime()),
                               (Time::HiRes::gettimeofday())[1],
                               $$,
                               ($n == 0 ? "" : ".$n"),
                              );
        last unless -f $backup_file;
        $n++;
    }
    croak "already exists backup file: $backup_file" if -f $backup_file;

    copy_preserving_attr($self->_target_file, $backup_file);
}


sub delete {
    my $self = shift;
    unless ($self->_closed(1)) {
        $self->SUPER::close();
        return unlink($self->_temp_file);
    }
    1;
}

sub detach {
    my $self = shift;
    $self->SUPER::close() unless ($self->_closed(1));
    1;
}

sub copy_preserving_attr {
    my($from, $to) = @_;

    File::Copy::copy($from, $to) or croak $!;

    my($mode, $uid, $gid, $atime, $mtime) = (stat($from))[2,4,5,8,9];
    chown $uid, $gid, $to;
    chmod $mode,      $to;
    utime $atime, $mtime, $to;
    1;
}


1;
__END__