exiftool_vendored 12.62.0 → 12.63.0

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
Files changed (40) hide show
  1. checksums.yaml +4 -4
  2. data/bin/Changes +29 -1
  3. data/bin/MANIFEST +1 -0
  4. data/bin/META.json +4 -1
  5. data/bin/META.yml +4 -1
  6. data/bin/Makefile.PL +7 -1
  7. data/bin/README +10 -7
  8. data/bin/exiftool +22 -16
  9. data/bin/lib/Image/ExifTool/7Z.pm +793 -0
  10. data/bin/lib/Image/ExifTool/Canon.pm +1 -0
  11. data/bin/lib/Image/ExifTool/CanonRaw.pm +4 -4
  12. data/bin/lib/Image/ExifTool/Exif.pm +31 -14
  13. data/bin/lib/Image/ExifTool/FujiFilm.pm +3 -3
  14. data/bin/lib/Image/ExifTool/GPS.pm +5 -2
  15. data/bin/lib/Image/ExifTool/Geotag.pm +4 -1
  16. data/bin/lib/Image/ExifTool/Jpeg2000.pm +225 -28
  17. data/bin/lib/Image/ExifTool/MPF.pm +2 -1
  18. data/bin/lib/Image/ExifTool/MinoltaRaw.pm +2 -2
  19. data/bin/lib/Image/ExifTool/PNG.pm +6 -6
  20. data/bin/lib/Image/ExifTool/PhaseOne.pm +5 -5
  21. data/bin/lib/Image/ExifTool/QuickTime.pm +41 -12
  22. data/bin/lib/Image/ExifTool/QuickTimeStream.pl +18 -18
  23. data/bin/lib/Image/ExifTool/README +1 -1
  24. data/bin/lib/Image/ExifTool/RIFF.pm +11 -9
  25. data/bin/lib/Image/ExifTool/Shortcuts.pm +2 -1
  26. data/bin/lib/Image/ExifTool/SigmaRaw.pm +4 -4
  27. data/bin/lib/Image/ExifTool/Sony.pm +102 -8
  28. data/bin/lib/Image/ExifTool/TagLookup.pm +982 -953
  29. data/bin/lib/Image/ExifTool/TagNames.pod +75 -5
  30. data/bin/lib/Image/ExifTool/Validate.pm +17 -1
  31. data/bin/lib/Image/ExifTool/WriteExif.pl +9 -7
  32. data/bin/lib/Image/ExifTool/Writer.pl +7 -6
  33. data/bin/lib/Image/ExifTool/XMP.pm +14 -2
  34. data/bin/lib/Image/ExifTool/XMP2.pl +32 -0
  35. data/bin/lib/Image/ExifTool/ZIP.pm +5 -5
  36. data/bin/lib/Image/ExifTool.pm +54 -33
  37. data/bin/lib/Image/ExifTool.pod +17 -6
  38. data/bin/perl-Image-ExifTool.spec +6 -6
  39. data/lib/exiftool_vendored/version.rb +1 -1
  40. metadata +3 -2
