qpdf/copy_dlls

#!/usr/bin/env perl

require 5.008;
BEGIN { $^W = 1; }
use strict;
use File::Basename;

my $whoami = basename($0);

usage() unless @ARGV == 4;
my ($file, $destdir, $objdump, $windows_wordsize) = @ARGV;
my $filedir = dirname($file);

my $sep = ($^O eq 'MSWin32' ? ';' : ':');
my @path = ($filedir, '.', split($sep, $ENV{'PATH'}));
foreach my $var (qw(LIB))
{
    if (exists $ENV{$var})
    {
        push(@path, split($sep, $ENV{$var}));
    }
}
my $redist_suffix = (($windows_wordsize eq '64') ? "x64" : "x86");
if (exists $ENV{'VCINSTALLDIR'})
{
    my $redist = $ENV{'VCINSTALLDIR'} . "/Redist/$redist_suffix";
    if (opendir(D, $redist))
    {
        my @entries = readdir(D);
        closedir(D);
        foreach my $e (@entries)
        {
            if ($e =~ m/\.CRT$/i)
            {
                unshift(@path, "$redist/$e");
            }
        }
    }
}
if (exists $ENV{'UniversalCRTSdkDir'})
{
    my $redist = $ENV{'UniversalCRTSdkDir'} . "/Redist/ucrt/DLLs/$redist_suffix";
    unshift(@path, $redist);
}

my $format = undef;
my @to_find = get_dlls($file);

my %final = ();
my @notfound = ();

while (@to_find)
{
    my $dll = shift(@to_find);
    my $found = 0;
    foreach my $dir (@path)
    {
        if ((-f "$dir/$dll") && is_format("$dir/$dll", $format))
        {
            if (! exists $final{$dll})
            {
                $final{$dll} = "$dir/$dll";
                push(@to_find, get_dlls("$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 $dll (sort keys (%final))
{
    my $f = $final{$dll};
    $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_dlls
{
    my @result = ();
    my $exe = shift;
    open(O, "$objdump -p $exe|") 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|user32|msvcrt|advapi32)\.dll$/;
            push(@result, $dll);
        }
        elsif (m/^Magic.*\((PE.+?)\)/)
        {
            $format = $1;
        }
    }
    close(O);
    if (! defined $format)
    {
        die "$whoami: can't determine format of $exe\n";
    }
    @result;
}

sub is_format
{
    my ($file, $format) = @_;
    $file =~ s,\\,/,g;
    # Special case: msvc*.dll seem to be able to behave both as 32-bit
    # and 64-bit DLLs.  Either that, or this logic is wrong for those
    # DLLs and it doesn't matter because they're already installed on
    # my test system (which doesn't have msvc installed on it).
    if ($file =~ m,/msvc,i)
    {
        return 1;
    }
    my $result = 0;
    my $file_format = `file "$file"`;
    print "$file $format $file_format\n";
    if ($? == 0)
    {
        if ($file_format =~ m/\Q${format}\E executable/)
        {
            $result = 1;
        }
    }
    $result;
}

sub usage
{
    die "Usage: $whoami {exe|dll} destdir\n";
}