The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Test::More tests => 54;
BEGIN { require 't/test_setup.pl'; }

my $tphoto = 't/test_photo.jpg';
my $tdata  = 't/test_photo.desc';
my $shop   = 'PHOTOSHOP';
my ($image, $seg1, $seg2, $hash, $hash2, $hashtot, $ref, $segs, $recver, $num);

my $ht = { ObjectName           => [ "prova" ],
	   ByLine               => [ "ciao" ],
	   Keywords             => [ "donald", "duck" ],
	   ActionAdvised        => [ "02" ],
	   SupplementalCategory => ["arte", "scienza", "sport"] };
my $hn = { 55 => [ "19890207" ], 65 => [ 2 ],
	   80 => [ "d3", "d4" ], 15 => [ "b" ] };
my $ver = "\000\002";
my $nkey = 'singola';
my $iptc_tag = 0x0404;

my $phn = { 0x041c => ['xxx'],
	    0x041d => 'yyy',
	    0x041e => ['zzz', undef],
	    0x0421 => 'aaa',
	    0x0bb7 => ['bbb', 'Clipping path name'] };
my $pht = { 'GridGuidesInfo'    => 'ddd',
	    'ThumbnailResource' => ['eee'],
	    'ICCUntagged'       => ['fff', undef ],
	    'URL' => ['ggg', 'This is the universal resource locator'] };

#=======================================
diag "Testing APP13 IPTC set routines";
#=======================================

BEGIN { use_ok ($::pkgname) or exit; }

#########################
$image = newimage($tphoto);
eval { $image->set_app13_data(undef, undef, undef) };
is( $@, '', "No error with undefined arguments in set" );

#########################
eval { $image->set_app13_data({}, 'ADD', 'IpTccc') };
isnt( $@, '', "... but \$what cannot be wrong" );

#########################
$seg1 = $image->retrieve_app13_segment(0, 'IPTC');
$seg1->set_app13_data({'ObjectName' => 'newname'}, 'ADD', 'IPTC');
$seg1->set_app13_data({'ObjectName' => 'newname2'}, 'ADD', 'IPTC');
$hash = $seg1->get_app13_data('TEXTUAL', 'IPTC');
$ref = $$hash{'ObjectName'};
is( scalar @$ref, 1, "Non-repeatable IPTC constraint is enforced" );

#########################
is( $$ref[0], 'newname2', "Correct precedence for nonrepeatables" );

#########################
$hashtot = $seg1->get_app13_data('TEXTUAL', 'IPTC');
push @{$$hashtot{$_}}, @{$$ht{$_}} for keys %$ht;
$$hashtot{'ObjectName'} = $$ht{'ObjectName'}; # fix non-repeatable
$seg1->set_app13_data($ht, 'ADD', 'IPTC');
$hash = $seg1->get_app13_data('TEXTUAL', 'IPTC');
is_deeply( $hash, $hashtot, "Adding records textually" );

#########################
$seg1->set_app13_data({'Keywords' => $nkey}, 'UPDATE', 'IPTC');
$hash = $seg1->get_app13_data('TEXTUAL', 'IPTC');
is_deeply( $$hash{'Keywords'}, [ $nkey ], "UPDATE addresses user tags ..." );

#########################
is_deeply( $$hash{'SupplementalCategory'}, $$hashtot{'SupplementalCategory'},
	   "... without touching the others" );

#########################
$seg1->set_app13_data($ht, 'REPLACE', 'IPTC');
$hash = $seg1->get_app13_data('TEXTUAL', 'IPTC');
$recver = delete $$hash{'RecordVersion'};
is_deeply( $hash, $ht, "Replacing instead of adding" );

#########################
is( $$recver[0], $ver, "Record version is OK" );

#########################
$hash = $seg1->get_app13_data('NUMERIC', 'IPTC');
$seg1->set_app13_data($hn, 'ADD', 'IPTC');
$hashtot = $hash;
push @{$$hashtot{$_}}, @{$$hn{$_}} for keys %$hn;
$hash = $seg1->get_app13_data('NUMERIC', 'IPTC');
is_deeply( $hash, $hashtot, "Adding records numerically" );

