1 | #------------------------------------------------------------------------------
|
---|
2 | # File: PGF.pm
|
---|
3 | #
|
---|
4 | # Description: Read Progressive Graphics File meta information
|
---|
5 | #
|
---|
6 | # Revisions: 2011/01/25 - P. Harvey Created
|
---|
7 | #
|
---|
8 | # References: 1) http://www.libpgf.org/
|
---|
9 | # 2) http://www.exiv2.org/
|
---|
10 | #------------------------------------------------------------------------------
|
---|
11 |
|
---|
12 | package Image::ExifTool::PGF;
|
---|
13 |
|
---|
14 | use strict;
|
---|
15 | use vars qw($VERSION);
|
---|
16 | use Image::ExifTool qw(:DataAccess :Utils);
|
---|
17 |
|
---|
18 | $VERSION = '1.01';
|
---|
19 |
|
---|
20 | # PGF header information
|
---|
21 | %Image::ExifTool::PGF::Main = (
|
---|
22 | GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
|
---|
23 | PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
---|
24 | PRIORITY => 2, # (to take precedence over PNG tags from embedded image)
|
---|
25 | NOTES => q{
|
---|
26 | The following table lists information extracted from the header of
|
---|
27 | Progressive Graphics File (PGF) images. As well, information is extracted
|
---|
28 | from the embedded PNG metadata image if it exists. See
|
---|
29 | L<http://www.libpgf.org/> for the PGF specification.
|
---|
30 | },
|
---|
31 | 3 => {
|
---|
32 | Name => 'PGFVersion',
|
---|
33 | PrintConv => 'sprintf("0x%.2x", $val)',
|
---|
34 | # this is actually a bitmask (ref digikam PGFtypes.h):
|
---|
35 | # 0x02 - data structure PGFHeader of major version 2
|
---|
36 | # 0x04 - 32-bit values
|
---|
37 | # 0x08 - supports regions of interest
|
---|
38 | # 0x10 - new coding scheme since major version 5
|
---|
39 | # 0x20 - new HeaderSize: 32 bits instead of 16 bits
|
---|
40 | },
|
---|
41 | 8 => { Name => 'ImageWidth', Format => 'int32u' },
|
---|
42 | 12 => { Name => 'ImageHeight', Format => 'int32u' },
|
---|
43 | 16 => 'PyramidLevels',
|
---|
44 | 17 => 'Quality',
|
---|
45 | 18 => 'BitsPerPixel',
|
---|
46 | 19 => 'ColorComponents',
|
---|
47 | 20 => {
|
---|
48 | Name => 'ColorMode',
|
---|
49 | RawConv => '$$self{PGFColorMode} = $val',
|
---|
50 | PrintConvColumns => 2,
|
---|
51 | PrintConv => {
|
---|
52 | 0 => 'Bitmap',
|
---|
53 | 1 => 'Grayscale',
|
---|
54 | 2 => 'Indexed',
|
---|
55 | 3 => 'RGB',
|
---|
56 | 4 => 'CMYK',
|
---|
57 | 7 => 'Multichannel',
|
---|
58 | 8 => 'Duotone',
|
---|
59 | 9 => 'Lab',
|
---|
60 | },
|
---|
61 | },
|
---|
62 | 21 => { Name => 'BackgroundColor', Format => 'int8u[3]' },
|
---|
63 | );
|
---|
64 |
|
---|
65 | #------------------------------------------------------------------------------
|
---|
66 | # Extract information from a PGF image
|
---|
67 | # Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
---|
68 | # Returns: 1 on success, 0 if this wasn't a valid PGF file
|
---|
69 | sub ProcessPGF($$)
|
---|
70 | {
|
---|
71 | my ($exifTool, $dirInfo) = @_;
|
---|
72 | my $raf = $$dirInfo{RAF};
|
---|
73 | my $buff;
|
---|
74 |
|
---|
75 | # read header and check magic number
|
---|
76 | return 0 unless $raf->Read($buff, 24) == 24 and $buff =~ /^PGF(.)/s;
|
---|
77 | my $ver = ord $1;
|
---|
78 | $exifTool->SetFileType();
|
---|
79 | SetByteOrder('II');
|
---|
80 |
|
---|
81 | # currently support only version 0x36
|
---|
82 | unless ($ver == 0x36) {
|
---|
83 | $exifTool->Error(sprintf('Unsupported PGF version 0x%.2x', $ver));
|
---|
84 | return 1;
|
---|
85 | }
|
---|
86 | # extract information from the PGF header
|
---|
87 | my $tagTablePtr = GetTagTable('Image::ExifTool::PGF::Main');
|
---|
88 | $exifTool->ProcessDirectory({ DataPt => \$buff, DataPos => 0 }, $tagTablePtr);
|
---|
89 |
|
---|
90 | my $len = Get32u(\$buff, 4) - 16; # length of post-header data
|
---|
91 |
|
---|
92 | # skip colour table if necessary
|
---|
93 | $len -= $raf->Seek(1024, 1) ? 1024 : $len if $$exifTool{PGFColorMode} == 2;
|
---|
94 |
|
---|
95 | # extract information from the embedded metadata image (PNG format)
|
---|
96 | if ($len > 0 and $len < 0x1000000 and $raf->Read($buff, $len) == $len) {
|
---|
97 | $exifTool->ExtractInfo(\$buff, { ReEntry => 1 });
|
---|
98 | }
|
---|
99 | return 1;
|
---|
100 | }
|
---|
101 |
|
---|
102 |
|
---|
103 | 1; # end
|
---|
104 |
|
---|
105 | __END__
|
---|
106 |
|
---|
107 | =head1 NAME
|
---|
108 |
|
---|
109 | Image::ExifTool::PGF - Read Progressive Graphics File meta information
|
---|
110 |
|
---|
111 | =head1 SYNOPSIS
|
---|
112 |
|
---|
113 | This module is used by Image::ExifTool
|
---|
114 |
|
---|
115 | =head1 DESCRIPTION
|
---|
116 |
|
---|
117 | This module contains definitions required by Image::ExifTool to extract meta
|
---|
118 | information from Progressive Graphics File (PGF) images.
|
---|
119 |
|
---|
120 | =head1 AUTHOR
|
---|
121 |
|
---|
122 | Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
|
---|
123 |
|
---|
124 | This library is free software; you can redistribute it and/or modify it
|
---|
125 | under the same terms as Perl itself.
|
---|
126 |
|
---|
127 | =head1 REFERENCES
|
---|
128 |
|
---|
129 | =over 4
|
---|
130 |
|
---|
131 | =item L<http://www.libpgf.org/>
|
---|
132 |
|
---|
133 | =item L<http://www.exiv2.org/>
|
---|
134 |
|
---|
135 | =back
|
---|
136 |
|
---|
137 | =head1 SEE ALSO
|
---|
138 |
|
---|
139 | L<Image::ExifTool::TagNames/PGF Tags>,
|
---|
140 | L<Image::ExifTool(3pm)|Image::ExifTool>
|
---|
141 |
|
---|
142 | =cut
|
---|
143 |
|
---|