@@ -0,0 +1,793 @@
1
+ #------------------------------------------------------------------------------
2
+ # File: 7Z.pm
3
+ #
4
+ # Description: Read 7z archive meta information
5
+ #
6
+ # Revisions: 2023/04/28 - Amir Gooran (Cyberno)
7
+ # 2023-05-06 - PH Minor changes in ExifTool interfacing
8
+ #
9
+ # References: 1) https://py7zr.readthedocs.io/en/latest/archive_format.html
10
+ #------------------------------------------------------------------------------
11
+
12
+ package Image::ExifTool::7Z;
13
+
14
+ use strict;
15
+ use vars qw($VERSION);
16
+ use Image::ExifTool qw(:DataAccess :Utils);
17
+
18
+ $VERSION = '1.00';
19
+
20
+ sub ReadUInt32 {
21
+ my $buff;
22
+
23
+ $_[0]->Read($buff, 4);
24
+ my ($output) = unpack('L', $buff);
25
+ return $output;
26
+ }
27
+
28
+ sub ReadUInt64 {
29
+ my $buff;
30
+ my $output;
31
+
32
+ $_[0]->Read($buff, 1);
33
+ my $b = ord($buff);
34
+ if($b == 255){ # read real uint64
35
+ $_[0]->Read($buff, 8);
36
+ my ($output) = unpack('Q', $buff);
37
+ return $output;
38
+ }
39
+ my @blen = (0x7F, 0xBF, 0xDF, 0xEF, 0xF7, 0xFB, 0xFD, 0xFE);
40
+
41
+ my $mask = 0x80;
42
+ my $vlen = 8;
43
+
44
+ for (my $l = 0 ; $l < scalar(@blen) ; $l++) {
45
+ my $v = $blen[$l];
46
+ if($b <= $v){
47
+ $vlen = $l;
48
+ last;
49
+ }
50
+ $mask >>= 1;
51
+ }
52
+ if($vlen == 0){
53
+ return $b & ($mask - 1);
54
+ }
55
+ $_[0]->Read($buff, $vlen);
56
+ $buff .= "\0\0\0\0\0\0\0\0";
57
+
58
+ my $value = unpack('Q', $buff);
59
+ my $highpart = $b & ($mask - 1);
60
+ return $value + ($highpart << ($vlen * 8));
61
+ }
62
+
63
+ sub ReadRealUInt64 {
64
+ my $buff;
65
+
66
+ $_[0]->Read($buff, 8);
67
+ my $value = unpack('Q', $buff);
68
+ return $value;
69
+ }
70
+
71
+ sub ReadBoolean {
72
+ my $buff;
73
+ my $count = $_[1];
74
+ my $checkall = $_[2];
75
+ my @result = ();
76
+
77
+ if($checkall){
78
+ $_[0]->Read($buff, 1);
79
+ my $all_defined = ord($buff);
80
+ if($all_defined != 0){
81
+ @result = (1)x$count;
82
+ return @result;
83
+ }
84
+ }
85
+
86
+ my $b = 0;
87
+ my $mask = 0;
88
+
89
+ for (my $i = 0 ; $i < $count ; $i++) {
90
+ if($mask == 0){
91
+ $_[0]->Read($buff, 1);
92
+ $b = ord($buff);
93
+ $mask = 0x80;
94
+ }
95
+ push(@result, ($b & $mask) != 0);
96
+ $mask >>= 1;
97
+ }
98
+ return @result;
99
+ }
100
+
101
+ sub ReadUTF16 {
102
+ my $val = "";
103
+ my $ch;
104
+
105
+ for(my $i=0; $i < 65536; $i++){
106
+ $_[0]->Read($ch, 2);
107
+ if($ch eq "\0\0"){
108
+ last;
109
+ }
110
+ $val .= $ch;
111
+ }
112
+ return $val;
113
+ }
114
+
115
+ sub ReadPackInfo {
116
+ my $et = shift;
117
+
118
+ my $buff;
119
+ my %out_packinfo = ();
120
+ $out_packinfo{"packsizes"} = ();
121
+
122
+ $out_packinfo{"packpos"} = ReadUInt64($_[0]);
123
+ my $numstreams = ReadUInt64($_[0]);
124
+ $et->VPrint(0, "Number Of Streams: $numstreams\n");
125
+
126
+ $_[0]->Read($buff, 1);
127
+ my $pid = ord($buff);
128
+
129
+ my @packsizes;
130
+ if($pid == 9){ # size
131
+ for (my $i = 0 ; $i < $numstreams ; $i++) {
132
+ push(@{ $out_packinfo{"packsizes"} }, ReadUInt64($_[0]));
133
+ }
134
+ $_[0]->Read($buff, 1);
135
+ $pid = ord($buff);
136
+ if($pid == 10){ # crc
137
+ my @crcs;
138
+ my @digestdefined = ReadBoolean($_[0], $numstreams, 1);
139
+ foreach my $crcexist (@digestdefined) {
140
+ if($crcexist){
141
+ push(@crcs, ReadUInt32($_[0]));
142
+ }
143
+ }
144
+ $_[0]->Read($buff, 1);
145
+ $pid = ord($buff);
146
+ }
147
+ }
148
+ if($pid != 0) { # end id expected
149
+ return 0;
150
+ }
151
+ return \%out_packinfo;
152
+ }
153
+
154
+ sub findInBinPair {
155
+ my @bindpairs = @{$_[0]};
156
+ my $index = $_[1];
157
+
158
+ for (my $i = 0; $i < scalar(@bindpairs); $i++) {
159
+ if($bindpairs[$i] == $index){
160
+ return $i;
161
+ }
162
+ }
163
+ return -1;
164
+ }
165
+
166
+ sub ReadFolder {
167
+ my $et = shift;
168
+ my $buff;
169
+ my $totalin = 0;
170
+ my $totalout = 0;
171
+ my %out_folder = ();
172
+ $out_folder{"packed_indices"} = ();
173
+ $out_folder{"bindpairs"} = ();
174
+ $out_folder{"coders"} = ();
175
+
176
+ my $num_coders = ReadUInt64($_[0]);
177
+ $et->VPrint(0, "Number of coders: $num_coders\n");
178
+
179
+ for (my $i = 0; $i < $num_coders; $i++) {
180
+ my %c = ();
181
+ $_[0]->Read($buff, 1);
182
+ my $b = ord($buff);
183
+ my $methodsize = $b & 0xF;
184
+ my $iscomplex = ($b & 0x10) == 0x10;
185
+ my $hasattributes = ($b & 0x20) == 0x20;
186
+ if($methodsize > 0){
187
+ $_[0]->Read($buff, $methodsize);
188
+ $c{"method"} = $buff;
189
+ }
190
+ else{
191
+ $c{"method"} = "\0";
192
+ }
193
+ if($iscomplex){
194
+ $c{"numinstreams"} = ReadUInt64($_[0]);
195
+ $c{"numoutstreams"} = ReadUInt64($_[0]);
196
+ }
197
+ else{
198
+ $c{"numinstreams"} = 1;
199
+ $c{"numoutstreams"} = 1;
200
+ }
201
+ $totalin += $c{"numinstreams"};
202
+ $totalout += $c{"numoutstreams"};
203
+ if($hasattributes){
204
+ my $proplen = ReadUInt64($_[0]);
205
+ $_[0]->Read($buff, $proplen);
206
+ $c{"properties"} = $buff;
207
+ }
208
+ else {
209
+ $c{"properties"} = undef;
210
+ }
211
+ $et->VPrint(0, "Reading coder $i\n");
212
+ push(@{ $out_folder{"coders"} }, \%c);
213
+ }
214
+ my $num_bindpairs = $totalout - 1;
215
+ for (my $i = 0; $i < $num_bindpairs; $i++) {
216
+ my @bond = (ReadUInt64($_[0]), ReadUInt64($_[0]));
217
+ push(@{ $out_folder{"bindpairs"} }, @bond);
218
+ }
219
+ my $num_packedstreams = $totalin - $num_bindpairs;
220
+ if($num_packedstreams == 1){
221
+ for (my $i = 0; $i < $totalin; $i++) {
222
+ if(findInBinPair(\@{ $out_folder{"bindpairs"} }, $i) < 0){
223
+ push(@{ $out_folder{"packed_indices"} }, $i);
224
+ }
225
+ }
226
+ }
227
+ else{
228
+ for (my $i = 0; $i < $num_packedstreams; $i++) {
229
+ push(@{ $out_folder{"packed_indices"} }, ReadUInt64($_[0]));
230
+ }
231
+ }
232
+
233
+ return \%out_folder;
234
+ }
235
+
236
+ sub RetrieveCodersInfo{
237
+ my $et = shift;
238
+ my $buff;
239
+ my @folders = @{ $_[1] };
240
+
241
+ $_[0]->Read($buff, 1);
242
+ my $pid = ord($buff);
243
+
244
+ if($pid != 0x0c){ # coders unpack size id expected
245
+ return 0;
246
+ }
247
+ foreach my $folder (@folders) {
248
+ $folder->{"unpacksizes"} = ();
249
+ foreach my $c (@{ $folder->{"coders"} }) {
250
+ for (my $i = 0 ; $i < $c->{"numoutstreams"} ; $i++) {
251
+ push(@{ $folder->{"unpacksizes" } }, ReadUInt64($_[0]));
252
+ }
253
+ }
254
+ }
255
+ $_[0]->Read($buff, 1);
256
+ $pid = ord($buff);
257
+
258
+ if($pid == 0x0a){ #crc
259
+ my $numfolders = scalar(@folders);
260
+ $et->VPrint(0, "Number of folders: $numfolders\n");
261
+ my @defined = ReadBoolean($_[0], $numfolders, 1);
262
+ my @crcs;
263
+ foreach my $crcexist (@defined) {
264
+ if($crcexist){
265
+ push(@crcs, ReadUInt32($_[0]));
266
+ }
267
+ }
268
+ for (my $i = 0 ; $i < $numfolders ; $i++) {
269
+ $folders[$i]->{"digestdefined"} = $defined[$i];
270
+ $folders[$i]->{"crc"} = $crcs[$i];
271
+ }
272
+ $_[0]->Read($buff, 1);
273
+ $pid = ord($buff);
274
+ }
275
+
276
+ if($pid != 0x00){ # end id expected
277
+ $et->VPrint(0, "Invalid PID: $pid\n");
278
+ return 0;
279
+ }
280
+ return 1;
281
+ }
282
+
283
+ sub ReadUnpackInfo {
284
+ my $et = shift;
285
+ my $buff;
286
+ my %out_unpackinfo = ();
287
+
288
+ $_[0]->Read($buff, 1);
289
+ my $pid = ord($buff);
290
+
291
+ if($pid != 0xb) { # folder id expected
292
+ return 0;
293
+ }
294
+
295
+ $out_unpackinfo{"numfolders"} = ReadUInt64($_[0]);
296
+ $out_unpackinfo{"folders"} = ();
297
+
298
+ $_[0]->Read($buff, 1);
299
+ my $external = ord($buff);
300
+
301
+ if($external == 0x00){
302
+ for (my $i = 0 ; $i < $out_unpackinfo{"numfolders"}; $i++) {
303
+ $et->VPrint(0, "Reading folder $i\n");
304
+ my $folder = ReadFolder($et, $_[0]);
305
+ push(@{ $out_unpackinfo{"folders"} }, $folder);
306
+ }
307
+ }
308
+ return 0 unless RetrieveCodersInfo($et, $_[0], $out_unpackinfo{"folders"});
309
+ return \%out_unpackinfo;
310
+ }
311
+
312
+ sub ReadSubstreamsInfo {
313
+ my $et = shift;
314
+ my $buff;
315
+ my %out_substreamsinfo = ();
316
+ $out_substreamsinfo{"num_unpackstreams_folders"} = ();
317
+
318
+ my $numfolders = $_[1];
319
+ my $folders = $_[2];
320
+
321
+ $_[0]->Read($buff, 1);
322
+ my $pid = ord($buff);
323
+ if($pid == 13){ # num unpack stream
324
+ $et->VPrint(0, "Num unpack stream detected.\n");
325
+ for (my $i = 0 ; $i < $numfolders; $i++) {
326
+ push(@{ $out_substreamsinfo{"num_unpackstreams_folders"} }, ReadUInt64($_[0]));
327
+ }
328
+ $_[0]->Read($buff, 1);
329
+ $pid = ord($buff);
330
+ }
331
+ else{
332
+ @{ $out_substreamsinfo{"num_unpackstreams_folders"} } = (1)x$numfolders;
333
+ }
334
+ if($pid == 9){ # size property
335
+ $et->VPrint(0, "Size property detected.\n");
336
+ $out_substreamsinfo{"unpacksizes"} = ();
337
+ for(my $i=0; $i< scalar(@{ $out_substreamsinfo{"num_unpackstreams_folders"} }); $i++){
338
+ my $totalsize = 0;
339
+ for(my $j=1; $j < @{ $out_substreamsinfo{"num_unpackstreams_folders"} }[$i]; $j++){
340
+ my $size = ReadUInt64($_[0]);
341
+ push(@{ $out_substreamsinfo{"unpacksizes"} }, $size);
342
+ $totalsize += $size;
343
+ }
344
+ # self.unpacksizes.append(folders[i].get_unpack_size() - totalsize)
345
+ }
346
+ $_[0]->Read($buff, 1);
347
+ $pid = ord($buff);
348
+ }
349
+ my $num_digests = 0;
350
+ my $num_digests_total = 0;
351
+ for (my $i = 0 ; $i < $numfolders; $i++) {
352
+ my $numsubstreams = @{ $out_substreamsinfo{"num_unpackstreams_folders"} }[$i];
353
+ if($numsubstreams != 1 or not @{ $folders }[$i]->{"digestdefined"}){
354
+ $num_digests += $numsubstreams;
355
+ }
356
+ $num_digests_total += $numsubstreams;
357
+ }
358
+ $et->VPrint(0, "Num Digests Total: $num_digests_total\n");
359
+ if($pid == 10) { # crc property
360
+ $et->VPrint(0, "CRC property detected.\n");
361
+ my @crcs;
362
+ my @defined = ReadBoolean($_[0], $num_digests, 1);
363
+ foreach my $crcexist (@defined) {
364
+ push(@crcs, ReadUInt32($_[0]));
365
+ }
366
+ $_[0]->Read($buff, 1);
367
+ $pid = ord($buff);
368
+ }
369
+ if($pid != 0x00){ # end id expected
370
+ return 0;
371
+ }
372
+ return \%out_substreamsinfo;
373
+ }
374
+
375
+ sub ReadStreamsInfo {
376
+ my $et = shift;
377
+ my $buff;
378
+ my $unpackinfo;
379
+ my %out_streamsinfo = ();
380
+
381
+ $_[0]->Read($buff, 1);
382
+ my $pid = ord($buff);
383
+ if($pid == 6){ # pack info
384
+ my $packinfo = ReadPackInfo($et, $_[0]);
385
+ return 0 unless $packinfo;
386
+ $out_streamsinfo{"packinfo"} = $packinfo;
387
+ $_[0]->Read($buff, 1);
388
+ $pid = ord($buff);
389
+ }
390
+ if($pid == 7) { # unpack info
391
+ $et->VPrint(0, "Unpack info data detected.\n");
392
+ $unpackinfo = ReadUnpackInfo($et, $_[0]);
393
+ return 0 unless $unpackinfo;
394
+ $out_streamsinfo{"unpackinfo"} = $unpackinfo;
395
+ $_[0]->Read($buff, 1);
396
+ $pid = ord($buff);
397
+ }
398
+ if($pid == 8){ # substreams info
399
+ $et->VPrint(0, "Substreams info data detected.\n");
400
+ my $substreamsinfo = ReadSubstreamsInfo($et, $_[0], $unpackinfo->{"numfolders"}, $unpackinfo->{"folders"});
401
+ return 0 unless $substreamsinfo;
402
+ $out_streamsinfo{"substreamsinfo"} = $substreamsinfo;
403
+ $_[0]->Read($buff, 1);
404
+ $pid = ord($buff);
405
+ }
406
+ if($pid != 0x00){ # end id expected
407
+ $et->VPrint(0, "Invalid PID: $pid\n");
408
+ return 0;
409
+ }
410
+ return \%out_streamsinfo;
411
+ }
412
+
413
+ sub IsNativeCoder {
414
+ my $coder = $_[0];
415
+
416
+ if(ord(substr($coder->{"method"}, 0, 1)) == 3){
417
+ if(ord(substr($coder->{"method"}, 1, 1)) == 1) {
418
+ if(ord(substr($coder->{"method"}, 2, 1)) == 1) {
419
+ return "LZMA";
420
+ }
421
+ }
422
+ }
423
+ elsif(ord(substr($coder->{"method"}, 0, 1)) == 6){
424
+ if(ord(substr($coder->{"method"}, 1, 1)) == 0xf1) {
425
+ if(ord(substr($coder->{"method"}, 2, 1)) == 7) {
426
+ if(ord(substr($coder->{"method"}, 3, 1)) == 1) {
427
+ return "7zAES";
428
+ }
429
+ }
430
+ }
431
+ }
432
+ }
433
+
434
+ sub GetDecompressor {
435
+ my $et = shift;
436
+
437
+ my $folder = $_[0];
438
+ my %out_decompressor = ();
439
+ $out_decompressor{"chain"} = ();
440
+ $out_decompressor{"input_size"} = $_[1];
441
+ $out_decompressor{"_unpacksizes"} = $folder->{"unpacksizes"};
442
+ @{ $out_decompressor{"_unpacked"} } = (0) x scalar(@{ $out_decompressor{"_unpacksizes"} });
443
+ $out_decompressor{"consumed"} = 0;
444
+ $out_decompressor{"block_size"} = 32768;
445
+ $out_decompressor{"_unused"} = [];
446
+
447
+ foreach my $coder (@{ $folder->{"coders"} }) {
448
+ my $algorithm = IsNativeCoder($coder);
449
+ if($algorithm eq "7zAES") {
450
+ $et->Warn("File is encrypted.", 0);
451
+ return 0;
452
+ }
453
+ else{
454
+ push(@{ $out_decompressor{"chain"} }, $algorithm);
455
+ }
456
+ }
457
+
458
+ return \%out_decompressor;
459
+ }
460
+
461
+ sub ReadData {
462
+ my $et = shift;
463
+ my $decompressor = $_[1];
464
+ my $rest_size = $decompressor->{"input_size"} - $decompressor->{"consumed"};
465
+ my $unused_s = scalar(@{ $decompressor->{"_unused"} });
466
+ my $read_size = $rest_size - $unused_s;
467
+ my $data = "";
468
+ if($read_size > $decompressor->{"block_size"} - $unused_s){
469
+ $read_size = $decompressor->{"block_size"} - $unused_s;
470
+ }
471
+ if($read_size > 0){
472
+ $decompressor->{"consumed"} += $_[0]->Read($data, $read_size);
473
+ $et->VPrint(0, "Compressed size: $read_size\n");
474
+ }
475
+ return $data;
476
+ }
477
+
478
+ sub Decompress_Internal {
479
+ my $data = "";
480
+ for(my $i=0; $i < scalar(@{ $_[0]->{"chain"} }); $i++){
481
+ if(@{ $_[0]->{"_unpacked"} }[$i] < @{ $_[0]->{"_unpacksizes"} }[$i]){
482
+ my %opts = ();
483
+ $opts{"Filter"} = Lzma::Filter::Lzma1();
484
+ my ($z, $status) = Compress::Raw::Lzma::RawDecoder->new( %opts );
485
+ $status = $z->code($_[1], $data);
486
+ @{ $_[0]->{"_unpacked"} }[$i] += length($data);
487
+ }
488
+ }
489
+ return $data;
490
+ }
491
+
492
+ sub Decompress {
493
+ my $et = shift;
494
+ my $max_length = $_[1];
495
+ my $data = ReadData($et, $_[0], $_[1]);
496
+ my $tmp = Decompress_Internal($_[1], $data);
497
+ return $tmp;
498
+ }
499
+
500
+ sub ReadName {
501
+ my $numfiles = $_[1];
502
+
503
+ for(my $i=0; $i < $numfiles; $i++){
504
+ @{ $_[2] }[$i]->{"filename"} = ReadUTF16($_[0]);
505
+ }
506
+ }
507
+
508
+ sub ReadTimes {
509
+ my $et = shift;
510
+ my $external;
511
+ my $numfiles = $_[1];
512
+ my $name = $_[2];
513
+
514
+ my @defined = ReadBoolean($_[0], $numfiles, 1);
515
+ $_[0]->Read($external, 1);
516
+ if(ord($external) != 0){
517
+ $et->Warn("Invalid or corrupted file. (ReadTimes)");
518
+ return 0;
519
+ }
520
+
521
+ for(my $i=0; $i < $numfiles; $i++){
522
+ if($defined[$i]){
523
+ my $value = ReadRealUInt64($_[0]);
524
+ $value = $value / 10000000.0 - 11644473600;
525
+ @{ $_[3] }[$i]->{$name} = $value;
526
+ }
527
+ else{
528
+ @{ $_[3] }[$i]->{$name} = undef;
529
+ }
530
+ }
531
+ }
532
+
533
+ sub ReadAttributes {
534
+ my $numfiles = $_[1];
535
+
536
+ for(my $i=0; $i < $numfiles; $i++){
537
+ if($_[2][$i]){
538
+ my $value = ReadUInt32($_[0]);
539
+ @{ $_[3] }[$i]->{"attributes"} = $value >> 8;
540
+ }
541
+ else{
542
+ @{ $_[3] }[$i]->{"attributes"} = undef;
543
+ }
544
+ }
545
+ }
546
+
547
+ sub ReadFilesInfo {
548
+ my $et = shift;
549
+ my $buff;
550
+
551
+ my $numfiles = ReadUInt64($_[0]);
552
+ my @out_files = ();
553
+ for(my $i = 0; $i < $numfiles; $i++){
554
+ my %new_file = ();
555
+ $new_file{"emptystream"} = 0;
556
+ push(@out_files, \%new_file);
557
+ }
558
+ my $numemptystreams = 0;
559
+ $et->VPrint(0, "Number of files: $numfiles\n");
560
+ while(1){
561
+ $_[0]->Read($buff, 1);
562
+ my $prop = ord($buff);
563
+ if($prop == 0){ # end
564
+ return \@out_files;
565
+ }
566
+ my $size = ReadUInt64($_[0]);
567
+ if($prop == 25) { # dummy
568
+ $_[0]->Seek($size, 1);
569
+ next;
570
+ }
571
+ $_[0]->Read($buff, $size);
572
+ my $buffer = new File::RandomAccess(\$buff);
573
+ if($prop == 14){ # empty stream
574
+ my @isempty = ReadBoolean($buffer, $numfiles, 0);
575
+ my $numemptystreams = 0;
576
+ for(my $i = 0; $i < $numfiles; $i++){
577
+ if($isempty[$i] == 0){
578
+ $out_files[$i]->{"emptystream"} = 0;
579
+ }
580
+ else{
581
+ $out_files[$i]->{"emptystream"} = 1;
582
+ $numemptystreams++;
583
+ }
584
+ }
585
+ }
586
+ elsif($prop == 15) { # empty file
587
+
588
+ }
589
+ elsif($prop == 17){ # name
590
+ $et->VPrint(0, "Name prop detected.\n");
591
+ my $external;
592
+ $buffer->Read($external, 1);
593
+ my $is_external = ord($external);
594
+ if($is_external == 0){
595
+ ReadName($buffer, $numfiles, \@out_files);
596
+ }
597
+ }
598
+ elsif($prop == 20){ # last write time
599
+ $et->VPrint(0, "Last write time detected.\n");
600
+ ReadTimes($et, $buffer, $numfiles, "lastwritetime", \@out_files);
601
+ }
602
+ elsif($prop == 21){ # attributes
603
+ $et->VPrint(0, "File attributes detected.\n");
604
+ my $external;
605
+ my @defined = ReadBoolean($buffer, $numfiles, 1);
606
+ $_[0]->Read($external, 1);
607
+ if(ord($external) == 0){
608
+ ReadAttributes($buffer, $numfiles, \@defined, \@out_files);
609
+ }
610
+ else{
611
+ my $dataindex = ReadUINT64($buffer);
612
+ #TODO: try to read external data
613
+ }
614
+ }
615
+ }
616
+ }
617
+
618
+ sub ExtractHeaderInfo {
619
+ my $et = shift;
620
+ my $buff;
621
+ my %out_headerinfo = ();
622
+ $out_headerinfo{"files_info"} = ();
623
+ my $files_info;
624
+
625
+ $_[0]->Read($buff, 1);
626
+ my $pid = ord($buff);
627
+
628
+ if($pid == 0x04){
629
+ my $mainstreams = ReadStreamsInfo($et, $_[0]);
630
+ if($mainstreams == 0){
631
+ $et->Warn("Invalid or corrupted file. (ExtractHeaderInfo)");
632
+ return 0;
633
+ }
634
+ $_[0]->Read($buff, 1);
635
+ $pid = ord($buff);
636
+ }
637
+ if($pid == 0x05){
638
+ $et->VPrint(0, "File info pid reached.\n");
639
+ $files_info = ReadFilesInfo($et, $_[0]);
640
+ push(@{ $out_headerinfo{"files_info"} }, $files_info);
641
+ $_[0]->Read($buff, 1);
642
+ $pid = ord($buff);
643
+ }
644
+ if($pid != 0x00){ # end id expected
645
+ $et->VPrint(0, "Invalid PID: $pid\n");
646
+ return 0;
647
+ }
648
+ return \%out_headerinfo;
649
+ }
650
+
651
+ sub DisplayFiles {
652
+ my $et = shift;
653
+ my $docNum = 0;
654
+ my $tagTablePtr = GetTagTable('Image::ExifTool::ZIP::RAR5');
655
+
656
+ foreach my $currentfile (@{ $_[0] }){
657
+ $$et{DOC_NUM} = ++$docNum;
658
+ $et->HandleTag($tagTablePtr, 'ModifyDate', $currentfile->{"lastwritetime"});
659
+ $et->HandleTag($tagTablePtr, 'ArchivedFileName', $currentfile->{"filename"});
660
+ }
661
+ delete $$et{DOC_NUM};
662
+ if($docNum > 1 and not $et->Options('Duplicates')){
663
+ $et->Warn("Use the Duplicates option to extract tags for all $docNum files", 1);
664
+ }
665
+ }
666
+
667
+ #------------------------------------------------------------------------------
668
+ # Extract information from a 7z file
669
+ # Inputs: 0) ExifTool object reference, 1) dirInfo reference
670
+ # Returns: 1 on success, 0 if this wasn't a valid 7z file
671
+ sub Process7Z($$)
672
+ {
673
+ my ($et, $dirInfo) = @_;
674
+ my $raf = $$dirInfo{RAF};
675
+ my ($flags, $buff);
676
+
677
+ return 0 unless $raf->Read($buff, 6) and $buff eq "7z\xbc\xaf\x27\x1c";
678
+
679
+ $et->SetFileType();
680
+
681
+ $raf->Read($buff, 2);
682
+ my ($major_version, $minor_version) = unpack('cc', $buff);
683
+ my $tagTablePtr = GetTagTable('Image::ExifTool::ZIP::RAR5');
684
+ $et->HandleTag($tagTablePtr, 'FileVersion', sprintf('7z v%d.%.2d',$major_version,$minor_version));
685
+
686
+ $raf->Seek(4, 1); # skip Start Header CRC
687
+
688
+ $raf->Read($buff, 20);
689
+ my ($nextheaderoffset, $nextheadersize) = unpack('QQx', $buff);
690
+ $et->VPrint(0, "NextHeaderOffset: $nextheaderoffset, NextHeaderSize: $nextheadersize\n");
691
+
692
+ $raf->Seek($nextheaderoffset, 1); # going to next header offset
693
+ $raf->Read($buff, 1);
694
+ my $pid = ord($buff);
695
+ if($pid == 1){ # normal header
696
+ $et->VPrint(0,"Normal header detected. trying to decode\n");
697
+ my $headerinfo = ExtractHeaderInfo($et, $raf);
698
+ if($headerinfo == 0){
699
+ $et->Warn("Invalid or corrupted file.");
700
+ return 1;
701
+ }
702
+ DisplayFiles($et, @{ $headerinfo->{"files_info"} });
703
+ }
704
+ elsif($pid == 23){ # encoded header
705
+ unless (eval { require Compress::Raw::Lzma }) {
706
+ $et->Warn("Install Compress::Raw::Lzma to read encoded 7z information");
707
+ return 1;
708
+ }
709
+ $et->VPrint(0, "Encoded Header detected. trying to decode\n");
710
+ my $streamsinfo = ReadStreamsInfo($et, $raf);
711
+ if($streamsinfo == 0){
712
+ $et->Warn("Invalid or corrupted file.");
713
+ return 1;
714
+ }
715
+ my $buffer2 = ();
716
+ foreach my $folder (@{ $streamsinfo->{"unpackinfo"}->{"folders"} }) {
717
+ my @uncompressed = @{ $folder->{"unpacksizes"} };
718
+ my $compressed_size = $streamsinfo->{"packinfo"}->{"packsizes"}[0];
719
+ my $uncompressed_size = @uncompressed[scalar(@uncompressed) - 1];
720
+ my $decomporessor = GetDecompressor($et, $folder, $compressed_size);
721
+ if($decomporessor == 0){
722
+ $et->Warn("Invalid or corrupted file.");
723
+ return 1;
724
+ }
725
+
726
+ my $src_start = 32;
727
+ $src_start += $streamsinfo->{"packinfo"}->{"packpos"};
728
+ $raf->Seek($src_start, 0);
729
+ my $remaining = $uncompressed_size;
730
+ my $folder_data = "";
731
+ while($remaining > 0){
732
+ $folder_data .= Decompress($et, $raf, $decomporessor, $remaining);
733
+ $remaining = $uncompressed_size - length($folder_data);
734
+ }
735
+ $buffer2 = new File::RandomAccess(\$folder_data);
736
+ }
737
+ $buffer2->Seek(0, 0);
738
+ $buffer2->Read($buff, 1);
739
+ $pid = ord($buff);
740
+ if($pid != 0x01){ # header field expected
741
+ return 0;
742
+ }
743
+ my $headerinfo = ExtractHeaderInfo($et, $buffer2);
744
+ if($headerinfo == 0){
745
+ $et->Warn("Invalid or corrupted file.");
746
+ return 1;
747
+ }
748
+ DisplayFiles($et, @{ $headerinfo->{"files_info"} });
749
+ }else{ # Unknown header
750
+ return 0;
751
+ }
752
+
753
+ return 1;
754
+ }
755
+
756
+ 1; # end
757
+
758
+ __END__
759
+
760
+ =head1 NAME
761
+
762
+ Image::ExifTool::7Z - Read 7z archives
763
+
764
+ =head1 SYNOPSIS
765
+
766
+ This module is used by Image::ExifTool
767
+
768
+ =head1 DESCRIPTION
769
+
770
+ This module contains definitions required by Image::ExifTool to extract meta
771
+ information from 7z archives.
772
+
773
+ =head1 AUTHOR
774
+
775
+ Copyright 2023, Amir Gooran
776
+
777
+ This library is free software; you can redistribute it and/or modify it
778
+ under the same terms as Perl itself.
779
+
780
+ =head1 REFERENCES
781
+
782
+ =over 4
783
+
784
+ =item L<https://py7zr.readthedocs.io/en/latest/archive_format.html>
785
+
786
+ =back
787
+
788
+ =head1 SEE ALSO
789
+
790
+ L<Image::ExifTool::TagNames/ZIP RAR5 Tags>
791
+
792
+ =cut
793
+