#########################
$seg1->set_app13_data($hn, 'REPLACE', 'IPTC');
$hash = $seg1->get_app13_data('NUMERIC', 'IPTC');
$recver = delete $$hash{0};
is_deeply( $hash, $hn, "Replacing records numerically" );

#########################
is( $$recver[0], $ver, "Record version added automatically" );

#########################
$hash = $image->get_app13_data('NUMERIC', 'IPTC');
$recver = delete $$hash{0};
is_deeply( $hash, $hn, "High level get IPTC data (numeric)" );

#########################
$hashtot = $seg1->get_app13_data('TEXTUAL', 'IPTC');
push @{$$hashtot{$_}}, @{$$ht{$_}} for keys %$ht;
$image->set_app13_data($ht, 'ADD', 'IPTC');
$hash = $image->get_app13_data('TEXTUAL', 'IPTC');
is_deeply( $hash, $hashtot, "High level set/get (textual)" );

#########################
$image->remove_app13_info(-1, 'IPTC');
$image->set_app13_data($ht, 'ADD', 'IPTC');
$hash = $image->get_app13_data('TEXTUAL', 'IPTC');
$recver = delete $$hash{'RecordVersion'};
is_deeply( $hash, {%$ht}, "Forcing an IPTC segment (high level)" );

#########################
$image->remove_app13_info(-1, 'IPTC');
$image->set_app13_data($hn, 'REPLACE', 'IPTC');
$hash = $image->get_app13_data('NUMERIC', 'IPTC');
$recver = delete $$hash{0};
is_deeply( $hash, {%$hn}, "Same, but with replace and numerically" );

#########################
$recver = [ "\123\156" ];
$image->set_app13_data({'RecordVersion' => $recver}, 'ADD', 'IPTC');
$hash = $image->get_app13_data('TEXTUAL', 'IPTC');
is_deeply( $$hash{'RecordVersion'}, $recver, "Record version can be changed" );

#########################
$seg1->set_app13_data($ht, 'REPLACE', 'IPTC');
$hashtot = $seg1->get_app13_data('NUMERIC', 'IPTC');
$seg1->set_app13_data($hn, 'ADD', 'IPTC');
push @{$$hashtot{$_}}, @{$$hn{$_}} for keys %$hn;
$ref = \ (my $buffer = "");
$image->save($ref);
$image = newimage($ref, 'APP13', 'FASTREADONLY');
isnt( $image, undef, "File written and re-read");

#########################
$hash = $image->get_app13_data('NUMERIC', 'IPTC');
isnt( $hash, undef, "There is an APP13 segment" );

#########################
is_deeply( $hash, $hashtot, "Re-read data is ok" );

#########################
$hashtot = undef;
$$hashtot{$_} = [ @{$$ht{$_}} ] for keys %$ht;
$$hashtot{$_} = [ @{$$hn{$_}} ] for keys %$hn;
$image->set_app13_data($hashtot, 'REPLACE', 'IPTC');
$hash = $image->get_app13_data('NUMERIC', 'IPTC');
$image->set_app13_data($ht, 'REPLACE', 'IPTC');
$hashtot = $image->get_app13_data('NUMERIC', 'IPTC');
for (keys %$hn) { if (! exists $$hashtot{$_}) { $$hashtot{$_} = $$hn{$_} }
		  # remember that numeric keys are merged first!
		  else { unshift @{$$hashtot{$_}}, @{$$hn{$_}} }; }
is_deeply( $hash, $hashtot, "Set with mixed type tags" );

#########################
$seg1 = $image->retrieve_app13_segment(0, 'IPTC');
$seg1->{name} = 'trick';
$image->provide_app13_segment('IPTC');
$seg1->{name} = 'APP13';
is( $image->retrieve_app13_segment(-1, 'IPTC'), 2, "Two APP13 segments now" );

