File Coverage

blib/lib/File/Symlink/Atomic.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	3	6	50.0
condition			n/a
subroutine	6	6	100.0
pod	1	1	100.0
total	36	39	92.3

package File::Symlink::Atomic;
use strict;
use warnings;
# ABSTRACT: an atomic drop-in replacement for CORE::symlink
our $VERSION = '0.002'; # VERSION

use File::Temp;
use File::Spec;
use Exporter qw(import);
our @EXPORT = qw(symlink); ## no critic(Modules::ProhibitAutomaticExportation)


sub symlink($$) { ## no critic(Subroutines::ProhibitSubroutinePrototypes Subroutines::ProhibitBuiltinHomonyms)
    my $symlink_target = shift;
    my $symlink_name   = shift;

    my ($volume, $dirs, $file) = File::Spec->splitpath($symlink_name);
    my $template = File::Spec->catpath($volume, $dirs, ".$file.$$.XXXXXX");
    my $tmp_symlink_name;
    ATTEMPT:
    for (1..10) { # try 10 times
        $tmp_symlink_name = mktemp($template);
        symlink $symlink_target, $tmp_symlink_name and last ATTEMPT;
    }
    return 0 unless -l $tmp_symlink_name; # wtf?

    rename $tmp_symlink_name, $symlink_name or return 0; # should be atomic
    return 1;
}

1;


__END__