Browse Source

bin/digikam-extract: hackery for pulling stuff out of digikam galleries

Brennen Bearnes 1 year ago
1 changed files with 190 additions and 0 deletions
  1. +190

+ 190
- 0
home/bin/digikam-extract View File

@ -0,0 +1,190 @@
#!/usr/bin/env perl
=head1 NAME
digikam-extract - find files by tag in a DigiKam 4 database
# 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
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.
=head1 AUTHOR
Brennen Bearnes
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';
'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";
foreach my $path ($dest, $root) {
die("$path is not a directory")
unless -d $path;
my $query = q{
SELECT, ii.creationDate, i.modificationDate, ar.specificPath,
a.relativePath, AS image_name, AS tag_name
FROM Tags t JOIN ImageTags it ON it.tagid =
JOIN Images i ON it.imageid =
JOIN Albums a ON i.album =
JOIN AlbumRoots ar ON = a.albumRoot
JOIN ImageInformation ii ON ii.imageid =
WHERE = ? AND ar.specificPath = ?
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", "", "");
my @bind = ($tag, $root);
my $sth = $dbh->prepare($query);
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";