summaryrefslogtreecommitdiffstats
path: root/build/macosx/universal/unify
diff options
context:
space:
mode:
authorMatt A. Tobin <mattatobin@localhost.localdomain>2018-02-02 04:16:08 -0500
committerMatt A. Tobin <mattatobin@localhost.localdomain>2018-02-02 04:16:08 -0500
commit5f8de423f190bbb79a62f804151bc24824fa32d8 (patch)
tree10027f336435511475e392454359edea8e25895d /build/macosx/universal/unify
parent49ee0794b5d912db1f95dce6eb52d781dc210db5 (diff)
downloadUXP-5f8de423f190bbb79a62f804151bc24824fa32d8.tar
UXP-5f8de423f190bbb79a62f804151bc24824fa32d8.tar.gz
UXP-5f8de423f190bbb79a62f804151bc24824fa32d8.tar.lz
UXP-5f8de423f190bbb79a62f804151bc24824fa32d8.tar.xz
UXP-5f8de423f190bbb79a62f804151bc24824fa32d8.zip
Add m-esr52 at 52.6.0
Diffstat (limited to 'build/macosx/universal/unify')
-rwxr-xr-xbuild/macosx/universal/unify1525
1 files changed, 1525 insertions, 0 deletions
diff --git a/build/macosx/universal/unify b/build/macosx/universal/unify
new file mode 100755
index 000000000..38dd35414
--- /dev/null
+++ b/build/macosx/universal/unify
@@ -0,0 +1,1525 @@
+#!/usr/bin/perl
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+use strict;
+use warnings;
+
+=pod
+
+=head1 NAME
+
+B<unify> - Mac OS X universal binary packager
+
+=head1 SYNOPSIS
+
+B<unify>
+I<ppc-path>
+I<x86-path>
+I<universal-path>
+[B<--dry-run>]
+[B<--only-one> I<action>]
+[B<--verbosity> I<level>]
+[B<--unify-with-sort> I<regex>]
+
+=head1 DESCRIPTION
+
+I<unify> merges any two architecture-specific files or directory trees
+into a single file or tree suitable for use on either architecture as a
+"fat" or "universal binary."
+
+Architecture-specific Mach-O files will be merged into fat Mach-O files
+using L<lipo(1)>. Non-Mach-O files in the architecture-specific trees
+are compared to ensure that they are equivalent before copying. Symbolic
+links are permitted in the architecture-specific trees and will cause
+identical links to be created in the merged tree, provided that the source
+links have identical targets. Directories are processed recursively.
+
+If the architecture-specific source trees contain zip archives (including
+jar files) that are not identical according to a byte-for-byte check, they
+are still assumed to be equivalent if both archives contain exactly the
+same members with identical checksums and sizes.
+
+Behavior when one architecture-specific tree contains files that the other
+does not is controlled by the B<--only-one> option.
+
+If Mach-O files cannot be merged using L<lipo(1)>, zip archives are not
+equivalent, regular files are not identical, or any other error occurs,
+B<unify> will fail with an exit status of 1. Diagnostic messages are
+typically printed to stderr; this behavior can be controlled with the
+B<--verbosity> option.
+
+=head1 OPTIONS
+
+=over 5
+
+=item I<ppc-path>
+
+=item I<x86-path>
+
+The paths to directory trees containing PowerPC and x86 builds,
+respectively. I<ppc-path> and I<x86-path> are permitted to contain files
+that are already "fat," and only the appropriate architecture's images will
+be used.
+
+I<ppc-path> and I<x86-path> are also permitted to both be files, in which
+case B<unify> operates solely on those files, and produces an appropriate
+merged file at I<target-path>.
+
+=item I<target-path>
+
+The path to the merged file or directory tree. This path will be created,
+and it must not exist prior to running B<unify>.
+
+=item B<--dry-run>
+
+When specified, the commands that would be executed are printed, without
+actually executing them. Note that B<--dry-run> and the equivalent
+B<--verbosity> level during "wet" runs may print equivalent commands when
+no commands are in fact executed: certain operations are handled internally
+within B<unify>, and an approximation of a command that performs a similar
+task is printed.
+
+=item B<--only-one> I<action>
+
+Controls handling of files that are only present in one of the two source
+trees. I<action> may be:
+ skip - These files are skipped.
+ copy - These files are copied from the tree in which they exist.
+ fail - When this condition occurs, it is treated as an error.
+
+The default I<action> is copy.
+
+=item B<--verbosity> I<level>
+
+Adjusts the level of loudness of B<unify>. The possible values for
+I<level> are:
+ 0 - B<unify> never prints anything.
+ (Other programs that B<unify> calls may still print messages.)
+ 1 - Fatal error messages are printed to stderr.
+ 2 - Nonfatal warnings are printed to stderr.
+ 3 - Commands are printed to stdout as they are executed.
+
+The default I<level> is 2.
+
+=item B<--unify-with-sort> I<regex>
+
+Allows merging files matching I<regex> that differ only by the ordering
+of the lines contained within them. The unified file will have its contents
+sorted. This option may be given multiple times to specify multiple
+regexes for matching files.
+
+=back
+
+=head1 EXAMPLES
+
+=over 5
+
+=item Create a universal .app bundle from two architecture-specific .app
+bundles:
+
+unify --only-one copy ppc/dist/firefox/Firefox.app
+ x86/dist/firefox/Firefox.app universal/Firefox.app
+ --verbosity 3
+
+=item Merge two identical architecture-specific trees:
+
+unify --only-one fail /usr/local /nfs/x86/usr/local
+ /tmp/usrlocal.fat
+
+=back
+
+=head1 REQUIREMENTS
+
+The only esoteric requirement of B<unify> is that the L<lipo(1)> command
+be available. It is present on Mac OS X systems at least as early as
+10.3.9, and probably earlier. Mac OS X 10.4 ("Tiger") or later are
+recommended.
+
+=head1 LICENSE
+
+MPL 2.
+
+=head1 AUTHOR
+
+The software was initially written by Mark Mentovai; copyright 2006
+Google Inc.
+
+=head1 SEE ALSO
+
+L<cmp(1)>, L<ditto(1)>, L<lipo(1)>
+
+=cut
+
+use Archive::Zip(':ERROR_CODES');
+use Errno;
+use Fcntl;
+use File::Compare;
+use File::Copy;
+use Getopt::Long;
+
+my (%gConfig, $gDryRun, $gOnlyOne, $gVerbosity, @gSortMatches);
+
+sub argumentEscape(@);
+sub command(@);
+sub compareZipArchives($$);
+sub complain($$@);
+sub copyIfIdentical($$$);
+sub slurp($);
+sub get_sorted($);
+sub compare_sorted($$);
+sub copyIfIdenticalWhenSorted($$$);
+sub createUniqueFile($$);
+sub makeUniversal($$$);
+sub makeUniversalDirectory($$$);
+sub makeUniversalInternal($$$$);
+sub makeUniversalFile($$$);
+sub usage();
+sub readZipCRCs($);
+
+{
+ package FileAttrCache;
+
+ sub new($$);
+
+ sub isFat($);
+ sub isMachO($);
+ sub isZip($);
+ sub lIsDir($);
+ sub lIsExecutable($);
+ sub lIsRegularFile($);
+ sub lIsSymLink($);
+ sub lstat($);
+ sub lstatMode($);
+ sub lstatType($);
+ sub magic($);
+ sub magic2($);
+ sub path($);
+ sub stat($);
+ sub statSize($);
+}
+
+%gConfig = (
+ 'cmd_lipo' => 'lipo',
+ 'cmd_rm' => 'rm',
+);
+
+$gDryRun = 0;
+$gOnlyOne = 'copy';
+$gVerbosity = 2;
+@gSortMatches = ();
+
+Getopt::Long::Configure('pass_through');
+GetOptions('dry-run' => \$gDryRun,
+ 'only-one=s' => \$gOnlyOne,
+ 'verbosity=i' => \$gVerbosity,
+ 'unify-with-sort=s' => \@gSortMatches,
+ 'config=s' => \%gConfig); # "hidden" option not in usage()
+
+if (scalar(@ARGV) != 3 || $gVerbosity < 0 || $gVerbosity > 3 ||
+ ($gOnlyOne ne 'skip' && $gOnlyOne ne 'copy' && $gOnlyOne ne 'fail')) {
+ usage();
+ exit(1);
+}
+
+if (!makeUniversal($ARGV[0],$ARGV[1],$ARGV[2])) {
+ # makeUniversal or something it called will have printed an error.
+ exit(1);
+}
+
+exit(0);
+
+# argumentEscape(@arguments)
+#
+# Takes a list of @arguments and makes them shell-safe.
+sub argumentEscape(@) {
+ my (@arguments);
+ @arguments = @_;
+
+ my ($argument, @argumentsOut);
+ foreach $argument (@arguments) {
+ $argument =~ s%([^A-Za-z0-9_\-/.=+,])%\\$1%g;
+ push(@argumentsOut, $argument);
+ }
+
+ return @argumentsOut;
+}
+
+# command(@arguments)
+#
+# Runs the specified command by calling system(@arguments). If $gDryRun
+# is true, the command is printed but not executed, and 0 is returned.
+# if $gVerbosity is greater than 1, the command is printed before being
+# executed. When the command is executed, the system() return value will
+# be returned. stdout and stderr are left connected for command output.
+sub command(@) {
+ my (@arguments);
+ @arguments = @_;
+ if ($gVerbosity >= 3 || $gDryRun) {
+ print(join(' ', argumentEscape(@arguments))."\n");
+ }
+ if ($gDryRun) {
+ return 0;
+ }
+ return system(@arguments);
+}
+
+# compareZipArchives($zip1, $zip2)
+#
+# Given two pathnames to zip archives, determines whether or not they are
+# functionally identical. Returns true if they are, false if they differ in
+# some substantial way, and undef if an error occurs. If the zip files
+# differ, diagnostic messages are printed indicating how they differ.
+#
+# Zip files will differ if any of the members are different as defined by
+# readZipCRCs, which consider CRCs, sizes, and file types as stored in the
+# file header. Timestamps are not considered. Zip files also differ if one
+# file contains members that the other one does not. $gOnlyOne has no
+# effect on this behavior.
+sub compareZipArchives($$) {
+ my ($zip1, $zip2);
+ ($zip1, $zip2) = @_;
+
+ my ($CRCHash1, $CRCHash2);
+ if (!defined($CRCHash1 = readZipCRCs($zip1))) {
+ # readZipCRCs printed an error.
+ return undef;
+ }
+ if (!defined($CRCHash2 = readZipCRCs($zip2))) {
+ # readZipCRCs printed an error.
+ return undef;
+ }
+
+ my (@diffCRCs, @onlyInZip1);
+ @diffCRCs = ();
+ @onlyInZip1 = ();
+
+ my ($memberName);
+ foreach $memberName (keys(%$CRCHash1)) {
+ if (!exists($$CRCHash2{$memberName})) {
+ # The member is present in $zip1 but not $zip2.
+ push(@onlyInZip1, $memberName);
+ }
+ elsif ($$CRCHash1{$memberName} ne $$CRCHash2{$memberName}) {
+ # The member is present in both archives but its CRC or some other
+ # other critical attribute isn't identical.
+ push(@diffCRCs, $memberName);
+ }
+ delete($$CRCHash2{$memberName});
+ }
+
+ # If any members remain in %CRCHash2, it's because they're not present
+ # in $zip1.
+ my (@onlyInZip2);
+ @onlyInZip2 = keys(%$CRCHash2);
+
+ if (scalar(@onlyInZip1) + scalar(@onlyInZip2) + scalar(@diffCRCs)) {
+ complain(1, 'compareZipArchives: zip archives differ:',
+ $zip1,
+ $zip2);
+ if (scalar(@onlyInZip1)) {
+ complain(1, 'compareZipArchives: members only in former:',
+ @onlyInZip1);
+ }
+ if (scalar(@onlyInZip2)) {
+ complain(1, 'compareZipArchives: members only in latter:',
+ @onlyInZip2);
+ }
+ if (scalar(@diffCRCs)) {
+ complain(1, 'compareZipArchives: members differ:',
+ @diffCRCs);
+ }
+ return 0;
+ }
+
+ return 1;
+}
+
+# complain($severity, $message, @list)
+#
+# Prints $message to stderr if $gVerbosity allows it for severity level
+# $severity. @list is a list of words that will be shell-escaped and printed
+# after $message, one per line, intended to be used, for example, to list
+# arguments to a call that failed.
+#
+# Expected severity levels are 1 for hard errors and 2 for non-fatal warnings.
+#
+# Always returns false as a convenience, so callers can return complain's
+# return value when it is used to signal errors.
+sub complain($$@) {
+ my ($severity, $message, @list);
+ ($severity, $message, @list) = @_;
+
+ if ($gVerbosity >= $severity) {
+ print STDERR ($0.': '.$message."\n");
+
+ my ($item);
+ while ($item = shift(@list)) {
+ print STDERR (' '.(argumentEscape($item))[0].
+ (scalar(@list)?',':'')."\n");
+ }
+ }
+
+ return 0;
+}
+
+# copyIfIdentical($source1, $source2, $target)
+#
+# $source1 and $source2 are FileAttrCache objects that are compared, and if
+# identical, copied to path string $target. The comparison is initially
+# done as a byte-for-byte comparison, but if the files differ and appear to
+# be zip archives, compareZipArchives is called to determine whether
+# files that are not byte-for-byte identical are equivalent archives.
+#
+# Returns true on success, false for files that are not identical or
+# equivalent archives, and undef if an error occurs.
+#
+# One of $source1 and $source2 is permitted to be undef. In this event,
+# whichever source is defined is copied directly to $target without performing
+# any comparisons. This enables the $gOnlyOne = 'copy' mode, which is
+# driven by makeUniversalDirectory and makeUniversalInternal.
+sub copyIfIdentical($$$) {
+ my ($source1, $source2, $target);
+ ($source1, $source2, $target) = @_;
+
+ if (!defined($source1)) {
+ # If there's only one source file, make it the first file. Order
+ # isn't important here, and this makes it possible to use
+ # defined($source2) as the switch, and to always copy from $source1.
+ $source1 = $source2;
+ $source2 = undef;
+ }
+
+ if (defined($source2)) {
+ # Only do the comparisons if there are two source files. If there's
+ # only one source file, skip the comparisons and go straight to the
+ # copy operation.
+ if ($gVerbosity >= 3 || $gDryRun) {
+ print('cmp -s '.
+ join(' ',argumentEscape($source1->path(), $source2->path()))."\n");
+ }
+ my ($comparison);
+ if (!defined($comparison = compare($source1->path(), $source2->path())) ||
+ $comparison == -1) {
+ return complain(1, 'copyIfIdentical: compare: '.$!.' while comparing:',
+ $source1->path(),
+ $source2->path());
+ }
+ elsif ($comparison != 0) {
+ my ($zip1, $zip2);
+ if (defined($zip1 = $source1->isZip()) &&
+ defined($zip2 = $source2->isZip()) &&
+ $zip1 && $zip2) {
+ my ($zipComparison);
+ if (!defined($zipComparison = compareZipArchives($source1->path(),
+ $source2->path)) ||
+ !$zipComparison) {
+ # An error occurred or the zip files aren't sufficiently identical.
+ # compareZipArchives will have printed an error message.
+ return 0;
+ }
+ # The zip files were compared successfully, and they both contain
+ # all of the same members, and all of their members' CRCs are
+ # identical. For the purposes of this script, the zip files can be
+ # treated as identical, so reset $comparison.
+ $comparison = 0;
+ }
+ }
+ if ($comparison != 0) {
+ return complain(1, 'copyIfIdentical: files differ:',
+ $source1->path(),
+ $source2->path());
+ }
+ }
+
+ if ($gVerbosity >= 3 || $gDryRun) {
+ print('cp '.
+ join(' ',argumentEscape($source1->path(), $target))."\n");
+ }
+
+ if (!$gDryRun) {
+ my ($isExecutable);
+
+ # Set the execute bits (as allowed by the umask) on the new file if any
+ # execute bit is set on either old file.
+ $isExecutable = $source1->lIsExecutable() ||
+ (defined($source2) && $source2->lIsExecutable());
+
+ if (!createUniqueFile($target, $isExecutable ? 0777 : 0666)) {
+ # createUniqueFile printed an error.
+ return 0;
+ }
+
+ if (!copy($source1->path(), $target)) {
+ complain(1, 'copyIfIdentical: copy: '.$!.' while copying',
+ $source1->path(),
+ $target);
+ unlink($target);
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+# slurp($file)
+#
+# Read the contents of $file into an array and return it.
+# Returns undef on error.
+sub slurp($) {
+ my $file = $_[0];
+ open FILE, $file or return undef;
+ my @lines = <FILE>;
+ close FILE;
+ return @lines;
+}
+
+# get_sorted($file)
+# Get the sorted lines of a file as a list, normalizing a newline on the last line if necessary.
+sub get_sorted($) {
+ my ($file) = @_;
+ my @lines = slurp($file);
+ my $lastline = $lines[-1];
+ if (!($lastline =~ /\n/)) {
+ $lines[-1] = $lastline . "\n";
+ }
+ return sort(@lines);
+}
+
+# compare_sorted($file1, $file2)
+#
+# Read the contents of both files into arrays, sort the arrays,
+# and then compare the two arrays for equality.
+#
+# Returns 0 if the sorted array contents are equal, or 1 if not.
+# Returns undef on error.
+sub compare_sorted($$) {
+ my ($file1, $file2) = @_;
+ my @lines1 = get_sorted($file1);
+ my @lines2 = get_sorted($file2);
+
+ return undef if !@lines1 || !@lines2;
+ return 1 unless scalar @lines1 == scalar @lines2;
+
+ for (my $i = 0; $i < scalar @lines1; $i++) {
+ return 1 if $lines1[$i] ne $lines2[$i];
+ }
+ return 0;
+}
+
+# copyIfIdenticalWhenSorted($source1, $source2, $target)
+#
+# $source1 and $source2 are FileAttrCache objects that are compared, and if
+# identical, copied to path string $target. The comparison is done by
+# sorting the individual lines within the two files and comparing the results.
+#
+# Returns true on success, false for files that are not equivalent,
+# and undef if an error occurs.
+sub copyIfIdenticalWhenSorted($$$) {
+ my ($source1, $source2, $target);
+ ($source1, $source2, $target) = @_;
+
+ if ($gVerbosity >= 3 || $gDryRun) {
+ print('cmp -s '.
+ join(' ',argumentEscape($source1->path(), $source2->path()))."\n");
+ }
+ my ($comparison);
+ if (!defined($comparison = compare_sorted($source1->path(),
+ $source2->path())) ||
+ $comparison == -1) {
+ return complain(1, 'copyIfIdenticalWhenSorted: compare: '.$!
+ .' while comparing:',
+ $source1->path(),
+ $source2->path());
+ }
+ if ($comparison != 0) {
+ return complain(1, 'copyIfIdenticalWhenSorted: files differ:',
+ $source1->path(),
+ $source2->path());
+ }
+
+ if ($gVerbosity >= 3 || $gDryRun) {
+ print('cp '.
+ join(' ',argumentEscape($source1->path(), $target))."\n");
+ }
+
+ if (!$gDryRun) {
+ my ($isExecutable);
+
+ # Set the execute bits (as allowed by the umask) on the new file if any
+ # execute bit is set on either old file.
+ $isExecutable = $source1->lIsExecutable() ||
+ (defined($source2) && $source2->lIsExecutable());
+
+ if (!createUniqueFile($target, $isExecutable ? 0777 : 0666)) {
+ # createUniqueFile printed an error.
+ return 0;
+ }
+
+ if (!copy($source1->path(), $target)) {
+ complain(1, 'copyIfIdenticalWhenSorted: copy: '.$!
+ .' while copying',
+ $source1->path(),
+ $target);
+ unlink($target);
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+# createUniqueFile($path, $mode)
+#
+# Creates a new plain empty file at pathname $path, provided it does not
+# yet exist. $mode is used as the file mode. The actual file's mode will
+# be modified by the effective umask. Returns false if the file could
+# not be created, setting $! to the error. An error message is printed
+# in the event of failure.
+sub createUniqueFile($$) {
+ my ($path, $mode);
+ ($path, $mode) = @_;
+
+ my ($fh);
+ if (!sysopen($fh, $path, O_WRONLY | O_CREAT | O_EXCL, $mode)) {
+ return complain(1, 'createUniqueFile: open: '.$!.' for:',
+ $path);
+ }
+ close($fh);
+
+ return 1;
+}
+
+# makeUniversal($pathPPC, $pathX86, $pathTarget)
+#
+# The top-level call. $pathPPC, $pathX86, and $pathTarget are strings
+# identifying the ppc and x86 files or directories to merge and the location
+# to merge them to. Returns false on failure and true on success.
+sub makeUniversal($$$) {
+ my ($pathTarget, $pathPPC, $pathX86);
+ ($pathPPC, $pathX86, $pathTarget) = @_;
+
+ my ($filePPC, $fileX86);
+ $filePPC = FileAttrCache->new($pathPPC);
+ $fileX86 = FileAttrCache->new($pathX86);
+
+ return makeUniversalInternal(1, $filePPC, $fileX86, $pathTarget);
+}
+
+# makeUniversalDirectory($dirPPC, $dirX86, $dirTarget)
+#
+# This is part of the heart of recursion. $dirPPC and $dirX86 are
+# FileAttrCache objects designating the source ppc and x86 directories to
+# merge into a universal directory at $dirTarget, a string. For each file
+# in $dirPPC and $dirX86, makeUniversalInternal is called.
+# makeUniversalInternal will call back into makeUniversalDirectory for
+# directories, thus completing the recursion. If a failure is encountered
+# in ths function or in makeUniversalInternal or anything that it calls,
+# false is returned, otherwise, true is returned.
+#
+# If there are files present in one source directory but not both, the
+# value of $gOnlyOne controls the behavior. If $gOnlyOne is 'copy', the
+# single source file is copied into $pathTarget. If it is 'skip', it is
+# skipped. If it is 'fail', such files will trigger makeUniversalDirectory
+# to fail.
+#
+# If either source directory is undef, it is treated as having no files.
+# This facilitates deep recursion when entire directories are only present
+# in one source when $gOnlyOne = 'copy'.
+sub makeUniversalDirectory($$$) {
+ my ($dirPPC, $dirX86, $dirTarget);
+ ($dirPPC, $dirX86, $dirTarget) = @_;
+
+ my ($dh, @filesPPC, @filesX86);
+
+ @filesPPC = ();
+ if (defined($dirPPC)) {
+ if (!opendir($dh, $dirPPC->path())) {
+ return complain(1, 'makeUniversalDirectory: opendir ppc: '.$!.' for:',
+ $dirPPC->path());
+ }
+ @filesPPC = readdir($dh);
+ closedir($dh);
+ }
+
+ @filesX86 = ();
+ if (defined($dirX86)) {
+ if (!opendir($dh, $dirX86->path())) {
+ return complain(1, 'makeUniversalDirectory: opendir x86: '.$!.' for:',
+ $dirX86->path());
+ }
+ @filesX86 = readdir($dh);
+ closedir($dh);
+ }
+
+ my (%common, $file, %onlyPPC, %onlyX86);
+
+ %onlyPPC = ();
+ foreach $file (@filesPPC) {
+ if ($file eq '.' || $file eq '..') {
+ next;
+ }
+ $onlyPPC{$file}=1;
+ }
+
+ %common = ();
+ %onlyX86 = ();
+ foreach $file (@filesX86) {
+ if ($file eq '.' || $file eq '..') {
+ next;
+ }
+ if ($onlyPPC{$file}) {
+ delete $onlyPPC{$file};
+ $common{$file}=1;
+ }
+ else {
+ $onlyX86{$file}=1;
+ }
+ }
+
+ # First, handle files common to both.
+ foreach $file (sort(keys(%common))) {
+ if (!makeUniversalInternal(0,
+ FileAttrCache->new($dirPPC->path().'/'.$file),
+ FileAttrCache->new($dirX86->path().'/'.$file),
+ $dirTarget.'/'.$file)) {
+ # makeUniversalInternal will have printed an error.
+ return 0;
+ }
+ }
+
+ # Handle files found only in a single directory here. There are three
+ # options, dictated by $gOnlyOne: fail if files are only present in
+ # one directory, skip any files only present in one directory, or copy
+ # these files straight over to the target directory. In any event,
+ # a message will be printed indicating that the file trees don't match
+ # exactly.
+ if (keys(%onlyPPC)) {
+ complain(($gOnlyOne eq 'fail' ? 1 : 2),
+ ($gOnlyOne ne 'fail' ? 'warning: ' : '').
+ 'makeUniversalDirectory: only in ppc '.
+ (argumentEscape($dirPPC->path()))[0].':',
+ argumentEscape(keys(%onlyPPC)));
+ }
+
+ if (keys(%onlyX86)) {
+ complain(($gOnlyOne eq 'fail' ? 1 : 2),
+ ($gOnlyOne ne 'fail' ? 'warning: ' : '').
+ 'makeUniversalDirectory: only in x86 '.
+ (argumentEscape($dirX86->path()))[0].':',
+ argumentEscape(keys(%onlyX86)));
+ }
+
+ if ($gOnlyOne eq 'fail' && (keys(%onlyPPC) || keys(%onlyX86))) {
+ # Error message(s) printed above.
+ return 0;
+ }
+
+ if ($gOnlyOne eq 'copy') {
+ foreach $file (sort(keys(%onlyPPC))) {
+ if (!makeUniversalInternal(0,
+ FileAttrCache->new($dirPPC->path().'/'.$file),
+ undef,
+ $dirTarget.'/'.$file)) {
+ # makeUniversalInternal will have printed an error.
+ return 0;
+ }
+ }
+
+ foreach $file (sort(keys(%onlyX86))) {
+ if (!makeUniversalInternal(0,
+ undef,
+ FileAttrCache->new($dirX86->path().'/'.$file),
+ $dirTarget.'/'.$file)) {
+ # makeUniversalInternal will have printed an error.
+ return 0;
+ }
+ }
+ }
+
+ return 1;
+}
+
+# makeUniversalFile($sourcePPC, $sourceX86, $targetPath)
+#
+# Creates a universal file at pathname $targetPath based on a ppc image at
+# $sourcePPC and an x86 image at $sourceX86. $sourcePPC and $sourceX86 are
+# both FileAttrCache objects. Returns true on success and false on failure.
+# On failure, diagnostics will be printed to stderr.
+#
+# The source files may be either thin Mach-O images of the appropriate
+# architecture, or fat Mach-O files that contain images of the appropriate
+# architecture.
+#
+# This function wraps the lipo utility, see lipo(1).
+sub makeUniversalFile($$$) {
+ my ($sourcePPC, $sourceX86, $targetPath, @tempThinFiles, $thinPPC, $thinX86);
+ ($sourcePPC, $sourceX86, $targetPath) = @_;
+ $thinPPC = $sourcePPC;
+ $thinX86 = $sourceX86;
+
+ @tempThinFiles = ();
+
+ # The source files might already be fat. They should be thinned out to only
+ # contain a single architecture.
+
+ my ($isFatPPC, $isFatX86);
+
+ if(!defined($isFatPPC = $sourcePPC->isFat())) {
+ # isFat printed its own error
+ return 0;
+ }
+ elsif($isFatPPC) {
+ $thinPPC = FileAttrCache->new($targetPath.'.ppc');
+ push(@tempThinFiles, $thinPPC->path());
+ if (command($gConfig{'cmd_lipo'}, '-thin', 'ppc',
+ $sourcePPC->path(), '-output', $thinPPC->path()) != 0) {
+ unlink(@tempThinFiles);
+ return complain(1, 'lipo thin ppc failed for:',
+ $sourcePPC->path(),
+ $thinPPC->path());
+ }
+ }
+
+ if(!defined($isFatX86 = $sourceX86->isFat())) {
+ # isFat printed its own error
+ unlink(@tempThinFiles);
+ return 0;
+ }
+ elsif($isFatX86) {
+ $thinX86 = FileAttrCache->new($targetPath.'.x86');
+ push(@tempThinFiles, $thinX86->path());
+ if (command($gConfig{'cmd_lipo'}, '-thin', 'i386',
+ $sourceX86->path(), '-output', $thinX86->path()) != 0) {
+ unlink(@tempThinFiles);
+ return complain(1, 'lipo thin x86 failed for:',
+ $sourceX86->path(),
+ $thinX86->path());
+ }
+ }
+
+ # The image for each architecture in the fat file will be aligned on
+ # a specific boundary, default 4096 bytes, see lipo(1) -segalign.
+ # Since there's no tail-padding, the fat file will consume the least
+ # space on disk if the image that comes last exceeds the segment size
+ # by the smallest amount.
+ #
+ # This saves an average of 1kB per fat file over the naive approach of
+ # always putting one architecture first: average savings is 2kB per
+ # file, but the naive approach would have gotten it right half of the
+ # time.
+
+ my ($sizePPC, $sizeX86, $thinPPCForStat, $thinX86ForStat);
+
+ if (!$gDryRun) {
+ $thinPPCForStat = $thinPPC;
+ $thinX86ForStat = $thinX86;
+ }
+ else {
+ # Normally, fat source files will have been converted into temporary
+ # thin files. During a dry run, that doesn't happen, so fake it up
+ # a little bit by always using the source file, fat or thin, for the
+ # stat.
+ $thinPPCForStat = $sourcePPC;
+ $thinX86ForStat = $sourceX86;
+ }
+
+ if (!defined($sizePPC = $thinPPCForStat->statSize())) {
+ unlink(@tempThinFiles);
+ return complain(1, 'stat ppc: '.$!.' for:',
+ $thinPPCForStat->path());
+ }
+ if (!defined($sizeX86 = $thinX86ForStat->statSize())) {
+ unlink(@tempThinFiles);
+ return complain(1, 'stat x86: '.$!.' for:',
+ $thinX86ForStat->path());
+ }
+
+ $sizePPC = $sizePPC % 4096;
+ $sizeX86 = $sizeX86 % 4096;
+
+ my (@thinFiles);
+
+ if ($sizePPC == 0) {
+ # PPC image ends on an alignment boundary, there will be no padding before
+ # starting the x86 image.
+ @thinFiles = ($thinPPC->path(), $thinX86->path());
+ }
+ elsif ($sizeX86 == 0 || $sizeX86 > $sizePPC) {
+ # x86 image ends on an alignment boundary, there will be no padding before
+ # starting the PPC image, or the x86 image exceeds its alignment boundary
+ # by more than the PPC image, so there will be less padding if the x86
+ # comes first.
+ @thinFiles = ($thinX86->path(), $thinPPC->path());
+ }
+ else {
+ # PPC image exceeds its alignment boundary by more than the x86 image, so
+ # there will be less padding if the PPC comes first.
+ @thinFiles = ($thinPPC->path(), $thinX86->path());
+ }
+
+ my ($isExecutable);
+ $isExecutable = $sourcePPC->lIsExecutable() ||
+ $sourceX86->lIsExecutable();
+
+ if (!$gDryRun) {
+ # Ensure that the file does not yet exist.
+
+ # Set the execute bits (as allowed by the umask) on the new file if any
+ # execute bit is set on either old file. Yes, it is possible to have
+ # proper Mach-O files without x-bits: think object files (.o) and static
+ # archives (.a).
+ if (!createUniqueFile($targetPath, $isExecutable ? 0777 : 0666)) {
+ # createUniqueFile printed an error.
+ unlink(@tempThinFiles);
+ return 0;
+ }
+ }
+
+ # Create the fat file.
+ if (command($gConfig{'cmd_lipo'}, '-create', @thinFiles,
+ '-output', $targetPath) != 0) {
+ unlink(@tempThinFiles, $targetPath);
+ return complain(1, 'lipo create fat failed for:',
+ @thinFiles,
+ $targetPath);
+ }
+
+ unlink(@tempThinFiles);
+
+ if (!$gDryRun) {
+ # lipo seems to think that it's free to set its own file modes that
+ # ignore the umask, which is bogus when the rest of this script
+ # respects the umask.
+ if (!chmod(($isExecutable ? 0777 : 0666) & ~umask(), $targetPath)) {
+ complain(1, 'makeUniversalFile: chmod: '.$!.' for',
+ $targetPath);
+ unlink($targetPath);
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+# makeUniversalInternal($isToplevel, $filePPC, $fileX86, $fileTargetPath)
+#
+# Given FileAttrCache objects $filePPC and $fileX86, compares filetypes
+# and performs the appropriate action to produce a universal file at
+# path string $fileTargetPath. $isToplevel should be true if this is
+# the recursive base and false otherwise; this controls cleanup behavior
+# (cleanup is only performed at the base, because cleanup itself is
+# recursive).
+#
+# This handles regular files by determining whether they are Mach-O files
+# and calling makeUniversalFile if so and copyIfIdentical otherwise. Symbolic
+# links are handled directly in this function by ensuring that the source link
+# targets are identical and creating a new link with the same target
+# at $fileTargetPath. Directories are handled by calling
+# makeUniversalDirectory.
+#
+# One of $filePPC and $fileX86 is permitted to be undef. In that case,
+# the defined source file is copied directly to the target if a regular
+# file, and symlinked appropriately if a symbolic link. This facilitates
+# use of $gOnlyOne = 'copy', although no $gOnlyOne checks are made in this
+# function, they are all handled in makeUniversalDirectory.
+#
+# Returns true on success. Returns false on failure, including failures
+# in other functions called.
+sub makeUniversalInternal($$$$) {
+ my ($filePPC, $fileTargetPath, $fileX86, $isToplevel);
+ ($isToplevel, $filePPC, $fileX86, $fileTargetPath) = @_;
+
+ my ($typePPC, $typeX86);
+ if (defined($filePPC) && !defined($typePPC = $filePPC->lstatType())) {
+ return complain(1, 'makeUniversal: lstat ppc: '.$!.' for:',
+ $filePPC->path());
+ }
+ if (defined($fileX86) && !defined($typeX86 = $fileX86->lstatType())) {
+ return complain(1, 'makeUniversal: lstat x86: '.$!.' for:',
+ $fileX86->path());
+ }
+
+ if (defined($filePPC) && defined($fileX86) && $typePPC != $typeX86) {
+ return complain(1, 'makeUniversal: incompatible types:',
+ $filePPC->path(),
+ $fileX86->path());
+ }
+
+ # $aSourceFile will contain a FileAttrCache object that will return
+ # the correct type data. It's used because it's possible for one of
+ # the two source files to be undefined (indicating a straight copy).
+ my ($aSourceFile);
+ if (defined($filePPC)) {
+ $aSourceFile = $filePPC;
+ }
+ else {
+ $aSourceFile = $fileX86;
+ }
+
+ if ($aSourceFile->lIsDir()) {
+ if ($gVerbosity >= 3 || $gDryRun) {
+ print('mkdir '.(argumentEscape($fileTargetPath))[0]."\n");
+ }
+ if (!$gDryRun && !mkdir($fileTargetPath)) {
+ return complain(1, 'makeUniversal: mkdir: '.$!.' for:',
+ $fileTargetPath);
+ }
+
+ my ($rv);
+
+ if (!($rv = makeUniversalDirectory($filePPC, $fileX86, $fileTargetPath))) {
+ # makeUniversalDirectory printed an error.
+ if ($isToplevel) {
+ command($gConfig{'cmd_rm'},'-rf','--',$fileTargetPath);
+ }
+ }
+ else {
+ # Touch the directory when leaving it. If unify is being run on an
+ # .app bundle, the .app might show up without an icon because the
+ # system might have found the .app before it was completely built.
+ # Touching it dirties it in LaunchServices' mind.
+ if ($gVerbosity >= 3) {
+ print('touch '.(argumentEscape($fileTargetPath))[0]."\n");
+ }
+ utime(undef, undef, $fileTargetPath);
+ }
+
+ return $rv;
+ }
+ elsif ($aSourceFile->lIsSymLink()) {
+ my ($linkPPC, $linkX86);
+ if (defined($filePPC) && !defined($linkPPC=readlink($filePPC->path()))) {
+ return complain(1, 'makeUniversal: readlink ppc: '.$!.' for:',
+ $filePPC->path());
+ }
+ if (defined($fileX86) && !defined($linkX86=readlink($fileX86->path()))) {
+ return complain(1, 'makeUniversal: readlink x86: '.$!.' for:',
+ $fileX86->path());
+ }
+ if (defined($filePPC) && defined($fileX86) && $linkPPC ne $linkX86) {
+ return complain(1, 'makeUniversal: symbolic links differ:',
+ $filePPC->path(),
+ $fileX86->path());
+ }
+
+ # $aLink here serves the same purpose as $aSourceFile in the enclosing
+ # block: it refers to the target of the symbolic link, whether there
+ # is one valid source or two.
+ my ($aLink);
+ if (defined($linkPPC)) {
+ $aLink = $linkPPC;
+ }
+ else {
+ $aLink = $linkX86;
+ }
+
+ if ($gVerbosity >= 3 || $gDryRun) {
+ print('ln -s '.
+ join(' ',argumentEscape($aLink, $fileTargetPath))."\n");
+ }
+ if (!$gDryRun && !symlink($aLink, $fileTargetPath)) {
+ return complain(1, 'makeUniversal: symlink: '.$!.' for:',
+ $aLink,
+ $fileTargetPath);
+ }
+
+ return 1;
+ }
+ elsif($aSourceFile->lIsRegularFile()) {
+ my ($machPPC, $machX86, $fileName);
+ if (!defined($filePPC) || !defined($fileX86)) {
+ # One of the source files isn't present. The right thing to do is
+ # to just copy what does exist straight over, so skip Mach-O checks.
+ $machPPC = 0;
+ $machX86 = 0;
+ if (defined($filePPC)) {
+ $fileName = $filePPC;
+ } elsif (defined($fileX86)) {
+ $fileName = $fileX86;
+ } else {
+ complain(1, "The file must exist in at least one directory");
+ exit(1);
+ }
+ }
+ else {
+ # both files exist, pick the name of one.
+ $fileName = $fileX86;
+ if (!defined($machPPC=$filePPC->isMachO())) {
+ return complain(1, 'makeUniversal: isFileMachO ppc failed for:',
+ $filePPC->path());
+ }
+ if (!defined($machX86=$fileX86->isMachO())) {
+ return complain(1, 'makeUniversal: isFileMachO x86 failed for:',
+ $fileX86->path());
+ }
+ }
+
+ if ($machPPC != $machX86) {
+ return complain(1, 'makeUniversal: variant Mach-O attributes:',
+ $filePPC->path(),
+ $fileX86->path());
+ }
+
+ if ($machPPC) {
+ # makeUniversalFile will print an error if it fails.
+ return makeUniversalFile($filePPC, $fileX86, $fileTargetPath);
+ }
+
+ if (grep { $fileName->path() =~ m/$_/; } @gSortMatches) {
+ # Regular files, but should be compared with sorting first.
+ # copyIfIdenticalWhenSorted will print an error if it fails.
+ return copyIfIdenticalWhenSorted($filePPC, $fileX86, $fileTargetPath);
+ }
+
+ # Regular file. copyIfIdentical will print an error if it fails.
+ return copyIfIdentical($filePPC, $fileX86, $fileTargetPath);
+ }
+
+ # Special file, don't know how to handle.
+ return complain(1, 'makeUniversal: cannot handle special file:',
+ $filePPC->path(),
+ $fileX86->path());
+}
+
+# usage()
+#
+# Give the user a hand.
+sub usage() {
+ print STDERR (
+"usage: unify <ppc-path> <x86-path> <universal-path>\n".
+" [--dry-run] (print what would be done)\n".
+" [--only-one <action>] (skip, copy, fail; default=copy)\n".
+" [--verbosity <level>] (0, 1, 2, 3; default=2)\n");
+ return;
+}
+
+# readZipCRCs($zipFile)
+#
+# $zipFile is the pathname to a zip file whose directory will be read.
+# A reference to a hash is returned, with the member pathnames from the
+# zip file as keys, and reasonably unique identifiers as values. The
+# format of the values is not specified exactly, but does include the
+# member CRCs and sizes and differentiates between files and directories.
+# It specifically does not distinguish between modification times. On
+# failure, prints a message and returns undef.
+sub readZipCRCs($) {
+ my ($zipFile);
+ ($zipFile) = @_;
+
+ my ($ze, $zip);
+ $zip = Archive::Zip->new();
+
+ if (($ze = $zip->read($zipFile)) != AZ_OK) {
+ complain(1, 'readZipCRCs: read error '.$ze.' for:',
+ $zipFile);
+ return undef;
+ }
+
+ my ($member, %memberCRCs, @memberList);
+ %memberCRCs = ();
+ @memberList = $zip->members();
+
+ foreach $member (@memberList) {
+ # Take a few of the attributes that identify the file and stuff them into
+ # the members hash. Directories will show up with size 0 and crc32 0,
+ # so isDirectory() is used to distinguish them from empty files.
+ $memberCRCs{$member->fileName()} = join(',', $member->isDirectory() ? 1 : 0,
+ $member->uncompressedSize(),
+ $member->crc32String());
+ }
+
+ return {%memberCRCs};
+}
+
+{
+ # FileAttrCache allows various attributes about a file to be cached
+ # so that if they are needed again after first use, no system calls
+ # will be made and the program won't need to hit the disk.
+
+ package FileAttrCache;
+
+ # from /usr/include/mach-o/loader.h
+ use constant MH_MAGIC => 0xfeedface;
+ use constant MH_CIGAM => 0xcefaedfe;
+ use constant MH_MAGIC_64 => 0xfeedfacf;
+ use constant MH_CIGAM_64 => 0xcffaedfe;
+
+ use Fcntl(':DEFAULT', ':mode');
+
+ # FileAttrCache->new($path)
+ #
+ # Creates a new FileAttrCache object for the file at path $path and
+ # returns it. The cache is not primed at creation time, values are
+ # fetched lazily as they are needed.
+ sub new($$) {
+ my ($class, $path, $proto, $this);
+ ($proto, $path) = @_;
+ if (!($class = ref($proto))) {
+ $class = $proto;
+ }
+ $this = {
+ 'path' => $path,
+ 'lstat' => undef,
+ 'lstatErrno' => 0,
+ 'lstatInit' => 0,
+ 'magic' => undef,
+ 'magic2' => undef,
+ 'magicErrno' => 0,
+ 'magicErrMsg' => undef,
+ 'magicInit' => 0,
+ 'stat' => undef,
+ 'statErrno' => 0,
+ 'statInit' => 0,
+ };
+ bless($this, $class);
+ return($this);
+ }
+
+ # $FileAttrCache->isFat()
+ #
+ # Returns true if the file is a fat Mach-O file, false if it's not, and
+ # undef if an error occurs. See /usr/include/mach-o/fat.h.
+ sub isFat($) {
+ my ($magic, $magic2, $this);
+ ($this) = @_;
+
+ # magic() caches, there's no separate cache because isFat() doesn't hit
+ # the disk other than by calling magic().
+
+ if (!defined($magic = $this->magic())) {
+ return undef;
+ }
+ $magic2 = $this->magic2();
+
+ # We have to sanity check the second four bytes, because Java class
+ # files use the same magic number as Mach-O fat binaries.
+ # This logic is adapted from file(1), which says that Mach-O uses
+ # these bytes to count the number of architectures within, while
+ # Java uses it for a version number. Conveniently, there are only
+ # 18 labelled Mach-O architectures, and Java's first released
+ # class format used the version 43.0.
+ if ($magic == 0xcafebabe && $magic2 < 20) {
+ return 1;
+ }
+
+ return 0;
+ }
+
+ # $FileAttrCache->isMachO()
+ #
+ # Returns true if the file is a Mach-O image (including a fat file), false
+ # if it's not, and undef if an error occurs. See
+ # /usr/include/mach-o/loader.h and /usr/include/mach-o/fat.h.
+ sub isMachO($) {
+ my ($magic, $this);
+ ($this) = @_;
+
+ # magic() caches, there's no separate cache because isMachO() doesn't hit
+ # the disk other than by calling magic().
+
+ if (!defined($magic = $this->magic())) {
+ return undef;
+ }
+
+ # Accept Mach-O fat files or Mach-O thin files of either endianness.
+ if ($magic == MH_MAGIC ||
+ $magic == MH_CIGAM ||
+ $magic == MH_MAGIC_64 ||
+ $magic == MH_CIGAM_64 ||
+ $this->isFat()) {
+ return 1;
+ }
+
+ return 0;
+ }
+
+ # $FileAttrCache->isZip()
+ #
+ # Returns true if the file is a zip file, false if it's not, and undef if
+ # an error occurs. See http://www.pkware.com/business_and_developers/developer/popups/appnote.txt .
+ sub isZip($) {
+ my ($magic, $this);
+ ($this) = @_;
+
+ # magic() caches, there's no separate cache because isFat() doesn't hit
+ # the disk other than by calling magic().
+
+ if (!defined($magic = $this->magic())) {
+ return undef;
+ }
+
+ if ($magic == 0x504b0304) {
+ return 1;
+ }
+
+ return 0;
+ }
+
+ # $FileAttrCache->lIsExecutable()
+ #
+ # Wraps $FileAttrCache->lstat(), returning true if the file is has any,
+ # execute bit set, false if none are set, or undef if an error occurs.
+ # On error, $! is set to lstat's errno.
+ sub lIsExecutable($) {
+ my ($mode, $this);
+ ($this) = @_;
+
+ if (!defined($mode = $this->lstatMode())) {
+ return undef;
+ }
+
+ return $mode & (S_IXUSR | S_IXGRP | S_IXOTH);
+ }
+
+ # $FileAttrCache->lIsDir()
+ #
+ # Wraps $FileAttrCache->lstat(), returning true if the file is a directory,
+ # false if it isn't, or undef if an error occurs. Because lstat is used,
+ # this will return false even if the file is a symlink pointing to a
+ # directory. On error, $! is set to lstat's errno.
+ sub lIsDir($) {
+ my ($type, $this);
+ ($this) = @_;
+
+ if (!defined($type = $this->lstatType())) {
+ return undef;
+ }
+
+ return S_ISDIR($type);
+ }
+
+ # $FileAttrCache->lIsRegularFile()
+ #
+ # Wraps $FileAttrCache->lstat(), returning true if the file is a regular,
+ # file, false if it isn't, or undef if an error occurs. Because lstat is
+ # used, this will return false even if the file is a symlink pointing to a
+ # regular file. On error, $! is set to lstat's errno.
+ sub lIsRegularFile($) {
+ my ($type, $this);
+ ($this) = @_;
+
+ if (!defined($type = $this->lstatType())) {
+ return undef;
+ }
+
+ return S_ISREG($type);
+ }
+
+ # $FileAttrCache->lIsSymLink()
+ #
+ # Wraps $FileAttrCache->lstat(), returning true if the file is a symbolic,
+ # link, false if it isn't, or undef if an error occurs. On error, $! is
+ # set to lstat's errno.
+ sub lIsSymLink($) {
+ my ($type, $this);
+ ($this) = @_;
+
+ if (!defined($type = $this->lstatType())) {
+ return undef;
+ }
+
+ return S_ISLNK($type);
+ }
+
+ # $FileAttrCache->lstat()
+ #
+ # Wraps the lstat system call, providing a cache to speed up multiple
+ # lstat calls for the same file. See lstat(2) and lstat in perlfunc(1).
+ sub lstat($) {
+ my (@stat, $this);
+ ($this) = @_;
+
+ # Use the cached lstat result.
+ if ($$this{'lstatInit'}) {
+ if (defined($$this{'lstatErrno'})) {
+ $! = $$this{'lstatErrno'};
+ }
+ return @{$$this{'lstat'}};
+ }
+ $$this{'lstatInit'} = 1;
+
+ if (!(@stat = CORE::lstat($$this{'path'}))) {
+ $$this{'lstatErrno'} = $!;
+ }
+
+ $$this{'lstat'} = [@stat];
+ return @stat;
+ }
+
+ # $FileAttrCache->lstatMode()
+ #
+ # Wraps $FileAttrCache->lstat(), returning the mode bits from the st_mode
+ # field, or undef if an error occurs. On error, $! is set to lstat's
+ # errno.
+ sub lstatMode($) {
+ my (@stat, $this);
+ ($this) = @_;
+
+ if (!(@stat = $this->lstat())) {
+ return undef;
+ }
+
+ return S_IMODE($stat[2]);
+ }
+
+ # $FileAttrCache->lstatType()
+ #
+ # Wraps $FileAttrCache->lstat(), returning the type bits from the st_mode
+ # field, or undef if an error occurs. On error, $! is set to lstat's
+ # errno.
+ sub lstatType($) {
+ my (@stat, $this);
+ ($this) = @_;
+
+ if (!(@stat = $this->lstat())) {
+ return undef;
+ }
+
+ return S_IFMT($stat[2]);
+ }
+
+ # $FileAttrCache->magic()
+ #
+ # Returns the "magic number" for the file by reading its first four bytes
+ # as a big-endian unsigned 32-bit integer and returning the result. If an
+ # error occurs, returns undef and prints diagnostic messages to stderr. If
+ # the file is shorter than 32 bits, returns -1. A cache is provided to
+ # speed multiple magic calls for the same file.
+ sub magic($) {
+ my ($this);
+ ($this) = @_;
+
+ # Use the cached magic result.
+ if ($$this{'magicInit'}) {
+ if (defined($$this{'magicErrno'})) {
+ if (defined($$this{'magicErrMsg'})) {
+ main::complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:',
+ $$this{'path'});
+ }
+ $! = $$this{'magicErrno'};
+ }
+ return $$this{'magic'};
+ }
+
+ $$this{'magicInit'} = 1;
+
+ my ($fh);
+ if (!sysopen($fh, $$this{'path'}, O_RDONLY)) {
+ $$this{'magicErrno'} = $!;
+ $$this{'magicErrMsg'} = 'open "'.$$this{'path'}.'": '.$!;
+ main::complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:',
+ $$this{'path'});
+ return undef;
+ }
+
+ $! = 0;
+ my ($bytes, $magic, $bytes2, $magic2);
+ if (!defined($bytes = sysread($fh, $magic, 4))) {
+ $$this{'magicErrno'} = $!;
+ $$this{'magicErrMsg'} = 'read "'.$$this{'path'}.'": '.$!;
+ main::complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:',
+ $$this{'path'});
+ close($fh);
+ return undef;
+ }
+ else {
+ $bytes2 = sysread($fh, $magic2, 4);
+ }
+
+ close($fh);
+
+ if ($bytes != 4) {
+ # The file is too short, didn't read a magic number. This isn't really
+ # an error. Return an unlikely value.
+ $$this{'magic'} = -1;
+ $$this{'magic2'} = -1;
+ return -1;
+ }
+ if ($bytes2 != 4) {
+ # File is too short to read a second 4 bytes.
+ $magic2 = -1;
+ }
+
+ $$this{'magic'} = unpack('N', $magic);
+ $$this{'magic2'} = unpack('N', $magic2);
+ return $$this{'magic'};
+ }
+
+ # $FileAttrCache->magic2()
+ #
+ # Returns the second four bytes of the file as a 32-bit little endian number.
+ # See magic(), above for more info.
+ sub magic2($) {
+ my ($this);
+ ($this) = @_;
+
+ # we do the actual work (and cache it) in magic().
+ if (!$$this{'magicInit'}) {
+ my $magic = $$this->magic();
+ }
+
+ return $$this{'magic2'};
+ }
+
+ # $FileAttrCache->path()
+ #
+ # Returns the file's pathname.
+ sub path($) {
+ my ($this);
+ ($this) = @_;
+ return $$this{'path'};
+ }
+
+ # $FileAttrCache->stat()
+ #
+ # Wraps the stat system call, providing a cache to speed up multiple
+ # stat calls for the same file. If lstat() has already been called and
+ # the file is not a symbolic link, the cached lstat() result will be used.
+ # See stat(2) and lstat in perlfunc(1).
+ sub stat($) {
+ my (@stat, $this);
+ ($this) = @_;
+
+ # Use the cached stat result.
+ if ($$this{'statInit'}) {
+ if (defined($$this{'statErrno'})) {
+ $! = $$this{'statErrno'};
+ }
+ return @{$$this{'stat'}};
+ }
+
+ $$this{'statInit'} = 1;
+
+ # If lstat has already been called, and the file isn't a symbolic link,
+ # use the cached lstat result.
+ if ($$this{'lstatInit'} && !$$this{'lstatErrno'} &&
+ !S_ISLNK(${$$this{'lstat'}}[2])) {
+ $$this{'stat'} = $$this{'lstat'};
+ return @{$$this{'stat'}};
+ }
+
+ if (!(@stat = CORE::stat($$this{'path'}))) {
+ $$this{'statErrno'} = $!;
+ }
+
+ $$this{'stat'} = [@stat];
+ return @stat;
+ }
+
+ # $FileAttrCache->statSize()
+ #
+ # Wraps $FileAttrCache->stat(), returning the st_size field, or undef
+ # undef if an error occurs. On error, $! is set to stat's errno.
+ sub statSize($) {
+ my (@stat, $this);
+ ($this) = @_;
+
+ if (!(@stat = $this->lstat())) {
+ return undef;
+ }
+
+ return $stat[7];
+ }
+}