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 f4f6ce7d1e07f9c1b98e4c7412f6fa527ea29fdc
parent 799f2f6773bd664ad4a4f593af617dc51e11e37e
Author: René Wagner <rwagner@rw-net.de>
Date:   Sat,  2 Jan 2021 20:59:57 +0100

update links & remove .pl extentions

Diffstat:
D.build.yml | 30------------------------------
MPKGBUILD | 2+-
MREADME.md | 19++++++-------------
Aafm | 158+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dafm.pl | 158-------------------------------------------------------------------------------
Ajd | 99+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Djd.pl | 99-------------------------------------------------------------------------------
Aspmvsc | 118+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dspmvsc.pl | 118-------------------------------------------------------------------------------
Asposc | 104+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dsposc.pl | 104-------------------------------------------------------------------------------
11 files changed, 486 insertions(+), 523 deletions(-)

diff --git a/.build.yml b/.build.yml @@ -1,30 +0,0 @@ -image: archlinux -packages: - - perl - - perl-par-packer - - perl-file-find-rule - - perl-file-homedir - - perl-modern-perl -sources: - - https://git.sr.ht/~rwa/photo-helpers -artifacts: - - photo-helpers/output.tar -tasks: - - build: | - cd photo-helpers - perl -c afm.pl - perl -c jd.pl - perl -c sposc.pl - perl -c spmvsc.pl - mkdir bin - /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 - tar -czf ${TAG}_linux_amd64.tar.gz afm jd sposc spmvsc - makepkg -g - makepkg - tar -cf output.tar *.tar.gz *.tar.zst diff --git a/PKGBUILD b/PKGBUILD @@ -6,7 +6,7 @@ pkgrel=1 pkgdesc='simple photo workflow helper scripts' arch=('x86_64') license=('BSD') -url='https://git.sr.ht/~rwa/photo-helpers' +url='https://src.clttr.info/rwa/photo-helpers' provides=('photo-helpers') options=(!strip) source=('afm' 'jd' 'sposc' 'spmvsc') diff --git a/README.md b/README.md @@ -1,17 +1,10 @@ # About This rather small scripts written in [Perl](https://perl.org) provide useful function for managing (raw and output) files for photographers. -**Additional information can be found on the [wiki page](https://man.sr.ht/~rwa/photo-workflow/).** - ## usage +Simply clone the repo or manually download the scripts from https://src.clttr.info/rwa/photo-helpers/ -### using binary (recommended) -There are prebuilt binarys (currently only x86\_64 for linux) and packages for Arch Linux and derivatives available for [every ref](https://git.sr.ht/~rwa/photo-helpers/refs). - -### using bare scripts -Simply clone the repo or manually download the scripts from https://git.sr.ht/~rwa/photo-stats/ - -To run the script, open a shell and invoke `perl script.pl`, on most systems it should be sufficient to just invoke `script.pl` (after you granted execute-permissions to the script). +To run the script, open a shell and invoke `perl <script>`, on most systems it should be sufficient to just invoke `script` (after you granted execute-permissions to the script). #### prerequisites for running the pure scripts @@ -34,14 +27,14 @@ Additionally the following perl modules need to be installed: Helper scripts to manage files which where handled by [ART](https://clttr.info/art), the easy-to-use RAW converter forked from RawTherapee. ## processed file mover -Filename: `afm(.pl)` +Filename: `afm` Moves all already converted raw files and their corresponding jpegs to a given folder. # generic scripts ## JpegDivider -Filename: `jd(.pl)` +Filename: `jd` Moves all jpeg files (suffixes .jpg and .jpeg) in the given folder or the current working directory to the subfolder JPEG (or the given subfolder). @@ -64,11 +57,11 @@ base folder ``` ## orphaned sidecar cleaner -Filename: `sposc(.pl)` +Filename: `sposc` 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: `spmvsc(.pl)` +Filename: `spmvsc` 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 b/afm @@ -0,0 +1,158 @@ +#!/usr/bin/perl +# Copyright(c) René Wagner 2019-2020 +# https://src.clttr.info/rwa/photo-helpers +# published under BSD 3-Clause License + +use Modern::Perl '2019'; +use Cwd; +use File::Basename; +use File::Copy; +use File::Find::Rule; +use File::Spec::Functions; +use File::HomeDir; +use Getopt::Std; + +$Getopt::Std::STANDARD_HELP_VERSION = 'true'; + +my $VERSION = '0.7'; +my $PROGRAM = 'ART File Mover'; + +my $configfile = catfile(File::HomeDir->my_home, '.afm.conf'); + +# read commandline switches +our $opt_l = 0; +our $opt_R = 'DNG'; +our $opt_F = 'JPEG'; +our $opt_E = 'jpe{0,1}g'; +our $opt_C = ''; + +getconfig(); + +getopts('lR:F:E:C:') or die "Invalid parameters provided! See 'afm --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; } + +writeconfig(); + +move_files($destination_dir); + +exit 0; + +sub move_files +{ + my ( $destination_dir ) = @_; + my $move_counter = 0; + + say "destination dir : $destination_dir"; + ($opt_C eq '') or say "copy dir : $opt_C"; + say "raw file ext : $opt_R"; + say "output file dir : $opt_F"; + say "output file ext : $opt_E"; + 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_E$/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 ($opt_C ne '' && -d $opt_C) + { + copy($converted_file, catfile($opt_C, basename($converted_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 +{ + if ( -f $configfile ) { do $configfile; } +} + +sub writeconfig +{ + open(my $filehandle, '>', $configfile) or die "Could not open file '$configfile': $!"; + say $filehandle '$opt_F="'. $opt_F .'";'; + say $filehandle '$opt_E="'. $opt_E .'";'; + say $filehandle '$opt_R="'. $opt_R .'";'; + say $filehandle '$opt_C="'. $opt_C .'";'; + 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 [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 ' This option is automatically saved in the user config and can be omitted on the next run'; + say ' -F <folder> : override the folder for converted files, defaults to "JPEG"'; + say ' This option is automatically saved in the user config and can be omitted on the next run'; + say ' -E <ext> : override the converted file extenion (case-insensitive), defaults to "jp(e)g"'; + say ' Perl-compatible regular expressions allowed'; + say ' This option is automatically saved in the user config and can be omitted on the next run'; + say ' -C <folder> : copy the converted (output) files (ie jpegs) to an additional directory'; + say ' This option is automatically saved in the user config and can be omitted on the next run'; + say ' --help : show this help'; +} diff --git a/afm.pl b/afm.pl @@ -1,158 +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 Modern::Perl '2019'; -use Cwd; -use File::Basename; -use File::Copy; -use File::Find::Rule; -use File::Spec::Functions; -use File::HomeDir; -use Getopt::Std; - -$Getopt::Std::STANDARD_HELP_VERSION = 'true'; - -my $VERSION = '0.7'; -my $PROGRAM = 'ART File Mover'; - -my $configfile = catfile(File::HomeDir->my_home, '.afm.conf'); - -# read commandline switches -our $opt_l = 0; -our $opt_R = 'DNG'; -our $opt_F = 'JPEG'; -our $opt_E = 'jpe{0,1}g'; -our $opt_C = ''; - -getconfig(); - -getopts('lR:F:E:C:') or die "Invalid parameters provided! See 'afm.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; } - -writeconfig(); - -move_files($destination_dir); - -exit 0; - -sub move_files -{ - my ( $destination_dir ) = @_; - my $move_counter = 0; - - say "destination dir : $destination_dir"; - ($opt_C eq '') or say "copy dir : $opt_C"; - say "raw file ext : $opt_R"; - say "output file dir : $opt_F"; - say "output file ext : $opt_E"; - 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_E$/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 ($opt_C ne '' && -d $opt_C) - { - copy($converted_file, catfile($opt_C, basename($converted_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 -{ - if ( -f $configfile ) { do $configfile; } -} - -sub writeconfig -{ - open(my $filehandle, '>', $configfile) or die "Could not open file '$configfile': $!"; - say $filehandle '$opt_F="'. $opt_F .'";'; - say $filehandle '$opt_E="'. $opt_E .'";'; - say $filehandle '$opt_R="'. $opt_R .'";'; - say $filehandle '$opt_C="'. $opt_C .'";'; - 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 ' This option is automatically saved in the user config and can be omitted on the next run'; - say ' -F <folder> : override the folder for converted files, defaults to "JPEG"'; - say ' This option is automatically saved in the user config and can be omitted on the next run'; - say ' -E <ext> : override the converted file extenion (case-insensitive), defaults to "jp(e)g"'; - say ' Perl-compatible regular expressions allowed'; - say ' This option is automatically saved in the user config and can be omitted on the next run'; - say ' -C <folder> : copy the converted (output) files (ie jpegs) to an additional directory'; - say ' This option is automatically saved in the user config and can be omitted on the next run'; - say ' --help : show this help'; -} diff --git a/jd b/jd @@ -0,0 +1,99 @@ +#!/usr/bin/perl +# Copyright(c) René Wagner 2019-2020 +# https://src.clttr.info/rwa/photo-helpers +# published under BSD 3-Clause License + +use Modern::Perl '2019'; +use Cwd; +use File::Basename; +use File::Copy; +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'; +our $opt_e = 'jpe{0,1}g'; + +getopts('lf:e:') or die "Invalid parameters provided! See 'jd --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 "file ext : $opt_e"; + 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/\.$opt_e$/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 [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 ' -e <ext> : override the converted file extenion (case-insensitive), defaults to "jp(e)g"'; + say ' Perl-compatible regular expressions allowed'; + say ' --help : show this help'; +} diff --git a/jd.pl b/jd.pl @@ -1,99 +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 Modern::Perl '2019'; -use Cwd; -use File::Basename; -use File::Copy; -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'; -our $opt_e = 'jpe{0,1}g'; - -getopts('lf:e:') or die "Invalid parameters provided! See 'jd.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 "file ext : $opt_e"; - 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/\.$opt_e$/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 ' -e <ext> : override the converted file extenion (case-insensitive), defaults to "jp(e)g"'; - say ' Perl-compatible regular expressions allowed'; - say ' --help : show this help'; -} diff --git a/spmvsc b/spmvsc @@ -0,0 +1,118 @@ +#!/usr/bin/perl +# Copyright(c) René Wagner 2019-2020 +# https://src.clttr.info/rwa/photo-helpers +# published under BSD 3-Clause License + +use Modern::Perl '2019'; +use Cwd; +use File::Basename; +use File::Find::Rule; +use Getopt::Std; + +$Getopt::Std::STANDARD_HELP_VERSION = 'true'; + +my $VERSION = '0.6'; +my $PROGRAM = 'SilkyPix Multiversion Sidecar Cleaner'; + +# read commandline switches +our $opt_l = 0; + +getopts('l') or die "Invalid parameters provided! See 'spmvsc --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 [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/spmvsc.pl b/spmvsc.pl @@ -1,118 +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 Modern::Perl '2019'; -use Cwd; -use File::Basename; -use File::Find::Rule; -use Getopt::Std; - -$Getopt::Std::STANDARD_HELP_VERSION = 'true'; - -my $VERSION = '0.6'; -my $PROGRAM = 'SilkyPix Multiversion Sidecar Cleaner'; - -# read commandline switches -our $opt_l = 0; - -getopts('l') or die "Invalid parameters provided! See 'spmvsc.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 b/sposc @@ -0,0 +1,104 @@ +#!/usr/bin/perl +# Copyright(c) René Wagner 2019-2020 +# https://src.clttr.info/rwa/photo-helpers +# published under BSD 3-Clause License + +use Modern::Perl '2019'; +use Cwd; +use File::Basename; +use File::Find::Rule; +use File::Spec::Functions; +use Getopt::Std; + +$Getopt::Std::STANDARD_HELP_VERSION = 'true'; + +my $VERSION = '0.5'; +my $PROGRAM = 'SilkyPix Orphaned Sidecar Cleaner'; + +# read commandline switches +our $opt_l = 0; + +getopts('l') or die "Invalid parameters provided! See 'sposc --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 [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 @@ -1,104 +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 Modern::Perl '2019'; -use Cwd; -use File::Basename; -use File::Find::Rule; -use File::Spec::Functions; -use Getopt::Std; - -$Getopt::Std::STANDARD_HELP_VERSION = 'true'; - -my $VERSION = '0.5'; -my $PROGRAM = 'SilkyPix Orphaned Sidecar Cleaner'; - -# read commandline switches -our $opt_l = 0; - -getopts('l') or die "Invalid parameters provided! See 'sposc.rpl --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'; -}