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; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 =pod
  19
  20 =head1 DESCRIPTION
  21
  22 This Perl script takes directory file list and renames all files,
  23 making some substitution changes.  It has some rules for musical
  24 files and rules to convert russian filenames to translit.
  25
  26 =head1 USAGE
  27
  28 Simply run this script in directory where you want files and/or
  29 directorires to be renamed.
  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.9";
  64
  65 my $src;
  66 my $dst;
  67 my $src_filename;
  68
  69 print "torn version $VERSION, Copyright (C) 2007-2019 Sergey Matveev
  70 torn comes with ABSOLUTELY NO WARRANTY.  This is free software,
  71 and you are welcome to redistribute it under certain conditions.\n\n";
  72
  73 opendir DIR, "." or die "Can not open directory\n";
  74 foreach (sort readdir DIR) {
  75     # Skip directory itself
  76     next if /^\.{1,2}$/;
  77
  78     $src_filename = $_;
  79     $src = decode "utf-8", $src_filename;
  80     $dst = $src;
  81
  82     # Basic corrections for music files
  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/_\)/\)/g;
  93     $dst =~ s/\&/and/g;
  94
  95     # Make translit
  96     $dst =~ y/абвгдеёзийклмнопрстуфхцьъыэ/abvgdeezijklmnoprstufhcjjye/;
  97     $dst =~ y/АБВГДЕЁЗИЙКЛМНОПРСТУФХЦЬЪЫЭ/ABVGDEEZIJKLMNOPRSTUFHCJJYE/;
  98     $dst =~ s/ж/zh/g;
  99     $dst =~ s/ч/ch/g;
 100     $dst =~ s/ш/sh/g;
 101     $dst =~ s/щ/sch/g;
 102     $dst =~ s/я/ja/g;
 103     $dst =~ s/ю/ju/g;
 104     $dst =~ s/Ж/Zh/g;
 105     $dst =~ s/Ч/Ch/g;
 106     $dst =~ s/Ш/Sh/g;
 107     $dst =~ s/Щ/Sch/g;
 108     $dst =~ s/Я/Ja/g;
 109     $dst =~ s/Ю/Ju/g;
 110
 111     # Lowercase file extensions
 112     if($dst =~ /^(.*)\.([^\.]+)$/){
 113         $dst = $1 . "." . lc $2;
 114     };
 115
 116     # Change looking of track numbers
 117     # And renaming itself
 118     if($dst =~ /^(\d+)\-(.+)$/){
 119         print "$src -> $1.$2\n";
 120         rename $src_filename, "$1.$2";
 121     } else {
 122         print "$src -> $dst\n";
 123         rename $src_filename, $dst;
 124     };
 125 };
 126 closedir DIR;