torn.pl

   1 #!/usr/bin/env perl
   2 # torn - Musical files renaming with russian language transliteration
   3 # Copyright (C) 2007-2021 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 This version is unsupported! Use Z shell-based implementation instead.
  26
  27 =head1 USAGE
  28
  29 Simply run this script in directory where you want files and/or
  30 directories to be renamed. Directories are not transliterated by
  31 default, but you can use FORCE_DIR=1 environment variable.
  32
  33 =head1 OVERVIEW
  34
  35 =over 4
  36
  37 =item * Transliterate everything
  38
  39 =item * Replaces spaces with underscore
  40
  41 =item * Downcase all extensions
  42
  43 =item * "_-_" so good looking on the screen is replaced by single dash
  44
  45 =item * Remove spaces before and after brackets
  46
  47 =item * Remove "[]" brackets
  48
  49 =item * Replace ampersand with "and" word
  50
  51 =back
  52
  53 =head1 AUTHOR
  54
  55 Sergey Matveev L<mailto:stargrave@stargrave.org>
  56
  57 =cut
  58
  59 use strict;
  60 use utf8;
  61 use Encode;
  62
  63 binmode STDOUT, ":utf8";
  64
  65 my $VERSION = "0.10";
  66
  67 my $src;
  68 my $dst;
  69 my $src_filename;
  70
  71 if ($#ARGV >= 0) {
  72     print "torn version $VERSION, Copyright (C) 2007-2023 Sergey Matveev
  73 torn comes with ABSOLUTELY NO WARRANTY.  This is free software,
  74 and you are welcome to redistribute it under certain conditions.\n
  75 Usage: just run inside the directory. Look for POD inside the script itself.\n";
  76 };
  77
  78 opendir DIR, "." or die "Can not open directory\n";
  79 foreach (sort readdir DIR) {
  80     # Skip directory itself
  81     next if /^\.{1,2}$/;
  82     next if -d and not $ENV{FORCE_DIR};
  83
  84     $src_filename = $_;
  85     $src = decode "utf-8", $src_filename;
  86     $dst = $src;
  87
  88     # Basic corrections for music files
  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/\(_/\(/g;
  98     $dst =~ s/_\)/\)/g;
  99     $dst =~ s/\&/and/g;
 100
 101     # Make translit
 102     $dst =~ y/абвгдеёзийклмнопрстуфхцьъыэ/abvgdeezijklmnoprstufhcjjye/;
 103     $dst =~ y/АБВГДЕЁЗИЙКЛМНОПРСТУФХЦЬЪЫЭ/ABVGDEEZIJKLMNOPRSTUFHCJJYE/;
 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     $dst =~ s/Ж/Zh/g;
 111     $dst =~ s/Ч/Ch/g;
 112     $dst =~ s/Ш/Sh/g;
 113     $dst =~ s/Щ/Sch/g;
 114     $dst =~ s/Я/Ja/g;
 115     $dst =~ s/Ю/Ju/g;
 116
 117     # Lowercase file extensions
 118     if ($dst =~ /^(.*)\.([^\.]+)$/) {
 119         $dst = $1 . "." . lc $2;
 120     };
 121
 122     # Change looking of track numbers
 123     if ($dst =~ /^(\d+)[-.]_*(.+)$/) {
 124         $dst = "$1.$2";
 125     };
 126
 127     next if ($src_filename eq $dst);
 128     print "$src -> $dst\n";
 129     die "\"$dst\" exists" if -e $dst;
 130     rename $src_filename, $dst;
 131 };
 132 closedir DIR;