File Coverage

blib/lib/Image/ExifTool/CaptureOne.pm
Criterion Covered Total %
statement 90 96 93.7
branch 21 36 58.3
condition 8 12 66.6
subroutine 9 9 100.0
pod 0 4 0.0
total 128 157 81.5


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: CaptureOne.pm
3             #
4             # Description: Read Capture One EIP and COS files
5             #
6             # Revisions: 2009/11/01 - P. Harvey Created
7             #
8             # Notes: The EIP format is a ZIP file containing an image (IIQ or TIFF)
9             # and some settings files (COS). COS files are XML based.
10             #------------------------------------------------------------------------------
11              
12             package Image::ExifTool::CaptureOne;
13              
14 1     1   8 use strict;
  1         2  
  1         43  
15 1     1   5 use vars qw($VERSION);
  1         32  
  1         73  
16 1     1   7 use Image::ExifTool qw(:DataAccess :Utils);
  1         2  
  1         261  
17 1     1   7 use Image::ExifTool::XMP;
  1         2  
  1         32  
18 1     1   6 use Image::ExifTool::ZIP;
  1         2  
  1         978  
19              
20             $VERSION = '1.04';
21              
22             # CaptureOne COS XML tags
23             # - tags are added dynamically when encountered
24             # - this table is not listed in tag name docs
25             %Image::ExifTool::CaptureOne::Main = (
26             GROUPS => { 0 => 'XML', 1 => 'XML', 2 => 'Image' },
27             PROCESS_PROC => \&Image::ExifTool::XMP::ProcessXMP,
28             VARS => { NO_ID => 1 },
29             ColorCorrections => { ValueConv => '\$val' }, # (long list of floating point numbers)
30             );
31              
32             #------------------------------------------------------------------------------
33             # We found an XMP property name/value
34             # Inputs: 0) attribute list ref, 1) attr hash ref,
35             # 2) property name ref, 3) property value ref
36             # Returns: true if value was changed
37             sub HandleCOSAttrs($$$$)
38             {
39 58     58 0 112 my ($attrList, $attrs, $prop, $valPt) = @_;
40 58         79 my $changed;
41 58 50 66     270 if (not length $$valPt and defined $$attrs{K} and defined $$attrs{V}) {
      66        
42 53         93 $$prop = $$attrs{K};
43 53         84 $$valPt = $$attrs{V};
44             # remove these attributes from the list
45 53         121 my @attrs = @$attrList;
46 53         90 @$attrList = ( );
47 53         78 my $a;
48 53         94 foreach $a (@attrs) {
49 106 50 66     285 if ($a eq 'K' or $a eq 'V') {
50 106         198 delete $$attrs{$a};
51             } else {
52 0         0 push @$attrList, $a;
53             }
54             }
55 53         102 $changed = 1;
56             }
57 58         160 return $changed;
58             }
59              
60             #------------------------------------------------------------------------------
61             # We found a COS property name/value
62             # Inputs: 0) ExifTool object ref, 1) tag table ref
63             # 2) reference to array of XMP property names (last is current property)
64             # 3) property value, 4) attribute hash ref (not used here)
65             # Returns: 1 if valid tag was found
66             sub FoundCOS($$$$;$)
67             {
68 53     53 0 108 my ($et, $tagTablePtr, $props, $val, $attrs) = @_;
69              
70 53         88 my $tag = $$props[-1];
71 53 100       116 unless ($$tagTablePtr{$tag}) {
72 48         200 $et->VPrint(0, " | [adding $tag]\n");
73 48         97 my $name = ucfirst $tag;
74 48         87 $name =~ tr/-_a-zA-Z0-9//dc;
75 48 50       98 return 0 unless length $tag;
76 48         152 my %tagInfo = ( Name => $tag );
77             # try formatting any tag with "Date" in the name as a date
78             # (shouldn't affect non-date tags)
79 48 50       123 if ($name =~ /Date(?![a-z])/) {
80 0         0 $tagInfo{Groups} = { 2 => 'Time' };
81 0         0 $tagInfo{ValueConv} = 'Image::ExifTool::XMP::ConvertXMPDate($val,1)';
82 0         0 $tagInfo{PrintConv} = '$self->ConvertDateTime($val)';
83             }
84 48         124 AddTagToTable($tagTablePtr, $tag, \%tagInfo);
85             }
86             # convert from UTF8 to ExifTool Charset
87 53         161 $val = $et->Decode($val, "UTF8");
88             # un-escape XML character entities
89 53         129 $val = Image::ExifTool::XMP::UnescapeXML($val);
90 53         169 $et->HandleTag($tagTablePtr, $tag, $val);
91 53         140 return 0;
92             }
93              
94             #------------------------------------------------------------------------------
95             # Extract information from a COS file
96             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
97             # Returns: 1 on success, 0 if this wasn't a valid XML file
98             sub ProcessCOS($$)
99             {
100 1     1 0 3 my ($et, $dirInfo) = @_;
101              
102             # process using XMP module, but override handling of attributes and tags
103             $$dirInfo{XMPParseOpts} = {
104 1         6 AttrProc => \&HandleCOSAttrs,
105             FoundProc => \&FoundCOS,
106             };
107 1         4 my $tagTablePtr = GetTagTable('Image::ExifTool::CaptureOne::Main');
108 1         5 my $success = $et->ProcessDirectory($dirInfo, $tagTablePtr);
109 1         3 delete $$dirInfo{XMLParseArgs};
110 1         3 return $success;
111             }
112              
113             #------------------------------------------------------------------------------
114             # Extract information from a CaptureOne EIP file
115             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
116             # Returns: 1
117             # Notes: Upon entry to this routine, the file type has already been verified
118             # and the dirInfo hash contains a ZIP element unique to this process proc:
119             # ZIP - reference to Archive::Zip object for this file
120             sub ProcessEIP($$)
121             {
122 1     1 0 2 my ($et, $dirInfo) = @_;
123 1         3 my $zip = $$dirInfo{ZIP};
124 1         2 my ($file, $buff, $status, $member, %parseFile);
125              
126 1         27 $et->SetFileType('EIP');
127              
128             # must catch all Archive::Zip warnings
129 1         6 local $SIG{'__WARN__'} = \&Image::ExifTool::ZIP::WarnProc;
130             # find all manifest files
131 1         4 my @members = $zip->membersMatching('^manifest\d*.xml$');
132             # and choose the one with the highest version number (any better ideas?)
133 1         72 while (@members) {
134 2         4 my $m = shift @members;
135 2         5 my $f = $m->fileName();
136 2 50 66     19 next if $file and $file gt $f;
137 2         4 $member = $m;
138 2         5 $file = $f;
139             }
140             # get file names from our chosen manifest file
141 1 50       4 if ($member) {
142 1         6 ($buff, $status) = $zip->contents($member);
143 1 50       823 if (not $status) {
144 1         5 my $foundImage;
145 1         10 while ($buff =~ m{<(RawPath|SettingsPath)>(.*?)}sg) {
146 2         6 $file = $2;
147 2 50       10 next unless $file =~ /\.(cos|iiq|jpe?g|tiff?)$/i;
148 2         6 $parseFile{$file} = 1; # set flag to parse this file
149 2 100       10 $foundImage = 1 unless $file =~ /\.cos$/i;
150             }
151             # ignore manifest unless it contained a valid image
152 1 50       4 undef %parseFile unless $foundImage;
153             }
154             }
155             # extract meta information from embedded files
156 1         3 my $docNum = 0;
157 1         4 @members = $zip->members(); # get all members
158 1         7 foreach $member (@members) {
159             # get filename of this ZIP member
160 5         16 $file = $member->fileName();
161 5 50       42 next unless defined $file;
162 5         22 $et->VPrint(0, "File: $file\n");
163             # set the document number and extract ZIP tags
164 5         11 $$et{DOC_NUM} = ++$docNum;
165 5         16 Image::ExifTool::ZIP::HandleMember($et, $member);
166 5 50       13 if (%parseFile) {
167 5 100       16 next unless $parseFile{$file};
168             } else {
169             # reading the manifest didn't work, so look for image files in the
170             # root directory and .cos files in the CaptureOne directory
171 0 0       0 next unless $file =~ m{^([^/]+\.(iiq|jpe?g|tiff?)|CaptureOne/.*\.cos)$}i;
172             }
173             # extract the contents of the file
174             # Note: this could use a LOT of memory here for RAW images...
175 2         11 ($buff, $status) = $zip->contents($member);
176 2 50       1501 $status and $et->Warn("Error extracting $file"), next;
177 2 100       12 if ($file =~ /\.cos$/i) {
178             # process Capture One Settings files
179 1         5 my %dirInfo = (
180             DataPt => \$buff,
181             DirLen => length $buff,
182             DataLen => length $buff,
183             );
184 1         8 ProcessCOS($et, \%dirInfo);
185             } else {
186             # set HtmlDump error if necessary because it doesn't work with embedded files
187 1 50       3 if ($$et{HTML_DUMP}) {
188 0         0 $$et{HTML_DUMP}{Error} = "Sorry, can't dump images embedded in ZIP files";
189             }
190             # process IIQ, JPEG and TIFF images
191 1         25 $et->ExtractInfo(\$buff, { ReEntry => 1 });
192             }
193 2         9 undef $buff; # (free memory now)
194             }
195 1         3 delete $$et{DOC_NUM};
196 1         7 return 1;
197             }
198              
199             1; # end
200              
201             __END__