Category: miscellaneous
Author/Contact Info Joseph Jones jjdraco@acsalaska.net
Description: will take a list of directory names that are subdirectories to the location of rename.pl and rename all image files in thoses directories to directoryname####.ext

this is my first program written in perl, don't know if any one would have a use for it but i would like some feedback.		 
#!perl
# rename.pl [dir1]...[dir##]
# takes a list of directorys as parameters
# renames all files in given directory to dir####
# not sure if it will run on other OS besides Win32
# by Joseph Jones <jjdraco@acsalaska.net>


use strict;
use warnings;
use Win32::File;
use Cwd;

#
# global Variables
#
my @Dir_List;

#
# Subroutines
#
sub dir_list
{

   #
   # gets the list of directories from @ARGV
   # stores directory list in @Dir_List
   # need to put in error handling to check for invalid directory name
+s
   #
   my $count = @_;    # gets length of @ARGV

   if ($count == 0) { die "No arguments where passed"; }

   # dies if no args where passed

   foreach my $item (@_)    #pushes list of directorys on to array
   {
      push (@Dir_List, $item);
   }
}    # end of sub dir_list

sub scan_dir
{

   # gets passes a name of a directory
   # goes through all files in that directory and renames them
   my (@file_list, @files_good, @rename_files, $file_name, $dir, $attr
+ibs);
   $file_name = $_[0];                 #name of directoyr will be name
+ of file
   $file_name = ucfirst $file_name;    #make sure $file_name is capita
+lized

   #gets current directory and changes to new directory
   $dir = cwd();
   $dir .= '/' . $file_name;
   chdir($dir);

   opendir(DIR, $dir) or die "unable to open directory";

   @file_list = grep {    # filters out hidden files and directories
                          # stores directory list in @file_list
      -f $dir . '/' . $_
        && Win32::File::GetAttributes($_, $attribs)
        && !($attribs & HIDDEN)
   } readdir(DIR);

   foreach
     my $item (@file_list)    # find out which files have already been
+ renamed
   {
      if ($item =~ /^$file_name[0000-9999]/)
      {                       #list of files that have been renambed
         push (@files_good, $item);
      } else
      {                       #list of files that need to be renamed
         push (@rename_files, $item);
      }
   }

   @files_good = sort @files_good;

   foreach
     my $item (@rename_files)    # goes through list of files and rena
+mes them
   {
      my ($newname, $count);
      $count   = "0001";                # appended to end of $file_nam
+e
      $newname = $file_name . $count;
      foreach
        my $item2 (@files_good)    # checks to see if $file_name.$coun
+t already
      {                            # exists in @files_good

         ++$count
           if ($item2 =~ /$newname/);    # if file exist goes to next 
+possible
         $newname = $file_name . $count;
      }    # file name $file_name.$count+1
      $item =~ /(gif|jpg|jpe|jpeg|bmp)$/;    # finds the file extentio
+n
      $newname = $newname . "\." . $1;       # and appends it to $newn
+ame
      push (@files_good, $newname);    # pushes $newname on to list so
+ when
                                       # it looks for next availible n
+ame
                                       # it knows this name is already
+ taken
      @files_good = sort @files_good;
      print "renaming $item to $newname\n";
      system("ren \"$item\" \"$newname\"");
   }

   closedir(DIR);
   chdir("..");
}

&dir_list(@ARGV);

foreach my $item (@Dir_List)
{
   print "\n\n$item directory***********************\n\n";
   &scan_dir($item);
}
Replies are listed 'Best First'.
Re: rename
by Aristotle (Chancellor) on Sep 02, 2002 at 04:37 UTC

    dir_list() is pretty useless; it takes a list and pushes it item by item onto an array. A simple array assignment will do that job just as well.

    Not that there has to be one, because the @Dir_List array only gets used in one place. You can just as well use @ARGV itself there.

    The [0000-9999] bit in your filename checking regex does not do what you think it does. Its result is a character class that will match a single digit from 0-9.

    Also note that the filename may contain characters that have special meaning to the regex engine. In that case the regex will malfunction. You need to put \Q and \E around the $file_name.

    Using an array, @files_good in your case, to check for existence, is very awkward and slow. Instead, put the values as keys into a hash, and checking for existance becomes a single operation rather than a loop.

    A minor point is that you may want to include $! (or whichever other variable is appropriate) in your die message when dealing with filesystem operations. As a rule of thumb, each die message should contain at least one variable; that usually makes tracking down the source of the error a lot easier.

    grep is essentially a loop; you don't need it if you're going to use a for loop to separate the resulting list into two arrays anyway.

    Your code that checks for whether a filename already exists is defective; the new filename it checks for has no extension until after the test has succeeded.

    Rather than starting a shell to call its ren command for every file, a very slow procedure, you can just use Perl's own rename function.

    All that applied, the code looks much more manageably like this:

    #!perl
use strict;
use warnings;
use Win32::File;
use Cwd;

die "[usage message explaining the commandline parameters here]\n" unl
+ess @ARGV;

for my $dir (@ARGV) {
    print "\n\n$dir directory***********************\n\n";

    my $filename_prefix = ucfirst $dir;

    my (@rename_file, %filename_seen);

    opendir(DIR, $dir) or die "unable to open directory: $!";
    for (readdir DIR) {
        next unless -f "$dir/$_";

        my $attribs;
        Win32::File::GetAttributes("$dir/$_",$attribs);
        next if $attribs & HIDDEN;

        if (/^\Q$filename_prefix\E(\d{4})/) {
            $file_seen{$_}++;
        }
        else {
            push (@rename_file, $_);
        }
    }
    closedir DIR;

    for (@rename_file) {
        my ($count, $newname);
        my ($extension) = /\.(gif|jpg|jpe|jpeg|bmp)\z/;

        do {
            $newname =
                $filename_prefix
                . sprintf("%04d", ++$count)
                . $extension
        } while exists $filename_seen{$newname};

        print "renaming $item to $newname\n";
        rename "$dir/$_", "$dir/$newname";
    }
}

    [download]

    Makeshifts last the longest.

[reply]
[d/l]
Re: rename
by sauoq (Abbot) on Sep 02, 2002 at 20:55 UTC

    I suggest renaming rename to something else as Larry Wall himself wrote a rename script that used to be distributed with perl in the examples ('eg') directory. Although I don't think it is included in newer distributions, it's a very useful little script and is often moved to /usr/local/bin or an equivalent by sysadmins who want to make it available to their users.

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

Back to Code Catacombs