| 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 | use strict;
|
|---|
| 15 | use vars qw($VERSION);
|
|---|
| 16 | use Image::ExifTool qw(:DataAccess :Utils);
|
|---|
| 17 | use Image::ExifTool::XMP;
|
|---|
| 18 | use Image::ExifTool::ZIP;
|
|---|
| 19 |
|
|---|
| 20 | $VERSION = '1.02';
|
|---|
| 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 | sub HandleCOSAttrs($$$$)
|
|---|
| 37 | {
|
|---|
| 38 | my ($attrList, $attrs, $prop, $valPt) = @_;
|
|---|
| 39 | if (not length $$valPt and defined $$attrs{K} and defined $$attrs{V}) {
|
|---|
| 40 | $$prop = $$attrs{K};
|
|---|
| 41 | $$valPt = $$attrs{V};
|
|---|
| 42 | # remove these attributes from the list
|
|---|
| 43 | my @attrs = @$attrList;
|
|---|
| 44 | @$attrList = ( );
|
|---|
| 45 | my $a;
|
|---|
| 46 | foreach $a (@attrs) {
|
|---|
| 47 | if ($a eq 'K' or $a eq 'V') {
|
|---|
| 48 | delete $$attrs{$a};
|
|---|
| 49 | } else {
|
|---|
| 50 | push @$attrList, $a;
|
|---|
| 51 | }
|
|---|
| 52 | }
|
|---|
| 53 | }
|
|---|
| 54 | }
|
|---|
| 55 |
|
|---|
| 56 | #------------------------------------------------------------------------------
|
|---|
| 57 | # We found a COS property name/value
|
|---|
| 58 | # Inputs: 0) ExifTool object ref, 1) tag table ref
|
|---|
| 59 | # 2) reference to array of XMP property names (last is current property)
|
|---|
| 60 | # 3) property value, 4) attribute hash ref (not used here)
|
|---|
| 61 | # Returns: 1 if valid tag was found
|
|---|
| 62 | sub FoundCOS($$$$;$)
|
|---|
| 63 | {
|
|---|
| 64 | my ($exifTool, $tagTablePtr, $props, $val, $attrs) = @_;
|
|---|
| 65 |
|
|---|
| 66 | my $tag = $$props[-1];
|
|---|
| 67 | unless ($$tagTablePtr{$tag}) {
|
|---|
| 68 | $exifTool->VPrint(0, " | [adding $tag]\n");
|
|---|
| 69 | my $name = ucfirst $tag;
|
|---|
| 70 | $name =~ tr/-_a-zA-Z0-9//dc;
|
|---|
| 71 | return 0 unless length $tag;
|
|---|
| 72 | my %tagInfo = ( Name => $tag );
|
|---|
| 73 | # try formatting any tag with "Date" in the name as a date
|
|---|
| 74 | # (shouldn't affect non-date tags)
|
|---|
| 75 | if ($name =~ /Date(?![a-z])/) {
|
|---|
| 76 | $tagInfo{Groups} = { 2 => 'Time' };
|
|---|
| 77 | $tagInfo{ValueConv} = 'Image::ExifTool::XMP::ConvertXMPDate($val,1)';
|
|---|
| 78 | $tagInfo{PrintConv} = '$self->ConvertDateTime($val)';
|
|---|
| 79 | }
|
|---|
| 80 | Image::ExifTool::AddTagToTable($tagTablePtr, $tag, \%tagInfo);
|
|---|
| 81 | }
|
|---|
| 82 | # convert from UTF8 to ExifTool Charset
|
|---|
| 83 | $val = $exifTool->Decode($val, "UTF8");
|
|---|
| 84 | # un-escape XML character entities
|
|---|
| 85 | $val = Image::ExifTool::XMP::UnescapeXML($val);
|
|---|
| 86 | $exifTool->HandleTag($tagTablePtr, $tag, $val);
|
|---|
| 87 | return 0;
|
|---|
| 88 | }
|
|---|
| 89 |
|
|---|
| 90 | #------------------------------------------------------------------------------
|
|---|
| 91 | # Extract information from a COS file
|
|---|
| 92 | # Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
|---|
| 93 | # Returns: 1 on success, 0 if this wasn't a valid XML file
|
|---|
| 94 | sub ProcessCOS($$)
|
|---|
| 95 | {
|
|---|
| 96 | my ($exifTool, $dirInfo) = @_;
|
|---|
| 97 |
|
|---|
| 98 | # process using XMP module, but override handling of attributes and tags
|
|---|
| 99 | $$dirInfo{XMPParseOpts} = {
|
|---|
| 100 | AttrProc => \&HandleCOSAttrs,
|
|---|
| 101 | FoundProc => \&FoundCOS,
|
|---|
| 102 | };
|
|---|
| 103 | my $tagTablePtr = GetTagTable('Image::ExifTool::CaptureOne::Main');
|
|---|
| 104 | my $success = $exifTool->ProcessDirectory($dirInfo, $tagTablePtr);
|
|---|
| 105 | delete $$dirInfo{XMLParseArgs};
|
|---|
| 106 | return $success;
|
|---|
| 107 | }
|
|---|
| 108 |
|
|---|
| 109 | #------------------------------------------------------------------------------
|
|---|
| 110 | # Extract information from a CaptureOne EIP file
|
|---|
| 111 | # Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
|---|
| 112 | # Returns: 1
|
|---|
| 113 | # Notes: Upon entry to this routine, the file type has already been verified
|
|---|
| 114 | # and the dirInfo hash contains a ZIP element unique to this process proc:
|
|---|
| 115 | # ZIP - reference to Archive::Zip object for this file
|
|---|
| 116 | sub ProcessEIP($$)
|
|---|
| 117 | {
|
|---|
| 118 | my ($exifTool, $dirInfo) = @_;
|
|---|
| 119 | my $zip = $$dirInfo{ZIP};
|
|---|
| 120 | my ($file, $buff, $status, $member, %parseFile);
|
|---|
| 121 |
|
|---|
| 122 | $exifTool->SetFileType('EIP');
|
|---|
| 123 |
|
|---|
| 124 | # must catch all Archive::Zip warnings
|
|---|
| 125 | local $SIG{'__WARN__'} = \&Image::ExifTool::ZIP::WarnProc;
|
|---|
| 126 | # find all manifest files
|
|---|
| 127 | my @members = $zip->membersMatching('^manifest\d*.xml$');
|
|---|
| 128 | # and choose the one with the highest version number (any better ideas?)
|
|---|
| 129 | while (@members) {
|
|---|
| 130 | my $m = shift @members;
|
|---|
| 131 | my $f = $m->fileName();
|
|---|
| 132 | next if $file and $file gt $f;
|
|---|
| 133 | $member = $m;
|
|---|
| 134 | $file = $f;
|
|---|
| 135 | }
|
|---|
| 136 | # get file names from our chosen manifest file
|
|---|
| 137 | if ($member) {
|
|---|
| 138 | ($buff, $status) = $zip->contents($member);
|
|---|
| 139 | if (not $status) {
|
|---|
| 140 | my $foundImage;
|
|---|
| 141 | while ($buff =~ m{<(RawPath|SettingsPath)>(.*?)</\1>}sg) {
|
|---|
| 142 | $file = $2;
|
|---|
| 143 | next unless $file =~ /\.(cos|iiq|jpe?g|tiff?)$/i;
|
|---|
| 144 | $parseFile{$file} = 1; # set flag to parse this file
|
|---|
| 145 | $foundImage = 1 unless $file =~ /\.cos$/i;
|
|---|
| 146 | }
|
|---|
| 147 | # ignore manifest unless it contained a valid image
|
|---|
| 148 | undef %parseFile unless $foundImage;
|
|---|
| 149 | }
|
|---|
| 150 | }
|
|---|
| 151 | # extract meta information from embedded files
|
|---|
| 152 | my $docNum = 0;
|
|---|
| 153 | @members = $zip->members(); # get all members
|
|---|
| 154 | foreach $member (@members) {
|
|---|
| 155 | # get filename of this ZIP member
|
|---|
| 156 | $file = $member->fileName();
|
|---|
| 157 | next unless defined $file;
|
|---|
| 158 | $exifTool->VPrint(0, "File: $file\n");
|
|---|
| 159 | # set the document number and extract ZIP tags
|
|---|
| 160 | $$exifTool{DOC_NUM} = ++$docNum;
|
|---|
| 161 | Image::ExifTool::ZIP::HandleMember($exifTool, $member);
|
|---|
| 162 | if (%parseFile) {
|
|---|
| 163 | next unless $parseFile{$file};
|
|---|
| 164 | } else {
|
|---|
| 165 | # reading the manifest didn't work, so look for image files in the
|
|---|
| 166 | # root directory and .cos files in the CaptureOne directory
|
|---|
| 167 | next unless $file =~ m{^([^/]+\.(iiq|jpe?g|tiff?)|CaptureOne/.*\.cos)$}i;
|
|---|
| 168 | }
|
|---|
| 169 | # extract the contents of the file
|
|---|
| 170 | # Note: this could use a LOT of memory here for RAW images...
|
|---|
| 171 | ($buff, $status) = $zip->contents($member);
|
|---|
| 172 | $status and $exifTool->Warn("Error extracting $file"), next;
|
|---|
| 173 | if ($file =~ /\.cos$/i) {
|
|---|
| 174 | # process Capture One Settings files
|
|---|
| 175 | my %dirInfo = (
|
|---|
| 176 | DataPt => \$buff,
|
|---|
| 177 | DirLen => length $buff,
|
|---|
| 178 | DataLen => length $buff,
|
|---|
| 179 | );
|
|---|
| 180 | ProcessCOS($exifTool, \%dirInfo);
|
|---|
| 181 | } else {
|
|---|
| 182 | # set HtmlDump error if necessary because it doesn't work with embedded files
|
|---|
| 183 | if ($$exifTool{HTML_DUMP}) {
|
|---|
| 184 | $$exifTool{HTML_DUMP}{Error} = "Sorry, can't dump images embedded in ZIP files";
|
|---|
| 185 | }
|
|---|
| 186 | # process IIQ, JPEG and TIFF images
|
|---|
| 187 | $exifTool->ExtractInfo(\$buff, { ReEntry => 1 });
|
|---|
| 188 | }
|
|---|
| 189 | undef $buff; # (free memory now)
|
|---|
| 190 | }
|
|---|
| 191 | delete $$exifTool{DOC_NUM};
|
|---|
| 192 | return 1;
|
|---|
| 193 | }
|
|---|
| 194 |
|
|---|
| 195 | 1; # end
|
|---|
| 196 |
|
|---|
| 197 | __END__
|
|---|
| 198 |
|
|---|
| 199 | =head1 NAME
|
|---|
| 200 |
|
|---|
| 201 | Image::ExifTool::CaptureOne - Read Capture One EIP and COS files
|
|---|
| 202 |
|
|---|
| 203 | =head1 SYNOPSIS
|
|---|
| 204 |
|
|---|
| 205 | This module is used by Image::ExifTool
|
|---|
| 206 |
|
|---|
| 207 | =head1 DESCRIPTION
|
|---|
| 208 |
|
|---|
| 209 | This module contains definitions required by Image::ExifTool to extract meta
|
|---|
| 210 | information from Capture One EIP (Enhanced Image Package) and COS (Capture
|
|---|
| 211 | One Settings) files.
|
|---|
| 212 |
|
|---|
| 213 | =head1 NOTES
|
|---|
| 214 |
|
|---|
| 215 | The EIP format is a ZIP file containing an image (IIQ or TIFF) and some
|
|---|
| 216 | settings files (COS).
|
|---|
| 217 |
|
|---|
| 218 | =head1 AUTHOR
|
|---|
| 219 |
|
|---|
| 220 | Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
|
|---|
| 221 |
|
|---|
| 222 | This library is free software; you can redistribute it and/or modify it
|
|---|
| 223 | under the same terms as Perl itself.
|
|---|
| 224 |
|
|---|
| 225 | =head1 SEE ALSO
|
|---|
| 226 |
|
|---|
| 227 | L<Image::ExifTool::TagNames/ZIP Tags>,
|
|---|
| 228 | L<Image::ExifTool(3pm)|Image::ExifTool>
|
|---|
| 229 |
|
|---|
| 230 | =cut
|
|---|
| 231 |
|
|---|
