Avoiding Wallop with Perl

This is a little bit of Perl code that copies a file, but if a file by that name exists, appends a number between the name and the suffix.

view plainprint?

1. #!/usr/bin/perl  
2. use Modern::Perl ;  
3. use File::Copy ;  
4.   
5. my $from = '/home/jacoby/test.test.pl' ;  
6. my $to   = '/home/jacoby/target.target.pl' ;  
7.   
8. while ( -f $to ) {  
9.     my @to = split m{\.}mx , $to ;  
10.     my $suffix = pop @to ;  
11.     if ( scalar @to == 1 ) {  
12.         my $num = 1 ;  
13.         push @to , $num ;  
14.         push @to , $suffix ;  
15.         }  
16.     elsif ( $to[-1]  !~ m{\D}mx ) {  
17.         my $num = pop @to ;  
18.         $num ++ ;  
19.         push @to , $num ;  
20.         push @to , $suffix ;  
21.         }  
22.     else {  
23.         my $num = 1 ;  
24.         push @to , $num ;  
25.         push @to , $suffix ;  
26.         }  
27.     $to = join '.' , @to ;  
28.     }  
29. say "F\t" . $from ;  
30. say "T\t" . $to ;  
31. copy $from , $to ;  

#!/usr/bin/perl
use Modern::Perl ;
use File::Copy ;

my $from = '/home/jacoby/test.test.pl' ;
my $to   = '/home/jacoby/target.target.pl' ;

while ( -f $to ) {
    my @to = split m{\.}mx , $to ;
    my $suffix = pop @to ;
    if ( scalar @to == 1 ) {
        my $num = 1 ;
        push @to , $num ;
        push @to , $suffix ;
        }
    elsif ( $to[-1]  !~ m{\D}mx ) {
        my $num = pop @to ;
        $num ++ ;
        push @to , $num ;
        push @to , $suffix ;
        }
    else {
        my $num = 1 ;
        push @to , $num ;
        push @to , $suffix ;
        }
    $to = join '.' , @to ;
    }
say "F\t" . $from ;
say "T\t" . $to ;
copy $from , $to ;