Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

rename 0.3 - now with two extra cupholders

by Aristotle (Chancellor)
on Nov 01, 2003 at 15:43 UTC ( #303814=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info /msg Aristotle
Description:

Update: originally forgot to include shell metacharacter cleansing in --sanitize.

This is a much improved version of the script I posted at rename 0.2 - an improved version of the script which comes with Perl, which in turn is an evolution of the script that comes with Perl. (PodMaster informs me that it's only included in ActivePerl. I haven't looked.)

It now does everything I could personally ask for in such a script; thanks particularly to graff and sauoq for feedback and food for thought.

I also stole a few options from Peder Strey's rename on CPAN. That one has additional options for finely grained control over keeping backups of the files under their old names; personally, I don't see the merit. If you do, please let me know. In either case, even if anyone thinks such facilities would be good to have, I feel they should be provided by a more general mechanism. After all, this is a script you can pass Perl code to; while there's good reason to optimize for the common case, I feel it is better to leave the specialised cases to the expressive prowess of Perl rather than try to invent a narrowly defined interface for them.

Blue-sky stuff: just yesterday I also decided this is basically a perfect vehicle to build a batch MP3 processor onto. Now I plan to eventually add facilities for querying as well manipulating the ID3 tags in MP3 files alongside their filenames. Given a cleanly integrated interface, this script would naturally lend itself to that task and become a MP3 renamer to end all MP3 renamers - without even focussing on that task. Of course all MP3 processing stuff would be optional and its main purpose would still be plain old renaming of files.

Anyway, without further ado, have at it. Please give this a thorough whirl and let me know of any kinks.

#!/usr/bin/perl
use strict;
use warnings;

=head1 NAME

rename - renames multiple files

=head1 SYNOPSIS

F<rename>
B<-h>

F<rename>
S<B<[ -0 ]>>
S<B<[ -c | -C ]>>
S<B<[ -e code ]>>
S<B<[ -f ]>>
S<B<[ -i ]>>
S<B<[ -l | -L ]>>
S<B<[ -n ]>>
S<B<[ -s from to ]>>
S<B<[ -v ]>>
S<B<[ files ]>>

=head1 DESCRIPTION

C<rename> renames the filenames supplied according to the rules specif
+ied. If a given filename is not modified, it will not be renamed. If 
+no filenames are given on the command line, filenames will be read vi
+a standard input.

For example, to rename all files matching C<*.bak> to strip the extens
+ion, you might say

 rename 's/\.bak$//' *.bak

If are confident that none of the filenames has C<.bak> anywhere else 
+than at the end, you can also use the much easier typed

 rename -s .bak '' *.bak

You can always do multiple changes in one ago:

 rename -s .tgz .tar.gz -s .tbz2 .tar.bz2 *.tar.*

Note however that expressive options are order sensitive. The followin
+g would probably surprise you:

 rename -s foo bar -s bar baz *

Because changes are cumulative, this would end up substituting a F<foo
+> match in a filename with F<baz>, not F<bar>! To get the intended re
+sults in the above example, you could reverse the order of options:

 rename -s bar baz -s foo bar *

If you placed the C<-c> after the C<-e> in the above example, files wi
+th F<.zip> and F<.ZIP> extensions would be (attempted to be) moved to
+ different directories.

To translate uppercase names to lower, you'd use

 rename -c *

If you have files with control characters and blanks in their names, C
+<-z> will clean them up.

 rename -z *

You can combine all of these to suit your needs. F.ex files from Windo
+ws systems often have blanks and (sometimes nothing but) capital lett
+ers. Let's say you have a bunch of such files to clean up, and you al
+so want to move them to subdirectories based on extension. The follow
+ing command should help, provided all directories already exist:

 rename -cz -e '$_ = "$1/$_" if /(\..*)\z/' *

Again you need to pay attention to order sensitivity for expressive op
+tions. If you placed the C<-c> after the C<-e> in the above example, 
+files with F<.zip> and F<.ZIP> extensions would be (attempted to be) 
+moved to different directories because the directory name prefix woul
+d be added before the filenames were normalized.

=head1 ARGUMENTS

=over 4

=item B<-h>, B<--help>

Browse the manpage.

=back

=head1 OPTIONS

=over 4

=item B<-0>, B<--null>

When reading file names from C<STDIN>, split on null bytes instead of 
+newlines. This is useful in combination with GNU find's C<-print0> op
+tion, GNU grep's C<-Z> option, and GNU sort's C<-z> option, to name j
+ust a few. B<Only valid if no filenames have been given on the comman
+dline.>

=item B<-c>, B<--lower-case>

Converts file names to all lower case.

=item B<-C>, B<--upper-case>

Converts file names to all upper case.

=item B<-e>, B<--expr>

The C<code> argument to this option should be a Perl expression that a
+ssumes the filename in the C<$_> variable and modifies it for the fil
+enames to be renamed. When no other C<-c>, C<-C>, C<-e>, C<-s>, or C<
+-z> options are given, you can omit the C<-e> from infront of the cod
+e.

=item B<-f>, B<--force>

Rename even when a file with the destination name already exists.

=item B<-i>, B<--interactive>

Ask the user to confirm every action before it is taken.

=item B<-l>, B<--symlink>

Create symlinks from the new names to the existing ones, instead of re
+naming the files. B<Cannot be used in conjunction with C<-L>.>

=item B<-L>, B<--hardlink>

Create hard links from the new names to the existing ones, instead of 
+renaming the files. B<Cannot be used in conjunction with C<-l>.>

=item B<-n>, B<--dry-run>, B<--just-print>

Show how the files would be renamed, but don't actually do anything.

=item B<-s>, B<--subst>, B<--simple>

Perform a simple textual substitution of C<from> to C<to>. The C<from>
+ and C<to> parameters must immediately follow the argument.

This is equivalent to supplying a C<perlexpr> of C<s/\Qfrom/to/>.

=item B<-v>, B<--verbose>

Print additional information about the operations (not) executed.

=item B<-z>, B<--sanitize>

Replaces consecutive blanks, shell meta characters, and control charac
+ters in filenames with underscores.

=back

=head1 SEE ALSO

mv(1), perl(1), find(1), grep(1), sort(1)

=head1 AUTHORS

Aristotle Pagaltzis

Original code from Larry Wall and Robin Barker.

=head1 BUGS

None currently known.

=cut

use Pod::Usage;
use Getopt::Long;

sub DEBUG { print "@_\n" if $::LEVEL >= 2 }
sub INFO  { print "@_\n" if $::LEVEL >= 1 }
sub ERROR { print "@_\n" }

my @perlexpr;

Getopt::Long::Configure(qw(bundling no_ignore_case));
GetOptions(
    'h|help'               => sub { pod2usage( -verbose => 2 ) },
    '0|null'               => \my $opt_null,
    'c|lower-case'         => sub { push @perlexpr, 's/([[:upper:]]+)/
+\L$1/g' },
    'C|upper-case'         => sub { push @perlexpr, 's/([[:lower:]]+)/
+\U$1/g' },
    'e|expr=s'             => \@perlexpr,
    'f|force'              => \my $opt_force,
    'i|interactive'        => \my $opt_interactive,
    'l|symlink'            => \my $opt_symlink,
    'L|hardlink'           => \my $opt_hardlink,
    'n|just-print|dry-run' => \my $opt_dryrun,
    's|subst|simple'       => sub {
        pod2usage( -verbose => 1 ) if @ARGV < 2;
        my @param = map(quotemeta, splice @ARGV, 0, 2);
        # NB: ${\"..."} is necessary because unknown backslash escapes
+ are not
        # treated the same in pattern- vs doublequote-quoting context,
+ and we need
        # the latter to do the right thing with user input like 'foo{b
+ar}baz'
        push @perlexpr, sprintf 's/\Q${\"%s"}\E/%s/', @param;
    },
    'v|verbose+'           => \my $opt_verbose,
    'z|sanitize'           => sub { push @perlexpr, 's/[!"$&()=?`*\';<
+>|_[:cntrl:][:blank:]]+/_/g' },
) or pod2usage( -verbose => 1 );

pod2usage( -verbose => 1 ) if $opt_hardlink and $opt_symlink;

if(not @perlexpr) {
    if(@ARGV) { push @perlexpr, shift }
    else { pod2usage( -verbose => 1 ) }
}

pod2usage( -verbose => 1 ) if $opt_null and @ARGV;

$::LEVEL = ($opt_verbose || 0) + ($opt_dryrun || 0);

my $code = do {
    my $cat = "sub { ".join('; ', @perlexpr)." }";
    DEBUG("Using expression: $cat");
    my $evaled = eval $cat;
    die $@ if $@;
    die "Could not evaluate to code ref\n" unless 'CODE' eq ref $evale
+d;
    $evaled;
};

if (!@ARGV) {
    INFO("Reading filenames from STDIN");
    @ARGV = do {
        if($opt_null) {
            INFO("Splitting on null bytes");
            local $/ = "\0";
        }
        <STDIN>;
    };
    chomp @ARGV;
}

my ($verb, $verbed, $action) =
    $opt_hardlink ? ( qw(link linked), sub { link shift, shift } ) :
    $opt_symlink  ? ( qw(symlink symlinked), sub { symlink shift, shif
+t } ) :
    do { qw(rename renamed), sub { rename shift, shift } };

for (@ARGV) {
    my $oldname = $_;

    $code->();

    if($oldname eq $_) {
        DEBUG("'$oldname' unchanged");
        next;
    }

    ERROR("'$oldname' not $verbed: '$_' already exists"), next
        if not $opt_force and -e;

    if($opt_interactive and not $opt_dryrun) {
        print "\u$verb '$oldname' to '$_' (y/n)? ";
        if(<STDIN> !~ /^y/i) {
            DEBUG("Skipping '$oldname'.");
            next;
        }
    }

    if ($opt_dryrun or $action->($oldname, $_)) {
        INFO("'$oldname' $verbed to '$_'");
    }
    else {
        ERROR("Can't $verb '$oldname' to '$_': $!");
    }
}

INFO('Dry run, no changes were made.') if $opt_dryrun;

Comment on rename 0.3 - now with two extra cupholders
Download Code
Re: rename 0.3 - now with two extra cupholders
by sauoq (Abbot) on Nov 01, 2003 at 23:03 UTC
    (PodMaster informs me that it's only included in ActivePerl. I haven't looked.)

    I was going to claim this was incorrect, but then I checked. It seems it has been removed sometime since 5.6.1. (It used to be in the eg/ directory.) That's too bad, imho.

    While you are blue-skying... and I really like the idea for MP3 handling... I think that the ID3 tag support should be provided by a separate module. (Maybe MP3::ID3Lib? That's not a recommendation, just a pointer.) If the module is not available and the user tries to use the ID3 related options, it should die with an error.

    Not only does it make sense to leave out ID3 specific code from a general rename script, but designing it like this might also allow you to add special support for other file formats. For instance, I'd personally love support for using EXIF data in jpegs extracted via Image::EXIF or similar. (Again, not a recommendation; just a pointer.)

    On a related note, it seems Johan Vromans has an mp3rename script on CPAN that uses ID3 tag info. Maybe it'll be helpful to look at it.

    -sauoq
    "My two cents aren't worth a dime.";
    

      I know, I've seen it before. It's very limited though.

      I think that the ID3 tag support should be provided by a separate module.

      My thoughts exactly, though I was thinking of MP3::Info. The idea is to have an --mp3 switch require the module at runtime, then have code that provides the information from the ID3 tag in variables like $ARTIST etc. Afterwards they're checked for changes just like $_ is. Assuming you have names like 02 Falling.mp3 you could then do something like

      rename --mp3 '$_="\L\u$ARTIST/\u$ALBUM\E/$_"; $TRACK=0+((/^(\d+)/)[0]) +' -z *

      and have it end up in Spicelab/A_day_on_our_planet/02_Falling.mp3 with its ID3 tracknumber set properly.

      Adding similar mechanism for EXIF data would be simple (and a good idea too - I didn't think of EXIF, thanks!).

      Makeshifts last the longest.

Re: rename 0.3 - now with two extra cupholders
by sauoq (Abbot) on Nov 23, 2003 at 00:03 UTC

    I have a small suggestion/request. Provide a switch other than -h to "browse the manpage" and use -h to provide just the synopsis. That's the usual function of -h and I found it just a tad annoying that looking for help while running as root got me a "Superuser must not run /usr/bin/perldoc. . ." message.

    -sauoq
    "My two cents aren't worth a dime.";
    
      Ok, that's simple to fix.. another thing I often found myself minorly annoyed with is that I have to make sure all directories any files might end up in exist beforehand. So requesting path autocreation for files is going to be a feature in the next time version.

      Makeshifts last the longest.

        If the requested path is "/some/where/else", and only "/some" exists, would you create "where/else" or just "else"?

        How would you go about this: on failure of simple "mkdir()" would you run "File::Path:mkpath()" (or similar) or just run "File::Path::mkpath()" in the first place?

(bug report) Re: rename 0.3 - now with two extra cupholders
by sauoq (Abbot) on Nov 23, 2003 at 01:56 UTC

    Well, at least you know I'm using it... :-)

    While doing a dry run using your sanitize option, I noticed a warning:

    Use of uninitialized value in concatenation (.) or string at (eval 1) +line 1.
    I ran it again with -v to print to get this:
    Using expression: sub { s/[!"$&()=?`*';<>|_[:cntrl:][:blank:]]+/_/g }
    The problem is that the $& is being interpolated. It is uninitialized, hence the warning. Worse, however, is that it doesn't remove dollars and ampersands from filenames. The fix is obvious; just escape the '$' in your character class.

    FWIW, this behavior surprised me. Badly surprised me. I blanch at the thought that I may have made this same error countless times. I believe I've even given the advice "there's no need to escape a dollar sign in your character class" many, many times.

    -sauoq
    "My two cents aren't worth a dime.";
    
      Yes - a fellow monk had sent me a msg about this a while, so I am aware (he was also going to post a reply here that was on his scratchpad, but which he didn't yet; unfortunately I saved the scratchpad stuff but not his nick :-( ). You are right as per your msg that I knew about it, but that happens with facts you learn but don't use soon enough.. :-)

      Makeshifts last the longest.

Re: rename 0.3 - now with two extra cupholders
by Ciantic (Initiate) on Mar 21, 2010 at 14:16 UTC

    I just tried this with Strawberryperl while a go, and remember it working just well. Now that I'm sitting on Windows 7* it doesn't seem to be able to get the list of files:

    C:\Pics>dir Volume in drive C has no label. Volume Serial Number is 4C17-845B Directory of C:\Pics 20.02.2010 04:23 <DIR> . 20.02.2010 04:23 <DIR> .. 29.05.2009 14:59 1 578 868 DSCF3888.JPG 29.05.2009 14:59 1 565 825 DSCF3889.JPG 29.05.2009 14:59 1 643 616 DSCF3890.JPG 29.05.2009 14:59 1 664 020 DSCF3891.JPG 4 File(s) 6 452 329 bytes 2 Dir(s) 187 149 787 136 bytes free C:\Pics>renamer -n -s DSCF okay *.JPG Dry run, no changes were made. C:\Pics>

    Notice that I had to rename the script to renamer, but this does not affect anything

    * I suppose it worked under Windows 7 earlier, but it might have been Release Candidate of Windows 7, now I'm using the real thing.

      It never worked the way you remember, try adding use Win32::Autoglob;
      perl -MWin32::Autoglob -le"print for @ARGV" *

        ... or alternatively

        @ARGV = map { glob $_ } @ARGV;

        or, if you want sane whitespace handling,

        use File::Glob qw(bsd_glob); @ARGV = map { bsd_glob $_ } @ARGV;

        , optionally in a BEGIN block. But now, actually looking at the source of Win32::Autoglob, that's just what the module does. Thanks for pointing it out to me :).

        That works, thanks! I must have tested it under sane OS back then. I'd like to list the complete procedure one is required to do under Windows to get Perl renaming work:

        1. Get strawberryperl, portable version is just fine (make sure that path to the strawberryperl does not have spaces!)

        2. Start strawberryperl command line. And run CPAN Win32::Autoglob (this installs the Autoglob)

        3. Copy code of above rename program to the C:\strawberryperl\perl\bin\renamer file (Windows has program called rename already, so don't use that name)

        5. Create copy of file C:\strawberryperl\perl\bin\runperl.bat as name renamer.bat (Contents of this file is not needed to change)

        6. Add use Win32::Autoglob; to the renaming code.

        Now you should have portable Perl capable renaming script to take with you.

        I know the steps I described above are routine tasks, but many times one just wants to rename files and not go through the hassle of learning to install Perl in Windows. So I wish my instruction will help someone.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://303814]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (7)
As of 2014-12-26 10:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (171 votes), past polls