photo-helpers

Unnamed repository; edit this file 'description' to name the repository.
git clone git://code.clttr.info/photo-helpers.git
Log | Files | Refs | README | LICENSE

commit 44e7f8c73d3845f2515428c79546a5e6509c9506
parent eb094b58c172bc61dfb4a74f633fcd36b267cc0b
Author: René Wagner <rwagner@rw-net.de>
Date:   Sat, 18 Jul 2020 20:26:05 +0200

unify parameter usage (especially -l) and help formating

Diffstat:
M.build.yml | 8++++----
MREADME.md | 12++++++------
Aafm.pl | 151++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dart_file_mover.pl | 151------------------------------------------------------------------------------
Ajd.pl | 98+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Djpegdivider.pl | 98-------------------------------------------------------------------------------
Dsilkypix_multiversion_sidecar_cleaner.pl | 121-------------------------------------------------------------------------------
Dsilkypix_orphaned_sidecar_cleaner.pl | 106-------------------------------------------------------------------------------
Aspmvsc.pl | 121+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Asposc.pl | 107+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
10 files changed, 487 insertions(+), 486 deletions(-)

diff --git a/.build.yml b/.build.yml @@ -16,10 +16,10 @@ tasks: perl -c silkypix_orphaned_sidecar_cleaner.pl perl -c silkypix_multiversion_sidecar_cleaner.pl mkdir bin - /usr/bin/vendor_perl/pp -z 9 -f Bleach -o afm art_file_mover.pl - /usr/bin/vendor_perl/pp -z 9 -f Bleach -o jd jpegdivider.pl - /usr/bin/vendor_perl/pp -z 9 -f Bleach -o sposc silkypix_orphaned_sidecar_cleaner.pl - /usr/bin/vendor_perl/pp -z 9 -f Bleach -o spmvsc silkypix_multiversion_sidecar_cleaner.pl + /usr/bin/vendor_perl/pp -z 9 -f Bleach -o afm afm.pl + /usr/bin/vendor_perl/pp -z 9 -f Bleach -o jd jd.pl + /usr/bin/vendor_perl/pp -z 9 -f Bleach -o sposc sposc.pl + /usr/bin/vendor_perl/pp -z 9 -f Bleach -o spmvsc spmvsc.pl - package: | TAG=`date +"%Y%m%d"` cd photo-helpers diff --git a/README.md b/README.md @@ -32,15 +32,15 @@ For information about parameters and usage call `script.pl --help`. # ART helper scripts Helper scripts to manage files which where handled by [ART](https://clttr.info/art). -## file mover -Filename: `art_file_mover.pl` +## processed file mover +Filename: `afm.pl` Moves all already converted raw files and their corresponding jpegs to a given folder. # generic scripts -## jpeg divider -Filename: `jpegdivider.pl` +## JpegDivider +Filename: `jd.pl` Moves all jpeg files (suffixes .jpg and .jpeg) in a folder to the subfolder JPEG (or a given subfolder). @@ -63,11 +63,11 @@ base folder ``` ## orphaned sidecar cleaner -Filename: `silkypix_orphaned_sidecar_cleaner.pl` +Filename: `sposc.pl` Deletes all sidecar files in the given directory or alternatively in the current working directory when the associated raw file is missing. ## multiversion sidecar cleaner -Filename: `silkypix_multiversion_sidecar_cleaner.pl` +Filename: `spmvsc.pl` Deletes Silkypix Sidecar files when newer versions of the files are available. This usually happens when a file is opened in a newer version of Silkypix, as the sidecar files are version specific. diff --git a/afm.pl b/afm.pl @@ -0,0 +1,151 @@ +#!/usr/bin/perl +# Copyright(c) René Wagner 2019-2020 +# https://git.sr.ht/~rwa/photo-helpers +# published under BSD 3-Clause License - https://git.sr.ht/~rwa/photo-helpers/tree/master/LICENSE + +use warnings; +use strict; +use feature qw(say); +use Cwd; +use File::Basename; +use File::Copy; +use File::Find; +use File::Find::Rule; +use File::Spec::Functions; +use File::HomeDir; +use Getopt::Std; + +$Getopt::Std::STANDARD_HELP_VERSION = 'true'; + +my $VERSION = '0.6'; +my $PROGRAM = 'Art File Mover'; + +my $configfile = catfile(File::HomeDir->my_home, '.art_file_mover.conf'); + +# read commandline switches +our $opt_l = 0; +our $opt_r = 'DNG'; +our $opt_f = 'JPEG'; +our $opt_c = 'jpe{0,1}g'; +our $opt_s = 0; + +getconfig($configfile); + +getopts('slr:f:c:') or die "Invalid parameters provided! See 'art_file_mover.pl --help' for more details."; + +# read remaining commandline args für destination dir +# last dir will win +# fallback to list-only mode when no dir is given +my $destination_dir = getcwd; +foreach my $arg ( @ARGV ) +{ + $destination_dir = $arg; +} + +if ($destination_dir eq getcwd) { $opt_l = 1; } + +if ( $opt_s ) { writeconfig($configfile); } + +move_files($destination_dir); + +exit 0; + +sub move_files +{ + my ( $destination_dir ) = @_; + my $move_counter = 0; + + say "destination dir : $destination_dir"; + say "raw file ext : $opt_r"; + say "output file dir : $opt_f"; + say "output file ext : $opt_c"; + say 'action : '. ($opt_l ? 'list only' : 'move'); + say ''; + my $converted_destination_dir = catfile($destination_dir, $opt_f); + + if ( !$opt_l && (! -d $destination_dir || ! -d $converted_destination_dir)) + { + if (! -d $destination_dir ) { mkdir $destination_dir or die "Could not create destination dir $_ : $!"; } + if (! -d $converted_destination_dir ) { mkdir $converted_destination_dir or die "Could not create destination dir $_ : $!"; } + } + + # find all jpegs in current dir + my @files = File::Find::Rule->file()->name( qr/\.$opt_c$/i )->maxdepth(1)->in( catfile(getcwd, $opt_f) ); + + foreach my $converted_file ( @files ) + { + my ( $filename, $path, $ext ) = fileparse($converted_file, qr/\.[^.]*/); + my $outarp_file = $converted_file. '.out.arp'; + my $raw_file = catfile(dirname($path), $filename .'.'. $opt_r); + my $rawarp_file = $raw_file. '.arp'; + + print $raw_file .'...'; + + $move_counter++; + # do not move files that have no raw-file anymore + if ( ! -e $raw_file ) + { + print 'raw-file not found!'; + } + elsif ( !$opt_l ) + { + # only warn if JPEG or RAW file could not be moved + # the processing files *.arp are optional and are fine to be absent + move($outarp_file, catfile($converted_destination_dir, basename($outarp_file))); + move($rawarp_file, catfile($destination_dir, basename($rawarp_file))); + + if ( move($converted_file, catfile($converted_destination_dir, basename($converted_file))) && + move($raw_file, catfile($destination_dir, basename($raw_file))) ) + { + print 'moved.'; + } + else + { + print "move failed: $!"; + } + } + say ''; + } + + say "\r\nfound $move_counter files."; +} + +sub getconfig +{ + my ( $config_filename ) = @_; + if ( -f $config_filename ) { do $config_filename; } +} + +sub writeconfig +{ + my ( $config_filename ) = @_; + open(my $filehandle, '>', $config_filename) or die "Could not open file '$config_filename': $!"; + say $filehandle '$opt_f="'. $opt_f .'";'; + say $filehandle '$opt_c="'. $opt_c .'";'; + say $filehandle '$opt_r="'. $opt_r .'";'; + close $filehandle; +} + +sub main::VERSION_MESSAGE() +{ + say $PROGRAM . ' - version ' . $VERSION; + say 'published under BSD 3 - Clause License'; + say 'Copyright(c) 2019-2020 René Wagner'; + say 'https://git.sr.ht/~rwa/photo-helpers'; +} + +sub main::HELP_MESSAGE +{ + say ''; + say 'Find all by ART converted files in the current folder and their corresponding RAWs and move them to specified directory.'; + say ''; + say 'usage: afm(.pl) [options] <target folder>'; + say ''; + say 'options:'; + say ' -l : list-only mode - does not move files but only lists which files would be moved'; + say ' -r <raw> : override the raw extensions, defaults to "DNG"'; + say ' -f <folder> : override the folder for converted files, defaults to "JPEG"'; + say ' -c <ext> : override the converted file extenion (case-insensitive), defaults to "jp(e)g"'; + say ' -s : safe current options (-r, -f, -c only) to user profile. If present the saved values are applied automatically.'; + say ' --help : show this help'; +} diff --git a/art_file_mover.pl b/art_file_mover.pl @@ -1,151 +0,0 @@ -#!/usr/bin/perl -# Copyright(c) René Wagner 2019-2020 -# https://git.sr.ht/~rwa/photo-helpers -# published under BSD 3-Clause License - https://git.sr.ht/~rwa/photo-helpers/tree/master/LICENSE - -use warnings; -use strict; -use feature qw(say); -use Cwd; -use File::Basename; -use File::Copy; -use File::Find; -use File::Find::Rule; -use File::Spec::Functions; -use File::HomeDir; -use Getopt::Std; - -$Getopt::Std::STANDARD_HELP_VERSION = 'true'; - -my $VERSION = '0.5'; -my $PROGRAM = 'Art File Mover'; - -my $configfile = catfile(File::HomeDir->my_home, '.art_file_mover.conf'); - -# read commandline switches -our $opt_l = 0; -our $opt_r = 'DNG'; -our $opt_f = 'JPEG'; -our $opt_c = 'jpe{0,1}g'; -our $opt_s = 0; - -getconfig($configfile); - -getopts('slr:f:c:') or die "Invalid parameters provided! See 'art_file_mover.pl --help' for more details."; - -# read remaining commandline args für destination dir -# last dir will win -# fallback to list-only mode when no dir is given -my $destination_dir = getcwd; -foreach my $arg ( @ARGV ) -{ - $destination_dir = $arg; -} - -if ($destination_dir eq getcwd) { $opt_l = 1; } - -if ( $opt_s ) { writeconfig($configfile); } - -move_files($destination_dir); - -exit 0; - -sub move_files -{ - my ( $destination_dir ) = @_; - my $move_counter = 0; - - say "destination dir : $destination_dir"; - say "raw file ext : $opt_r"; - say "output file dir : $opt_f"; - say "output file ext : $opt_c"; - say 'action : '. ($opt_l ? 'list only' : 'move'); - say ''; - my $converted_destination_dir = catfile($destination_dir, $opt_f); - - if ( !$opt_l && (! -d $destination_dir || ! -d $converted_destination_dir)) - { - if (! -d $destination_dir ) { mkdir $destination_dir or die "Could not create destination dir $_ : $!"; } - if (! -d $converted_destination_dir ) { mkdir $converted_destination_dir or die "Could not create destination dir $_ : $!"; } - } - - # find all jpegs in current dir - my @files = File::Find::Rule->file()->name( qr/\.$opt_c$/i )->maxdepth(1)->in( catfile(getcwd, $opt_f) ); - - foreach my $converted_file ( @files ) - { - my ( $filename, $path, $ext ) = fileparse($converted_file, qr/\.[^.]*/); - my $outarp_file = $converted_file. '.out.arp'; - my $raw_file = catfile(dirname($path), $filename .'.'. $opt_r); - my $rawarp_file = $raw_file. '.arp'; - - print $raw_file .'...'; - - $move_counter++; - # do not move files that have no raw-file anymore - if ( ! -e $raw_file ) - { - print 'raw-file not found!'; - } - elsif ( !$opt_l ) - { - # only warn if JPEG or RAW file could not be moved - # the processing files *.arp are optional and are fine to be absent - move($outarp_file, catfile($converted_destination_dir, basename($outarp_file))); - move($rawarp_file, catfile($destination_dir, basename($rawarp_file))); - - if ( move($converted_file, catfile($converted_destination_dir, basename($converted_file))) && - move($raw_file, catfile($destination_dir, basename($raw_file))) ) - { - print 'moved.'; - } - else - { - print "move failed: $!"; - } - } - say ''; - } - - say "\r\nfound $move_counter files."; -} - -sub getconfig -{ - my ( $config_filename ) = @_; - if ( -f $config_filename ) { do $config_filename; } -} - -sub writeconfig -{ - my ( $config_filename ) = @_; - open(my $filehandle, '>', $config_filename) or die "Could not open file '$config_filename': $!"; - say $filehandle '$opt_f="'. $opt_f .'";'; - say $filehandle '$opt_c="'. $opt_c .'";'; - say $filehandle '$opt_r="'. $opt_r .'";'; - close $filehandle; -} - -sub main::VERSION_MESSAGE() -{ - say $PROGRAM . ' - version ' . $VERSION; - say 'published under BSD 3 - Clause License'; - say 'Copyright(c) 2019-2020 René Wagner'; - say 'https://git.sr.ht/~rwa/photo-helpers'; -} - -sub main::HELP_MESSAGE -{ - say ''; - say 'Find all by ART converted files in the current folder and their corresponding RAWs and move them to specified directory.'; - say ''; - say 'usage: art_file_mover.pl [options] <target folder>'; - say ''; - say 'options:'; - say ' -l : list-only mode - does not move files but only lists which files would be moved'; - say ' -r <raw> : override the raw extensions, defaults to "DNG"'; - say ' -f <folder> : override the folder for converted files, defaults to "JPEG"'; - say ' -c <ext> : override the converted file extenion (case-insensitive), defaults to "jp(e)g"'; - say ' -s : safe current options (-r, -f, -c only) to user profile. If present the saved values are applied automatically.'; - say ' --help : show this help'; -} diff --git a/jd.pl b/jd.pl @@ -0,0 +1,98 @@ +#!/usr/bin/perl +# Copyright(c) René Wagner 2019-2020 +# https://git.sr.ht/~rwa/photo-helpers +# published under BSD 3-Clause License - https://git.sr.ht/~rwa/photo-helpers/tree/master/LICENSE + +use warnings; +use strict; +use feature qw(say); +use Cwd; +use File::Basename; +use File::Copy; +use File::Find; +use File::Find::Rule; +use File::Spec::Functions; +use Getopt::Std; + +$Getopt::Std::STANDARD_HELP_VERSION = 'true'; + +my $VERSION = '0.6'; +my $PROGRAM = 'JpegDivider'; + +# read commandline switches +our $opt_l = 0; +our $opt_f = 'JPEG'; + +getopts('lf:') or die "Invalid parameters provided! See 'jpegdivider.pl --help' for more details."; + +# read remaining commandline args +# last dir will win +my $work_dir = getcwd; +foreach my $arg ( @ARGV ) +{ + if ( -d $arg ) { $work_dir = $arg } +} + +move_files($work_dir); + +exit 0; + +sub move_files +{ + my ( $dir ) = @_; + my $move_counter = 0; + + say "working directory: $dir"; + say 'action : '. (!$opt_l ? 'move' : 'list only'); + say "subfolder : $opt_f"; + say ''; + + my $destination_dir = catdir($dir, $opt_f); + if ( !$opt_l && ! -d $destination_dir ) + { + mkdir $destination_dir or die "Could not create destination dir $_ : $!"; + } + + my @files = File::Find::Rule->file()->name( qr/\.jpe{0,1}g$/i )->maxdepth(1)->in( $dir ); + + foreach my $file ( @files ) + { + print $file .'...'; + $move_counter++; + if ( !$opt_l ) + { + if ( move($file, catfile($destination_dir, basename($file)) ) ) + { + print "moved."; + } + else + { + print "move failed: $!"; + } + } + say ''; + } + + say "\r\nfound $move_counter jpeg files to subfolder."; +} + +sub main::VERSION_MESSAGE() +{ + say $PROGRAM . ' - version ' . $VERSION; + say 'published under BSD 3 - Clause License'; + say 'Copyright(c) 2019-2020 René Wagner'; + say 'https://git.sr.ht/~rwa/photo-helpers'; +} + +sub main::HELP_MESSAGE +{ + say ''; + say 'Moves JPEG files to a designated subfolder, by default "JPEG"'; + say ''; + say 'usage: jd(.pl) [options] <target folder>'; + say ''; + say 'options:'; + say ' -l : list-only mode - does not move files but only lists which files would be moved'; + say ' -f <folder> : use the given subfolder instead of "JPEG"'; + say ' --help : show this help'; +} diff --git a/jpegdivider.pl b/jpegdivider.pl @@ -1,98 +0,0 @@ -#!/usr/bin/perl -# Copyright(c) René Wagner 2019-2020 -# https://git.sr.ht/~rwa/photo-helpers -# published under BSD 3-Clause License - https://git.sr.ht/~rwa/photo-helpers/tree/master/LICENSE - -use warnings; -use strict; -use feature qw(say); -use Cwd; -use File::Basename; -use File::Copy; -use File::Find; -use File::Find::Rule; -use File::Spec::Functions; -use Getopt::Std; - -$Getopt::Std::STANDARD_HELP_VERSION = 'true'; - -my $VERSION = '0.5'; -my $PROGRAM = 'JpegDivider'; - -# read commandline switches -our $opt_m = 0; -our $opt_f = 'JPEG'; - -getopts('mf:') or die "Invalid parameters provided! See 'jpegdivider.pl --help' for more details."; - -# read remaining commandline args -# last dir will win -my $work_dir = getcwd; -foreach my $arg ( @ARGV ) -{ - if ( -d $arg ) { $work_dir = $arg } -} - -move_files($work_dir); - -exit 0; - -sub move_files -{ - my ( $dir ) = @_; - my $move_counter = 0; - - say "working directory: $dir"; - say 'action : '. ($opt_m ? 'move' : 'list only'); - say "subfolder : $opt_f"; - say ''; - - my $destination_dir = catdir($dir, $opt_f); - if ( $opt_m && ! -d $destination_dir ) - { - mkdir $destination_dir or die "Could not create destination dir $_ : $!"; - } - - my @files = File::Find::Rule->file()->name( qr/\.jpe{0,1}g$/i )->maxdepth(1)->in( $dir ); - - foreach my $file ( @files ) - { - print $file .'...'; - $move_counter++; - if ( $opt_m ) - { - if ( move($file, catfile($destination_dir, basename($file)) ) ) - { - print "moved."; - } - else - { - print "move failed: $!"; - } - } - say ''; - } - - say "\r\nfound $move_counter jpeg files to subfolder."; -} - -sub main::VERSION_MESSAGE() -{ - say $PROGRAM . ' - version ' . $VERSION; - say 'published under BSD 3 - Clause License'; - say 'Copyright(c) 2019-2020 René Wagner'; - say 'https://git.clttr.info/photo-helpers/'; -} - -sub main::HELP_MESSAGE -{ - say ''; - say 'Moves JPEG files to a designated subfolder, by default "JPEG"'; - say ''; - say 'commandline parameters - should be combined to match your needs:'; - say 'jpegdivider.pl - list all jpeg files in the current working dir'; - say 'jpegdivider.pl -m - create a subfolder "JPEG" in the current working dir and move jpeg files in there'; - say 'jpegdivider.pl -f <subfolder> - use the given subfolder instead of "JPEG"'; - say 'jpegdivider.pl <folder> - list/move all jpeg files in the given directory'; - say 'jpegdivider.pl --help - show this help'; -} diff --git a/silkypix_multiversion_sidecar_cleaner.pl b/silkypix_multiversion_sidecar_cleaner.pl @@ -1,121 +0,0 @@ -#!/usr/bin/perl -# Copyright(c) René Wagner 2019-2020 -# https://git.sr.ht/~rwa/photo-helpers -# published under BSD 3-Clause License - https://git.sr.ht/~rwa/photo-helpers/tree/master/LICENSE - -use warnings; -use strict; -use feature qw(say); -use Cwd; -use File::Basename; -use File::Find::Rule; -use File::Find; -use Getopt::Std; - -$Getopt::Std::STANDARD_HELP_VERSION = 'true'; - -my $VERSION = '0.5'; -my $PROGRAM = 'Multiversion Sidecar Cleaner'; - -# read commandline switches -our $opt_d = 0; - -getopts('d') or die "Invalid parameters provided! See 'silkypix_multiversion_sidecar_cleaner.pl --help' for more details."; - -# read remaining commandline args -# last dir will win -my $work_dir = getcwd; -foreach my $arg ( @ARGV ) -{ - if ( -d $arg ) { $work_dir = $arg } -} - -delete_files($work_dir); - -exit 0; - -sub delete_files -{ - my ( $dir ) = @_; - my ( $file_counter ) = 0; - - say "working directory: $dir"; - say 'action : '. ($opt_d ? 'delete' : 'list only') . "\r\n"; - say 'files with newer versions:'; - - # alle Dateien in allen Unterordnern *.spd *.spf suchen - - my @files = File::Find::Rule->file->name( qr/\.sp(d|f)$/i )->in( $dir ); - - foreach my $file ( @files ) - { - if ( exist_newer_file($file, @files) ) - { - print $file .'...'; - $file_counter++; - if ( $opt_d ) - { - if ( unlink $file ) - { - print 'deleted.' - } - else - { - print " deletion failed: $!"; - } - } - say ''; - } - } - - say "\r\n$file_counter duplicate file versions found."; -} - -sub exist_newer_file -{ - my ( $original_file, @files_hash ) = @_; - - if ( -f $original_file ) - { - # build the regex to find all versions of this file - my @original_file_parts = split /\./, basename($original_file); - - # don't handle files that doesn't have a version - if ( scalar @original_file_parts < 4 ) - { - return 0; - } - - my $filefinder_regex = "$original_file_parts[0]\\.$original_file_parts[1]\\.[0-9]+\\.$original_file_parts[3]"; - my @version_files = File::Find::Rule->file->name( qr/$filefinder_regex/i )->in( dirname($original_file) ); - - foreach my $version_file ( @version_files ) - { - my @version_file_parts = split /\./, $version_file; - if ( $version_file_parts[2] > $original_file_parts[2] ) { return 1; } - } - } - - return 0; -} - -sub main::VERSION_MESSAGE() -{ - say $PROGRAM . ' - version ' . $VERSION; - say 'published under BSD 3 - Clause License'; - say 'Copyright(c) 2019-2020 René Wagner'; - say 'https://git.clttr.info/photo-helpers/'; -} - -sub main::HELP_MESSAGE -{ - say ''; - say 'Deletes Silkypix Sidecar files when newer versions of the files are available.'; - say 'This usually happens when a file is opened in a newer version of Silkypix, as the sidecar files are version specific.'; - say ''; - say 'commandline parameters - should be combined to match your needs:'; - say 'duplicate_sidecar_cleaner.pl - list duplicate sidecar file versions in current working directory and subfolders'; - say 'duplicate_sidecar_cleaner.pl -d - delete duplicate sidecar file versions in given directory and subfolders'; - say 'duplicate_sidecar_cleaner.pl <folder> - list/delete duplicate sidecar file versions in given directory and subfolders'; - say 'duplicate_sidecar_cleaner.pl --help - show this help'; -} diff --git a/silkypix_orphaned_sidecar_cleaner.pl b/silkypix_orphaned_sidecar_cleaner.pl @@ -1,106 +0,0 @@ -#!/usr/bin/perl -# Copyright(c) René Wagner 2019-2020 -# https://git.sr.ht/~rwa/photo-helpers -# published under BSD 3-Clause License - https://git.sr.ht/~rwa/photo-helpers/tree/master/LICENSE - -use warnings; -use strict; -use feature qw(say); -use Cwd; -use File::Basename; -use File::Find::Rule; -use File::Find; -use File::Spec::Functions; -use Getopt::Std; - -$Getopt::Std::STANDARD_HELP_VERSION = 'true'; - -my $VERSION = '0.3'; -my $PROGRAM = 'Orphaned Sidecar Cleaner'; - -# read commandline switches -our $opt_d = 0; - -getopts('d') or die "Invalid parameters provided! See 'silkypix_multiversion_sidecar_cleaner.pl --help' for more details."; - -# read remaining commandline args -# last dir will win -my $work_dir = getcwd; -foreach my $arg ( @ARGV ) -{ - if ( -d $arg ) { $work_dir = $arg } -} - -delete_files($work_dir); - -exit 0; - -sub delete_files -{ - my ( $delete_dir ) = @_; - my ( $file_counter ) = 0; - - say "working directory: $delete_dir"; - say 'action : '. ($opt_d ? 'delete' : 'list only') ."\r\n"; - say 'files with missing raw:'; - - # alle Dateien in allen Unterordnern *.spd *.spf suchen - my @files = File::Find::Rule->file->name( qr/\.sp(d|f)$/i )->in( $delete_dir ); - - foreach my $file ( @files ) - { - if ( ! exists_raw_filename($file) ) - { - print $file .'...'; - $file_counter++; - if ( $opt_d ) - { - if ( unlink $file ) - { - print 'deleted.'; - } - else - { - print " deletion failed: $!"; - } - } - say ''; - } - } - - say "\r\n$file_counter orphaned sidecar files found."; -} - -sub exists_raw_filename -{ - my ( $original_file ) = @_; - - my ( $filename, $dirs ) = fileparse($original_file); - # Silkypix Sidecar files reside in a "SILKYPIX_DS" folder, so we need to search in the parent folder - $filename =~ s/\.\d+\.sp.$//g; - if ( -f catfile(dirname($dirs), $filename) ) - { - return 1; - } - return 0; -} - -sub main::VERSION_MESSAGE() -{ - say $PROGRAM . ' - version ' . $VERSION; - say 'published under BSD 3 - Clause License'; - say 'Copyright(c) 2019-2020 René Wagner'; - say 'https://git.clttr.info/photo-helpers/'; -} - -sub main::HELP_MESSAGE -{ - say ''; - say 'Deletes Silkypix Sidecar files when corresponding RAW files are missing.'; - say ''; - say 'commandline parameters - should be combined to match your needs:'; - say 'orphaned_sidecar_cleaner.pl - list orphaned sidecar file in current working directory and subfolders'; - say 'orphaned_sidecar_cleaner.pl -d - delete orphaned sidecar file in current working directory and subfolders'; - say 'orphaned_sidecar_cleaner.pl <folder> - list/delete orphaned sidecar file in given directory and subfolders'; - say 'orphaned_sidecar_cleaner.pl --help - show this help'; -} diff --git a/spmvsc.pl b/spmvsc.pl @@ -0,0 +1,121 @@ +#!/usr/bin/perl +# Copyright(c) René Wagner 2019-2020 +# https://git.sr.ht/~rwa/photo-helpers +# published under BSD 3-Clause License - https://git.sr.ht/~rwa/photo-helpers/tree/master/LICENSE + +use warnings; +use strict; +use feature qw(say); +use Cwd; +use File::Basename; +use File::Find::Rule; +use File::Find; +use Getopt::Std; + +$Getopt::Std::STANDARD_HELP_VERSION = 'true'; + +my $VERSION = '0.6'; +my $PROGRAM = 'Multiversion Sidecar Cleaner'; + +# read commandline switches +our $opt_l = 0; + +getopts('l') or die "Invalid parameters provided! See 'silkypix_multiversion_sidecar_cleaner.pl --help' for more details."; + +# read remaining commandline args +# last dir will win +my $work_dir = getcwd; +foreach my $arg ( @ARGV ) +{ + if ( -d $arg ) { $work_dir = $arg } +} + +delete_files($work_dir); + +exit 0; + +sub delete_files +{ + my ( $dir ) = @_; + my ( $file_counter ) = 0; + + say "working directory: $dir"; + say 'action : '. (!$opt_l ? 'delete' : 'list only') . "\r\n"; + say 'files with newer versions:'; + + # alle Dateien in allen Unterordnern *.spd *.spf suchen + + my @files = File::Find::Rule->file->name( qr/\.sp(d|f)$/i )->in( $dir ); + + foreach my $file ( @files ) + { + if ( exist_newer_file($file, @files) ) + { + print $file .'...'; + $file_counter++; + if ( !$opt_l ) + { + if ( unlink $file ) + { + print 'deleted.' + } + else + { + print " deletion failed: $!"; + } + } + say ''; + } + } + + say "\r\n$file_counter duplicate file versions found."; +} + +sub exist_newer_file +{ + my ( $original_file, @files_hash ) = @_; + + if ( -f $original_file ) + { + # build the regex to find all versions of this file + my @original_file_parts = split /\./, basename($original_file); + + # don't handle files that doesn't have a version + if ( scalar @original_file_parts < 4 ) + { + return 0; + } + + my $filefinder_regex = "$original_file_parts[0]\\.$original_file_parts[1]\\.[0-9]+\\.$original_file_parts[3]"; + my @version_files = File::Find::Rule->file->name( qr/$filefinder_regex/i )->in( dirname($original_file) ); + + foreach my $version_file ( @version_files ) + { + my @version_file_parts = split /\./, $version_file; + if ( $version_file_parts[2] > $original_file_parts[2] ) { return 1; } + } + } + + return 0; +} + +sub main::VERSION_MESSAGE() +{ + say $PROGRAM . ' - version ' . $VERSION; + say 'published under BSD 3 - Clause License'; + say 'Copyright(c) 2019-2020 René Wagner'; + say 'https://git.sr.ht/~rwa/photo-helpers'; +} + +sub main::HELP_MESSAGE +{ + say ''; + say 'Deletes Silkypix Sidecar files when newer versions of the files are available.'; + say 'This usually happens when a file is opened in a newer version of Silkypix, as the sidecar files are version specific.'; + say ''; + say 'usage: spmvsc(.pl) [options] <target folder>'; + say ''; + say 'options:'; + say ' -l : list-only mode - does not delete files but only lists which files would be moved'; + say ' --help : show this help'; +} diff --git a/sposc.pl b/sposc.pl @@ -0,0 +1,107 @@ +#!/usr/bin/perl +# Copyright(c) René Wagner 2019-2020 +# https://git.sr.ht/~rwa/photo-helpers +# published under BSD 3-Clause License - https://git.sr.ht/~rwa/photo-helpers/tree/master/LICENSE + +use warnings; +use strict; +use feature qw(say); +use Cwd; +use File::Basename; +use File::Find::Rule; +use File::Find; +use File::Spec::Functions; +use Getopt::Std; + +$Getopt::Std::STANDARD_HELP_VERSION = 'true'; + +my $VERSION = '0.5'; +my $PROGRAM = 'Orphaned Sidecar Cleaner'; + +# read commandline switches +our $opt_l = 0; + +getopts('l') or die "Invalid parameters provided! See 'silkypix_multiversion_sidecar_cleaner.pl --help' for more details."; + +# read remaining commandline args +# last dir will win +my $work_dir = getcwd; +foreach my $arg ( @ARGV ) +{ + if ( -d $arg ) { $work_dir = $arg } +} + +delete_files($work_dir); + +exit 0; + +sub delete_files +{ + my ( $delete_dir ) = @_; + my ( $file_counter ) = 0; + + say "working directory: $delete_dir"; + say 'action : '. (!$opt_l ? 'delete' : 'list only') ."\r\n"; + say 'files with missing raw:'; + + # alle Dateien in allen Unterordnern *.spd *.spf suchen + my @files = File::Find::Rule->file->name( qr/\.sp(d|f)$/i )->in( $delete_dir ); + + foreach my $file ( @files ) + { + if ( ! exists_raw_filename($file) ) + { + print $file .'...'; + $file_counter++; + if ( !$opt_l ) + { + if ( unlink $file ) + { + print 'deleted.'; + } + else + { + print " deletion failed: $!"; + } + } + say ''; + } + } + + say "\r\n$file_counter orphaned sidecar files found."; +} + +sub exists_raw_filename +{ + my ( $original_file ) = @_; + + my ( $filename, $dirs ) = fileparse($original_file); + # Silkypix Sidecar files reside in a "SILKYPIX_DS" folder, so we need to search in the parent folder + $filename =~ s/\.\d+\.sp.$//g; + if ( -f catfile(dirname($dirs), $filename) ) + { + return 1; + } + return 0; +} + +sub main::VERSION_MESSAGE() +{ + say $PROGRAM . ' - version ' . $VERSION; + say 'published under BSD 3 - Clause License'; + say 'Copyright(c) 2019-2020 René Wagner'; + say 'https://git.sr.ht/~rwa/photo-helpers'; +} + +sub main::HELP_MESSAGE +{ + say ''; + say 'Deletes Silkypix Sidecar files when corresponding RAW files are missing.'; + say 'The program searches for orphaned files in the given folder or the current working directory if no folder is given.'; + say ''; + say 'usage: sposc(.pl) [options] <target folder>'; + say ''; + say 'options:'; + say ' -l : list-only mode - does not delete files but only lists which files would be moved'; + say ' --help : show this help'; +}