mirror of
https://github.com/qpdf/qpdf.git
synced 2024-10-31 19:02:30 +00:00
127 lines
2.7 KiB
Perl
Executable File
127 lines
2.7 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
require 5.008;
|
|
BEGIN { $^W = 1; }
|
|
use strict;
|
|
use File::Basename;
|
|
|
|
my $whoami = basename($0);
|
|
|
|
usage() unless @ARGV == 2;
|
|
my ($file, $destdir) = @ARGV;
|
|
my $filedir = dirname($file);
|
|
|
|
my %dlls = ();
|
|
open(O, "objdump -p $file|") or die "$whoami: can't run objdump\n";
|
|
while (<O>)
|
|
{
|
|
if (m/^\s+DLL Name:\s+(.+\.dll)/i)
|
|
{
|
|
my $dll = $1;
|
|
$dll =~ tr/A-Z/a-z/;
|
|
next if $dll =~ m/^(kernel32|msvcrt)\.dll$/;
|
|
$dlls{$dll} = 1;
|
|
}
|
|
}
|
|
close(O);
|
|
|
|
# Search the file's directory, the current directory, and the path for
|
|
# dlls since that's what Windows does.
|
|
my $sep = ($^O eq 'MSWin32' ? ';' : ':');
|
|
my @path = ($filedir, '.', split($sep, $ENV{'PATH'}));
|
|
if (-f "$file.manifest")
|
|
{
|
|
unshift(@path, get_manifest_dirs("$file.manifest"));
|
|
}
|
|
my @final = ();
|
|
my @notfound = ();
|
|
dll_loop:
|
|
foreach my $dll (sort keys %dlls)
|
|
{
|
|
my $found = 0;
|
|
foreach my $dir (@path)
|
|
{
|
|
if (-f "$dir/$dll")
|
|
{
|
|
push(@final, "$dir/$dll");
|
|
$found = 1;
|
|
last;
|
|
}
|
|
}
|
|
if (! $found)
|
|
{
|
|
push(@notfound, $dll);
|
|
}
|
|
}
|
|
|
|
if (@notfound)
|
|
{
|
|
die "$whoami: can't find the following dlls: " .
|
|
join(', ', @notfound), "\n";
|
|
}
|
|
|
|
foreach my $f (@final)
|
|
{
|
|
$f =~ s,\\,/,g;
|
|
print "Copying $f to $destdir\n";
|
|
system("cp -p $f $destdir") == 0 or
|
|
die "$whoami: copy $f to $destdir failed\n";
|
|
}
|
|
|
|
sub get_manifest_dirs
|
|
{
|
|
# Find all system directories in which to search for DLLs based on
|
|
# the contents of a Visual Studio manifest file.
|
|
|
|
my $manifest_file = shift;
|
|
|
|
require XML::Parser;
|
|
my $sysroot = $ENV{'SYSTEMROOT'} or die "$whoami: can't get \$SYSTEMROOT\n";
|
|
$sysroot =~ s,\\,/,g;
|
|
if ($^O eq 'cygwin')
|
|
{
|
|
chop($sysroot = `cygpath $sysroot`);
|
|
die "$whoami: can't get system root" unless $? == 0;
|
|
}
|
|
my $winsxs = "$sysroot/WinSxS";
|
|
opendir(D, $winsxs) or die "$whoami: can't opendir $winsxs: $!\n";
|
|
my @entries = readdir(D);
|
|
closedir(D);
|
|
|
|
my @candidates = ();
|
|
|
|
my $readAssemblyIdentity = sub
|
|
{
|
|
my ($parser, $element, %attrs) = @_;
|
|
return unless $element eq 'assemblyIdentity';
|
|
my $type = $attrs{'type'};
|
|
my $name = $attrs{'name'};
|
|
my $version = $attrs{'version'};
|
|
my $processorArchitecture = $attrs{'processorArchitecture'};
|
|
my $publicKeyToken = $attrs{'publicKeyToken'};
|
|
|
|
my $dir_start = join('_',
|
|
$processorArchitecture,
|
|
$name,
|
|
$publicKeyToken,
|
|
$version);
|
|
push(@candidates, $dir_start);
|
|
};
|
|
|
|
my $p = new XML::Parser(Handlers => {'Start' => $readAssemblyIdentity});
|
|
$p->parsefile($manifest_file);
|
|
|
|
my @dirs = ();
|
|
foreach my $c (@candidates)
|
|
{
|
|
push(@dirs, map { "$winsxs/$_" } (grep { m/^\Q$c\E/i } @entries));
|
|
}
|
|
|
|
@dirs;
|
|
}
|
|
|
|
sub usage
|
|
{
|
|
die "Usage: $whoami {exe|dll} destdir\n";
|
|
}
|