delete raw image files without matching jpgs in the same directory

orphan_raw

#!/usr/bin/env perl
use Modern::Perl;
use File::Find;
use Getopt::Long;

use constant PROGRAMME_NAME => 'orphan_raw';
use constant VERSION => '0.2';

GetOptions(
    'v|version'    => sub{ print PROGRAMME_NAME, ", version ", VERSION, "\n";
                           exit; },
    'h|help|?'     => sub{ exec('perldoc', $0); exit},
);

# file endings to look for
my @RAW = qw(RW2 NEF ORF);

my $VIEW1 = 'JPG';
my $VIEW2 = 'jpg';

# dir to look into, default to pwd
my $dir = shift;
$dir ||= '.';

my $files;			# data structure
find(\&collect, $dir);		# fill the data structure with files

# process files to find orphans
my $removable;			# array of potential orphans
for my $base (keys %$files) {
    my $raw;
    map {$raw = $_ if $files->{$base}->{$_} } @RAW;
    next unless $raw;
    next if $files->{$base}->{$VIEW1};
    next if $files->{$base}->{$VIEW2};
    push @$removable, $base. ".". $raw;
}

# exit if no orphans was found
unless (defined $removable) {
    say "No orphan raw files found...";
    exit 0;
}

# prompt the user with findings
say "About to remove these files:\n";
map {say $_ } @$removable;
print "\nRemove them now (y/n)? ";
my $input = <STDIN>;
chomp $input;
if ($input eq 'y') {
    say "Removing ". scalar(@$removable). " files ...";
    map { unlink $_ } @$removable;
    say "Done";
} else {
    say "Ignoring...";
}
#say ".qiv-trash file present" if -e "$dir/.qiv-trash";
# end of main

# the wanted subroutine for File::Find
sub collect {
    my ($path, $ext) = $File::Find::name =~ /(.*)\.(.*)/;
    return unless $path;
    $files->{$path}->{$ext}++;
}



=head1 NAME

B<orphan_raw> -- delete raw images without matching jpgs

=head1 SYNOPSIS

B<orphan_raw> [B<-v|--version> | [B<-h|--help>] [work_dir]

=head1 DESCRIPTION

This script finds raw image files without corresponding jpg file and
prompts user before removing them. It works by default in the working
directory. An unnamed argument takes an alternative directory name.

Variable @RAW can be amended for additional raw image file
extensions.

This is part of the workflow where raw files are processed into jpgs.
This script is run after unwanted jpgs have been deleted.

=head1 LICENSE

You may distribute this program under the same terms as perl itself.

=head1 AUTHOR

Heikki Lehvaslaiho, heikki lehvaslaiho a gmail com

=cut