123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157 |
- # Before "make install", this script should be runnable with "make test".
- # After "make install" it should work as "perl t/IPTC.t".
- BEGIN { $| = 1; print "1..8\n"; $Image::ExifTool::noConfig = 1; }
- END {print "not ok 1\n" unless $loaded;}
- # test 1: Load the module(s)
- use Image::ExifTool 'ImageInfo';
- use Image::ExifTool::IPTC;
- $loaded = 1;
- print "ok 1\n";
- use t::TestLib;
- my $testname = 'IPTC';
- my $testnum = 1;
- # test 2: Extract information from IPTC.jpg
- {
- ++$testnum;
- my $exifTool = new Image::ExifTool;
- my $info = $exifTool->ImageInfo('t/images/IPTC.jpg', {Duplicates => 1});
- print 'not ' unless check($exifTool, $info, $testname, $testnum);
- print "ok $testnum\n";
- }
- # test 3: Test GetValue() in list context
- {
- ++$testnum;
- my $exifTool = new Image::ExifTool;
- $exifTool->ExtractInfo('t/images/IPTC.jpg', {JoinLists => 0});
- my @values = $exifTool->GetValue('Keywords','ValueConv');
- my $values = join '-', @values;
- my $expected = 'ExifTool-Test-IPTC';
- unless ($values eq $expected) {
- warn "\n Test $testnum differs with \"$values\"\n";
- print 'not ';
- }
- print "ok $testnum\n";
- }
- # test 4: Test rewriting everything with slightly different values
- {
- ++$testnum;
- my $exifTool = new Image::ExifTool;
- $exifTool->Options(Duplicates => 1, Binary => 1, List => 1);
- my $info = $exifTool->ImageInfo('t/images/IPTC.jpg');
- my $tag;
- foreach $tag (keys %$info) {
- my $group = $exifTool->GetGroup($tag);
- my $val = $$info{$tag};
- if (ref $val eq 'ARRAY') {
- push @$val, 'v2';
- } elsif (ref $val eq 'SCALAR') {
- $val = 'v2';
- } elsif ($val =~ /^\d+(\.\d*)?$/) {
- # (add extra .001 to avoid problem with aperture of 4.85
- # getting rounded to 4.8 or 4.9 and causing failed tests)
- $val += ($val / 10) + 1.001;
- $1 or $val = int($val);
- } else {
- $val .= '-v2';
- }
- # eat return values so warning don't get printed
- my @x = $exifTool->SetNewValue($tag, $val, Group=>$group, Replace=>1);
- }
- # also try writing a few specific tags
- $exifTool->SetNewValue(CreatorCountry => 'Canada');
- $exifTool->SetNewValue(CodedCharacterSet => 'UTF8', Protected => 1);
- undef $info;
- my $image;
- my $ok = writeInfo($exifTool,'t/images/IPTC.jpg',\$image);
- # this is effectively what the RHEL 3 UTF8 LANG problem does:
- # $image = pack("U*", unpack("C*", $image));
- my $exifTool2 = new Image::ExifTool;
- $exifTool2->Options(Duplicates => 1);
- $info = $exifTool2->ImageInfo(\$image);
- my $testfile = "t/${testname}_${testnum}_failed.jpg";
- if (check($exifTool2, $info, $testname, $testnum) and $ok) {
- unlink $testfile;
- } else {
- # save bad file
- open(TESTFILE,">$testfile");
- binmode(TESTFILE);
- print TESTFILE $image;
- close(TESTFILE);
- print 'not ';
- }
- print "ok $testnum\n";
- }
- # test 5: Test IPTC special characters
- {
- ++$testnum;
- my @writeInfo = (
- # (don't put special character hex codes in string in an attempt to patch failed
- # test by dcollins on Perl 5.95 and i686-linux-thread-multi 2.6.28-11-generic)
- # ['IPTC:CopyrightNotice' => chr(0xc2) . chr(0xa9) . " 2008 Phil Harvey"],
- # - didn't fix it, so change it back again:
- # (dcollins is the only tester with this problem)
- ['IPTC:CopyrightNotice' => "\xc2\xa9 2008 Phil Harvey"],
- );
- print 'not ' unless writeCheck(\@writeInfo, $testname, $testnum, 't/images/Writer.jpg', 1);
- print "ok $testnum\n";
- }
- # test 6: Write and read using different default IPTC encoding
- {
- ++$testnum;
- my $exifTool = new Image::ExifTool;
- my $testfile = "t/${testname}_${testnum}_failed.jpg";
- unlink $testfile;
- $exifTool->Options(Charset => 'Cyrillic');
- $exifTool->SetNewValuesFromFile('t/images/MIE.mie', 'Comment-ru_RU>Caption-Abstract');
- $exifTool->Options(IPTCCharset => 'Cyrillic');
- my $ok = writeInfo($exifTool,'t/images/Writer.jpg',$testfile);
- $exifTool->Options(Charset => 'UTF8');
- my $info = $exifTool->ImageInfo($testfile, 'IPTC:*');
- if (check($exifTool, $info, $testname, $testnum) and $ok) {
- unlink $testfile;
- } else {
- print 'not ';
- }
- print "ok $testnum\n";
- }
- # test 7: Replace an entry in a list
- {
- ++$testnum;
- my @writeInfo = (
- ['IPTC:Keywords' => 'Test', DelValue => 1],
- ['IPTC:Keywords' => 'One'],
- ['IPTC:Keywords' => 'Two'],
- );
- print 'not ' unless writeCheck(\@writeInfo, $testname, $testnum, 't/images/IPTC.jpg', 1);
- print "ok $testnum\n";
- }
- # test 8: Write IPTC as a block
- {
- ++$testnum;
- my $exifTool = new Image::ExifTool;
- my $testfile = "t/${testname}_${testnum}_failed.jpg";
- unlink $testfile;
- $exifTool->SetNewValuesFromFile('t/images/IPTC.jpg', 'IPTC');
- my $ok = writeInfo($exifTool,'t/images/Writer.jpg',$testfile);
- my $info = $exifTool->ImageInfo($testfile, 'IPTC:*');
- if (check($exifTool, $info, $testname, $testnum) and $ok) {
- unlink $testfile;
- } else {
- print 'not ';
- }
- print "ok $testnum\n";
- }
- # end
|