#!/usr/bin/perl -w

##
## Copyright 2008 Jeffrey Friedl
## http://regex.info/blog/
##

use strict;
our $VERSION = "20080520.1";

##
## Given a file, return a hash with info read about the crop.
##
sub ReadCrop
{
    local($/) = undef;
    my $file = shift;
    if (not open IN, $file) {
        die "$0: couldn't read '$file': $!\n";
    }
    my $data = <IN>;
    close IN;

    my $info = {};
    ($info->{CropTop})    = $data =~ m/crs:CropTop="([.\d]+)"/;
    ($info->{CropLeft})   = $data =~ m/crs:CropLeft="([.\d]+)"/;
    ($info->{CropBottom}) = $data =~ m/crs:CropBottom="([.\d]+)"/;
    ($info->{CropRight})  = $data =~ m/crs:CropRight="([.\d]+)"/;
    ($info->{CropAngle})  = $data =~ m/crs:CropAngle="(-?[.\d]+)"/;

    $info->{CropTop}      ||= 0;
    $info->{CropLeft}     ||= 0;
    $info->{CropBottom}   ||= 1;
    $info->{CropRight}    ||= 1;
    $info->{CropAngle}    ||= 0;

    if ($info->{CropAngle} != 0) {
        die "$0: can't handle rotated crop ($file)\n";
    }

    ($info->{ImageWidth})  = $data =~ m/tiff:ImageWidth="(-?[.\d]+)"/;
    ($info->{ImageHeight}) = $data =~ m/tiff:ImageLength="(-?[.\d]+)"/;

    if ($info->{ImageHeight} == 0 or $info->{ImageHeight} == 0) {
        die "$file: bad width/height\n";
    }

    $info->{CropWidth}  = int(0.5 + $info->{ImageWidth}  * ($info->{CropRight}  - $info->{CropLeft}));
    $info->{CropHeight} = int(0.5 + $info->{ImageHeight} * ($info->{CropBottom} - $info->{CropTop}));

    $info->{AspectRatio} = $info->{CropWidth} / $info->{CropHeight};

    # print "READ: ", join(', ', $file, $info->{CropLeft}, $info->{CropRight}, $info->{CropTop}, $info->{CropBottom}, $info->{CropAngle}), "\n";
    return $info;
}

##
## Given a Crop location coordinate (top/bottom/right/left), ensure that
## the number is within the range of 0..1, and that it's not excessively
## long.
##
sub Fixup
{
    my $num = shift;
    if ($num < 0) {
        return 0;
    } elsif ($num > 1) {
        return 1;
    } elsif (length($num) > 8) {
        return substr($num, 0, 8);
    } else {
        return $num;
    }
}

