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