qpdf/copy_dlls

#!/usr/bin/env perl
require 5.008;
use warnings;
use strict;
use File::Basename;
use File::Path qw(make_path);

my $whoami = basename($0);

usage() unless @ARGV == 3;
my ($file, $libqpdf, $destdir) = @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 $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 ($libqpdf, @path)
    {
        if ((-f "$dir/$dll") && is_format("$dir/$dll", $format))
        {
            if (! exists $final{$dll})
            {
                if ($dir ne $libqpdf)
                {
                    $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";
}

make_path($destdir);
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$/;
            next if $dll =~ m/^(api-ms-win.*|ws2_32|crypt32|bcrypt)\.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} libqpdf-dir destdir\n";
}