#!/usr/bin/perl -w
#
###############################################
# #
# xboxnames.pl v1.0 20040211 #
# #
###############################################
# LICENSE:
# ========
#
# Copyright (C)2004 Fredrik Rodland - fmr_at_rodland_dot_no,
# http://rodland.no This program and all its previous versions, are free
# software; you can redistribute it and/or modify it under the terms of
# the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any
# later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You may get a copy of GPLv2 at http://www.gnu.org/licenses/gpl.txt
#
# DISCLAMER:
# ==========
# You're using this at your own risk. I will not be held accountable
# this produces results less than desirable. Before doing anything
# you'll regret, backup whatever it is you'll be working on.
#
# THANKS:
# =======
# - thanx to jinx_removing for writing the readme to "baRenameX
# v0.99a" (http://www.xbins.org/nfo.php?file=xboxnfo417.nfo)
#
# TODO:
# =====
# run script with -h options for a list of things to do, or read the
# text at the bottom of the script
#
# BEHAVIOR:
# =========
# run script with -h options to see what's going on, or read the text
# at the bottom of the script
# REQUIRES:
# =========
# - Perl
# - Perl-lib: File::Find
# - Perl-lib: Getopt::Std
use strict;
use File::Find;
use Getopt::Std;
# used in regexp to remove these chars original version was:
# '[<>=?*+\|\/=;:,]', punctuations has their own replacement-mapping
# in %subst_chars
my $not_allowed = "[<>=?*+\|\/=]";
my $remove_multiple = "[/W_]";
my $allowed_non_word_no_closing_parant = "-_.( &";
my $allowed_non_word = ")$allowed_non_word_no_closing_parant";
# only these chars will be kept at the end
my $allowed = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$allowed_non_word";
# the following substitution will be made
my %subst_chars = ("ø" => "o",
"Ø" => "O",
"æ" => "a",
"Æ" => "A",
"{" => "(",
"[" => "(",
"]" => ")",
"," => ".",
";" => ".",
":" => ".",
"}" => ")",
"å" => "a",
"Å" => "A");
# this is the std substitution if a char does not exist in %subst_chars
my $subst_char = "_";
my $root_dir = "/home/mp3";
my $action = "Moving";
# max length of a filename on the XBOX.
my $max_length = 42;
# parsing input-arguments and showing help (usage) if -h is given as arument
my %opt;
getopts("qtvrhw", \%opt) or usage();
usage() if $opt{h};
my $quiet = $opt{q};
my $real = $opt{r};
my $test = (! $real) || $opt{t};
my $werbose = $opt{w};
my $verbose = $werbose || $test || $opt{v};
$action = "Would move" if $test;
if (defined $ARGV[0]) {
$root_dir = $ARGV[0];
}
if (! -d $root_dir) {
die("directory $root_dir not found\nfor usage/help: $0 -h\n");
}
finddepth(\&check_and_move_file, $root_dir);
sub check_and_move_file{
my $file = $_;
my $new_file = $file;
# do not attempt to do anything on '.'
return if /^\.+$/;
#my $dir = $File::Find::dir;
#my $full_path = $File::Find::name;
$new_file = replace_chars($new_file);
$new_file = trim($new_file);
$new_file = capitalize($new_file);
$new_file = fix_length($new_file);
$new_file = match_paranthesis($new_file);
$new_file = clean_up($new_file);
if ($file ne $new_file) {
verbose("$action $file ==> $new_file");
if (! $test) {
my $ren_result = rename ($file, $new_file);
if (! $ren_result) {
error("NOT SUCCESSFULL WITH LAST RENAME: $ren_result");
}
}
} else {
werbose("Filenames are equal: $file");
}
}
#
# the operations in the other functions tend to end up with some odd
# constructs. This function whould be run last to clean the filename.
sub clean_up{
my $file = $_[0];
# replaces '_ _' with '_'
while ($file =~ s/_ _/_/g) { }
# my $parant_reg = "(\\([^\\)]*\\))";
# my @parantheses = ($file =~ /$parant_reg/g); # matches,
# $file =~ /(\([^\)]*\))/g;
# foreach (@parantheses) {
# print "HHHH " . $_ . "\n";
# }
# replace special char followed by dot with dot.
while ($file =~ s/[$allowed_non_word_no_closing_parant]\./\./g) { }
# while ($file =~ s/[$allowed_non_word]\./\./g) { }
# remove empty parantheses
$file =~ s/\(\)//g;
werbose("Cleaned up name for odd char-sequences.");
return $file;
}
#
# ensures equal # of paranthesis. See comment in code for more info.
sub match_paranthesis{
my $file = $_[0];
my $last_dot = rindex ($file, ".");
my $ext = "";
my $pre = $file;
if ($last_dot != -1) {
$ext = substr ($file, $last_dot);
$pre = substr ($file, 0, $last_dot);
}
my $length_pre = length($pre);
# if we have an opening paranthesis but no closing, replace the
# last char in $pre with an ending paranthesis.
my @opn = ($pre =~ /\(/g); # matches,
my @cl = ($pre =~ /\)/g); # matches,
my $opening = @opn;
my $closing = @cl;
if ($opening > $closing) {
werbose("$opening opening but only $closing closing paranthesis - forcing a close $pre");
# handling the rare case where the additional paranthesis is
# at the end. In this case just delete it. else replace the
# last char of $pre with a closing paranthesis.
if (substr($pre, $length_pre -1, 1) eq "(") {
$pre = substr($pre, 0, $length_pre - 1);
} else {
$pre = substr($pre, 0, $length_pre - 1) . ")";
}
} elsif ($closing > $opening) {
werbose("more closing ($closing) than opening ($opening) paranthesis - removing last");
$pre =~ s/(.*)\)/$1/;
}
return $pre . $ext;
}
#
# ensures that the entire filename is under $max_length (42 for XBOX).
# The file-ext is left unchanged.
sub fix_length{
my $file = $_[0];
my $length = length($file);
if ($length <= $max_length) {
return $file;
}
my $last_dot = rindex ($file, ".");
my $ext = "";
my $pre = $file;
if ($last_dot != -1) {
$ext = substr ($file, $last_dot);
$pre = substr ($file, 0, $last_dot);
}
my $length_ext = length($ext);
my $length_pre = length($pre);
my $new_length_pre = $max_length - $length_ext;
my $missed = substr($pre, $new_length_pre);
werbose("File to longer than $max_length - shortened (removed '$missed')");
return $pre . $ext;
}
#
# Removes leading spaces, trailing spaces, and spaces before and after
# all '.'
sub trim{
my $file = $_[0];
# trim leading and trailing spaces from filename
if ($file =~ s/^\s*(.*?)\s*$/$1/) {
werbose("Trimmed edges");
}
#removes all spaces before and after dot ('.')
if ($file =~ s/ +\. */./g){
werbose("Removed spaces before.");
}
return $file;
}
#
# Capitalizes - but does not capitalize words imidiatly following
# non-whitespaces (i.e. '.', '_' etc)
sub capitalize{
my $file = $_[0];
# Capiltalize
if ($file =~ s/\s(\S)/ \u\L$1/g) {
werbose("Capitalized");
}
return $file;
}
#
# Replaces all unknown characters with '_'. Replaces accordingly to
# %subst_chars. Replaces multiple spaces following each other with one
# single. Ditto with multiple '_'.
sub replace_chars{
my $file = $_[0];
if ($file =~ s/$not_allowed/_/g) {
werbose("removed illegal chars ($not_allowed)");
}
my $new_file = "";
my $previous_char = "a";
my @str_to_check = split //, $file;
foreach my $char (@str_to_check) {
my $orig_char = $char;
if (index($allowed, $char) == -1) {
$char = $subst_chars{$char};
if (! defined $char) {
$char = $subst_char;
}
werbose("replacing char: $orig_char => $char");
}
#my $remove_multiple = "[ -]";
if (! ($previous_char =~ /(\W|_)/ && $char eq $1)) {
$new_file .= $char;
}
$previous_char = $char;
}
return $new_file;
}
#
# Various functions for printing, depending on log-level. Errors are
# printed to STDERR.
#
sub out {
print "$_[0]\n" unless $quiet;
}
sub verbose {
print " $_[0]\n" if ($verbose && ! $quiet);
}
sub werbose {
print " $_[0]\n" if ($werbose && ! $quiet);
}
sub error {
my $str = "*** " . uc($_[0]). "\n";
print STDERR $str;
}
#
# Prints usage with options
sub usage {
print <<END_USAGE;
Usage: xboxify.pl [-rqvWth] directory_to_start
Copyright (c) 2004 - Fredrik Rodland
Script that changes names on both files and directories to comply with
xbox's restrictions on which, and the number of characters allowed.
Instead of just stripping the number of chars, the script tries to
free som characters not used, replces redundant characters. Finally it
tries to beautify the filename before renaming the files.
No actions takes place unless the -r option is passed on.
directory_to_start is traversed recursivly.
Options:
-r really do the renaming. Without this option nothing is done -
only printing to screen
-q quiet - does not produce output
-v verbose (prints files that are renamed)
-w very verbose (prints chars that are replace) (implies -v)
-t does not move file - only prints what it should do (implies -v)
-h prints this message (no execution is performed)
Todo:
- check which chars are really supported on xbox and reverse these
back
- find out it's the entire filname (with ext) which cannot extend
42 chars on xbox, or if it's only the first protion.
- implement a has with search/replace functionality to use
abreviations for common words.
- actually run script on my entire mp3-collection.
- actually ftp my mp3-collecrtion to the xbox, and if filenames
still have errors, fix the bugs in this script, and ftp again.
- document behavior (in detail) - i.e. which tests are run etc.)
- add command-line options for the various parts which is not
mandatory-xbox
- add some counters and print a summary of what's been done
(unless quiet) is set
- add option to delete all spaces and/or special characters before
cropping filename.
END_USAGE
exit;
}
Generated by GNU enscript 1.6.4.