File Coverage

blib/lib/Image/ExifTool/JSON.pm
Criterion Covered Total %
statement 68 69 98.5
branch 27 40 67.5
condition 10 27 37.0
subroutine 7 7 100.0
pod 0 3 0.0
total 112 146 76.7


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: JSON.pm
3             #
4             # Description: Read JSON files
5             #
6             # Notes: Set ExifTool MissingTagValue to "null" to ignore JSON nulls
7             #
8             # Revisions: 2017/03/13 - P. Harvey Created
9             #------------------------------------------------------------------------------
10              
11             package Image::ExifTool::JSON;
12 16     16   4423 use strict;
  16         43  
  16         1078  
13 16     16   99 use vars qw($VERSION);
  16         38  
  16         914  
14 16     16   96 use Image::ExifTool qw(:DataAccess :Utils);
  16         30  
  16         3905  
15 16     16   12100 use Image::ExifTool::Import;
  16         60  
  16         21238  
16              
17             $VERSION = '1.11';
18              
19             sub ProcessJSON($$;$);
20             sub ProcessTag($$$$%);
21              
22             %Image::ExifTool::JSON::Main = (
23             GROUPS => { 0 => 'JSON', 1 => 'JSON', 2 => 'Other' },
24             VARS => { ID_FMT => 'none' },
25             PROCESS_PROC => \&ProcessJSON,
26             NOTES => q{
27             Other than a few tags in the table below, JSON tags have not been
28             pre-defined. However, ExifTool will read any existing tags from basic
29             JSON-formatted files.
30             },
31             # ON1 settings tags
32             ON1_SettingsData => {
33             RawConv => q{
34             require Image::ExifTool::XMP;
35             $val = Image::ExifTool::XMP::DecodeBase64($val);
36             },
37             SubDirectory => { TagTable => 'Image::ExifTool::PLIST::Main' },
38             },
39             ON1_SettingsMetadataCreated => { Groups => { 2 => 'Time' } },
40             ON1_SettingsMetadataModified => { Groups => { 2 => 'Time' } },
41             ON1_SettingsMetadataName => { },
42             ON1_SettingsMetadataPluginID => { },
43             ON1_SettingsMetadataTimestamp => { Groups => { 2 => 'Time' } },
44             ON1_SettingsMetadataUsage => { },
45             ON1_SettingsMetadataVisibleToUser=>{ },
46             adjustmentsSettingsStatisticsLightMap => { # (in JSON of AAE files)
47             Name => 'AdjustmentsSettingsStatisticsLightMap',
48             ValueConv => 'Image::ExifTool::XMP::DecodeBase64($val)',
49             },
50             );
51              
52             #------------------------------------------------------------------------------
53             # Store a tag value
54             # Inputs: 0) ExifTool ref, 1) tag table, 2) tag ID, 3) value, 4) tagInfo flags
55             sub FoundTag($$$$%)
56             {
57 77     77 0 215 my ($et, $tagTablePtr, $tag, $val, %flags) = @_;
58              
59             # special case to reformat ON1 tag names
60 77 50       204 if ($tag =~ s/^settings\w{8}-\w{4}-\w{4}-\w{4}-\w{12}(Data|Metadata.+)$/ON1_Settings$1/) {
61 0 0       0 $et->OverrideFileType('ONP','application/on1') if $$et{FILE_TYPE} eq 'JSON';
62             }
63              
64             # avoid conflict with special table entries
65 77 50       201 $tag .= '!' if $Image::ExifTool::specialTags{$tag};
66              
67 77 100       203 unless ($$tagTablePtr{$tag}) {
68 68         126 my $name = $tag;
69 68         145 $name =~ tr/:/_/; # use underlines in place of colons in tag name
70 68         142 $name =~ s/^c2pa/C2PA/i; # hack to fix "C2PA" case
71 68         265 $name = Image::ExifTool::MakeTagName($name);
72 68         207 my $desc = Image::ExifTool::MakeDescription($name);
73 68         160 $desc =~ s/^C2 PA/C2PA/; # hack to get "C2PA" correct
74 68         446 $et->VPrint(0, $$et{INDENT}, "[adding $tag]\n");
75 68         487 AddTagToTable($tagTablePtr, $tag, {
76             Name => $name,
77             Description => $desc,
78             %flags,
79             Temporary => 1,
80             });
81             }
82 77         273 $et->HandleTag($tagTablePtr, $tag, $val);
83             }
84              
85             #------------------------------------------------------------------------------
86             # Process a JSON tag
87             # Inputs: 0) ExifTool ref, 1) tag table, 2) tag ID, 3) value, 4) tagInfo flags
88             # - expands structures into flattened tags as required
89             sub ProcessTag($$$$%)
90             {
91 88     88 0 131 local $_;
92 88         246 my ($et, $tagTablePtr, $tag, $val, %flags) = @_;
93              
94 88 100       331 if (ref $val eq 'HASH') {
    100          
    100          
95 2 50       10 if ($et->Options('Struct')) {
96 2         9 FoundTag($et, $tagTablePtr, $tag, $val, %flags, Struct => 1);
97 2 50       10 return unless $et->Options('Struct') > 1;
98             }
99             # support hashes with ordered keys
100 2         8 foreach (Image::ExifTool::OrderedKeys($val)) {
101 4 50 33     28 my $tg = $tag . ((/^\d/ and $tag =~ /\d$/) ? '_' : '') . ucfirst;
102 4         12 $tg =~ s/([^a-zA-Z])([a-z])/$1\U$2/g;
103 4         18 ProcessTag($et, $tagTablePtr, $tg, $$val{$_}, %flags, Flat => 1);
104             }
105             } elsif (ref $val eq 'ARRAY') {
106 8         18 foreach (@$val) {
107 13         42 ProcessTag($et, $tagTablePtr, $tag, $_, %flags, List => 1);
108             }
109             } elsif (defined $val) {
110 75         235 FoundTag($et, $tagTablePtr, $tag, $val, %flags);
111             }
112             }
113              
114             #------------------------------------------------------------------------------
115             # Extract meta information from a JSON file
116             # Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) tag table ref
117             # Returns: 1 on success, 0 if this wasn't a recognized JSON file
118             sub ProcessJSON($$;$)
119             {
120 61     61 0 134 local $_;
121 61         177 my ($et, $dirInfo, $tagTablePtr) = @_;
122 61         179 my $raf = $$dirInfo{RAF};
123 61         263 my $structOpt = $et->Options('Struct');
124 61         137 my (%database, $key, $tag, $dataPt);
125              
126 61 100       179 unless ($raf) {
127 60         153 $dataPt = $$dirInfo{DataPt};
128 60 50 0     283 if ($$dirInfo{DirStart} or ($$dirInfo{DirLen} and $$dirInfo{DirLen} ne length($$dataPt))) {
      33        
129 60         111 my $buff = substr(${$$dirInfo{DataPt}}, $$dirInfo{DirStart}, $$dirInfo{DirLen});
  60         248  
130 60         125 $dataPt = \$buff;
131             }
132 60         329 $raf = File::RandomAccess->new($dataPt);
133             # extract as a block if requested
134 60 50       250 my $blockName = $$dirInfo{BlockInfo} ? $$dirInfo{BlockInfo}{Name} : '';
135 60         211 my $blockExtract = $et->Options('BlockExtract');
136 60 100 66     670 if ($blockName and ($blockExtract or $$et{REQ_TAG_LOOKUP}{lc $blockName} or
      66        
137             ($$et{TAGS_FROM_FILE} and not $$et{EXCL_TAG_LOOKUP}{lc $blockName})))
138             {
139 15         72 $et->FoundTag($$dirInfo{BlockInfo}, $$dataPt);
140 15 50 33     53 return 1 if $blockExtract and $blockExtract > 1;
141             }
142 60         255 $et->VerboseDir('JSON');
143             }
144              
145             # read information from JSON file into database structure
146 61         191 my $err = Image::ExifTool::Import::ReadJSON($raf, \%database,
147             $et->Options('MissingTagValue'), $et->Options('Charset'));
148              
149 61 50 33     323 return 0 if $err or not %database;
150              
151 61 100       172 $et->SetFileType() unless $dataPt;
152              
153 61 100       149 $tagTablePtr or $tagTablePtr = GetTagTable('Image::ExifTool::JSON::Main');
154              
155             # remove any old tag definitions in case they change flags
156 61         236 foreach $key (TagTableKeys($tagTablePtr)) {
157 604 100       1533 delete $$tagTablePtr{$key} if $$tagTablePtr{$key}{Temporary};
158             }
159              
160             # extract tags from JSON database
161 61         227 foreach $key (sort keys %database) {
162 61         272 foreach $tag (Image::ExifTool::OrderedKeys($database{$key})) {
163 71         150 my $val = $database{$key}{$tag};
164             # (ignore SourceFile if generated automatically by ReadJSON)
165 71 0 33     222 next if $tag eq 'SourceFile' and defined $val and $val eq '*';
      33        
166 71         205 ProcessTag($et, $tagTablePtr, $tag, $val);
167             }
168             }
169 61         484 return 1;
170             }
171              
172             1; # end
173              
174             __END__