renamepic

   1 #! /usr/bin/perl
   2
   3 # This program is used to rename pictures in a directory. First it
   4 # displays the picture, then it lists a reasonable default name which
   5 # can be edited.
   6 #
   7 # The image is then renamed if there doesn't exist an image with the
   8 # same name already in the directory.
   9
  10 # Sorting now is fixed. Images are sorted by shot order, rather than
  11 # directory transversal.
  12
  13 # BUGS:
  14 #
  15 # Renaming should be done in a loop rather than going through once
  16 # only. [Eg, repeat the file on a renaming error.]
  17
  18 # TODO:
  19 #
  20 # number of leading zeros adjustable... [or automatic?]
  21 #
  22
  23
  24 use warnings;
  25 use strict;
  26
  27 use IO::Dir;
  28
  29 use Term::ReadLine;
  30
  31 use Image::Info qw(image_info);
  32
  33 use Getopt::Long;
  34
  35 use Date::Calc qw(Date_to_Time);
  36
  37 my $config = {counter_start => 1,
  38               renumber_only => 0,
  39              };
  40
  41 ($config->{program_name}) = $0 =~/([^\/]+)\s*$/;
  42
  43 GetOptions($config,'counter_start|c=i','renumber_only|renumber-only|r!');
  44
  45 if ($#ARGV < 0) {
  46      print STDERR "No Directory Specified\nUsage:  $config->{program_name} <directory>\n";
  47      exit 1;
  48 }
  49
  50 $config->{dir} ||= $ARGV[0];
  51
  52
  53 # The counter is used to keep the images in the order in which they
  54 # were shot.  It assumes that the order they are listed in the
  55 # directory is the same as the order in which they were shot. May not
  56 # always be true, but it's a decent guess.
  57 my $file_counter = $config->{counter_start};
  58
  59 my $current_directory = new IO::Dir $config->{dir} or die "Unable to read directory $config->{dir}";
  60
  61 # We use readline to handle prompting for a new name for the picture
  62 my $readline = new Term::ReadLine 'RenamePicture';
  63
  64 my @pictures = ();
  65
  66 while (defined($_ = $current_directory->read)) {
  67      #skip non images
  68      next unless /(jpg|gif|jpeg|png|pict|bmp)$/i;
  69      # Change the extension to lower case.
  70
  71      my %picture = ();
  72
  73      $picture{extension} = lc $1;
  74      # ignore directories [directories named .bmp? strange.]
  75      next unless -f $_;
  76
  77
  78      # Read image info, and ignore images for which there is no
  79      # info. [probably not really an image.]
  80      $picture{image_info} = image_info($_);
  81      next if not defined $picture{image_info};
  82
  83      $picture{old_name} = $_;
  84
  85      # Default name is ${file_counter}__${picture_time}.${extension}
  86      ($picture{clean_old_name}) = $picture{old_name} =~ /\d+\_(.*?)\_?\d+\.(?:jpg|gif|jpeg|png|pict|bmp)/i;
  87      $picture{clean_old_name} ||= '';
  88      # Pull out the date and time when the image was shot
  89      $picture{date_ymdhms} = [split(/[\s\:]+/,$picture{image_info}{DateTime})];
  90      $picture{picture_time} = join('',@{$picture{date_ymdhms}}[0..2]);
  91      $picture{default_name} = qq(_$picture{clean_old_name}_$picture{picture_time}.$picture{extension});
  92      push @pictures, \%picture;
  93 }
  94
  95 # Sort
  96
  97 @pictures = sort {Date_to_Time(@{$$a{date_ymdhms}})<=> Date_to_Time(@{$$b{date_ymdhms}})} @pictures;
  98
  99 # Rename
 100
 101 foreach my $picture (@pictures) {
 102      # view the image
 103      `feh -FZ $$picture{old_name} > /dev/null` unless $$config{renumber_only};
 104
 105      #prompt to rename the picture
 106      print "Rename $$picture{old_name}\n";
 107
 108 #     sprintf('%03s',$file_counter);
 109
 110      $$picture{clean_old_name} = $readline->readline('new name:',$$picture{clean_old_name})
 111           unless $$config{renumber_only};
 112      my $line = sprintf('%03s',$file_counter).qq(_$$picture{clean_old_name}_$$picture{picture_time}.$$picture{extension});
 113
 114      # Remove leading and trailing spaces, replace all remaining
 115      # spaces with _, and remove ugly characters. lowercase everything
 116      # while we're at it.
 117      $line =~ s/^\s*//;
 118      $line =~ s/\s*$//;
 119      $line =~ s/\s+/\_/g;
 120      $line =~ tr/A-Z/a-z/;
 121      $line =~ s/[^\w\_\-\d\.]//g;
 122      # Make sure we're not saving over an existing file.
 123      if (not -e $line) {
 124           rename $$picture{old_name}, $line;
 125           print "Renamed $$picture{old_name} to $line\n";
 126      }
 127      else {
 128           print STDERR "$line already exists, cowardly doing nothing to $$picture{old_name}.\n";
 129      }
 130      $file_counter++;
 131 }