73d84fc874d690d652af303b3c0a301fe07f09e3
[torn.git] / torn
1 #!/usr/bin/env perl
2 # torn - Musical files renaming with russian language transliteration
3 # Copyright (C) 2007-2022 Sergey Matveev (stargrave@stargrave.org)
4 #
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation, version 3 of the License.
8 #
9 # This program is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 # GNU General Public License for more details.
13 #
14 # You should have received a copy of the GNU General Public License
15 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
16
17 =pod
18
19 =head1 DESCRIPTION
20
21 This Perl script takes directory file list and renames all files,
22 making some substitution changes.  It has some rules for musical
23 files and rules to convert russian filenames to translit.
24
25 =head1 USAGE
26
27 Simply run this script in directory where you want files and/or
28 directories to be renamed. Directories are not transliterated by
29 default, but you can use FORCE_DIR=1 environment variable.
30
31 =head1 OVERVIEW
32
33 =over 4
34
35 =item * Transliterate everything
36
37 =item * Replaces spaces with underscore
38
39 =item * Downcase all extensions
40
41 =item * "_-_" so good looking on the screen is replaced by single dash
42
43 =item * Remove spaces before and after brackets
44
45 =item * Remove "[]" brackets
46
47 =item * Replace ampersand with "and" word
48
49 =back
50
51 =head1 AUTHOR
52
53 Sergey Matveev L<mailto:stargrave@stargrave.org>
54
55 =cut
56
57 use strict;
58 use utf8;
59 use Encode;
60
61 binmode STDOUT, ":utf8";
62
63 my $VERSION = "0.10";
64
65 my $src;
66 my $dst;
67 my $src_filename;
68
69 if ($#ARGV >= 0) {
70     print "torn version $VERSION, Copyright (C) 2007-2022 Sergey Matveev
71 torn comes with ABSOLUTELY NO WARRANTY.  This is free software,
72 and you are welcome to redistribute it under certain conditions.\n
73 Usage: just run inside the directory. Look for POD inside the script itself.\n";
74 };
75
76 opendir DIR, "." or die "Can not open directory\n";
77 foreach (sort readdir DIR) {
78     # Skip directory itself
79     next if /^\.{1,2}$/;
80     next if -d and not $ENV{FORCE_DIR};
81
82     $src_filename = $_;
83     $src = decode "utf-8", $src_filename;
84     $dst = $src;
85
86     # Basic corrections for music files
87     $dst =~ s/ /_/g;
88     $dst =~ s/_-_/-/g;
89     $dst =~ s/_\(/\(/g;
90     $dst =~ s/-\(/-/g;
91     $dst =~ s/\)_/-/g;
92     $dst =~ s/\,_/\,/g;
93     $dst =~ s/\[//g;
94     $dst =~ s/\]//g;
95     $dst =~ s/\(_/\(/g;
96     $dst =~ s/_\)/\)/g;
97     $dst =~ s/\&/and/g;
98
99     # Make translit
100     $dst =~ y/абвгдеёзийклмнопрстуфхцьъыэ/abvgdeezijklmnoprstufhcjjye/;
101     $dst =~ y/АБВГДЕЁЗИЙКЛМНОПРСТУФХЦЬЪЫЭ/ABVGDEEZIJKLMNOPRSTUFHCJJYE/;
102     $dst =~ s/ж/zh/g;
103     $dst =~ s/ч/ch/g;
104     $dst =~ s/ш/sh/g;
105     $dst =~ s/щ/sch/g;
106     $dst =~ s/я/ja/g;
107     $dst =~ s/ю/ju/g;
108     $dst =~ s/Ж/Zh/g;
109     $dst =~ s/Ч/Ch/g;
110     $dst =~ s/Ш/Sh/g;
111     $dst =~ s/Щ/Sch/g;
112     $dst =~ s/Я/Ja/g;
113     $dst =~ s/Ю/Ju/g;
114
115     # Lowercase file extensions
116     if ($dst =~ /^(.*)\.([^\.]+)$/) {
117         $dst = $1 . "." . lc $2;
118     };
119
120     # Change looking of track numbers
121     if ($dst =~ /^(\d+)[-.]_*(.+)$/) {
122         $dst = "$1.$2";
123     };
124
125     next if ($src_filename eq $dst);
126     print "$src -> $dst\n";
127     die "\"$dst\" exists" if -e $dst;
128     rename $src_filename, $dst;
129 };
130 closedir DIR;