#########################
$seg1 = $image->retrieve_app13_segment(0, 'IPTC');
$seg2 = $image->retrieve_app13_segment(1, 'IPTC');
$seg1->set_app13_data($ht, 'REPLACE', 'IPTC');
$seg2->set_app13_data($hn, 'REPLACE', 'IPTC');
$hash  = $image->get_app13_data(undef, 'IPTC'); # use undef $type
$hash2 = $seg1->get_app13_data(undef, 'IPTC');
is_deeply( $hash, $hash2, "Run get_IPTC_data with two segments (get 1st)" );

#########################
$image->remove_app13_info(0, 'IPTC');
is( $image->retrieve_app13_segment(-1,'IPTC'), 1, "First segment eliminated" );

#########################
$hash  = $image->get_app13_data(undef, 'IPTC');
$hash2 = $seg2->get_app13_data(undef, 'IPTC');
is_deeply( $hash, $hash2, "get_IPTC_data now retrieves the second segment" );

#########################
$$ht{'An invalid tag'} = [ 'ciao', 34 ];
$$ht{'Zibaldone'} = [ 'ariciao' ];
$hash = $image->set_app13_data($ht, 'ADD', 'IPTC');
is( scalar keys %$hash, 2, "Two invalid textual entries rejected" );

#########################
$$hn{99} = [ 'pippero' ];
$$hn{-1} = [ 'paperopoli' ];
$hash = $image->set_app13_data($hn, 'ADD', 'IPTC');
is( scalar keys %$hash, 2, "Two invalid numeric entries rejected" );

#########################
$hash = $image->set_app13_data({'RecordVersion'=>["ab","cd"]},'UPDATE','IPTC');
is( scalar keys %$hash, 1, "Updating illegally fails" );

#########################
$hash  = $image->get_app13_data('TEXTUAL', 'IPTC');
$hash2 = $image->set_app13_data({'RecordVersion' => 'ab'}, 'UPDATE', 'IPTC');
is( scalar keys %$hash2, 0, "Updating record version work ..." );

#########################
$hash2 = $image->get_app13_data('TEXTUAL', 'IPTC');
$$hash{'RecordVersion'} = [ 'ab' ];
is_deeply( $hash, $hash2, "... without touching the other tags" );

#########################
$hash = $image->set_app13_data({'City' => undef}, 'ADD', 'IPTC');
is( scalar keys %$hash, 1, "A value array with one undef is invalid" );

#########################
$hash = $image->set_app13_data({'City' => [undef, undef, undef]},'ADD','IPTC');
is( scalar keys %$hash, 1, "... also with multiple undefs" );

#########################
$hash = $image->set_app13_data({'City' => []},'ADD', 'IPTC');
is( scalar keys %$hash, 1, "... also with no elements" );

#########################
$image = newimage($tphoto); # reset
ok( $image, "From now on we are testing [$shop]" );

#########################
$hash = $image->set_app13_data({$iptc_tag => "xx"}, 'ADD', $shop);
is( scalar keys %$hash, 1, "You cannot add the IPTC/NAA tag" );

#########################
$hash  = $image->get_app13_data('NUMERIC', $shop);
$hash2 = $image->set_app13_data($phn, 'UPDATE', $shop);
is( scalar keys %$hash2, 0, "All numeric tags updated" );

for (keys %$hash2) { printf "K: '0x%04x'\n", $_; }

#########################
$$hash{$_} = ref $$phn{$_} ? $$phn{$_} : [$$phn{$_}] for keys %$phn;
$$hash{$_}[1] = exists $$hash{$_}[1] ? $$hash{$_}[1] : undef for keys %$hash;
$hash2 = $image->get_app13_data('NUMERIC', $shop);
is_deeply( $hash, $hash2, "... resource block correctly updated" );

#########################
$hash  = $image->get_app13_data('TEXTUAL', $shop);
$hash2 = $image->set_app13_data($pht, 'UPDATE', $shop);
is( scalar keys %$hash2, 0, "All textual tags updated" );

