exiftool_vendored 12.62.0 → 12.63.0

Sign up to get free protection for your applications and to get access to all the features.
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
+