#!/usr/bin/perl

=head1 Name

iptc.pl -- interface for reading or adding IPTC data to image files

NOTE: Requires IPTCInfo.pm (www.cpan.org)

Reads IPTC header data from files (presumably image files).

Author: Dan Heller <argv@danheller.com>
	http://www.danheller.com/

=cut

$usage = qq(

iptc.pl [options] img.jpg [img2.gif ... ]

    -save		save file with changes (default: just report, no save)
    -dir		directory to save modified img (default: same file)
    -country country	Add "country" Location to IPTC header
    -city city		Add "city" Location to IPTC header
    -state state	Add "state" Location to IPTC header
    -newkeys		Reset keywords. (default: keywords are appended)
    -keyfile file	Add keywords found in "file" (default file: "Keywords")
    -stop dir		Stop upward parse of $keyfile's when "dir" reached
    -byline "name"	Add "name" as the by-line
    -credit "string"	Add "string" as the credit

    Reads or writes IPTC data to files, filling in fields in the ITPC
    structure if fields are specified in commandline params.

    By default, image data is read, but not overwritten, even if new values
    are given.

    -save MUST be given to save any modified files.
    -dir can be used to save modified files to a new path (used with -save)

    Keywords are taken from the file "Keywords" if the file exists.
    Keywords are separated by commas, semicolons or newlines.
    Hyphens and Underscores (- and _) are converted to spaces (but, same key)
    One and Two letter words, and any ending digits are pruned.
    Keywords are always converted to lower case.
    Words that have multiple capital letters are split into separate words.

    The directory tree is traversed upwards, adding keywords found in each
    successive "keyfile" found until the root ("/") is reached.

    Entire path, including the image name itself, are added as keywords.

    Example:

	images/UnitedStates/California/SanFrancisco/CableCars/trolly-1.jpg

    Keywords added:

	images, united states, california, san francisco, cable cars, trolly

    Also added to the Keywords list will be data found in any file called
    "Keywords" in any of the directories on the way up the tree (regardless
    of where the command is run). Tree Traversal is terminated when the
    directory $stop is found. This cannot be "." or a pathname--it must be
    a plain name, like "images" or "NewYork" or some other word in the path.

    COMPLETE Directory path elements will be added, regardless of $stop.
    ($stop only applies to looking for $keyfile files.)

    Images that end in "-big.jpg" will NOT get the word "big" added.
    (I name my hi-res files with "-big" extensions, and low-res with "-sm.jpg")
    Add the word "big" to Keywords file if you want it, or make sure it's
    part of the image name without the "-" extension. Ie., "BigMoma-big.jpg"

    Keywords will be sorted alphabetically and duplicates removed.
);

use Image::IPTCInfo;
use File::Basename;
use Cwd;
use Getopt::Long;

my ($f, $t, $curdir, $path, $file, @keywords, @tokens, $country, $city, $state);
my $info;	# iptc data for image
my $bail = 0;
my $save = 0;
my $byline = "";
my $credit = "";
my $dir = "";
my $stop = "/";
my $keyfile = "Keywords";
my $newkeys = 0; # reset (overwrite) or append to keywords in img's iptc data
my @iptc_headers = (
    "object name",               "originating program",
    "edit status",               "program version",
    "editorial update",          "object cycle",
    "urgency",                   "by-line",
    "subject reference",         "by-line title",
    "category",                  "city",
    "fixture identifier",        "sub-location",
    "content location code",     "province/state",
    "content location name",     "country/primary location code",
    "release date",              "country/primary location name",
    "release time",              "original transmission reference",
    "expiration date",           "headline",
    "expiration time",           "credit",
    "special instructions",      "source",
    "action advised",            "copyright notice",
    "reference service",         "contact",
    "reference date",            "caption/abstract",
    "reference number",          "writer/editor",
    "date created",              "image type",
    "time created",              "image orientation",
    "digital creation date",     "language identifier",
    "digital creation time"
);

GetOptions(
    "help"	=>	\$bail,
    "byline=s"	=>	\$byline,
    "credit=s"	=>	\$credit,
    "save"	=>	\$save,
    "stop=s"	=>	\$stop,
    "dir=s"	=>	\$dir,
    "country=s"	=>	\$country,
    "city=s"	=>	\$city,
    "newkeys"	=>	\$newkeys,
    "keyfile=s"	=>	\$keyfile,
    "state=s"	=>	\$state,
    "province=s"	=>	\$state,
    ) or $bail = 2;

if ($bail) {
    if ($bail == 1) { print $usage }
    else { print "$0: Bad Parameter. Use --help for help."; }
    exit 1;
}

