#!/opt/perl/bin/perl

# BTH - 2010-11-26 - v0.8

# A script to make a snapshot of XMP Camera Raw Settings

use strict;
use warnings;

use XML::Twig;

use POSIX qw( strftime );

my $fmt_ISO8601 = "%Y-%m-%dT%H:%M:%S";
my $suffix = "." . strftime($fmt_ISO8601, localtime $^T); # default: timestamp
# my $suffix = undef;  # replace by this in case you prefer NO backup by default

my $snapshot_name = "New Snapshot";

#-----------------------------------------------------------------------------

use Getopt::Long qw( HelpMessage );
use Pod::Usage;

my $verbose= 0;
# my $simulate= 1;

GetOptions( 'help|?'       => sub{HelpMessage()}, # Should always be there
	    'verbose:+'    => \$verbose,
	    # 'simulate!'    => \$simulate,  # TODO - probably useful

	    'suffix:s'     => \$suffix,
	    'name:s'       => \$snapshot_name,
	    );

@ARGV = map { s/ /\\ /g; glob } @ARGV;   # Win32 compat

@ARGV || HelpMessage();

#-----------------------------------------------------------------------------

sub snapshot_file;

foreach my $f ( @ARGV ) {
    my $res = snapshot_file ( $f, $snapshot_name, $suffix );
    if ( $verbose ) {
	if ( not defined $res ) {
	    print STDERR "Error snapshoting \"$f\" - skip it\n";
	}
	else {
	    print STDERR "OK $f\n";
	}
    }
}

#=============================================================================
# Where the real job is done

sub snapshot_twig {
    my $twig = shift @_;
    my $snapshot_name = shift @_;

    my @return_msg = ();

    my $r = $twig->root;

    if ( $r->name ne "x:xmpmeta" ) { 
	push @return_msg, "ERR> Not of the right type\n";
	return wantarray ? (undef, @return_msg) : undef;
    }

    # print scalar $twig->children('rdf:Description') , "\n"; # DBG

    my $rdf = $r->first_child; 

    my $crs = undef;
    my $crss = undef;

    foreach my $c ( $rdf->children ) {
	if ( $c->att('xmlns:crs') ) {
	    if ( $c->att('xmlns:crss') ) {
		push @return_msg, "INFO> found Saved Settings\n";
		$crss = $c;
	    }
	    else {
		push @return_msg, "DBG> got the Camera Raw Settings\n";
		$crs = $c;
	    }
	}
    }

    my $ssenv = undef;
    my $bag = undef;

    if ( not defined $crss ) {

	# Create the new Saved Settings environment

	my $crs_def_url  = "http://ns.adobe.com/camera-raw-settings/1.0/";
	my $crss_def_url = "http://ns.adobe.com/camera-raw-saved-settings/1.0/";

	$crss= XML::Twig::Elt->new( 'rdf:Description' 
				    => { 
					'rdf:about' => '',
					'xmlns:crs' => $crs_def_url,
					'xmlns:crss' => $crss_def_url,
				    }
	    );

	$ssenv = XML::Twig::Elt->new('crss:SavedSettings');
	$bag = XML::Twig::Elt->new('rdf:Bag');

	# I used to: $new_ent->paste ( last_child => $rdf );
	# but apparently, as soon as re-applied, the CRS goes AFTER the crss
	$crss->paste ( before => $crs );
	$ssenv->paste( last_child => $crss );
	$bag->paste ( last_child => $ssenv );
    }
    else {
	# TODO - bullet-proof-icize this, please !
	$ssenv = $crss->first_child;
	$bag = $ssenv->first_child;

	# Don't create two snapshots with the same name

	foreach my $li ( $bag->children ) {
	    unless ( $li->att('rdf:parseType') eq "Resource" ) {
		push @return_msg, "ERR> unexpected rdf:parseType - stopping\n";
		return wantarray ? ( undef, @return_msg ) : undef;
	    }
	    my $n = $li->first_child_text( "crss:Name" );
	    # print STDERR "> Name = $n\n";
	    if ( $snapshot_name eq $n ) {
		my $fmt_ISO8601 = "%Y-%m-%dT%H:%M:%S";
		$snapshot_name .= " - " . strftime($fmt_ISO8601, localtime $^T);
		push @return_msg,  "INFO> Snapshot \"$n\" already exists"
		    . " - use \"$snapshot_name\" instead\n";
	    }
	}
    }
    
    # Create the new snapshot entry and sub-elements

    my $li = XML::Twig::Elt->new('rdf:li' => { 'rdf:parseType' => "Resource" } );

    $li->paste ( last_child => $bag );

    my $name = XML::Twig::Elt->new('crss:Name');
    $name->set_text($snapshot_name);

    my $type = XML::Twig::Elt->new('crss:Type');
    $type->set_text('Snapshot');

    my $param = XML::Twig::Elt->new('crss:Parameters' 
				    => {'rdf:parseType' => "Resource"});

    $name->paste ( last_child => $li );
    $type->paste ( last_child => $li );
    $param->paste ( last_child => $li );

    # Fill the Parameters with a copy of CRS section

    my @filtered_params = ( 'RawFileName',     # Present in CRS, not in CRSS
			    # For the following ones, not quite sure why,
			    # but this is what I saw.
			    'HasCrop',         
			    'HasSettings', 
			    'AlreadyApplied',
	);
    my %filtered_params = map { "crs:".$_ => 1 } @filtered_params;

    foreach my $s ( $crs->children ) {
	next if ( $filtered_params{$s->tag} );
	my $new_s = $s->copy;
	$new_s->paste ( last_child => $param );
    }

    return wantarray ? ( 1, @return_msg ) : 1;
}