#########################
$$hash{$_} = ref $$pht{$_} ? $$pht{$_} : [$$pht{$_}] for keys %$pht;
$$hash{$_}[1] = exists $$hash{$_}[1] ? $$hash{$_}[1] : undef for keys %$hash;
$hash2 = $image->get_app13_data('TEXTUAL', $shop);
is_deeply( $hash, $hash2, "... resource block correctly updated" );

#########################
$image->set_app13_data($pht, 'ADD', $shop);
$hash2 = $image->get_app13_data('TEXTUAL', $shop);
is_deeply( $hash, $hash2, "ADD behaves like UPDATE" );

#########################
$num = scalar grep { $_ != 2 } map { scalar @{$_} } values %$hash2;
is( $num, 0, "All value arrays have exactly 2 values" );

#########################
$hash2 = $image->set_app13_data($phn, 'REPLACE', $shop);
is( scalar keys %$hash2, 0, "All numeric tags replaced" );

#########################
$hash2 = $image->get_app13_data('NUMERIC', $shop);
%$hash = ();
$$hash{$_} = ref $$phn{$_} ? $$phn{$_} : [$$phn{$_}] for keys %$phn;
$$hash{$_}[1] = exists $$hash{$_}[1] ? $$hash{$_}[1] : undef for keys %$hash;
is_deeply( $hash2, $hash, "REPLACE works as expected (NUMERIC)" );

#########################
$hash2 = $image->set_app13_data($pht, 'REPLACE', $shop);
is( scalar keys %$hash2, 0, "All textual tags replaced" );

#########################
$hash2 = $image->get_app13_data('TEXTUAL', $shop);
%$hash = ();
$$hash{$_} = ref $$pht{$_} ? $$pht{$_} : [$$pht{$_}] for keys %$pht;
$$hash{$_}[1] = exists $$hash{$_}[1] ? $$hash{$_}[1] : undef for keys %$hash;
is_deeply( $hash2, $hash, "... also with TEXTUAL tags" );

#########################
$num = scalar grep { $_ != 2 } map { scalar @{$_} } values %$hash2;
is( $num, 0, "All value arrays have exactly 2 values" );

#########################
$hash = $image->set_app13_data({'Invalid' => ['xxx', 'desc' ],
			        'PhotoshopSecret' => 'wow' }, 'ADD', $shop);
is( scalar keys %$hash, 2, "Invalid textual tags are rejected" );

#########################
$hash = $image->set_app13_data({0x0001 => ['xxx', 'desc' ],
			        0x1111 => 'wow' }, 'ADD', $shop);
is( scalar keys %$hash, 2, "Invalid numeric tags are rejected" );

#########################
$hash = $image->set_app13_data({0x0888 => "\012\333\231\000f"}, 'ADD', $shop);
is( scalar keys %$hash, 0, "Valid tags with strange data accepted" );

#########################
$hash = $image->set_app13_data({'URL' => ['x', 'd', 'third' ]}, 'ADD', $shop);
is( scalar keys %$hash, 1, "Value arrays cannot have > 2 element" );

#########################
$hash = $image->set_app13_data({'URL' => []}, 'ADD', $shop);
is( scalar keys %$hash, 1, ".... nor less than one" );

#########################
$hash = $image->set_app13_data({'URL' => undef}, 'ADD', $shop);
is( scalar keys %$hash, 1, ".... nor an undefined one" );

#########################
$seg1 = $image->provide_app13_segment('PHOTOSHOP');
$hash2 = {GlobalAngle    => pack('N', 0x1e),
	  GlobalAltitude => pack('N', 0x1e),
	  CopyrightFlag  => "\001",
	  IDsBaseValue   => [ pack('N', 1), 'Layer ID Generator Base' ] };
$hash = $seg1->set_app13_data($hash2, 'ADD', 'PHOTOSHOP');
is( scalar keys %$hash, 0, "This is the exemple in the .pod" );

### Local Variables: ***
### mode:perl ***
### End: ***