1: #!/usr/bin/perl -w
   2: use strict;
   3: 
   4: # Just a little script to screen the given files for corrupt images
   5: # and delete/move/report them if so instructed. 
   6: # Depends on Image::Magick being installed
   7: 
   8: # -r           : delete corrupt images
   9: # -q           : mention filenames of corrupt images, keep quiet otherwise.
  10: # -m directory : move to directory, takes precedence over -r. Will be created
  11: #                if not already there.
  12: # -f file      : instead of taking filenames from the command line, take them
  13: #                from file ("-" if you want to use a pipe)
  14: 
  15: # example : find -type f | cleaner.pl -m ./corrupt -f -
  16: # will move all corrupt images to ./corrupt, being pretty verbose
  17: 
  18: use Image::Magick;
  19: use Getopt::Std;
  20: use File::Basename;
  21: 
  22: getopts('rqm:f:');
  23: our($opt_r, $opt_q, $opt_m, $opt_f, @filelist);
  24: my $count=0;
  25: 
  26: if ($opt_f) {
  27:   open FILELIST, $opt_f;
  28:   @filelist = <FILELIST>;
  29:   close FILELIST;
  30: } else { 
  31:   @filelist = @ARGV; 
  32: }
  33: 
  34: if ($opt_m) {
  35:   if (!-d $opt_m) { mkdir $opt_m or die "can't create directory $opt_m\n"; }
  36: }
  37: 
  38: foreach my $file (@filelist) {
  39:   $count++;
  40:   chomp $file;
  41:   if (-f $file) {
  42:     $opt_q or print "Testing " . sprintf ("%4d",$count) . "/" .
  43:      sprintf ("%4d", scalar @filelist) . " " . basename($file) . " ... ";
  44:     my $p = new Image::Magick;
  45:     my $s = 0;
  46:     my $error = $p->Read($file);
  47:     if ($error) { 
  48:       $error =~ /(\d+)/;        
  49:       my $errorcode = $1;
  50:       if ($errorcode == 330) {
  51:         $opt_q or print "which does not exist";
  52:       } elsif ($errorcode == 325) {            
  53:         $opt_q or print "which seems to be corrupt ... ";
  54:         $opt_q or (($opt_r or $opt_m) or print "keeping it anyway.");
  55:         if ($opt_m) { 
  56:           $opt_q or print "moving to $opt_m ... ";
  57:           ($s = rename $file, $opt_m.'/'.basename($file) 
  58:            and print "done.")
  59:            or ($opt_q or print "could not move $file to $opt_m");
  60:         } elsif ($opt_r) { 
  61:           $opt_q or print "deleting ... ";
  62:           ($s = unlink $file and print "done.") 
  63:            or ($opt_q or print "could not delete $file");
  64:         } # if ($opt_
  65:         $opt_q and print "$file\n";
  66:       } elsif ($errorcode == 320) {
  67:         $opt_q or print "which is not an image";
  68:       } else {
  69:         $opt_q or print "which yielded an error : $error";
  70:       } # if (errorcode=
  71:     } else {
  72:       $opt_q or print "which is fine";
  73:     } # if (error)
  74:   $opt_q or ($s ? print "\n" : print ", skipping.\n");
  75:   } # if (-f $file)
  76: }