#-----------------------------------------------------------------------------
# Simple wrapper to handle (less interesting ?) file operations

sub snapshot_file {
    my $file = shift @_;
    my $snapshot_name = shift @_;
    my $suffix = shift @_;

    my $twig = XML::Twig->new( 
	pretty_print => 'indented',
	);

    eval { $twig->parsefile ( $file ); }; 
    if ( $@ ) {
	warn "Error at parsing: $@";
	return undef;
    }

    my ( $res, @msg ) = snapshot_twig ( $twig, $snapshot_name );
    if ( not $res ) {
	print STDERR "Error(s) processing $file: \n", @msg;
	return undef;
    }
    ( $verbose ) && print STDERR "Msg when snapshoting $file: \n", @msg;

    # Backup the file, if needed

    if ( $suffix ) {
	my $backup = $file . $suffix; 

        unless ( rename ( $file, $backup ) ) {
	    warn "SKIP - cannot backup $file to $backup: $!";
	    return undef;
	}
    }

    # Finish the job: rewrite the file

    my $fh = undef;
    unless ( open $fh, ">:utf8", $file ) {
	warn "cannot write-open $file: $!";
	return undef;
    }

    $twig->flush ( $fh );
}

##############################################################################
__END__
##############################################################################

##############################################################################
# Man

=head1 NAME    

xmpcrssnapshot - snapshots .xmp Adobe Bridge / Camera Raw CS5 sidecar files

=head1 SYNOPSIS

xmpcrssnapshot [options] file1 [file2...]

  Options:
    --help            brief help message
    --verbose[=n]     set verbosity level to n
    --suffix SUFFIX   backup file1 as file1SUFFIX before modification
                      (default: timestamp with script start time)
    --name SNAPSHOT   uses SNAPSHOT as name for the snapshot
                      (default: "New Snapshot")

=head1 OPTIONS

=over 8

=item B<--help>

Print a brief help message and exits.

=item B<--verbose>

Deliver more information about what we are doing.

=item B<--suffix>

Append SUFFIX to the name of each processed file. By default, backup files
are timestamped with script execution time / date.

If you don't want to backup, use C< --suffix '' >.

=item B<--name>

Uses SNAPSHOT as name for the snapshot (default: "New Snapshot").  As the
name should be unique, the script checks for the existence of a snapshot of
the same name, and append the time and date of script start to SNAPSHOT
(ISO8601 format, separated by a dash) if positive.

=back

=head1 DESCRIPTION

Adobe Bridge CS5 and Adobe Camera Raw use .xmp "sidecar" files in order to
store all information about the files they manipulate, in a "non-disruptive"
philosophy: original files are considered as "negatives", and all
parameters you modify are applied on the fly when you "develop" your
photos.

Adobe Camera Raw, in particular, allows the recording of "snapshots" of the
current parameters, for later re-apply. This feature can be used to store
several versions of the same picture (e.g. one color, one black-and-white,
and one cropped on a specific detail).

However, although you can select several pictures and modify the same
parameter (including the "auto" settings of exposure), it does not allow
multi-selection snapshots.

This script is here to "correct" this and bring the functionnality.

