create copy_dlls

git-svn-id: svn+q:///qpdf/trunk@863 71b93d88-0707-0410-a8cf-f5a4172ac649

1 files changed, 127 insertions, 0 deletions

diff --git a/copy_dlls b/copy_dlls
new file mode 100755
index 00000000..4e8f09f4
--- /dev/null
+++ b/copy_dlls
@@ -0,0 +1,127 @@
+#!/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|msvcr)\.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";
+    print $f, "\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";
+}