File Coverage

blib/lib/IO/InSitu.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	13	20	65.0
condition	4	9	44.4
subroutine	14	14	100.0
pod	1	1	100.0
total	89	101	88.1

package IO::InSitu;

use version; $VERSION = qv('0.0.2');

use warnings;
use strict;
use Carp;

sub import {
    no strict 'refs';
    *{caller().'::open_rw'} = \&open_rw;
}

sub _make_tmp {
    my ($in_name) = @_;
    return "$in_name.bak";
}

sub open_rw {
    my $opt_arg = ref $_[-1] eq 'HASH' ? pop : {};

    my ($in_name, $out_name) = splice @_, 0, 2;
    $out_name = $in_name if !defined $out_name;

    croak 'Usage: open_rw($in_filename, $opt_out_filename, \%opt_options)'
        if @_ || !defined $out_name;

    my $make_tmp = defined $opt_arg->{tmp} ? $opt_arg->{tmp} : \&_make_tmp;

    croak "Can't open non-existent input file '$in_name'"
        if !( ref $in_name ||  -e $in_name );

    my ($in, $out);

    if (-e $out_name) {
        my ($in_dev,  $in_node)  = stat $in_name;
        my ($out_dev, $out_node) = stat $out_name;

        goto NORMAL_IN if $in_dev != $out_dev || $in_node != $out_node;

        use File::Temp qw( :POSIX );

        my $tmp_name = $make_tmp->($in_name);

        use File::Copy;
        copy($in_name, $tmp_name);

        $in = IO::File::SE->new($tmp_name, '<')
            or croak "Can't open copy of input file '$in_name'";

        goto NORMAL_OUT;
    }

NORMAL_IN:
    open $in, '<', $in_name
        or croak "Can't open input file '$in_name': $!";

NORMAL_OUT:
    open $out, '>', $out_name
        or croak "Can't open output file '$out_name': $!";

    return ($in, $out);
}

package IO::File::SE;
use base qw( IO::File );
use Carp;

my %file_name_of;

sub new {
    my ($class, $name, @otherargs) = @_;
    my $fh = $class->SUPER::new($name, @otherargs);
    $file_name_of{$fh} = $name;
    return $fh;
}

sub DESTROY {
    my ($self) = @_;
    $self->SUPER::DESTROY();
    unlink $file_name_of{$self};
    return;
}

1; # Magic true value required at end of module
__END__