/usr/share/perl5/Image/ExifTool/WriteQuickTime.pl is in libimage-exiftool-perl 10.40-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 | #------------------------------------------------------------------------------
# File: WriteQuickTime.pl
#
# Description: Write XMP to QuickTime (MOV and MP4) files
#
# Revisions: 2013-10-29 - P. Harvey Created
#------------------------------------------------------------------------------
package Image::ExifTool::QuickTime;
use strict;
# map for adding directories to QuickTime-format files
my %movMap = (
# MOV (no 'ftyp', or 'ftyp'='qt ') -> 'moov'-'udta'-'XMP_'
XMP => 'UserData',
UserData => 'Movie',
Movie => 'MOV',
);
my %mp4Map = (
# MP4 ('ftyp' compatible brand 'mp41', 'mp42' or 'f4v ') -> top level 'uuid'
XMP => 'MOV',
);
my %dirMap = (
MOV => \%movMap,
MP4 => \%mp4Map,
);
#------------------------------------------------------------------------------
# Check to see if path is current
# Inputs: 0) ExifTool object ref, 1) directory name
# Returns: true if current path is the root of the specified directory
sub IsCurPath($$)
{
local $_;
my ($et, $dir) = @_;
$dir = $$et{DirMap}{$dir} and $dir eq $_ or last foreach reverse @{$$et{PATH}};
return($dir and $dir eq 'MOV');
}
#------------------------------------------------------------------------------
# Write a series of QuickTime atoms from file or in memory
# Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
# Returns: A) if dirInfo contains DataPt: new directory data
# B) otherwise: true on success, 0 if a write error occurred
# (true but sets an Error on a file format error)
sub WriteQuickTime($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my ($foundMDAT, @hold, $track);
my $outfile = $$dirInfo{OutFile} or return 0;
my $raf = $$dirInfo{RAF};
my $dataPt = $$dirInfo{DataPt};
my $dirName = $$dirInfo{DirName};
my $parent = $$dirInfo{Parent};
my $addDirs = $$et{ADD_DIRS};
my $rtnVal = 1;
if ($dataPt) {
$raf = new File::RandomAccess($dataPt);
my $outBuff = '';
$outfile = \$outBuff;
} else {
return 0 unless $raf;
}
for (;;) {
my ($hdr, $buff);
my $n = $raf->Read($hdr, 8);
unless ($n == 8) {
if ($n == 4 and $hdr eq "\0\0\0\0") {
# "for historical reasons" the udta is optionally terminated by 4 zeros (ref 1)
# --> hold this terminator to the end
push @hold, $hdr;
} elsif ($n != 0) {
$et->Error('File format error');
}
last;
}
my ($size, $tag) = unpack('Na4', $hdr);
if ($size >= 8) {
$size -= 8;
} elsif ($size == 1) {
# read the extended size
$raf->Read($buff, 8) == 8 or $et->Error('Truncated extended atom'), last;
$hdr .= $buff;
my ($hi, $lo) = unpack('NN', $buff);
$size = $hi * 4294967296 + $lo - 16;
$size < 0 and $et->Error('Invalid extended atom size'), last;
} elsif (not $size and not $dataPt) {
# size of zero is only valid for top-level atom, and
# indicates the atom extends to the end of file
if (not $raf->{FILE_PT}) {
# get file size from image in memory
$size = length ${$$raf{BUFF_PT}};
} else {
$size = -s $$raf{FILE_PT};
}
if ($size and ($size -= $raf->Tell()) >= 0 and $size <= 0x7fffffff) {
Set32u($size + 8, \$hdr, 0);
} elsif (@hold) {
$et->Error("Sorry, can't yet add tags to this type of QuickTime file");
return $rtnVal;
} else {
# blindly copy the rest of the file
Write($outfile, $hdr) or $rtnVal = 0;
while ($raf->Read($buff, 65536)) {
Write($outfile, $buff) or $rtnVal = 0, last;
}
return $rtnVal;
}
} else {
$et->Error('Invalid atom size');
last;
}
# set flag if we have passed the 'mdat' atom
$foundMDAT = 1 if $tag eq 'mdat';
# rewrite this atom
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
if (defined $tagInfo and not $tagInfo) {
my $n = $size < 256 ? $size : 256;
unless ($raf->Read($buff, $n) == $n and $raf->Seek(-$n, 1)) {
$et->Error("Read/seek error in $tag atom");
last;
}
$tagInfo = $et->GetTagInfo($tagTablePtr, $tag, \$buff);
}
if ($tagInfo) {
if ($$tagInfo{Unknown}) {
undef $tagInfo;
} elsif ($size > 100000000) {
# limit maximum size of atom that we load into memory
my $mb = $size / 0x100000;
$et->Warn("Not editing metadata in $tag atom. $mb MB is too big");
undef $tagInfo;
}
}
if ($tagInfo) {
# read the atom data
$raf->Read($buff, $size) == $size or $et->Error("Error reading $tag data"), last;
my $subdir = $$tagInfo{SubDirectory};
my $newData;
if ($subdir) {
my $subName = $$subdir{DirName} || $$tagInfo{Name};
my $start = $$subdir{Start} || 0;
my $base = ($$dirInfo{Base} || 0) + $raf->Tell() - $size;
my $dPos = 0;
my $hdrLen = $start;
if ($$subdir{Base}) {
my $localBase = eval $$subdir{Base};
$dPos -= $localBase;
$base -= $dPos;
# get length of header before base offset
$hdrLen -= $localBase if $localBase <= $hdrLen;
}
my %subdirInfo = (
Parent => $dirName,
DirName => $subName,
DataPt => \$buff,
DataLen => $size,
DataPos => $dPos,
DirStart => $start,
DirLen => $size - $start,
Base => $base,
HasData => $$subdir{HasData}, # necessary?
Multi => $$subdir{Multi}, # necessary?
OutFile => $outfile,
);
# pass the header pointer if necessary (for EXIF IFD's
# where the Base offset is at the end of the header)
if ($hdrLen and $hdrLen < $size) {
my $header = substr($buff,0,$hdrLen);
$subdirInfo{HeaderPtr} = \$header;
}
SetByteOrder('II') if $$subdir{ByteOrder} and $$subdir{ByteOrder} =~ /^Little/;
my $oldWriteGroup = $$et{CUR_WRITE_GROUP};
if ($subName eq 'Track') {
$track or $track = 0;
$$et{CUR_WRITE_GROUP} = 'Track' . (++$track);
}
my $subTable = GetTagTable($$subdir{TagTable});
# demote non-QuickTime errors to warnings
$$et{DemoteErrors} = 1 unless $$subTable{GROUPS}{0} eq 'QuickTime';
my $oldChanged = $$et{CHANGED};
$newData = $et->WriteDirectory(\%subdirInfo, $subTable);
if ($$et{DemoteErrors}) {
# just copy existing subdirectory a non-quicktime error occurred
$$et{CHANGED} = $oldChanged if $$et{DemoteErrors} > 1;
delete $$et{DemoteErrors};
}
undef $newData if $$et{CHANGED} == $oldChanged; # don't change unless necessary
$$et{CUR_WRITE_GROUP} = $oldWriteGroup;
SetByteOrder('MM');
# add back header if necessary
if ($start and defined $newData and length $newData) {
$newData = substr($buff,0,$start) . $newData;
}
# the directory exists, so we don't need to add it
delete $$addDirs{$subName} if IsCurPath($et, $subName);
} else {
# --> this is where individual QuickTime tags would be edited,
# (this is such a can of worms, so don't implement this for now)
}
if (defined $newData) {
my $len = length $newData;
$len > 0x7ffffff7 and $et->Error("$tag to large to write"), last;
if ($len == $size or $dataPt or $foundMDAT) {
# write the updated directory now
Write($outfile, Set32u($len+8), $tag, $newData) or $rtnVal = 0, last;
next;
} else {
# bad things happen if 'mdat' atom is moved (eg. Adobe Bridge crashes --
# there must be some absolute offsets somewhere that point into mdat),
# so hold this atom and write it out later
if ($len) {
push @hold, Set32u($len+8), $tag, $newData;
$et->VPrint(0," Moving '$tag' atom to after 'mdat'");
} else {
$et->VPrint(0," Freeing '$tag' atom (and zeroing data)");
}
# write a 'free' atom here to keep 'mdat' at the same offset
substr($hdr, 4, 4) = 'free';
$buff = "\0" x length($buff); # zero out old data
}
}
# write out the existing atom (or 'free' padding)
Write($outfile, $hdr, $buff) or $rtnVal = 0, last;
} else {
# write the unknown/large atom header
Write($outfile, $hdr) or $rtnVal = 0, last;
next unless $size;
# copy the atom data
my $result = Image::ExifTool::CopyBlock($raf, $outfile, $size);
defined $result or $rtnVal = 0, last;
$result or $et->Error("Truncated $tag atom"), last;
}
}
# add new directories at this level if necessary
if (exists $$et{EDIT_DIRS}{$dirName}) {
# get a hash of tagInfo references to add to this directory
my $dirs = $et->GetAddDirHash($tagTablePtr, $dirName);
# make sorted list of new tags to be added
my @addTags = sort keys(%$dirs);
my $tag;
foreach $tag (@addTags) {
my $tagInfo = $$dirs{$tag};
my $subdir = $$tagInfo{SubDirectory} or next;
my $subName = $$subdir{DirName} || $$tagInfo{Name};
# QuickTime hierarchy is complex, so check full directory path before adding
next unless IsCurPath($et, $subName);
my $buff = ''; # write from scratch
my %subdirInfo = (
Parent => $dirName,
DirName => $subName,
DataPt => \$buff,
DirStart => 0,
OutFile => $outfile,
);
my $subTable = GetTagTable($$subdir{TagTable});
my $newData = $et->WriteDirectory(\%subdirInfo, $subTable);
if ($newData and length($newData) <= 0x7ffffff7) {
my $uuid = '';
# add atom ID if necessary (obtain from Condition expression)
if ($$subdir{Start}) {
my $cond = $$tagInfo{Condition};
$uuid = eval qq("$1") if $cond and $cond =~ m{=~\s*\/\^(.*)/};
length($uuid) == $$subdir{Start} or $et->Error('Internal UUID error');
}
my $newHdr = Set32u(8+length($newData)+length($uuid)) . $tag . $uuid;
Write($outfile, $newHdr, $newData) or $rtnVal = 0;
}
delete $$addDirs{$subName}; # add only once (must delete _after_ call to WriteDirectory())
}
}
# write out any atoms that we are holding until the end
Write($outfile, @hold) or $rtnVal = 0 if @hold;
# issue minor error if we didn't find an 'mdat' atom
# (we could duplicate atoms indefinitely through repeated editing if we
# held back some atoms here, so in this case it isn't a minor error)
$dataPt or $foundMDAT or $et->Error('No mdat atom found', @hold ? 0 : 1);
return $dataPt ? ($rtnVal ? $$outfile : undef) : $rtnVal;
}
#------------------------------------------------------------------------------
# Write QuickTime-format MOV/MP4 file
# Inputs: 0) ExifTool ref, 1) dirInfo ref
# Returns: 1 on success, 0 if this wasn't a valid QuickTime file,
# or -1 if a write error occurred
sub WriteMOV($$)
{
my ($et, $dirInfo) = @_;
$et or return 1;
my $raf = $$dirInfo{RAF} or return 0;
my ($buff, $ftype);
# read the first atom header
return 0 unless $raf->Read($buff, 8) == 8;
my ($size, $tag) = unpack('Na4', $buff);
return 0 if $size < 8 and $size != 1;
# validate the file format
my $tagTablePtr = GetTagTable('Image::ExifTool::QuickTime::Main');
return 0 unless $$tagTablePtr{$tag};
# determine the file type
if ($tag eq 'ftyp' and $size >= 12 and $size < 100000 and
$raf->Read($buff, $size-8) == $size-8 and
$buff !~ /^(....)+(qt )/s)
{
# file is MP4 format if 'ftyp' exists without 'qt ' as a compatible brand
$ftype = 'MP4';
} else {
$ftype = 'MOV';
}
$et->SetFileType($ftype); # need to set "FileType" tag for a Condition
$et->InitWriteDirs($dirMap{$ftype}, 'XMP');
$$et{DirMap} = $dirMap{$ftype}; # need access to directory map when writing
SetByteOrder('MM');
$raf->Seek(0,0);
# write the file
$$dirInfo{Parent} = '';
$$dirInfo{DirName} = 'MOV';
return WriteQuickTime($et, $dirInfo, $tagTablePtr) ? 1 : -1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::WriteQuickTime.pl - Write XMP to QuickTime (MOV and MP4) files
=head1 SYNOPSIS
These routines are autoloaded by Image::ExifTool::QuickTime.
=head1 DESCRIPTION
This file contains routines used by ExifTool to write XMP metadata to
QuickTime-based file formats like MOV and MP4.
=head1 AUTHOR
Copyright 2003-2017, 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 SEE ALSO
L<Image::ExifTool::QuickTime(3pm)|Image::ExifTool::QuickTime>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut
|