sub make_keyword
{
    $t = shift;

    # print qq(converting "$t"\n);
    $t =~ s/([A-Z])/ \l$1/g; # make multiple words and lowercase all caps
    # print qq(\t"$t" (separate words)\n);
    $t =~ s/(-big)?\.(gif|jpg)$//; # lose trailing .'s and their extensions
    # print qq(\t"$t"\n);
    $t =~ s/\d//g; # lose all digits
    # print qq(\t"$t" (lose digits)\n);
    $t =~ s/[-_]/ /g; # convert hyphens and underscores to blanks
    # print qq(\t"$t" (- and _ to blanks)\n);
    $t =~ s/\b[a-z]\b//g; # lose all single letters
    # print qq(\t"$t" (single letter)\n);
    $t =~ s/\b..\b//g; # lose all double letter words
    # print qq(\t"$t" (double letter)\n);
    $t =~ s/(^\s+)//; # lose leading blanks
    # print qq(\t"$t"\n);
    $t =~ s/(\s+)$//; # lose trailing blanks
    # print qq(\t"$t"\n);
    $t =~ s/(\s+)/ /; # compress multiple spaces
    # print qq("$t"\n);
    return $t;
}

while (my $img = shift) {
    $img =~ m,(.*)/(.*),;
    $path = $1; $file = $2;

    if ("$path" eq "") {
	$path = cwd();
	$file = $img;
    }

    # Create new info object
    $info = create Image::IPTCInfo($img);
    if (! $info ) {
	print "$img: ", Image::IPTCInfo->Error, "\n";
	next;
    }

    print "iptc data for $file\n";
    foreach my $hdr (@iptc_headers) {
	if ($a = $info->Attribute($hdr)) { print qq("$hdr" = "$a"\n) }
    }

    # Get list of keywords or supplemental categories...
    if (@keywords = @{$info->Keywords()}) {
	print "keywords = ";
	foreach $f (@keywords) { print qq("$f" ) }
	print "\n";
    }
    print "----end iptc data-----\n";

    # Get specific attributes...
    $country = $info->Attribute('country/primary location name') if $country eq "";
    $state = $info->Attribute('province/state') if $state eq "";
    $city = $info->Attribute('city') if $city eq "";
    $copyright = $info->Attribute('copyright notice');
    $caption = $info->Attribute('caption/abstract');

    print qq(
img = "$img"
country = "$country", state = "$state", city = "$city"
copyright = $copyright
caption = $caption
);

    if ($newkeys) { @keywords = () }

    @tokens = split /\//, "$path/$file";
    foreach $t (@tokens) {
	$t = make_keyword($t);
	push @keywords, $t if $t ne "";
    }
    push @keywords, lc $country if $country ne "";
    push @keywords, lc $state if $state ne "";
    push @keywords, lc $city if $city ne "";

    # Crawl up directory tree, looking for "keywords" files. These are
    # to apply to all pages created at this level and up.
    my $curdir;
    for ($curdir = "$path/$file"; $curdir ne "/"; $curdir = dirname($curdir)) {
	next if !open FILE, "$curdir/$keyfile";
	while (<FILE>) {
	    chomp;
	    foreach $t (split /[,;]/) {
		$t = make_keyword($t);
		push(@keywords, $t) if $t ne "";
	    }
	}
	close FILE;
	last if ($stop ne "" && $curdir =~ /$stop$/);
    }

    # sort and remove duplicates
    @keywords = sort @keywords;
    for ($t = $#keywords; $t > 0; $t--) {
	# print qq(comparing "$keywords[$t]" with "$keywords[$t-1]"\n);
	if ($keywords[$t] eq $keywords[$t-1] || $keywords[$t] eq "") {
	    # print "spliced \"$keywords[$t]\"\n";
	    splice @keywords, $t, 1;
	}
	if ($keywords[$t-1] eq "") { splice @keywords, $t-1, 1 }
    }

    print "There are ", $#keywords + 1, " keywords\n";
    print "new keywords = ";
    $info->ClearKeywords();
    map { $info->AddKeyword( $_ ) if ($_ ne ""); print qq("$_" ) } @keywords;
    print "\n";

    $info->SetAttribute('by-line', $byline);
    $info->SetAttribute('credit', $credit);
    $info->SetAttribute('country/primary location name', $country);
    $info->SetAttribute('province/state', $state);
    $info->SetAttribute('city', $city);

    print "-----------------\n";
    $file = $img if (!defined($file) || $file eq "");
    if ($save) {
	if ($dir ne "") {
	    $info->SaveAs("$dir/$file") ;
	    print "saved to $dir/$file...\n";
	} else {
	    $info->Save();
	    print "saved $img...\n";
	}
    } else {
	print "New values NOT saved in image.\n";
    }
}