torn

   1 #!/usr/bin/env perl
   2 # torn - Musical files renaming with russian language transliteration
   3 # Copyright (C) 2007-2019 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 directorires to be renamed.
  29
  30 =head1 OVERVIEW
  31
  32 =over 4
  33
  34 =item * Transliterate everything
  35
  36 =item * Replaces spaces with underscore
  37
  38 =item * Downcase all extensions
  39
  40 =item * "_-_" so good looking on the screen is replaced by single dash
  41
  42 =item * Remove spaces before and after brackets
  43
  44 =item * Remove "[]" brackets
  45
  46 =item * Replace ampersand with "and" word
  47
  48 =back
  49
  50 =head1 AUTHOR
  51
  52 Sergey Matveev L<mailto:stargrave@stargrave.org>
  53
  54 =cut
  55
  56 use strict;
  57 use utf8;
  58 use Encode;
  59
  60 binmode STDOUT, ":utf8";
  61
  62 my $VERSION = "0.9";
  63
  64 my $src;
  65 my $dst;
  66 my $src_filename;
  67
  68 print "torn version $VERSION, Copyright (C) 2007-2019 Sergey Matveev
  69 torn comes with ABSOLUTELY NO WARRANTY.  This is free software,
  70 and you are welcome to redistribute it under certain conditions.\n\n";
  71
  72 opendir DIR, "." or die "Can not open directory\n";
  73 foreach (sort readdir DIR) {
  74     # Skip directory itself
  75     next if /^\.{1,2}$/;
  76
  77     $src_filename = $_;
  78     $src = decode "utf-8", $src_filename;
  79     $dst = $src;
  80
  81     # Basic corrections for music files
  82     $dst =~ s/ /_/g;
  83     $dst =~ s/_-_/-/g;
  84     $dst =~ s/_\(/\(/g;
  85     $dst =~ s/-\(/-/g;
  86     $dst =~ s/\)_/-/g;
  87     $dst =~ s/\,_/\,/g;
  88     $dst =~ s/\[//g;
  89     $dst =~ s/\]//g;
  90     $dst =~ s/\(_/\(/g;
  91     $dst =~ s/_\)/\)/g;
  92     $dst =~ s/\&/and/g;
  93
  94     # Make translit
  95     $dst =~ y/абвгдеёзийклмнопрстуфхцьъыэ/abvgdeezijklmnoprstufhcjjye/;
  96     $dst =~ y/АБВГДЕЁЗИЙКЛМНОПРСТУФХЦЬЪЫЭ/ABVGDEEZIJKLMNOPRSTUFHCJJYE/;
  97     $dst =~ s/ж/zh/g;
  98     $dst =~ s/ч/ch/g;
  99     $dst =~ s/ш/sh/g;
 100     $dst =~ s/щ/sch/g;
 101     $dst =~ s/я/ja/g;
 102     $dst =~ s/ю/ju/g;
 103     $dst =~ s/Ж/Zh/g;
 104     $dst =~ s/Ч/Ch/g;
 105     $dst =~ s/Ш/Sh/g;
 106     $dst =~ s/Щ/Sch/g;
 107     $dst =~ s/Я/Ja/g;
 108     $dst =~ s/Ю/Ju/g;
 109
 110     # Lowercase file extensions
 111     if($dst =~ /^(.*)\.([^\.]+)$/){
 112         $dst = $1 . "." . lc $2;
 113     };
 114
 115     # Change looking of track numbers
 116     # And renaming itself
 117     if($dst =~ /^(\d+)\-(.+)$/){
 118         print "$src -> $1.$2\n";
 119         rename $src_filename, "$1.$2";
 120     } else {
 121         print "$src -> $dst\n";
 122         rename $src_filename, $dst;
 123     };
 124 };
 125 closedir DIR;