File Coverage

blib/lib/App/FileRenameUtils.pm
Criterion Covered Total %
statement 25 25 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 34 34 100.0


line stmt bran cond sub pod time code
1             package App::FileRenameUtils;
2              
3 1     1   64855 use 5.010001;
  1         13  
4 1     1   6 use strict;
  1         2  
  1         101  
5 1     1   7 use warnings;
  1         2  
  1         39  
6              
7 1     1   6 use Exporter 'import';
  1         2  
  1         96  
8              
9             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
10             our $DATE = '2023-03-02'; # DATE
11             our $DIST = 'App-FileRenameUtils'; # DIST
12             our $VERSION = '0.009'; # VERSION
13              
14             our @EXPORT_OK = qw(add_filename_suffix find_unique_filename);
15              
16             sub add_filename_suffix {
17 1     1   7 no warnings 'uninitialized';
  1         2  
  1         184  
18              
19 7     7 1 2374 my ($filename, $suffix) = @_;
20 7         63 $filename =~ s/(.+?)(\.\w+)?\z/$1 . $suffix . $2/e;
  7         32  
21 7         104 $filename;
22             }
23              
24             sub find_unique_filename {
25 4     4 1 2651 my $filename = shift;
26              
27 4         7 my $orig_filename = $filename;
28 4         7 my $i = 0;
29 4         71 while (-e $filename) {
30 5         13 $i++;
31 5         20 $filename = add_filename_suffix($orig_filename, " ($i)");
32             }
33 4         33 $filename;
34             }
35              
36             1;
37             # ABSTRACT: Utilities related to renaming/moving files
38              
39             __END__