File Coverage

blib/lib/App/perlmv/scriptlet/remove_common_prefix.pm

Criterion	Covered	Total	%
statement	11	11	100.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	15	15	100.0

package App::perlmv::scriptlet::remove_common_prefix;

use 5.010001;
use strict;
use warnings;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-06-30'; # DATE
our $DIST = 'App-perlmv'; # DIST
our $VERSION = '0.607'; # VERSION

our $SCRIPTLET = {
    summary => 'Remove prefix that are common to all args, e.g. (file1, file2b) -> (1, 2b)',
    code => sub {
        package
            App::perlmv::code;
        use vars qw($COMMON_PREFIX $TESTING $FILES);

        if (!defined($COMMON_PREFIX) && !$TESTING) {
            my $i;
            for ($i=0; $i[0]); $i++) {
                last if grep { substr($_, $i, 1) ne substr($FILES->[0], $i, 1) } @{$FILES}[1..@$FILES-1];
            }
            $COMMON_PREFIX = substr($FILES->[0], 0, $i);
        }

        s/^\Q$COMMON_PREFIX//;
        $_;
    },
};

1;

# ABSTRACT: Remove prefix that are common to all args, e.g. (file1, file2b) -> (1, 2b)

__END__