#!/usr/bin/perl # # thumbs_cleanup [options] [dir...] # # Options: # -f Forcefully delete all thumbnail dirs and image stats # -n Dry run, just report thumbnails that are too old # -q Be quiet, don't report number of thumbnails left # -v Show results for all individual thumbnail files # -t days How old before deleteing thumbnail directories (def: 30 days) # # Locate and attempt to clean up old and obsolete thumbnail sub-directories # such as ".xvpic" (XV), and ".thumbnails" (GQView); as well as special image # statistics files (personal image comparisions) such as ".metrics". # # This will only remove thumbnails for which master images don't exist, or are # newer. It will then only remove a whole directory of thumbnails if all the # thumbnails is older than set date (default 30 days), UNLESS FORCED. # # That is thumbnail directories are preserved for a time or deleted # if no longer valid. # ###### # # Anthony Thyssen 18 Jane 2007 # Developed from a previous script to handle XV thumbnail directories # use strict; use File::Find; use FindBin; my $PROGNAME = $FindBin::Script; sub Usage { print STDERR "$PROGNAME: ", @_, "\n" if @_; @ARGV = ( "$FindBin::Bin/$PROGNAME" ); # locate script file while( <> ) { next if 1 .. 2; last if /^###/; last unless /^#/; s/^#$//; s/^# //; last if /^$/; print STDERR "Usage: " if 3 .. 3; print STDERR; } print STDERR "For Options use --help\n"; exit 10; } sub Help { @ARGV = ( "$FindBin::Bin/$PROGNAME" ); # locate script file while( <> ) { next if $. == 1; last if /^###/; last unless /^#/; s/^#$//; s/^# //; print STDERR; } exit 10; } my $DEBUG = 1; # output debug messages (0 = quite 1 = changes 2 = verbose) my $DELETE = 1; # do delete the old thumbnail dirs and files my $FORCE = 0; # forcefully delete thumbnail dirs and files my $thumbage = 30; # age of thumbnail files before deleting my $images = qr'\.(png|jpg|gif|jpeg|xpm|xbm)$'io; my $t = ' '; # indent ARGUMENT: # Multi-switch option handling while( @ARGV && $ARGV[0] =~ s/^-(?=.)// ) { $_ = shift; { m/^$/ && do { next }; # Next argument m/^-$/ && do { last }; # End of options m/^\?/ && Usage; # Usage Help m/^-help$/ && Help; # Quick help (synopsis) s/^f// && do { $FORCE = 1; redo }; # force delete all thumbs s/^q// && do { $DEBUG = 0; redo }; # be quiet s/^v// && do { $DEBUG = 2; redo }; # be verbose s/^n// && do { $DELETE = 0; redo }; # dry run - report only s/^t// && do { $thumbage = length() ? $_ : shift; next }; # age to delete Usage( "$PROGNAME: Unknown Option \"-$_\"" ); } continue { next ARGUMENT }; last ARGUMENT; } select((select(STDOUT), $| = 1)[$[]); select((select(STDERR), $| = 1)[$[]); # ---------------------------------------------------------------- # Look for the ".xvpics" sub-directory my $dir = shift; if ( $dir ) { die "Usage: thumbs_cleanup [-f] [dir]\n" if $dir =~ /^-/ && ! -d $dir; # fake the directory search chdir $dir or die "Unable to change to dir \"$dir\" : $!\n"; find(\&wanted, '.' ); } else { # search from current directory down find(\&wanted, '.' ); } exit 0; # Have we found a thumbnail directory? sub wanted { # A ".metrics" file. if ( -f $_ ) { &cleanup_thumbfile($_) if /^\.metrics/; return; } # Thumbnail sub-directories # Do not search in "backup" or ".gvfs" sub-directories if ( -d $_ ) { #print "Dir ", $File::Find::name, "\n"; $File::Find::prune = 1,return if $_ eq 'backup'; $File::Find::prune = 1,return if $_ eq '.gvfs'; &cleanup_thumbdir($_, '') if $_ eq '.xvpics'; # This fails due to sub-directories - seperate cleanup needed #&cleanup_thumbdir($_, '.png') if $_ eq '.thumbnails'; return; } } # Examine and clean up file of image statistics sub cleanup_thumbfile { my( $thumbfile ) = @_; my $dir = $File::Find::dir; # the directory we are in my $age = -M $thumbfile-.01; # date file was last updated if( $age > $thumbage ) { print "${t}Thumbnail file \"$thumbfile\" too old (", int $age, " days)", $DELETE ? " -- deleting\n" : "\n" if $DEBUG; system( qw( rm -f ), $thumbfile ) if $DELETE; } else { my $entries = `grep -c '^[^ ]' "$thumbfile"`; chop $entries; print $FORCE ? "Removing":"Leaving", " \"$dir/$thumbfile\"... -- $entries entries\n" if $DEBUG; system( qw( rm -rf ), $thumbfile ) if $DELETE && $FORCE; } } # Examine and clean up the thumbnail directory found. sub cleanup_thumbdir { my( $thumbdir, $thumbsfx ) = @_; my $dir = $File::Find::dir; # the directory we are in $File::Find::prune = 1; # no need to go into the thumbnail directory my $nl = ''; # newline for previous line if needed print $FORCE ? "Removing":"Cleaning", " \"$dir/$thumbdir\"..." if $DEBUG; $nl = "\n" if $DEBUG; my $images_left=0; # number of thumbnail left in directory after cleanup my $newest = 99999999; # date of last directory/thumbnail update # foreach thumbnail pic in ".xvpics" check the original exists # and has a "correct" image suffix. opendir( TDIR, $thumbdir ) or do { print $nl; $nl=''; warn "Unable to open directory \"$dir\" : $! -- SKIPPING\n"; return; }; while ( my $thumb = readdir(TDIR) ) { next if $thumb eq '.' || $thumb eq '..'; if ( -d "$thumbdir/$thumb" ) { close TDIR; if ( "$thumbdir/$thumb" eq ".thumbnails/normal" ) { print " -- skip gnome thumbnail dir\n" if $DEBUG; return; } print $nl; $nl=''; warn "WARNING: directory \"$thumb\" found in \"$dir/$thumbdir\" ". "-- SKIPPING!\n"; return; } my $delete = 0; # by default do not delete the thubmail. my $file = $thumb; $file =~ s/\Q$thumbsfx\E$//; my $age = (-M _ ) -.01; # get how old a last modify time (with offset) if ( $FORCE ) { $delete++ if $DELETE; } elsif ( $file !~ /$images/ ) { $delete++ if $DELETE; if ( $DEBUG ) { print $nl; $nl=''; print "${t}Thumbnail for \"$file\" which is not an image", $DELETE ? " -- deleting\n" : "\n"; } } elsif ( ! -e $file ) { $delete++ if $DELETE; if ( $DEBUG ) { print $nl; $nl=''; print "${t}Thumbnail for \"$file\" which does not exist", $DELETE ? " -- deleting\n" : "\n"; } } elsif ( -M _ < $age ) { # is original file older than thumbnail? $delete++ if $DELETE; if ( $DEBUG ) { print $nl; $nl=''; print "${t}Thumbnail for \"$file\" is older than original", $DELETE ? " -- deleting\n" : "\n"; } } # else don't delete thumbnail # remove the thumbnail if marked for deletion. if ( $delete ) { unlink( "$thumbdir/$thumb" ) or do { $age = -1; # this thumbs age is of no consequence print $nl; $nl=''; warn "Unable to delete thumbnail \"$dir/$thumbdir/$thumb\" : $!\n"; }; next; } # note if we have a thumbnail and date of newest being kept if ( $DEBUG>=2 ) { print $nl; $nl=''; print "${t}Keeping thumbnail for \"$file\" (age ", int $age, " days)\n"; } $images_left++; $newest = $age if $age < $newest; # is this file newer? } closedir(TDIR); # if their are no thumnail images left -- delete directory if ( $images_left && $DEBUG ) { print $nl ? "${t}-- $images_left thumbs" : "${t}-- Directory has $images_left thumbs", " (newest thumbnail age ", int $newest, " days)\n"; $nl=''; } else { if ( $DEBUG ) { print $nl; $nl=''; print "${t}Thumbnail dir \"$thumbdir\" is empty", $DELETE ? " -- deleting\n" : "\n" unless $FORCE; } rmdir $thumbdir or warn "Unable to delete \"$dir/$thumbdir\" directory : $!\n" if $DELETE; # This stuffs things up, some directories need to remain! #chdir '..'; # try and remove parent directory too -- if empty #rmdir $dir if $DELETE; # will probably fail, but try remove it anyway #chdir $dir; # return to lower directory if it still exists return; } # if youngest image is too old, delete the whole directory # Do not delete individual images because they are old, only whole dirs if( $newest > $thumbage ) { print "${t}Thumbnail dir \"$thumbdir\" too old (", int $newest, " days)", $DELETE ? " -- deleting\n" : "\n" if $DEBUG; system( qw( rm -rf ), $thumbdir ) if $DELETE; } }