#!/usr/bin/perl -w
#by Torben Menke
#http://www.entorb.net
# renames pictures: img_1234 -> tm1234 etc
# prefix 'tm' can be chosen


use strict; #makes perl stricter: all new vars. have to be defined
use warnings;
use File::Spec;
use Data::Dumper;

my $prefix;
my $count = 0;
my $error = 0;
my $input;

if (!@ARGV){
@ARGV = <*>;
}
@ARGV = grep {-f} @ARGV;
$prefix = "tm";

print "\nEnter new file prefix [default: $prefix]: ";
$input = <STDIN>;
$input =~ s/^\s*([^\s]*)\s*/$1/; #cleaning white spaces

$prefix = $input unless $input eq '';

my $old;
my $new;
for $old (@ARGV) {
my $folder = getPathFromFile ($old);
my $filename = getNameFromFile ($old);
$new = $filename;
# check if file is from my Olympus: tMTTNNNN.jpg
if ($filename =~ m/^t([1-9a-d]\d{6}\.(jpe?g))$/) {
$new = "$prefix$1";
} else {
$new =~ s/^([^\d]+|\d{2,4}_)([\d]+)\.(jpe?g)$/\L$prefix$2\.$3\E/i; #\L = lowercase till \E
}
$new = join_dir($folder,$new);
if (($old ne $new) and not (-f $new)){
chmod 0644, $old unless -w $old;
if (rename $old,$new){
print " $old\n-> $new\n";
$count++;
} else {
print "ERROR: can not rename $old -> $new\n";
$error++;
}
} else {
print "SKIPPING $old\n";
}
}
print "Job done, $count Files renamed!!!\n";



# /tmp/dir1/dir2/filename.txt -> /tmp/dir1/dir2
sub getPathFromFile {
my @dir = File::Spec->splitdir( shift );
pop @dir; # remove last item (= filename)
return File::Spec->catdir(@dir);
}


# /tmp/dir1/dir2/filename.txt -> filename.txt
sub getNameFromFile {
my @dir = File::Spec->splitdir( shift );
return pop @dir;
}

# joins ($dir,$file) -> "$dir/$file", but make it also work in windows
sub join_dir {
my @dir = File::Spec->splitdir( shift );
my @path = File::Spec->splitdir( shift );
push @dir,@path;
return File::Spec->catdir(@dir);
}

---

Hope you found what you where looking for. Feel free to drop me a line
Torben