Given YAML file from gather_tags.pl, stuff tags back into current copy of photos

fix_tags.pl

#!usr/bin/env perl

# This uses the YAML generated by gather_tags.pl
#
# See: https://gist.github.com/grifferz/5b116b87d93ee9586a053a4021ef86fc

use strict;
use warnings;

use utf8;

use open qw(:std :utf8);
use Encode qw(decode_utf8);

@ARGV = map { decode_utf8($_, 1) } @ARGV;

use Log::Log4perl qw(:easy);
use YAML::XS qw(LoadFile);
use List::MoreUtils qw(any uniq);
use Image::ExifTool qw(:Public);
use Data::Dumper;

Log::Log4perl->easy_init(
    {
        level  => $DEBUG,
        file   => ">>fix_tags.log",
        utf8   => 1,
        layout => '%d [%r] %p - %m{chomp}%n',
    },
);

if (scalar @ARGV != 1) {
    LOGDIE "Usage: $0 tagfile.yaml";
}

my $tags = LoadFile($ARGV[0]);

if (defined $tags) {
    DEBUG "Loaded YAML from " . $ARGV[0];
} else {
    LOGDIE "Failed to load YAML from " . $ARGV[0];
}

# Whre the current copy of my photos live on my home file server.
chdir('/srv/tank/Photos/Andy') or LOGDIE "chdir: $!";

my ($success, $errstr);

foreach my $fname (keys %{ $tags }) {
    my $keywords = $tags->{$fname}->{keywords};
    my $tagslist = $tags->{$fname}->{tagslist};

    my $exiftool = new Image::ExifTool;
    $exiftool->ExtractInfo($fname);
    $exiftool->Options(CharsetEXIF => 'UTF8');

    INFO "Need to set Keywords/TagsList on $fname";

    INFO "Current Keywords for $fname: ["
        . join('#', get_kw_and_subj($exiftool)) . ']';
    INFO "Current TagsList for $fname: ["
        . join('#', get_tagslist($exiftool)) . ']';

    # Too much repetition here really but this was a one-off quick and dirty script…
    foreach my $kw (@{ $keywords }) {
        # Delete all instances of the Keyword first so that we don't get
        # duplicates.
        $exiftool->SetNewValue(
            Keywords => $kw,
            DelValue => 1,
        );

        ($success, $errstr) = $exiftool->SetNewValue(
            Keywords => $kw,
            AddValue => 1,
        );

        if (! $success) {
            LOGDIE "Failed to set Keyword [$kw] on $fname: $errstr";
        }
        
        # Delete all instances of the Subject first so that we don't get
        # duplicates.
        $exiftool->SetNewValue(
            Subject  => $kw,
            DelValue => 1,
        );

        ($success, $errstr) = $exiftool->SetNewValue(
            Subject  => $kw,
            AddValue => 1,
        );

        if (! $success) {
            LOGDIE "Failed to set Subject [$kw] on $fname: $errstr";
        }
    }

    foreach my $t (@{ $tagslist }) {
        # Delete all instances of the tag first so that we don't get
        # duplicates.
        $exiftool->SetNewValue(
            TagsList => $t,
            DelValue => 1,
        );

        ($success, $errstr) = $exiftool->SetNewValue(
            TagsList => $t,
            AddValue => 1,
        );

        if (! $success) {
            LOGDIE "Failed to set TagsList [$t] on $fname: $errstr";
        }
    }

    INFO "Writing EXIF info back to $fname";

    $exiftool->WriteInfo($fname);
    $exiftool->ExtractInfo($fname);

    INFO "New Keywords for $fname: ["
        . join('#', get_kw_and_subj($exiftool)) . ']';
    INFO "New TagsList for $fname: ["
        . join('#', get_tagslist($exiftool)) . ']';
}

exit 0;

sub get_kw_and_subj {
    my ($et) = @_;

    my @cur_kw   = $et->GetValue('Keywords', 'ValueConv');
    my @cur_subj = $et->GetValue('Subject', 'ValueConv');
    my @cur = uniq @cur_kw, @cur_subj;
    @cur = map { decode_utf8($_, 1) } @cur;

    return @cur;
}

sub get_tagslist {
    my ($et) = @_;

    my @cur_tl = $et->GetValue('TagsList', 'ValueConv');
    @cur_tl = map { decode_utf8($_, 1) } @cur_tl;

    return @cur_tl;
}

=pod

Example logging output:

2020/01/01 13:38:47 [193] DEBUG - Loaded YAML from tags.yaml
2020/01/01 13:38:48 [1251] INFO - Need to set Keywords/TagsList on 2016/07/17/IMG_6447 (Modified).JPG
2020/01/01 13:38:48 [1252] INFO - Current Keywords for 2016/07/17/IMG_6447 (Modified).JPG: [Events#Long Ditton#Pets#Places#Surrey#WGW at Long Ditton Village Fair, July 2016]
2020/01/01 13:38:48 [1252] INFO - Current TagsList for 2016/07/17/IMG_6447 (Modified).JPG: [Events#Events/WGW at Long Ditton Village Fair, July 2016#Pets#Places#Places/Surrey#Places/Surrey/Long Ditton]
2020/01/01 13:38:48 [1595] INFO - Writing EXIF info back to 2016/07/17/IMG_6447 (Modified).JPG
2020/01/01 13:38:48 [1698] INFO - New Keywords for 2016/07/17/IMG_6447 (Modified).JPG: [Events#Long Ditton#Molly#Pets#Places#Surrey#WGW at Long Ditton Village Fair, July 2016]
2020/01/01 13:38:48 [1698] INFO - New TagsList for 2016/07/17/IMG_6447 (Modified).JPG: [Events#Events/WGW at Long Ditton Village Fair, July 2016#Pets#Pets/Molly#Places#Places/Surrey#Places/Surrey/Long Ditton]

=cut