#!/usr/bin/perl -w use strict; use lib './lib'; use base 'LEOCHARRE::CLI'; use File::PathInfo::Ext; my $o = gopts('f'); my $files = argv_aspaths() or man(); scalar @$files or man(); my $f = new File::PathInfo::Ext; debug("f instanced\n"); RENAME : for (@$files){ $f->set($_) or warn("$0, bad file? : $_") and next RENAME; $f->is_file or warn("$0, is not file: $_") and next RENAME; my $oldname = $f->filename; my $newname = $f->filename_only; $newname=~s/\s+/_/g; $newname=~s/^\s+|\s+$//g; $newname=~s/[^\w\.\_\-]+//sig; my $x=''; if (-e $f->abs_loc."/$newname.".$f->ext){ while ( -e $f->abs_loc."/$newname$x.".$f->ext) { $x++; } } $newname = "$newname$x.".$f->ext; if ($oldname eq $newname){ next RENAME; } unless( $o->{f} ){ yn("Rename [$oldname] to [$newname]?") or next RENAME; } $f->rename($newname); } no warnings; sub main::man { print STDERR `perldoc $0`; exit; } =pod =head1 NAME renamerfpi =head1 DESCRIPTION This script cleans up filenames. It takes funny chars out. You are prompted for change unless you use the -f flag no files are overwritten =head1 OPTIONS -f force, no prompt =head1 USAGE renamerfpi ./files*jpg renamerfpi -f ./files*jpg =cut