copy raw images corresponding to jpgs in a subdir into an other subdir

raw_copy

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

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

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

my $SOURCE_SUBDIR_NAME = "copied";
my $TARGET_SUBDIR_NAME = "raw";

unless (-e $SOURCE_SUBDIR_NAME ) {
    say "No such subdir [$SOURCE_SUBDIR_NAME]";
    exit 1;
}

# file endings to look for
# RAW
my @RAW = qw(RW2 NEF ORF);
# JPG
my $VIEW1 = 'JPG';
my $VIEW2 = 'jpg';

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

my $copydir = $dir. "/".  $TARGET_SUBDIR_NAME;
mkdir $copydir unless -e $copydir;


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

# the wanted subroutine for File::Find
sub collect {

    # process pathname
    my ($path, $ext) = $File::Find::name =~ /(.*)\.(.*)/;
    return unless $ext eq $VIEW1 or $ext eq $VIEW2;
    $path =~ s/.*\///;
    #say $path. "";

    # check and copy the raw file
    for my $r (@RAW) {
        copy ("../$path.$r") if -e "../$path.$r";
    }
}

sub copy {
    my $file = shift;
    say $file;
    `cp $file ../raw`;
}


=head1 NAME

B<raw_copy> -- copy raw images corresponding to jpgs in a subdir

=head1 SYNOPSIS

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

=head1 DESCRIPTION

This script creates a copy of all raw files in the directory given as
unnamed argument with a JPG file in the copied subdirectory. The
work directory defaults to working directory. The copies are placed in
a new subdirectory 'raw'.

This is part of the workflow where raw files are processed into jpgs.

=head1 LICENSE

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

=head1 AUTHOR

Heikki Lehvaslaiho, heikki lehvaslaiho a gmail com

=cut