File Coverage

blib/lib/File/Util/Rename.pm

Criterion	Covered	Total	%
statement	14	38	36.8
branch	0	16	0.0
condition	0	4	0.0
subroutine	5	7	71.4
pod	2	2	100.0
total	21	67	31.3

package File::Util::Rename;

use 5.010001;
use strict;
use warnings;
use Log::ger;

use Exporter 'import';

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2025-03-28'; # DATE
our $DIST = 'File-Util-Rename'; # DIST
our $VERSION = '0.003'; # VERSION

our @EXPORT_OK = qw(
                       rename_noclobber
                       rename_warnclobber
               );

sub rename_noclobber {
    my $opts = ref $_[0] eq 'HASH' ? shift : {};
    $opts->{pattern} //= " (%02d)";

    my ($from, $to) = @_;
    my $ext; $to =~ s/(\.\w+)\z// and $ext = $1;

    my $i = 0;
    my $to_final;
    while (1) {
        if ($i) {
            my $suffix = sprintf $opts->{pattern}, $i;
            $to_final = $ext ? "$to$suffix$ext" : "$to$suffix";
        } else {
            $to_final = $to;
        }
        lstat $to_final;
        last unless -e _;
        $i++;
    }
    rename $from, $to_final;
}

sub rename_warnclobber {
    my $opts = ref $_[0] eq 'HASH' ? shift : {};
    $opts->{log} //= 0;

    my ($from, $to) = @_;

    if (-e $to) {
        if ($opts->{log}) {
            log_warn "rename_warnclobber(`$from`, `$to`): Target already exists, renaming anyway ...";
        } else {
            warn "rename_warnclobber(`$from`, `$to`): Target already exists, renaming anyway ...\n";
        }
    }

    rename $from, $to;
}

1;
# ABSTRACT: Utilities related to renaming files

__END__