IPTC.t 5.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157
  1. # Before "make install", this script should be runnable with "make test".
  2. # After "make install" it should work as "perl t/IPTC.t".
  3. BEGIN { $| = 1; print "1..8\n"; $Image::ExifTool::noConfig = 1; }
  4. END {print "not ok 1\n" unless $loaded;}
  5. # test 1: Load the module(s)
  6. use Image::ExifTool 'ImageInfo';
  7. use Image::ExifTool::IPTC;
  8. $loaded = 1;
  9. print "ok 1\n";
  10. use t::TestLib;
  11. my $testname = 'IPTC';
  12. my $testnum = 1;
  13. # test 2: Extract information from IPTC.jpg
  14. {
  15. ++$testnum;
  16. my $exifTool = new Image::ExifTool;
  17. my $info = $exifTool->ImageInfo('t/images/IPTC.jpg', {Duplicates => 1});
  18. print 'not ' unless check($exifTool, $info, $testname, $testnum);
  19. print "ok $testnum\n";
  20. }
  21. # test 3: Test GetValue() in list context
  22. {
  23. ++$testnum;
  24. my $exifTool = new Image::ExifTool;
  25. $exifTool->ExtractInfo('t/images/IPTC.jpg', {JoinLists => 0});
  26. my @values = $exifTool->GetValue('Keywords','ValueConv');
  27. my $values = join '-', @values;
  28. my $expected = 'ExifTool-Test-IPTC';
  29. unless ($values eq $expected) {
  30. warn "\n Test $testnum differs with \"$values\"\n";
  31. print 'not ';
  32. }
  33. print "ok $testnum\n";
  34. }
  35. # test 4: Test rewriting everything with slightly different values
  36. {
  37. ++$testnum;
  38. my $exifTool = new Image::ExifTool;
  39. $exifTool->Options(Duplicates => 1, Binary => 1, List => 1);
  40. my $info = $exifTool->ImageInfo('t/images/IPTC.jpg');
  41. my $tag;
  42. foreach $tag (keys %$info) {
  43. my $group = $exifTool->GetGroup($tag);
  44. my $val = $$info{$tag};
  45. if (ref $val eq 'ARRAY') {
  46. push @$val, 'v2';
  47. } elsif (ref $val eq 'SCALAR') {
  48. $val = 'v2';
  49. } elsif ($val =~ /^\d+(\.\d*)?$/) {
  50. # (add extra .001 to avoid problem with aperture of 4.85
  51. # getting rounded to 4.8 or 4.9 and causing failed tests)
  52. $val += ($val / 10) + 1.001;
  53. $1 or $val = int($val);
  54. } else {
  55. $val .= '-v2';
  56. }
  57. # eat return values so warning don't get printed
  58. my @x = $exifTool->SetNewValue($tag, $val, Group=>$group, Replace=>1);
  59. }
  60. # also try writing a few specific tags
  61. $exifTool->SetNewValue(CreatorCountry => 'Canada');
  62. $exifTool->SetNewValue(CodedCharacterSet => 'UTF8', Protected => 1);
  63. undef $info;
  64. my $image;
  65. my $ok = writeInfo($exifTool,'t/images/IPTC.jpg',\$image);
  66. # this is effectively what the RHEL 3 UTF8 LANG problem does:
  67. # $image = pack("U*", unpack("C*", $image));
  68. my $exifTool2 = new Image::ExifTool;
  69. $exifTool2->Options(Duplicates => 1);
  70. $info = $exifTool2->ImageInfo(\$image);
  71. my $testfile = "t/${testname}_${testnum}_failed.jpg";
  72. if (check($exifTool2, $info, $testname, $testnum) and $ok) {
  73. unlink $testfile;
  74. } else {
  75. # save bad file
  76. open(TESTFILE,">$testfile");
  77. binmode(TESTFILE);
  78. print TESTFILE $image;
  79. close(TESTFILE);
  80. print 'not ';
  81. }
  82. print "ok $testnum\n";
  83. }
  84. # test 5: Test IPTC special characters
  85. {
  86. ++$testnum;
  87. my @writeInfo = (
  88. # (don't put special character hex codes in string in an attempt to patch failed
  89. # test by dcollins on Perl 5.95 and i686-linux-thread-multi 2.6.28-11-generic)
  90. # ['IPTC:CopyrightNotice' => chr(0xc2) . chr(0xa9) . " 2008 Phil Harvey"],
  91. # - didn't fix it, so change it back again:
  92. # (dcollins is the only tester with this problem)
  93. ['IPTC:CopyrightNotice' => "\xc2\xa9 2008 Phil Harvey"],
  94. );
  95. print 'not ' unless writeCheck(\@writeInfo, $testname, $testnum, 't/images/Writer.jpg', 1);
  96. print "ok $testnum\n";
  97. }
  98. # test 6: Write and read using different default IPTC encoding
  99. {
  100. ++$testnum;
  101. my $exifTool = new Image::ExifTool;
  102. my $testfile = "t/${testname}_${testnum}_failed.jpg";
  103. unlink $testfile;
  104. $exifTool->Options(Charset => 'Cyrillic');
  105. $exifTool->SetNewValuesFromFile('t/images/MIE.mie', 'Comment-ru_RU>Caption-Abstract');
  106. $exifTool->Options(IPTCCharset => 'Cyrillic');
  107. my $ok = writeInfo($exifTool,'t/images/Writer.jpg',$testfile);
  108. $exifTool->Options(Charset => 'UTF8');
  109. my $info = $exifTool->ImageInfo($testfile, 'IPTC:*');
  110. if (check($exifTool, $info, $testname, $testnum) and $ok) {
  111. unlink $testfile;
  112. } else {
  113. print 'not ';
  114. }
  115. print "ok $testnum\n";
  116. }
  117. # test 7: Replace an entry in a list
  118. {
  119. ++$testnum;
  120. my @writeInfo = (
  121. ['IPTC:Keywords' => 'Test', DelValue => 1],
  122. ['IPTC:Keywords' => 'One'],
  123. ['IPTC:Keywords' => 'Two'],
  124. );
  125. print 'not ' unless writeCheck(\@writeInfo, $testname, $testnum, 't/images/IPTC.jpg', 1);
  126. print "ok $testnum\n";
  127. }
  128. # test 8: Write IPTC as a block
  129. {
  130. ++$testnum;
  131. my $exifTool = new Image::ExifTool;
  132. my $testfile = "t/${testname}_${testnum}_failed.jpg";
  133. unlink $testfile;
  134. $exifTool->SetNewValuesFromFile('t/images/IPTC.jpg', 'IPTC');
  135. my $ok = writeInfo($exifTool,'t/images/Writer.jpg',$testfile);
  136. my $info = $exifTool->ImageInfo($testfile, 'IPTC:*');
  137. if (check($exifTool, $info, $testname, $testnum) and $ok) {
  138. unlink $testfile;
  139. } else {
  140. print 'not ';
  141. }
  142. print "ok $testnum\n";
  143. }
  144. # end