test_pie/external/exiftool/lib/Image/ExifTool/WTV.pm

320 lines
13 KiB
Perl

#------------------------------------------------------------------------------
# File: WTV.pm
#
# Description: Read WTV meta information
#
# Revisions: 2018-05-30 - P. Harvey Created
#
# References: 1) https://wiki.multimedia.cx/index.php?title=WTV
#------------------------------------------------------------------------------
package Image::ExifTool::WTV;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.00';
sub ProcessMetadata($$$);
my %timeInfo = (
# time looks like 100 ns intervals since 0:00 UTC Jan 1, 0001 (ref PH)
ValueConv => q{ # (719162 days from 0001:01:01 to 1970:01:01)
my $t = $val / 1e7 - 719162*24*3600;
return Image::ExifTool::ConvertUnixTime($t) . 'Z';
},
PrintConv => '$self->ConvertDateTime($val)',
);
my %bool = ( PrintConv => { 0 => 'No', 1 => 'Yes' }, PrintConvColumns => 2 );
# WTV chunks
%Image::ExifTool::WTV::Main = (
GROUPS => { 0 => 'WTV', 1 => 'WTV', 2 => 'Video' },
NOTES => 'Tags found in Windows recorded TV (WTV) videos.',
# 'timeline.table.0.header.Events' (not decoded)
# 'timeline.table.0.entries.Events' (not decoded)
# 'timeline' (not decoded)
# 'table.0.header.legacy_attrib' (not decoded)
'table.0.entries.legacy_attrib' => {
Name => 'Metdata',
SubDirectory => { TagTable => 'Image::ExifTool::WTV::Metadata' },
},
# 'table.0.redirector.legacy_attrib' (not decoded)
# 'table.0.header.time' (not decoded)
# 'table.0.entries.time' (not decoded)
);
# Note: Many of these tags are similar to those found in Image::ExifTool::Microsoft::Xtra
# and Image::ExifTool::ASF::ExtendedDescr
%Image::ExifTool::WTV::Metadata = (
GROUPS => { 0 => 'WTV', 1 => 'WTV', 2 => 'Video' },
PROCESS_PROC => \&ProcessMetadata,
NOTES => 'ExifTool will extract any tag found, even if not in this table.',
VARS => { NO_ID => 1 },
'Duration' => {
Name => 'Duration',
ValueConv => '$val/1e7',
PrintConv => 'ConvertDuration($val)',
},
'Title' => { },
'WM/Genre' => 'Genre',
'WM/Language' => 'Language',
'WM/MediaClassPrimaryID' => 'MediaClassPrimaryID',
'WM/MediaClassSecondaryID' => 'MediaClassSecondaryID',
'WM/MediaCredits' => 'MediaCredits',
'WM/MediaIsDelay' => { Name => 'MediaIsDelay', %bool },
'WM/MediaIsFinale' => { Name => 'MediaIsFinale', %bool },
'WM/MediaIsLive' => { Name => 'MediaIsLive', %bool },
'WM/MediaIsMovie' => { Name => 'MediaIsMovie', %bool },
'WM/MediaIsPremiere' => { Name => 'MediaIsPremiere', %bool },
'WM/MediaIsRepeat' => { Name => 'MediaIsRepeat', %bool },
'WM/MediaIsSAP' => { Name => 'MediaIsSAP', %bool },
'WM/MediaIsSport' => { Name => 'MediaIsSport', %bool },
'WM/MediaIsStereo' => { Name => 'MediaIsStereo', %bool, Groups => { 2 => 'Audio' } },
'WM/MediaIsSubtitled' => { Name => 'MediaIsSubtitled',%bool },
'WM/MediaIsTape' => { Name => 'MediaIsTape', %bool },
'WM/MediaNetworkAffiliation'=> 'MediaNetworkAffiliation',
'WM/MediaOriginalBroadcastDateTime' => {
Name => 'MediaOriginalBroadcastDateTime',
Groups => { 2 => 'Time' },
ValueConv => '$val =~ tr/-T/: /; $val',
PrintConv => '$self->ConvertDateTime($val)',
},
'WM/MediaOriginalChannel' => { Name => 'MediaOriginalChannel' },
'WM/MediaOriginalChannelSubNumber' => { Name => 'MediaOriginalChannelSubNumber' },
'WM/MediaOriginalRunTime' => {
Name => 'MediaOriginalRunTime',
ValueConv => '$val / 1e7',
PrintConv => 'ConvertDuration($val)',
},
'WM/MediaStationCallSign' => 'MediaStationCallSign',
'WM/MediaStationName' => 'MediaStationName',
'WM/MediaThumbAspectRatioX' => 'MediaThumbAspectRatioX',
'WM/MediaThumbAspectRatioY' => 'MediaThumbAspectRatioY',
'WM/MediaThumbHeight' => 'MediaThumbHeight',
'WM/MediaThumbRatingAttributes' => { Name => 'MediaThumbRatingAttributes' },
'WM/MediaThumbRatingLevel' => 'MediaThumbRatingLevel',
'WM/MediaThumbRatingSystem' => 'MediaThumbRatingSystem',
'WM/MediaThumbRet' => 'MediaThumbRet',
'WM/MediaThumbStride' => 'MediaThumbStride',
'WM/MediaThumbTimeStamp' => { Name => 'MediaThumbTimeStamp', Notes => 'unknown units', Unknown => 1 },
'WM/MediaThumbWidth' => 'MediaThumbWidth',
'WM/OriginalReleaseTime' => {
Name => 'OriginalReleaseTime',
Groups => { 2 => 'Time' },
ValueConv => '$val=~tr/-T/: /; $val',
PrintConv => '$self->ConvertDateTime($val)',
},
'WM/ParentalRating' => 'ParentalRating',
'WM/ParentalRatingReason' => 'ParentalRatingReason',
'WM/Provider' => 'Provider',
'WM/ProviderCopyright' => 'ProviderCopyright',
'WM/ProviderRating' => 'ProviderRating',
'WM/SubTitle' => 'Subtitle',
'WM/SubTitleDescription' => 'SubtitleDescription',
'WM/VideoClosedCaptioning' => { Name => 'VideoClosedCaptioning', %bool },
'WM/WMRVATSCContent' => { Name => 'ATSCContent', %bool },
'WM/WMRVActualSoftPostPadding' => 'ActualSoftPostPadding',
'WM/WMRVActualSoftPrePadding' => 'ActualSoftPrePadding',
'WM/WMRVBitrate' => { Name => 'Bitrate', Notes => 'unknown units', Unknown => 1 },
'WM/WMRVBrandingImageID' => 'BrandingImageID',
'WM/WMRVBrandingName' => 'BrandingName',
'WM/WMRVContentProtected' => { Name => 'ContentProtected', %bool },
'WM/WMRVContentProtectedPercent' => 'ContentProtectedPercent',
'WM/WMRVDTVContent' => { Name => 'DTVContent', %bool },
'WM/WMRVEncodeTime' => { Name => 'EncodeTime', Groups => { 2 => 'Time' }, %timeInfo },
'WM/WMRVEndTime' => { Name => 'EndTime', Groups => { 2 => 'Time' }, %timeInfo },
'WM/WMRVExpirationDate' => { Name => 'ExpirationDate', Groups => { 2 => 'Time' }, %timeInfo, Unknown => 1 },
'WM/WMRVExpirationSpan' => { Name => 'ExpirationSpan', Notes => 'unknown units', Unknown => 1 },
'WM/WMRVHDContent' => { Name => 'HDContent', %bool },
'WM/WMRVHardPostPadding' => 'HardPostPadding',
'WM/WMRVHardPrePadding' => 'HardPrePadding',
'WM/WMRVInBandRatingAttributes' => 'InBandRatingAttributes',
'WM/WMRVInBandRatingLevel' => 'InBandRatingLevel',
'WM/WMRVInBandRatingSystem' => 'InBandRatingSystem',
'WM/WMRVKeepUntil' => 'KeepUntil',
'WM/WMRVOriginalSoftPostPadding'=> 'OriginalSoftPostPadding',
'WM/WMRVOriginalSoftPrePadding' => 'OriginalSoftPrePadding',
'WM/WMRVProgramID' => 'ProgramID',
'WM/WMRVQuality' => 'Quality',
'WM/WMRVRequestID' => 'RequestID',
'WM/WMRVScheduleItemID' => 'ScheduleItemID',
'WM/WMRVSeriesUID' => 'SeriesUID',
'WM/WMRVServiceID' => 'ServiceID',
'WM/WMRVWatched' => { Name => 'Watched', %bool },
);
#------------------------------------------------------------------------------
# Read specified sectors from the file
# Inputs: 0) raf ref, 1) sector table ref, 2) offset in sector table, 3) sector size
# Returns: Data or undef on error
sub ReadSectors($$$$)
{
my ($raf, $secPt, $pos, $secSize) = @_;
my ($data, $buff);
while ($pos <= length($$secPt) - 4) {
my $sec = Get32u($secPt, $pos);
return undef if $sec == 0xffff; # (just in case)
last unless $sec; # a null marks the end of the sector table
defined($data) ? ($data .= $buff) : ($data = $buff);
return undef unless $raf->Seek($sec*$secSize,0) and $raf->Read($buff,$secSize) == $secSize;
$pos += 4;
}
return defined($data) ? $data . $buff : $buff;
}
#------------------------------------------------------------------------------
# Process WTV metadata
# Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) tag table ref
# Returns: 1 on success
sub ProcessMetadata($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $pos = 0;
my $end = length $$dataPt;
$et->VerboseDir('WTV Metadata', undef, $end);
while ($pos + 0x18 < $end) {
last unless substr($$dataPt,$pos,16) eq "\x5a\xfe\xd7\x6d\xc8\x1d\x8f\x4a\x99\x22\xfa\xb1\x1c\x38\x14\x53";
my $fmt = Get32u($dataPt, $pos + 0x10);
my $len = Get32u($dataPt, $pos + 0x14);
my $str = '';
$pos += 0x18;
for (;;) {
$pos + 2 > $end and $et->Warn('Corrupt metadata directory'), last;
my $ch = substr($$dataPt, $pos, 2);
$pos += 2;
last if $ch eq "\0\0";
$str .= $ch;
}
last if $pos + $len > $end;
my $tag = $et->Decode($str, 'UCS2', undef, 'UTF8');
my $dat = substr($$dataPt, $pos, $len);
# add tag if not already there
unless ($$tagTablePtr{$tag}) {
my $name = $tag;
$name =~ s{^(WTV_Metadata_)?WM/(WMRV)?}{};
AddTagToTable($tagTablePtr, $tag, $name);
$et->VPrint(0, $$et{INDENT}, "[adding WTV:$name]\n");
}
my $val;
if ($fmt==0 or $fmt==3) { # int32u or boolean32
$val = Get32s(\$dat, 0);
} elsif ($fmt == 1) { # string
$val = $et->Decode($dat, 'UCS2');
} elsif ($fmt == 6) { # GUID
$val = unpack('H*', $dat);
} elsif ($fmt == 4) { # int64u (date/time values use this)
$val = Get64u(\$dat, 0);
} else {
$val = $dat;
$fmt = "Unknown($fmt)";
}
$et->HandleTag($tagTablePtr, $tag, $val,
Format => "format $fmt",
Size => length $dat,
);
$et->VerboseDump(\$dat);
$pos += $len;
}
}
#------------------------------------------------------------------------------
# Extract information from a WTV video
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid WTV file
sub ProcessWTV($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my $verbose = $et->Options('Verbose');
my ($buff, $tagTablePtr, $pos, $len);
# verify this is a valid WTV file
return 0 unless $raf->Read($buff, 0x60) == 0x60;
return 0 unless $buff =~ /^\xb7\xd8\x00\x20\x37\x49\xda\x11\xa6\x4e\x00\x07\xe9\x5e\xad\x8d/;
$et->SetFileType();
SetByteOrder('II');
# 0x28 - int32u: sector size? (=0x1000) (PH NC)
# 0x38 - int32u: sector number for main WTV directory (PH assume this is a sector table, NC)
# 0x58 - int32u: total number of sectors in file
my $secSize = Get32u(\$buff, 0x28);
# in case I'm wrong about this, constrain sector size to
# either 0x1000 (standard) or 0x100 (ExifTool test file) - PH
$secSize = 0x1000 unless $secSize == 0x1000 or $secSize == 0x100;
$buff = ReadSectors($raf, \$buff, 0x38, $secSize); # read the WTV directory
return 0 unless defined $buff;
$tagTablePtr = GetTagTable('Image::ExifTool::WTV::Main');
# parse the WTV directory
$et->VerboseDir('WTV');
for ($pos=0; $pos<length($buff)-0x28; $pos+=$len) {
unless (substr($buff,$pos,0x10) eq "\x92\xb7\x74\x91\x59\x70\x70\x44\x88\xdf\x06\x3b\x82\xcc\x21\x3d") {
$et->Warn("WTV directory wasn't at expected location") unless $pos;
last;
}
$len = Get32u(\$buff, $pos+0x10);
last if $pos + $len > length($buff);
my $n = Get32u(\$buff, $pos + 0x20);
0x28 + $n*2 + 8 > $len and $et->Warn('WTV directory error'), last;
my $tag = $et->Decode(substr($buff,$pos+0x28,$n*2), 'UCS2', undef, 'UTF8');
my $ptr = $pos + 0x28 + $n * 2;
my $flg = Get32u(\$buff, $ptr + 4);
if ($verbose) {
my $s = Get32s(\$buff, $ptr);
$s = sprintf('0x%x', $s) unless $s < 0;
$et->VPrint(1,"- Tag '$tag' (sector=$s, flag=$flg)");
}
next unless $$tagTablePtr{$tag} and ($flg == 0 or $flg == 1);
my $sec = substr($buff, $ptr, 4);
my $data = ReadSectors($raf, \$sec, 0, $secSize);
last unless defined $data;
# read sectors from table if necessary (flag=1 indicates a sector table)
$data = ReadSectors($raf, \$data, 0, $secSize) if $flg == 1;
defined $data or $et->Warn("Error fetching data for $tag"), next;
$et->HandleTag($tagTablePtr, $tag, $data);
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::WTV - Read WTV meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read WTV
(Windows recorded TV show) videos.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<https://wiki.multimedia.cx/index.php?title=WTV>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/WTV Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut