File Coverage

blib/lib/App/perlmv/scriptlets/std.pm
Criterion Covered Total %
statement 8 8 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 11 11 100.0


line stmt bran cond sub pod time code
1             package App::perlmv::scriptlets::std;
2              
3 15     15   298 use 5.010;
  15         75  
4 15     15   95 use strict;
  15         40  
  15         434  
5 15     15   115 use warnings;
  15         32  
  15         3784  
6              
7             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
8             our $DATE = '2023-06-30'; # DATE
9             our $DIST = 'App-perlmv'; # DIST
10             our $VERSION = '0.607'; # VERSION
11              
12             # ABSTRACT: A collection of perlmv scriptlets
13              
14              
15             our %scriptlets;
16              
17              
18             $scriptlets{'dedup-space'} = <<'EOT';
19             ### Summary: Replace multiple spaces into a single space, example: "1 2.txt " -> "1 2.txt"
20             s/\s{2,}/ /g; $_
21             EOT
22              
23              
24             $scriptlets{'keep-one-ext'} = <<'EOT';
25             ### Summary: Remove all but the last file extension if there are more than one, e.g. (1.tar, 2.mp3.mp3) -> (1.tar, 2.mp3)
26             s/(.+?)(?:\.\w{1,5})+(\.\w{1,5})$/$1$2/
27             EOT
28              
29              
30             $scriptlets{'pinyin'} = <<'EOT';
31             ### Summary: Rename Chinese characters in filename into their pinyin
32             ### Requires: Lingua::Han::Pinyin
33             use Lingua::Han::PinYin;
34             $h||=Lingua::Han::PinYin->new; $h->han2pinyin($_)
35             EOT
36              
37              
38             $scriptlets{'remove-ext'} = <<'EOT';
39             ### Summary: Remove the last file extension, e.g. (1, 2.mp3, 3.tar.gz) -> (1, 2, 3.tar)
40             s/(.+)\.\w{1,5}$/$1/
41             EOT
42              
43              
44             $scriptlets{'remove-all-ext'} = <<'EOT';
45             ### Summary: Remove all file extensions, e.g. (file.html.gz) -> (file)
46             s/(.+?)(?:\.\w{1,5})+$/$1/
47             EOT
48              
49              
50             $scriptlets{'to-number'} = <<'EOT';
51             ### Summary: Rename files into numbers. Ex: (file1.txt, foo.jpg, quux.mpg) -> (1, 2, 3)
52             if ($COMPILING || $CLEANING) { $i=0 } else { $i++ }
53             $ndig = @$FILES >= 1000 ? 4 : @$FILES >= 100 ? 3 : @$FILES >= 10 ? 2 : 1;
54             sprintf "%0${ndig}d", $i
55             EOT
56              
57              
58             $scriptlets{'to-number-ext'} = <<'EOT';
59             ### Summary: Rename files into numbers. Preserve extensions. Ex: (file1.txt, foo.jpg, quux.mpg) -> (1.txt, 2.jpg, 3.mpg)
60             if ($COMPILING || $CLEANING) { $i=0 } else { $i++ }
61             if (/.+\.(.+)/) {$ext=$1} else {$ext=undef}
62             $ndig = @$FILES >= 1000 ? 4 : @$FILES >= 100 ? 3 : @$FILES >= 10 ? 2 : 1;
63             sprintf "%0${ndig}d%s", $i, (defined($ext) ? ".$ext" : "")
64             EOT
65              
66              
67             $scriptlets{'to-timestamp'} = <<'EOT';
68             ### Summary: Rename files into timestamp. Ex: file1.txt -> 2010-05-13-10_43_49
69             use POSIX;
70             @st = lstat $_;
71             POSIX::strftime("%Y-%m-%d-%H_%M_%S", localtime $st[9])
72             EOT
73              
74              
75             $scriptlets{'to-timestamp-ext'} = <<'EOT';
76             ### Summary: Rename files into timestamp. Preserve extensions. Ex: file1.txt -> 2010-05-13-10_43_49.txt
77             use POSIX; /.+\.(.+)/; $ext=$1;
78             @st = lstat $_;
79             POSIX::strftime("%Y-%m-%d-%H_%M_%S", localtime $st[9]).(defined($ext) ? ".$ext" : "")
80             EOT
81              
82              
83             $scriptlets{'trim'} = <<'EOT';
84             ### Summary: Remove leading and trailing blanks, example: " abc def .txt " -> "abc def.txt"
85             s/^\s+//; s/\s+(\.\w{1,8})?$/$1/; $_
86             EOT
87              
88              
89             $scriptlets{'unaccent'} = <<'EOT';
90             ### Summary: Remove accents in filename, e.g. accĂ©der.txt -> acceder.txt
91             ### Requires: Text::Unaccent::PurePerl
92             use Text::Unaccent::PurePerl;
93             unac_string("UTF8", $_)
94             EOT
95              
96              
97             1;
98              
99             __END__