[prog] bulk re-naming of files

[Wolf Rising]

Wow! Thank you :-)




On Thu, 27 Jan 2005 12:09:01 +1100, Jacinta Richardson
<jarich at perltraining.com.au> wrote:
> 
> Wolf Rising wrote:
> 
> > +-----------+---------------------------+-----------------------------+
> > | p_code    | s_name                    | filename                    |
> > +-----------+---------------------------+-----------------------------+
> > | 000797079 | Betty M. Brum         00005.JPG          |
> > | 000803314 | Mary E. Rems         00047.JPG          |
> >
> > there are well over 650 photos I need to rename.  My other option at
> > the moment is to download the directory
> > with all the photos and rename them one by one :-) Any help, ideas,
> > suggestions, would be greatly appreciated :-)
> 
> 650!  Definately calls for a script.
> 
> Apparently PHP can be done from the command line, but I'm crap at PHP
> (and have very little inclination to get better), so here's a start to
> how I'd do it in Perl.
> 
> #!/usr/bin/perl -w
> use strict;
> 
> use DBI;        # This is the database module for Perl, it's database
>                  # independant.  You'll need to install it and
>                  # DBD::mysql
> use File::Copy;
> 
> my $username = "wolf";
> my $password = "wolf"
> my $database = "WolfsDatabase";
> my $filepath = ".";  # Path to where these files are stored.
> 
> # connect to the database.  The stuff in curly braces are options to
> # say:
> # Commit after every database operation (ie don't use transactions)
> # Show the SQL statement that caused the error if applicable
> # Die if an error occurs with as much information as possible
> my $dbh = DBI->connect("dbi:mysql:database=$database",
>                         $username, $password,
>                         {
>                             AutoCommit => 1,
>                             ShowErrorStatement => 1,
>                             RaiseError => 1
>                         }
> );
> 
> # Naive select.  I'm sure that simple use of regular expressions that
> # mysql allows would give you the number only filenames but I don't have
> # time to look that up.
> my $select = $dbh->prepare("select p_code, s_name, filename from table");
> 
> $select->execute();
> 
> my $update = $dbh->prepare("update table set filename = ? where p_code =
> ?");
> 
> # Loop over all entries and make appropriate changes...
> 
> while(my $entry = $select->fetchrow_hashref()) {
> 
>          # Skip correct entries
>          next unless $entry->{filename} =~ /^\d+\.jpg/i;
> 
>          # Create a filename
>          my $name = $entry->{s_name};
>          $name =~ s/\W+//;             # get rid of non-word characters
> 
>          my $new_filename = "$name.JPG";
>          # Handle duplicate filenames (note that this could still cause
>          # problems if your OS isn't case sensitive.  I leave that to you
>          # to handle.
>          $i = 1;
>          while( -e "$filepath/" . $new_filename ) {
>               $new_filename = "${name}_$i.JPG";
>               $i++;
>          }
> 
>          # move the old file to the new location
>          move("$filepath/".$entry->{filename},
>               "$filepath/".$new_filename)
>                         or die "Failed to move file: $!";
> 
>          # update the database
>          $update->execute($new_filename, $entry->{p_code});
> 
>          print STDERR "Renamed " . $entry->{filename} .
>                       " to $new_filename\n";
> }
> 
> $dbh->disconnect();
> 
> __END__
> 
> There are probably a few typos.  I haven't tested the above for
> compilation.  There might be a missing { or } somewhere.  There may be a
> minor logic error.  But the shell is right and the code should work
> mostly as-is.
> 
> If you want to know more about DBI (it's great) have a look at our
> Database Programming with Perl course extract.  You can find it at
> http://www.perltraining.com.au/notes.html
> 
> It'll explain why we prepare statements etc.
> 
> All the best,
> 
>       Jacinta
> 
> --
>     ("`-''-/").___..--''"`-._          |  Jacinta Richardson         |
>      `6_ 6  )   `-.  (     ).`-.__.`)  |  Perl Training Australia    |
>      (_Y_.)'  ._   )  `._ `. ``-..-'   |      +61 3 9354 6001        |
>    _..`--'_..-_/  /--'_.' ,'           | contact at perltraining.com.au |
>   (il),-''  (li),'  ((!.-'             |   www.perltraining.com.au   |
> 
>