line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::perlmv::scriptlets::std; |
2
|
|
|
|
|
|
|
|
3
|
15
|
|
|
15
|
|
313
|
use 5.010; |
|
15
|
|
|
|
|
69
|
|
4
|
15
|
|
|
15
|
|
94
|
use strict; |
|
15
|
|
|
|
|
40
|
|
|
15
|
|
|
|
|
470
|
|
5
|
15
|
|
|
15
|
|
84
|
use warnings; |
|
15
|
|
|
|
|
39
|
|
|
15
|
|
|
|
|
3926
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY |
8
|
|
|
|
|
|
|
our $DATE = '2023-07-15'; # DATE |
9
|
|
|
|
|
|
|
our $DIST = 'App-perlmv'; # DIST |
10
|
|
|
|
|
|
|
our $VERSION = '0.608'; # 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__ |