File Coverage

blib/lib/Image/ExifTool/ASF.pm
Criterion Covered Total %
statement 165 223 73.9
branch 53 110 48.1
condition 6 11 54.5
subroutine 12 14 85.7
pod 0 9 0.0
total 236 367 64.3


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: ASF.pm
3             #
4             # Description: Read ASF/WMA/WMV meta information
5             #
6             # Revisions: 12/23/2005 - P. Harvey Created
7             #
8             # References: 1) http://www.microsoft.com/windows/windowsmedia/format/asfspec.aspx
9             # 2) http://www.adobe.com/devnet/xmp/pdfs/XMPSpecificationPart3.pdf (Oct 2008)
10             #------------------------------------------------------------------------------
11              
12             package Image::ExifTool::ASF;
13              
14 7     7   4784 use strict;
  7         22  
  7         232  
15 7     7   39 use vars qw($VERSION);
  7         24  
  7         284  
16 7     7   72 use Image::ExifTool qw(:DataAccess :Utils);
  7         17  
  7         1498  
17 7     7   1488 use Image::ExifTool::Exif;
  7         70  
  7         175  
18 7     7   5828 use Image::ExifTool::RIFF;
  7         63  
  7         25137  
19              
20             $VERSION = '1.25';
21              
22             sub ProcessASF($$;$);
23             sub ProcessContentDescription($$$);
24             sub ProcessExtendedContentDescription($$$);
25             sub ProcessMetadata($$$);
26             sub ProcessPicture($$$);
27             sub ProcessCodecList($$$);
28              
29             # GUID definitions
30             my %errorCorrection = (
31             '20FB5700-5B55-11CF-A8FD-00805F5C442B' => 'No Error Correction',
32             'BFC3CD50-618F-11CF-8BB2-00AA00B4E220' => 'Audio Spread',
33             );
34              
35             my %streamType = (
36             'F8699E40-5B4D-11CF-A8FD-00805F5C442B' => 'Audio',
37             'BC19EFC0-5B4D-11CF-A8FD-00805F5C442B' => 'Video',
38             '59DACFC0-59E6-11D0-A3AC-00A0C90348F6' => 'Command',
39             'B61BE100-5B4E-11CF-A8FD-00805F5C442B' => 'JFIF',
40             '35907DE0-E415-11CF-A917-00805F5C442B' => 'Degradable JPEG',
41             '91BD222C-F21C-497A-8B6D-5AA86BFC0185' => 'File Transfer',
42             '3AFB65E2-47EF-40F2-AC2C-70A90D71D343' => 'Binary',
43             );
44              
45             my %mutex = (
46             'D6E22A00-35DA-11D1-9034-00A0C90349BE' => 'MutexLanguage',
47             'D6E22A01-35DA-11D1-9034-00A0C90349BE' => 'MutexBitrate',
48             'D6E22A02-35DA-11D1-9034-00A0C90349BE' => 'MutexUnknown',
49             );
50              
51             my %bandwidthSharing = (
52             'AF6060AA-5197-11D2-B6AF-00C04FD908E9' => 'SharingExclusive',
53             'AF6060AB-5197-11D2-B6AF-00C04FD908E9' => 'SharingPartial',
54             );
55              
56             my %typeSpecific = (
57             '776257D4-C627-41CB-8F81-7AC7FF1C40CC' => 'WebStreamMediaSubtype',
58             'DA1E6B13-8359-4050-B398-388E965BF00C' => 'WebStreamFormat',
59             );
60              
61             my %advancedContentEncryption = (
62             '7A079BB6-DAA4-4e12-A5CA-91D38DC11A8D' => 'DRMNetworkDevices',
63             );
64              
65             # ASF top level objects
66             %Image::ExifTool::ASF::Main = (
67             PROCESS_PROC => \&ProcessASF,
68             NOTES => q{
69             The ASF format is used by Windows WMA and WMV files, and DIVX videos. Tag
70             ID's aren't listed because they are huge 128-bit GUID's that would ruin the
71             formatting of this table.
72             },
73             '75B22630-668E-11CF-A6D9-00AA0062CE6C' => {
74             Name => 'Header',
75             SubDirectory => { TagTable => 'Image::ExifTool::ASF::Header', Size => 6 },
76             },
77             '75B22636-668E-11CF-A6D9-00AA0062CE6C' => 'Data',
78             '33000890-E5B1-11CF-89F4-00A0C90349CB' => 'SimpleIndex',
79             'D6E229D3-35DA-11D1-9034-00A0C90349BE' => 'Index',
80             'FEB103F8-12AD-4C64-840F-2A1D2F7AD48C' => 'MediaIndex',
81             '3CB73FD0-0C4A-4803-953D-EDF7B6228F0C' => 'TimecodeIndex',
82             'BE7ACFCB-97A9-42E8-9C71-999491E3AFAC' => { #2
83             Name => 'XMP',
84             SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
85             },
86             );
87              
88             # ASF header objects
89             %Image::ExifTool::ASF::Header = (
90             PROCESS_PROC => \&ProcessASF,
91             '8CABDCA1-A947-11CF-8EE4-00C00C205365' => {
92             Name => 'FileProperties',
93             SubDirectory => { TagTable => 'Image::ExifTool::ASF::FileProperties' },
94             },
95             'B7DC0791-A9B7-11CF-8EE6-00C00C205365' => {
96             Name => 'StreamProperties',
97             SubDirectory => { TagTable => 'Image::ExifTool::ASF::StreamProperties' },
98             },
99             '5FBF03B5-A92E-11CF-8EE3-00C00C205365' => {
100             Name => 'HeaderExtension',
101             SubDirectory => { TagTable => 'Image::ExifTool::ASF::HeaderExtension', Size => 22 },
102             },
103             '86D15240-311D-11D0-A3A4-00A0C90348F6' => {
104             Name => 'CodecList',
105             SubDirectory => { TagTable => 'Image::ExifTool::ASF::CodecList' },
106             },
107             '1EFB1A30-0B62-11D0-A39B-00A0C90348F6' => 'ScriptCommand',
108             'F487CD01-A951-11CF-8EE6-00C00C205365' => 'Marker',
109             'D6E229DC-35DA-11D1-9034-00A0C90349BE' => 'BitrateMutualExclusion',
110             '75B22635-668E-11CF-A6D9-00AA0062CE6C' => 'ErrorCorrection',
111             '75B22633-668E-11CF-A6D9-00AA0062CE6C' => {
112             Name => 'ContentDescription',
113             SubDirectory => { TagTable => 'Image::ExifTool::ASF::ContentDescr' },
114             },
115             '2211B3FA-BD23-11D2-B4B7-00A0C955FC6E' => {
116             Name => 'ContentBranding',
117             SubDirectory => { TagTable => 'Image::ExifTool::ASF::ContentBranding' },
118             },
119             'D2D0A440-E307-11D2-97F0-00A0C95EA850' => {
120             Name => 'ExtendedContentDescr',
121             SubDirectory => { TagTable => 'Image::ExifTool::ASF::ExtendedDescr' },
122             },
123             '7BF875CE-468D-11D1-8D82-006097C9A2B2' => 'StreamBitrateProps',
124             '2211B3FB-BD23-11D2-B4B7-00A0C955FC6E' => 'ContentEncryption',
125             '298AE614-2622-4C17-B935-DAE07EE9289C' => 'ExtendedContentEncryption',
126             '2211B3FC-BD23-11D2-B4B7-00A0C955FC6E' => 'DigitalSignature',
127             '1806D474-CADF-4509-A4BA-9AABCB96AAE8' => 'Padding',
128             );
129              
130             %Image::ExifTool::ASF::ContentDescr = (
131             PROCESS_PROC => \&ProcessContentDescription,
132             GROUPS => { 2 => 'Video' },
133             0 => 'Title',
134             1 => { Name => 'Author', Groups => { 2 => 'Author' } },
135             2 => { Name => 'Copyright', Groups => { 2 => 'Author' } },
136             3 => 'Description',
137             4 => 'Rating',
138             );
139              
140             %Image::ExifTool::ASF::ContentBranding = (
141             PROCESS_PROC => \&ProcessContentBranding,
142             GROUPS => { 2 => 'Author' },
143             0 => {
144             Name => 'BannerImageType',
145             PrintConv => {
146             0 => 'None',
147             1 => 'Bitmap',
148             2 => 'JPEG',
149             3 => 'GIF',
150             },
151             },
152             1 => { Name => 'BannerImage', Groups => { 2 => 'Preview' }, Binary => 1 },
153             2 => 'BannerImageURL',
154             3 => 'CopyrightURL',
155             );
156              
157             # Note: Many of these tags are similar to those in Image::ExifTool::Microsoft::Xtra
158             # and Image::ExifTool::WTV::Metadata
159             # (tags in this table may have a leading "WM/" removed)
160             %Image::ExifTool::ASF::ExtendedDescr = (
161             PROCESS_PROC => \&ProcessExtendedContentDescription,
162             GROUPS => { 2 => 'Video' },
163             ASFLeakyBucketPairs => { Binary => 1 },
164             AspectRatioX => {},
165             AspectRatioY => {},
166             Author => { Groups => { 2 => 'Author' } },
167             AverageLevel => {},
168             BannerImageData => {},
169             BannerImageType => {},
170             BannerImageURL => {},
171             Bitrate => { PrintConv => 'ConvertBitrate($val)' },
172             Broadcast => {},
173             BufferAverage => {},
174             Can_Skip_Backward => {},
175             Can_Skip_Forward => {},
176             Copyright => { Groups => { 2 => 'Author' } },
177             CopyrightURL => { Groups => { 2 => 'Author' } },
178             CurrentBitrate => { PrintConv => 'ConvertBitrate($val)' },
179             Description => {},
180             DRM_ContentID => {},
181             DRM_DRMHeader_ContentDistributor => {},
182             DRM_DRMHeader_ContentID => {},
183             DRM_DRMHeader_IndividualizedVersion => {},
184             DRM_DRMHeader_KeyID => {},
185             DRM_DRMHeader_LicenseAcqURL => {},
186             DRM_DRMHeader_SubscriptionContentID => {},
187             DRM_DRMHeader => {},
188             DRM_IndividualizedVersion => {},
189             DRM_KeyID => {},
190             DRM_LASignatureCert => {},
191             DRM_LASignatureLicSrvCert => {},
192             DRM_LASignaturePrivKey => {},
193             DRM_LASignatureRootCert => {},
194             DRM_LicenseAcqURL => {},
195             DRM_V1LicenseAcqURL => {},
196             Duration => { PrintConv => 'ConvertDuration($val)' },
197             FileSize => {},
198             HasArbitraryDataStream => {},
199             HasAttachedImages => {},
200             HasAudio => {},
201             HasFileTransferStream => {},
202             HasImage => {},
203             HasScript => {},
204             HasVideo => {},
205             Is_Protected => {},
206             Is_Trusted => {},
207             IsVBR => {},
208             NSC_Address => {},
209             NSC_Description => {},
210             NSC_Email => {},
211             NSC_Name => {},
212             NSC_Phone => {},
213             NumberOfFrames => {},
214             OptimalBitrate => { PrintConv => 'ConvertBitrate($val)' },
215             PeakValue => {},
216             Rating => {},
217             Seekable => {},
218             Signature_Name => {},
219             Stridable => {},
220             Title => {},
221             VBRPeak => {},
222             # "WM/" tags...
223             AlbumArtist => {},
224             AlbumCoverURL => {},
225             AlbumTitle => {},
226             ASFPacketCount => {},
227             ASFSecurityObjectsSize => {},
228             AudioFileURL => {},
229             AudioSourceURL => {},
230             AuthorURL => { Groups => { 2 => 'Author' } },
231             BeatsPerMinute => {},
232             Category => {},
233             Codec => {},
234             Composer => {},
235             Conductor => {},
236             ContainerFormat => {},
237             ContentDistributor => {},
238             ContentGroupDescription => {},
239             Director => {},
240             DRM => {},
241             DVDID => {},
242             EncodedBy => {},
243             EncodingSettings => {},
244             EncodingTime => { Groups => { 2 => 'Time' }, PrintConv => '$self->ConvertDateTime($val)' },
245             Genre => {},
246             GenreID => {},
247             InitialKey => {},
248             ISRC => {},
249             Language => {},
250             Lyrics => {},
251             Lyrics_Synchronised => {},
252             MCDI => {},
253             MediaClassPrimaryID => { ValueConv => 'Image::ExifTool::ASF::GetGUID($val)' },
254             MediaClassSecondaryID => { ValueConv => 'Image::ExifTool::ASF::GetGUID($val)' },
255             MediaCredits => {},
256             MediaIsDelay => {},
257             MediaIsFinale => {},
258             MediaIsLive => {},
259             MediaIsPremiere => {},
260             MediaIsRepeat => {},
261             MediaIsSAP => {},
262             MediaIsStereo => {},
263             MediaIsSubtitled => {},
264             MediaIsTape => {},
265             MediaNetworkAffiliation => {},
266             MediaOriginalBroadcastDateTime => {
267             Groups => { 2 => 'Time' },
268             ValueConv => '$val=~tr/-T/: /; $val',
269             PrintConv => '$self->ConvertDateTime($val)',
270             },
271             MediaOriginalChannel => {},
272             MediaStationCallSign => {},
273             MediaStationName => {},
274             ModifiedBy => {},
275             Mood => {},
276             OriginalAlbumTitle => {},
277             OriginalArtist => {},
278             OriginalFilename => 'OriginalFileName',
279             OriginalLyricist => {},
280             OriginalReleaseTime => {
281             Groups => { 2 => 'Time' },
282             ValueConv => '$val=~tr/-T/: /; $val',
283             PrintConv => '$self->ConvertDateTime($val)',
284             },
285             OriginalReleaseYear => { Groups => { 2 => 'Time' } },
286             ParentalRating => {},
287             ParentalRatingReason => {},
288             PartOfSet => {},
289             PeakBitrate => { PrintConv => 'ConvertBitrate($val)' },
290             Period => {},
291             Picture => {
292             SubDirectory => {
293             TagTable => 'Image::ExifTool::ASF::Picture',
294             },
295             },
296             PlaylistDelay => {},
297             Producer => {},
298             PromotionURL => {},
299             ProtectionType => {},
300             Provider => {},
301             ProviderCopyright => {},
302             ProviderRating => {},
303             ProviderStyle => {},
304             Publisher => {},
305             RadioStationName => {},
306             RadioStationOwner => {},
307             SharedUserRating => {},
308             StreamTypeInfo => {},
309             SubscriptionContentID => {},
310             SubTitle => 'Subtitle',
311             SubTitleDescription => 'SubtitleDescription',
312             Text => {},
313             ToolName => {},
314             ToolVersion => {},
315             Track => {},
316             TrackNumber => {},
317             UniqueFileIdentifier => {},
318             UserWebURL => {},
319             VideoClosedCaptioning => {},
320             VideoFrameRate => {},
321             VideoHeight => {},
322             VideoWidth => {},
323             WMADRCAverageReference => {},
324             WMADRCAverageTarget => {},
325             WMADRCPeakReference => {},
326             WMADRCPeakTarget => {},
327             WMCollectionGroupID => {},
328             WMCollectionID => {},
329             WMContentID => {},
330             Writer => { Groups => { 2 => 'Author' } },
331             Year => { Groups => { 2 => 'Time' } },
332             );
333              
334             %Image::ExifTool::ASF::Picture = (
335             PROCESS_PROC => \&ProcessPicture,
336             GROUPS => { 2 => 'Image' },
337             0 => {
338             Name => 'PictureType',
339             PrintConv => { # (Note: Duplicated in ID3, ASF and FLAC modules!)
340             0 => 'Other',
341             1 => '32x32 PNG Icon',
342             2 => 'Other Icon',
343             3 => 'Front Cover',
344             4 => 'Back Cover',
345             5 => 'Leaflet',
346             6 => 'Media',
347             7 => 'Lead Artist',
348             8 => 'Artist',
349             9 => 'Conductor',
350             10 => 'Band',
351             11 => 'Composer',
352             12 => 'Lyricist',
353             13 => 'Recording Studio or Location',
354             14 => 'Recording Session',
355             15 => 'Performance',
356             16 => 'Capture from Movie or Video',
357             17 => 'Bright(ly) Colored Fish',
358             18 => 'Illustration',
359             19 => 'Band Logo',
360             20 => 'Publisher Logo',
361             },
362             },
363             1 => 'PictureMIMEType',
364             2 => 'PictureDescription',
365             3 => {
366             Name => 'Picture',
367             Groups => { 2 => 'Preview' },
368             Binary => 1,
369             },
370             );
371              
372             %Image::ExifTool::ASF::FileProperties = (
373             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
374             GROUPS => { 2 => 'Video' },
375             0 => {
376             Name => 'FileID',
377             Format => 'binary[16]',
378             ValueConv => 'Image::ExifTool::ASF::GetGUID($val)',
379             },
380             16 => { Name => 'FileLength', Format => 'int64u' },
381             24 => {
382             Name => 'CreationDate',
383             Format => 'int64u',
384             Groups => { 2 => 'Time' },
385             # time is in 100 ns intervals since 0:00 UTC Jan 1, 1601
386             ValueConv => q{ # (89 leap years between 1601 and 1970)
387             my $t = $val / 1e7 - (((1970-1601)*365+89)*24*3600);
388             return Image::ExifTool::ConvertUnixTime($t) . 'Z';
389             },
390             PrintConv => '$self->ConvertDateTime($val)',
391             },
392             32 => { Name => 'DataPackets', Format => 'int64u' },
393             40 => {
394             Name => 'Duration',
395             Format => 'int64u',
396             Notes => 'called PlayDuration by the ASF spec',
397             Priority => 0,
398             ValueConv => '$val / 1e7',
399             PrintConv => 'ConvertDuration($val)',
400             },
401             48 => {
402             Name => 'SendDuration',
403             Format => 'int64u',
404             ValueConv => '$val / 1e7',
405             PrintConv => 'ConvertDuration($val)',
406             },
407             56 => { Name => 'Preroll', Format => 'int64u' },
408             64 => { Name => 'Flags', Format => 'int32u' },
409             68 => { Name => 'MinPacketSize',Format => 'int32u' },
410             72 => { Name => 'MaxPacketSize',Format => 'int32u' },
411             76 => { Name => 'MaxBitrate', Format => 'int32u', PrintConv => 'ConvertBitrate($val)' },
412             );
413              
414             %Image::ExifTool::ASF::StreamProperties = (
415             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
416             GROUPS => { 2 => 'Video' },
417             NOTES => 'Tags with index 54 and greater are conditional based on the StreamType.',
418             0 => {
419             Name => 'StreamType',
420             Format => 'binary[16]',
421             RawConv => sub { # set ASF_STREAM_TYPE for use in conditional tags
422             my ($val, $et) = @_;
423             $$et{ASF_STREAM_TYPE} = $streamType{GetGUID($val)} || '';
424             return $val;
425             },
426             ValueConv => 'Image::ExifTool::ASF::GetGUID($val)',
427             PrintConv => \%streamType,
428             },
429             16 => {
430             Name => 'ErrorCorrectionType',
431             Format => 'binary[16]',
432             ValueConv => 'Image::ExifTool::ASF::GetGUID($val)',
433             PrintConv => \%errorCorrection,
434             },
435             32 => {
436             Name => 'TimeOffset',
437             Format => 'int64u',
438             ValueConv => '$val / 1e7',
439             PrintConv => '"$val s"',
440             },
441             48 => {
442             Name => 'StreamNumber',
443             Format => 'int16u',
444             PrintConv => '($val & 0x7f) . ($val & 0x8000 ? " (encrypted)" : "")',
445             },
446             54 => [
447             {
448             Condition => '$self->{ASF_STREAM_TYPE} eq "Audio"',
449             Name => 'AudioCodecID',
450             Format => 'int16u',
451             PrintHex => 1,
452             SeparateTable => 'RIFF AudioEncoding',
453             PrintConv => \%Image::ExifTool::RIFF::audioEncoding,
454             },
455             {
456             Condition => '$self->{ASF_STREAM_TYPE} =~ /^(Video|JFIF|Degradable JPEG)$/',
457             Name => 'ImageWidth',
458             Format => 'int32u',
459             },
460             ],
461             56 => {
462             Condition => '$self->{ASF_STREAM_TYPE} eq "Audio"',
463             Name => 'AudioChannels',
464             Format => 'int16u',
465             },
466             58 => [
467             {
468             Condition => '$self->{ASF_STREAM_TYPE} eq "Audio"',
469             Name => 'AudioSampleRate',
470             Format => 'int32u',
471             },
472             {
473             Condition => '$self->{ASF_STREAM_TYPE} =~ /^(Video|JFIF|Degradable JPEG)$/',
474             Name => 'ImageHeight',
475             Format => 'int32u',
476             },
477             ],
478             );
479              
480             %Image::ExifTool::ASF::HeaderExtension = (
481             PROCESS_PROC => \&ProcessASF,
482             '14E6A5CB-C672-4332-8399-A96952065B5A' => 'ExtendedStreamProps',
483             'A08649CF-4775-4670-8A16-6E35357566CD' => 'AdvancedMutualExcl',
484             'D1465A40-5A79-4338-B71B-E36B8FD6C249' => 'GroupMutualExclusion',
485             'D4FED15B-88D3-454F-81F0-ED5C45999E24' => 'StreamPrioritization',
486             'A69609E6-517B-11D2-B6AF-00C04FD908E9' => 'BandwidthSharing',
487             '7C4346A9-EFE0-4BFC-B229-393EDE415C85' => 'LanguageList',
488             'C5F8CBEA-5BAF-4877-8467-AA8C44FA4CCA' => {
489             Name => 'Metadata',
490             SubDirectory => {
491             # have seen some tags same as ExtendedDescr, so use this table - PH
492             TagTable => 'Image::ExifTool::ASF::ExtendedDescr',
493             ProcessProc => \&ProcessMetadata,
494             },
495             },
496             '44231C94-9498-49D1-A141-1D134E457054' => {
497             Name => 'MetadataLibrary',
498             SubDirectory => {
499             # have seen some tags same as ExtendedDescr, so use this table - PH
500             TagTable => 'Image::ExifTool::ASF::ExtendedDescr',
501             ProcessProc => \&ProcessMetadata,
502             },
503             },
504             'D6E229DF-35DA-11D1-9034-00A0C90349BE' => 'IndexParameters',
505             '6B203BAD-3F11-48E4-ACA8-D7613DE2CFA7' => 'TimecodeIndexParms',
506             '75B22630-668E-11CF-A6D9-00AA0062CE6C' => 'Compatibility',
507             '43058533-6981-49E6-9B74-AD12CB86D58C' => 'AdvancedContentEncryption',
508             'ABD3D211-A9BA-11cf-8EE6-00C00C205365' => 'Reserved1',
509             );
510              
511             %Image::ExifTool::ASF::CodecList = (
512             PROCESS_PROC => \&ProcessCodecList,
513             VideoCodecName => {},
514             VideoCodecDescription => {},
515             AudioCodecName => {},
516             AudioCodecDescription => {},
517             OtherCodecName => {},
518             OtherCodecDescription => {},
519             );
520              
521             #------------------------------------------------------------------------------
522             # Generate GUID from 16 bytes of binary data
523             # Inputs: 0) data
524             # Returns: GUID
525             sub GetGUID($)
526             {
527             # must do some byte swapping
528 50     50 0 164 my $val = shift;
529 50 50       216 return $val unless length($val) == 16;
530 50         372 my $buff = unpack('H*',pack('NnnNN',unpack('VvvNN',$val)));
531 50         666 $buff =~ s/(.{8})(.{4})(.{4})(.{4})/$1-$2-$3-$4-/;
532 50         261 return uc($buff);
533             }
534              
535             #------------------------------------------------------------------------------
536             # Process ASF content description
537             # Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
538             # Returns: 1 on success
539             sub ProcessContentDescription($$$)
540             {
541 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
542 0         0 my $dataPt = $$dirInfo{DataPt};
543 0         0 my $dirLen = $$dirInfo{DirLen};
544 0 0       0 return 0 if $dirLen < 10;
545 0         0 my @len = unpack('v5', $$dataPt);
546 0         0 my $pos = 10;
547 0         0 my $tag;
548 0         0 foreach $tag (0..4) {
549 0         0 my $len = shift @len;
550 0 0       0 next unless $len;
551 0 0       0 return 0 if $pos + $len > $dirLen;
552 0         0 my $val = $et->Decode(substr($$dataPt,$pos,$len),'UCS2','II');
553 0         0 $et->HandleTag($tagTablePtr, $tag, $val);
554 0         0 $pos += $len;
555             }
556 0         0 return 1;
557             }
558              
559             #------------------------------------------------------------------------------
560             # Process ASF content branding
561             # Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
562             # Returns: 1 on success
563             sub ProcessContentBranding($$$)
564             {
565 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
566 0         0 my $dataPt = $$dirInfo{DataPt};
567 0         0 my $dirLen = $$dirInfo{DirLen};
568 0 0       0 return 0 if $dirLen < 40;
569             # decode banner image type
570 0         0 $et->HandleTag($tagTablePtr, 0, unpack('V', $$dataPt));
571             # decode banner image, banner URL and copyright URL
572 0         0 my $pos = 4;
573 0         0 my $tag;
574 0         0 foreach $tag (1..3) {
575 0 0       0 return 0 if $pos + 4 > $dirLen;
576 0         0 my $size = unpack("x${pos}V", $$dataPt);
577 0         0 $pos += 4;
578 0 0       0 next unless $size;
579 0 0       0 return 0 if $pos + $size > $dirLen;
580 0         0 my $val = substr($$dataPt, $pos, $size);
581 0         0 $et->HandleTag($tagTablePtr, $tag, $val);
582 0         0 $pos += $size;
583             }
584 0         0 return 1;
585             }
586              
587             #------------------------------------------------------------------------------
588             # Read ASF value
589             # Inputs: 0) ExifTool object ref, 1) data reference, 2) value offset,
590             # 3) format number, 4) size
591             # Returns: converted value
592             sub ReadASF($$$$$)
593             {
594 19     19 0 39 my ($et, $dataPt, $pos, $format, $size) = @_;
595 19         27 my @vals;
596 19 100       55 if ($format == 0) { # unicode string
    100          
    100          
    50          
    50          
597 8         30 $vals[0] = $et->Decode(substr($$dataPt,$pos,$size),'UCS2','II');
598             } elsif ($format == 2) { # 4-byte boolean
599 3         9 @vals = ReadValue($dataPt, $pos, 'int32u', undef, $size);
600 3         7 foreach (@vals) {
601 3 100       12 $_ = $_ ? 'True' : 'False';
602             }
603             } elsif ($format == 3) { # int32u
604 4         10 @vals = ReadValue($dataPt, $pos, 'int32u', undef, $size);
605             } elsif ($format == 4) { # int64u
606 0         0 @vals = ReadValue($dataPt, $pos, 'int64u', undef, $size);
607             } elsif ($format == 5) { # int16u
608 0         0 @vals = ReadValue($dataPt, $pos, 'int16u', undef, $size);
609             } else { # any other format (including 1, byte array): return raw data
610 4         29 $vals[0] = substr($$dataPt,$pos,$size);
611             }
612 19         75 return join ' ', @vals;
613             }
614              
615             #------------------------------------------------------------------------------
616             # Process extended content description
617             # Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
618             # Returns: 1 on success
619             sub ProcessExtendedContentDescription($$$)
620             {
621 1     1 0 5 my ($et, $dirInfo, $tagTablePtr) = @_;
622 1         3 my $dataPt = $$dirInfo{DataPt};
623 1         3 my $dirLen = $$dirInfo{DirLen};
624 1 50       4 return 0 if $dirLen < 2;
625 1         4 my $count = Get16u($dataPt, 0);
626 1         8 $et->VerboseDir($dirInfo, $count);
627 1         1 my $pos = 2;
628 1         3 my $i;
629 1         17 for ($i=0; $i<$count; ++$i) {
630 11 50       29 return 0 if $pos + 6 > $dirLen;
631 11         33 my $nameLen = unpack("x${pos}v", $$dataPt);
632 11         19 $pos += 2;
633 11 50       27 return 0 if $pos + $nameLen + 4 > $dirLen;
634 11         51 my $tag = Image::ExifTool::Decode(undef,substr($$dataPt,$pos,$nameLen),'UCS2','II','Latin');
635 11         32 $tag =~ s/^WM\///; # remove leading "WM/"
636 11         18 $pos += $nameLen;
637 11         35 my ($dType, $dLen) = unpack("x${pos}v2", $$dataPt);
638 11         18 $pos += 4;
639 11 50       25 return 0 if $pos + $dLen > $dirLen;
640 11         24 my $val = ReadASF($et,$dataPt,$pos,$dType,$dLen);
641 11         44 $et->HandleTag($tagTablePtr, $tag, $val,
642             DataPt => $dataPt,
643             Start => $pos,
644             Size => $dLen,
645             );
646 11         30 $pos += $dLen;
647             }
648 1         4 return 1;
649             }
650              
651             #------------------------------------------------------------------------------
652             # Process ASF metadata library (similar to ProcessExtendedContentDescription above)
653             # Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
654             # Returns: 1 on success
655             sub ProcessMetadata($$$)
656             {
657 2     2 0 11 my ($et, $dirInfo, $tagTablePtr) = @_;
658 2         5 my $dataPt = $$dirInfo{DataPt};
659 2         3 my $dirLen = $$dirInfo{DirLen};
660 2 50       7 return 0 if $dirLen < 2;
661 2         5 my $count = Get16u($dataPt, 0);
662 2         9 $et->VerboseDir($dirInfo, $count);
663 2         4 my $pos = 2;
664 2         4 my $i;
665 2         27 for ($i=0; $i<$count; ++$i) {
666 8 50       20 return 0 if $pos + 12 > $dirLen;
667 8         32 my ($index, $stream, $nameLen, $dType, $dLen) = unpack("x${pos}v4V", $$dataPt);
668 8         14 $pos += 12;
669 8 50       19 return 0 if $pos + $nameLen + $dLen > $dirLen;
670 8         27 my $tag = Image::ExifTool::Decode(undef,substr($$dataPt,$pos,$nameLen),'UCS2','II','Latin');
671 8         24 $tag =~ s/^WM\///; # remove leading "WM/"
672 8         14 $pos += $nameLen;
673 8         20 my $val = ReadASF($et,$dataPt,$pos,$dType,$dLen);
674 8         31 $et->HandleTag($tagTablePtr, $tag, $val,
675             DataPt => $dataPt,
676             Start => $pos,
677             Size => $dLen,
678             );
679 8         23 $pos += $dLen;
680             }
681 2         6 return 1;
682             }
683              
684             #------------------------------------------------------------------------------
685             # Process WM/Picture preview
686             # Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
687             # Returns: 1 on success
688             sub ProcessPicture($$$)
689             {
690 1     1 0 3 my ($et, $dirInfo, $tagTablePtr) = @_;
691 1         4 my $dataPt = $$dirInfo{DataPt};
692 1         3 my $dirStart = $$dirInfo{DirStart};
693 1         3 my $dirLen = $$dirInfo{DirLen};
694 1 50       4 return 0 unless $dirLen > 9;
695             # extract picture type and length
696 1         7 my ($type, $picLen) = unpack("x${dirStart}CV", $$dataPt);
697 1         6 $et->VerboseDir('Picture');
698 1         11 $et->HandleTag($tagTablePtr, 0, $type);
699             # extract mime type and description strings (null-terminated unicode strings)
700 1         3 my $n = $dirLen - 5 - $picLen;
701 1 50 33     20 return 0 if $n & 0x01 or $n < 4;
702 1         5 my $str = substr($$dataPt, $dirStart+5, $n);
703 1 50       9 if ($str =~ /^((?:..)*?)\0\0((?:..)*?)\0\0/s) {
704 1         6 my ($mime, $desc) = ($1, $2);
705 1         4 $et->HandleTag($tagTablePtr, 1, $et->Decode($mime,'UCS2','II'));
706 1 50       4 $et->HandleTag($tagTablePtr, 2, $et->Decode($desc,'UCS2','II')) if length $desc;
707             }
708 1         6 $et->HandleTag($tagTablePtr, 3, substr($$dataPt, $dirStart+5+$n, $picLen));
709 1         5 return 1;
710             }
711              
712             #------------------------------------------------------------------------------
713             # Process codec list
714             # Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
715             # Returns: 1 on success
716             sub ProcessCodecList($$$)
717             {
718 1     1 0 4 my ($et, $dirInfo, $tagTablePtr) = @_;
719 1         3 my $dataPt = $$dirInfo{DataPt};
720 1         14 my $dirLen = $$dirInfo{DirLen};
721 1 50       6 return 0 if $dirLen < 20;
722 1         4 my $count = Get32u($dataPt, 16);
723 1         6 $et->VerboseDir($dirInfo, $count);
724 1         3 my $pos = 20;
725 1         3 my $i;
726 1         5 my %codecType = ( 1 => 'Video', 2 => 'Audio' );
727 1         5 for ($i=0; $i<$count; ++$i) {
728 2 50       6 return 0 if $pos + 8 > $dirLen;
729 2   50     7 my $type = ($codecType{Get16u($dataPt, $pos)} || 'Other') . 'Codec';
730             # stupid Windows programmers: these lengths are in characters (others are in bytes)
731 2         7 my $nameLen = Get16u($dataPt, $pos + 2) * 2;
732 2         5 $pos += 4;
733 2 50       6 return 0 if $pos + $nameLen + 2 > $dirLen;
734 2         8 my $name = $et->Decode(substr($$dataPt,$pos,$nameLen),'UCS2','II');
735 2         11 $et->HandleTag($tagTablePtr, "${type}Name", $name);
736 2         8 my $descLen = Get16u($dataPt, $pos + $nameLen) * 2;
737 2         5 $pos += $nameLen + 2;
738 2 50       7 return 0 if $pos + $descLen + 2 > $dirLen;
739 2         19 my $desc = $et->Decode(substr($$dataPt,$pos,$descLen),'UCS2','II');
740 2         10 $et->HandleTag($tagTablePtr, "${type}Description", $desc);
741 2         7 my $infoLen = Get16u($dataPt, $pos + $descLen);
742 2         9 $pos += $descLen + 2 + $infoLen;
743             }
744 1         4 return 1;
745             }
746              
747             #------------------------------------------------------------------------------
748             # Extract information from a ASF file
749             # Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) tag table ref
750             # Returns: 1 on success, 0 if this wasn't a valid ASF file
751             sub ProcessASF($$;$)
752             {
753 1     1 0 3 my ($et, $dirInfo, $tagTablePtr) = @_;
754 1         11 my $raf = $$dirInfo{RAF};
755 1         5 my $verbose = $et->Options('Verbose');
756 1         2 my $rtnVal = 0;
757 1         3 my $pos = 0;
758 1         2 my ($buff, $err, @parentTable, @childEnd);
759              
760 1         2 for (;;) {
761 17 100       54 last unless $raf->Read($buff, 24) == 24;
762 16         26 $pos += 24;
763 16         52 my $tag = GetGUID(substr($buff,0,16));
764 16 100       41 unless ($tagTablePtr) {
765             # verify this is a valid ASF file
766 1 50       10 last unless $tag eq '75B22630-668E-11CF-A6D9-00AA0062CE6C';
767 1         5 my $fileType = $$et{FILE_EXT};
768 1 50 33     11 $fileType = 'ASF' unless $fileType and $fileType =~ /^(ASF|WMV|WMA|DIVX)$/;
769 1         6 $et->SetFileType($fileType);
770 1         4 SetByteOrder('II');
771 1         4 $tagTablePtr = GetTagTable('Image::ExifTool::ASF::Main');
772 1         4 $rtnVal = 1;
773             }
774 16         59 my $size = Image::ExifTool::Get64u(\$buff, 16) - 24;
775 16 50       43 if ($size < 0) {
776 0         0 $err = 'Invalid ASF object size';
777 0         0 last;
778             }
779 16 50       32 if ($size > 0x7fffffff) {
780 0 0       0 if ($size > 0x7fffffff * 4294967296) {
    0          
781 0         0 $err = 'Invalid ASF object size';
782             } elsif ($et->Options('LargeFileSupport')) {
783 0 0       0 if ($raf->Seek($size, 1)) {
784 0         0 $et->VPrint(0, " Skipped large ASF object ($size bytes)\n");
785 0         0 $pos += $size;
786 0         0 next;
787             }
788 0         0 $err = 'Error seeking past large ASF object';
789             } else {
790 0         0 $err = 'Large ASF objects not supported (LargeFileSupport not set)';
791             }
792 0         0 last;
793             }
794             # go back to parent tag table if done with previous children
795 16 100 100     90 if (@childEnd and $pos >= $childEnd[-1]) {
796 1         3 pop @childEnd;
797 1         2 $tagTablePtr = pop @parentTable;
798 1         5 $$et{INDENT} = substr($$et{INDENT},0,-2);
799             }
800 16         51 my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
801 16 50       46 $verbose and $et->VerboseInfo($tag, $tagInfo);
802 16 100       39 if ($tagInfo) {
803 13         27 my $subdir = $$tagInfo{SubDirectory};
804 13 100       30 if ($subdir) {
805 9         26 my $subTable = GetTagTable($$subdir{TagTable});
806 9 100       50 if ($$subTable{PROCESS_PROC} eq \&ProcessASF) {
    50          
807 2 50       10 if (defined $$subdir{Size}) {
808 2         5 my $s = $$subdir{Size};
809 2 50       14 if ($verbose > 2) {
    50          
810 0 0       0 $raf->Read($buff, $s) == $s or $err = 'Truncated file', last;
811 0         0 $et->VerboseDump(\$buff);
812             } elsif (not $raf->Seek($s, 1)) {
813 0         0 $err = 'Seek error';
814 0         0 last;
815             }
816             # continue processing linearly using subTable
817 2         5 push @parentTable, $tagTablePtr;
818 2         5 push @childEnd, $pos + $size;
819 2         6 $tagTablePtr = $subTable;
820 2         5 $pos += $$subdir{Size};
821 2 50       6 if ($verbose) {
822 0         0 $$et{INDENT} .= '| ';
823 0         0 $et->VerboseDir($$tagInfo{Name});
824             }
825 2         9 next;
826             }
827             } elsif ($raf->Read($buff, $size) == $size) {
828             my %subdirInfo = (
829             DataPt => \$buff,
830             DirStart => 0,
831             DirLen => $size,
832             DirName => $$tagInfo{Name},
833 7         37 );
834 7 50       19 $et->VerboseDump(\$buff) if $verbose > 2;
835 7 50       30 unless ($et->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc})) {
836 0         0 $et->Warn("Error processing $$tagInfo{Name} directory");
837             }
838 7         17 $pos += $size;
839 7         22 next;
840             } else {
841 0         0 $err = 'Unexpected end of file';
842 0         0 last;
843             }
844             }
845             }
846 7 50       37 if ($verbose > 2) {
    50          
847 0 0       0 $raf->Read($buff, $size) == $size or $err = 'Truncated file', last;
848 0         0 $et->VerboseDump(\$buff);
849             } elsif (not $raf->Seek($size, 1)) { # skip the block
850 0         0 $err = 'Seek error';
851 0         0 last;
852             }
853 7         19 $pos += $size;
854             }
855 1 50       4 $err and $et->Warn($err);
856 1         6 return $rtnVal;
857             }
858              
859             1; # end
860              
861             __END__