##
## Given a hash with crop info, and a file, update the file's XMP data in place.
## The file must have already had its XMP written via Lightroom.
##
## This is extraordinarily ugly and fragile.
##
sub WriteCrop
{
    my $info = shift;
    my $file = shift;

    local($/) = undef;
    if (not open IN, $file) {
        die "$0: couldn't read '$file': $!\n";
    }
    my $data = <IN>;
    close IN;

    my $length = length($data);

    my $Left   = sprintf 'crs:CropLeft="%s"',   Fixup($info->{CropLeft});
    my $Right  = sprintf 'crs:CropRight="%s"',  Fixup($info->{CropRight});
    my $Top    = sprintf 'crs:CropTop="%s"',    Fixup($info->{CropTop});
    my $Bottom = sprintf 'crs:CropBottom="%s"', Fixup($info->{CropBottom});
    my $Angle  = sprintf 'crs:CropAngle="%s"',  $info->{CropAngle};
    my $HAS = 'crs:HasCrop="True"';
    my $APPLIED = 'crs:AlreadyApplied="False"';

    my @ADD;
    $data =~ s/crs:CropTop="[.\d]+"/$Top/            or push(@ADD, $Top);
    $data =~ s/crs:CropLeft="[.\d]+"/$Left/          or push(@ADD, $Left);
    $data =~ s/crs:CropBottom="[.\d]+"/$Bottom/      or push(@ADD, $Bottom);
    $data =~ s/crs:CropRight="[.\d]+"/$Right/        or push(@ADD, $Right);
    $data =~ s/crs:CropAngle="-?[.\d]+"/$Angle/      or push(@ADD, $Angle);
    $data =~ s/crs:HasCrop="[^\"]+"/$HAS/            or push(@ADD, $HAS);
    $data =~ s/crs:AlreadyApplied="[^\"]+"/$APPLIED/ or push(@ADD, $APPLIED);

    ##
    ## Add in there those that we weren't able to update.
    ##
    if (@ADD)
    {
        if (not $data =~ s/<rdf:Description/<rdf:Description @ADD/)
        {
            die "$0: '$file' doesn't seem to have Adobe-style XMP develop data\nTo fix, apply any random crop to it and Save XMP Metadata, then rerun this program.\n";
        }
    }


    ##
    ## We've updated the XMP section, but we must make sure that we don't change its overall
    ## length, so add/subtract whitespace in there until we get back to the original length.
    ## This is really, really ugly and fragile.
    ##
    while (length($data) > $length) {
        $data =~ s/  crs:/ crs:/ or $data =~ s{</x:xmpmeta> }{</x:xmpmeta>} or die "oops";
    }
    while (length($data) < $length) {
        $data =~ s/ crs:/  crs:/ or die "oops";
    }

    ##
    ## Write the results to a temporary file...
    ##
    my $tmp = "$file.tmp";
    if (not open OUT, ">$tmp") {
        die "$0: couldn't open temporary file '$tmp': $!\n";
    }
    if (not print OUT $data) {
        die "$0: couldn't write to temporary file '$tmp': $!\n";
    }
    if (not close OUT) {
        die "$0: couldn't close temporary file '$tmp': $!\n";
    }

    ##
    ## and rename..
    ##
    if (not rename($tmp, $file)) {
        die "$0: couldn't rename('$tmp', '$file'): $!\n";
    }

    #print join(', ', $file, $Left, $Right, $Top, $Bottom, $Angle), "\n";
    print "wrote $file\n";

}

sub Same($$)
{
    my ($a, $b) = @_;

    ## compare two aspect ratios to see if they're "close enough"
    my $diff = $a - $b;
    if ($diff < -0.1 or $diff > 0.1) {
        return 0;
    } else {
        return 1;
    }
}


##
## Check/process command-line arguments
##
if (@ARGV < 3) {
    die "$0: expected three or more images on the command line.\n";
}

my $Steps = @ARGV - 1;

my $from_file = shift @ARGV;
my $to_file   = pop   @ARGV;

my $from = ReadCrop($from_file);
my $to   = ReadCrop($to_file);

if (not Same($from->{AspectRatio}, $to->{AspectRatio}))
{
    die sprintf("$0: $from_file and $to_file have different aspect ratios (%.3f vs %.3f)\n", $from->{AspectRatio}, $to->{AspectRatio});
}

## calculate per-frame increments
my $IncLeft   = ( $to->{CropLeft}   -  $from->{CropLeft}   )  /  $Steps;
my $IncTop    = ( $to->{CropTop}    -  $from->{CropTop}    )  /  $Steps;
my $IncRight  = ( $to->{CropRight}  -  $from->{CropRight}  )  /  $Steps;
my $IncBottom = ( $to->{CropBottom} -  $from->{CropBottom} )  /  $Steps;

## apply to the intervening files
for my $file (@ARGV)
{
    $from->{CropLeft}   += $IncLeft;
    $from->{CropRight}  += $IncRight;
    $from->{CropTop}    += $IncTop;
    $from->{CropBottom} += $IncBottom;

    WriteCrop($from, $file);
}