=head1 README

=for comment (Section targeting CPAN script section).

This script creates a snapshot "a la" Adobe Camera Raw in multiple .xmp
sidecar files.

=head1 DISCUSSION

=head2 Underlying technology

This script uses L<XML::Twig> (excellent !) module, to parse, manipulate,
create and paste chunks of XML code, without needing a thorough
understanding of the whole content of them.

Appart from that, nothing special.

This means that it I<should> run on any platform without any issue -
however I do not guarantee anything... ;)

=head3  Why not C<Image::ExifTool> ?

Excellent module as well, L<Image::ExifTool> would have been overkill for
what I wanted to do - and I considered that understanding how to make it do
what I wanted would have taken too long.

=head2 Adobe CS files

=head3 Versions

This script has been written using :

=over

=item Adobe Bridge CS5 v4.0.3.9

=item Adobe Camera Raw v6.2

=back

=head3 Adobe CS5 side-car XMP file structure (simplified)

From L<http://en.wikipedia.org/wiki/Extensible_Metadata_Platform>, "XMP is
most commonly serialized and stored using a subset of the W3C Resource
Description Framework (RDF), which is in turn expressed in XML."

As far as my observations went, here is what an Adobe CS5 (Bridge or Camera
Raw generated) XMP file looks like:

C<<
 <x:xmpmeta>
   <rdf:RDF>
     <rdf:Description>[TIFF section]</rdf:Descripion>
     <rdf:Description>[EXIF section]</rdf:Descripion>
     <rdf:Description>[ XMP section]</rdf:Descripion>
     <rdf:Description>[ DC  section]</rdf:Descripion>
     <rdf:Description>[ AUX section]</rdf:Descripion>
     <rdf:Description>[ PS  section]</rdf:Descripion>
     <rdf:Description>[rights section]</rdf:Descripion>
     <rdf:Description>[ LR section]</rdf:Descripion>
     <rdf:Description>[CRS  section]</rdf:Descripion>
     <rdf:Description>[CRSS section]</rdf:Descripion>
   </rdf:RDF>
 </x:xmpmeta>
>>

C<CRS> stands for Camera Raw Settings. This section contains the current
parameters to be applied to the corresponding picture when presented on the
screen.

C<CRSS> stands for Camera Raw Saved Settings. The section is used to store the snapshots, under an rdf:Bag (equivalent to array), each rdf:li (item) looking like:

C<<
 <crss:Name>My New Snapshot Name</crss:Name>
 <crss:Type>Snapshot</crss:Type>
 <crss:Parameters rdf:parseType="Resource">
   [copy of CRS section at the moment of the snapshot]
 </crss:Parameters>
>>

There seems, however, to be some parameters filtered out when snapshoting.

=head3 Would this script work with other versions of Adobe CS ?

Honnestly I don't know - I have to confess that even for CS5, I just wrote
something that mimics the behaviour of Bridge / Camera Raw.

However, unless Adobe dramatically changed the envelop formats, as the
script only copy / paste chunks of (XML) codes, it should be ok.

I would be more than happy to hear about it.

=head1 SEE ALSO

L<http://en.wikipedia.org/wiki/Extensible_Metadata_Platform>

L<http://en.wikipedia.org/wiki/Resource_Description_Framework>

=head1 TODO

=over 4

=item B<HasCrop>

This parameter is used in the CRS section, but apparently not stored by ACR
in the CRSS section when snapshoting.

This has to be tested.

=item B<other filtered parameters>

C<HasSettings>

C<AlreadyApplied>

=item B<Extensions>: more XMP files handling tools

Merger - the idea is: usually, when we need another version of pictures, we
duplicate a whole directory, and then work on the images. It could be
interesting to have a tool to merge two (or more) side-car files into a
single one.

On the same idea, having a tool to massively rename / delete snapshots
could be interesting.

=back

=head1 PREREQUISITES

This script requires the C<strict> and C<warnings> modules. 
It also requires C<XML::Twig> and C<POSIX>.

=pod OSNAMES

any

=pod SCRIPT CATEGORIES

root

=head1 AUTHOR

Benjamin THOMAS (bthomas(at)cpan.org)

=head1 LICENSE

This is open-source code, please respect Perl license.

Usual disclaimer: this code is provided as is, without any guarantee to
work correctly, and I don't take responsibility to any damage to your
files. ;)

Please remember to make regular backups of your files and pictures !

=cut