#!/usr/bin/env perl =pod =head1 NAME digikam-extract - find files by tag in a DigiKam 4 database =head1 SYNOPSIS # List photos tagged "mom-album-2020": digikam-extract --tag mom-album-2020 # Copy tagged items to current dir, renamed by date: digikam-extract --tag mom-album-2020 --copy # Same, but falling back to file mtime for anything with a year of 1980: digikam-extract --tag mom-album-2020 --ctime-fallback 1980 --copy =head1 DESCRIPTION A silly hack for tagging photos in DigiKam and then copying the tagged stuff into a separate directory and renaming the files according to their creation date. If I need this workflow again, I may generalize this, but it's probably worth noting that the database schema is effectively an undocumented API and could easily get yanked out from under this code at any time. =head1 OPTIONS =over 4 =item B<--tag> [tagname] Specify a tag to search for. Required. =item B<--copy> [path] Copy files to destination path. Defaults to working directory. =item B<--dest> [path] Specify a destination path. =item B<--ctime-fallback> [year] Specify a year which probably means that the camera's date wasn't set, and fall back to whatever DigiKam's db thinks the modification time is instead. =item B<--dbfile> [path] Specify location of DigiKam4 database file. =item B<--date-format> "format" Specify date format for target filenames. See strftime(3) for date format. Defaults to C<%Y-%m-%d-%H%M%S>. =item B<--root> [path] Specify a gallery path. Must correspond to a root album folder defined in Collections Settings in DigiKam. No trailing slash. =item B<--help> Print help and exit. =back =head1 AUTHOR Brennen Bearnes =cut use warnings; use strict; use Cwd; use DBI; use Data::Dumper; use File::Basename; use File::Spec; use Getopt::Long; use Pod::Usage; use SQL::Abstract; use Time::Piece; use Time::Seconds; use File::Copy; use File::HomeDir; my $HOME = File::HomeDir->my_home; # Handle options, including help generated from the POD above. # TODO: This should use digikam config to extract current path to db # and roots should be extracted from the database, most likely. my $copy = 0; my $tag; my $dest = getcwd(); my $ctime_fallback; my $date_format = '%Y-%m-%d-%H%M%S'; my $dbfile = $HOME . "/digikam-db/digikam4.db"; my $root = $HOME . '/workspace/photos'; GetOptions( 'copy' => \$copy, 'dest=s' => \$dest, 'tag=s' => \$tag, 'root=s' => \$root, 'dbfile=s' => \$dbfile, 'ctime-fallback=s' => \$ctime_fallback, 'date-format' => \$date_format, 'help' => sub { pod2usage(-verbose => 2) }, ) or pod2usage(-verbose => 1, ); # Handle a couple of likely failure modes: unless (defined $tag) { print "Please specify a tag name with --tag\n"; exit(2); } foreach my $path ($dest, $root) { die("$path is not a directory") unless -d $path; } my $query = q{ SELECT i.id, ii.creationDate, i.modificationDate, ar.specificPath, a.relativePath, i.name AS image_name, t.name AS tag_name FROM Tags t JOIN ImageTags it ON it.tagid = t.id JOIN Images i ON it.imageid = i.id JOIN Albums a ON i.album = a.id JOIN AlbumRoots ar ON ar.id = a.albumRoot JOIN ImageInformation ii ON ii.imageid = i.id WHERE t.name = ? AND ar.specificPath = ? ; }; my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", "", ""); my @bind = ($tag, $root); my $sth = $dbh->prepare($query); $sth->execute(@bind); unless ($copy) { print "Dry run. Would copy:\n\n" } my %sources; while (my $data = $sth->fetchrow_hashref()) { my $cdate = Time::Piece->strptime($data->{creationDate}, "%Y-%m-%dT%T"); my $mdate = Time::Piece->strptime($data->{modificationDate}, "%Y-%m-%dT%T"); my $date = $cdate->strftime($date_format); if (defined $ctime_fallback) { # If we got a year to fall back to the mtime for, then do that - # so like if a bunch of stuff has 1980 because the clock wasn't # set right on the camera... if ($ctime_fallback eq $cdate->strftime('%Y')) { $date = $mdate->strftime($date_format); } } # print "$date\t"; my $source = $root . $data->{'relativePath'} . "/" . $data->{image_name}; my $dest = "$dest/$date-$data->{image_name}"; if (defined $sources{$dest}) { die("Collision: $source and $sources{$dest} would collide, making no copies"); } else { $sources{$dest} = $source; } } foreach my $dest (keys %sources) { my $source = $sources{$dest}; print "$source -> $dest\n"; next unless $copy; if (-e $dest) { print "Destination already exists: $dest\n"; } else { copy($source, $dest); } } unless ($copy) { print "\nAdd --copy to invocation to copy to $dest\n"; }