IO::File::AtomicChange - change content of a file atomically

  use IO::File::AtomicChange;

  my $fh = IO::File::AtomicChange->new("foo.conf", "w");
  $fh->print("# create new file\n");
  $fh->print("foo\n");
  $fh->print("bar\n");
  $fh->close; # MUST CALL close EXPLICITLY

  my $fh = IO::File::AtomicChange->new("foo.conf", "a",
                                       { backup_dir => "/var/backup/" });
  $fh->print("# append\n");
  $fh->print("baz\n");
  $fh->print("qux\n");
  $fh->close; # MUST CALL close EXPLICITLY

  * open
    1. fix filename of temporary file by mktemp.
    2. if target file already exists, copy target file to temporary file preserving permission and owner.
    3. open temporary file and return its file handle.

  * write
    1. write date into temporary file.

  * close
    1. close temporary file.
    2. if target file exists and specified "backup_dir" option, copy target file into backup directory preserving permission and owner, mtime.
    3. rename temporary file to target file.

  git clone git://github.com/hirose31/p5-io-file-atomicchange.git

package IO::File::AtomicChange;

use strict;
use warnings;

our $VERSION = '0.03';

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

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) = @_;
    File::Sync::fsync($self) or croak "fsync: $!";
    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__