2009-01-02 07:57:14 +01:00
|
|
|
#!/usr/bin/perl
|
|
|
|
use Getopt::Long;
|
2009-04-14 17:10:28 +02:00
|
|
|
use File::Temp qw'tempdir';
|
2009-01-02 07:57:14 +01:00
|
|
|
use File::Basename;
|
2009-04-10 06:29:25 +02:00
|
|
|
use File::Spec;
|
2009-01-02 07:57:14 +01:00
|
|
|
use strict;
|
|
|
|
|
2009-04-09 23:02:53 +02:00
|
|
|
sub dllname($;$);
|
2009-01-02 07:57:14 +01:00
|
|
|
|
2009-04-09 23:02:53 +02:00
|
|
|
my $static;
|
2009-04-12 05:19:52 +02:00
|
|
|
my $inverse;
|
|
|
|
my @exclude;
|
2009-04-09 23:02:53 +02:00
|
|
|
|
2009-04-12 05:19:52 +02:00
|
|
|
my ($ar, $as, $nm, $objcopy);
|
|
|
|
GetOptions('exclude=s'=>\@exclude, 'static!'=>\$static, 'v!'=>\$inverse,
|
|
|
|
'ar=s'=>\$ar, 'as=s'=>\$as,'nm=s'=>\$nm, 'objcopy=s'=>\$objcopy);
|
2009-03-28 05:55:36 +01:00
|
|
|
|
2009-04-12 05:19:52 +02:00
|
|
|
$_ = File::Spec->rel2abs($_) for @ARGV;
|
2009-04-09 23:02:53 +02:00
|
|
|
|
2009-04-12 05:19:52 +02:00
|
|
|
my $libdll = shift;
|
|
|
|
my $lib = pop;
|
|
|
|
|
|
|
|
open my $nm_fd, '-|', $nm, '-Apg', '--defined-only', @ARGV, $libdll or
|
2009-01-02 07:57:14 +01:00
|
|
|
die "$0: execution of $nm for object files failed - $!\n";
|
|
|
|
|
2009-04-09 23:02:53 +02:00
|
|
|
my %match_syms = ();
|
|
|
|
my $symfiles = ();
|
|
|
|
my $lastfn;
|
|
|
|
my %extract = ();
|
2009-04-12 05:19:52 +02:00
|
|
|
my $exclude_regex = @exclude ? join('|', @exclude) : '\\UnLiKeLy//';
|
|
|
|
$exclude_regex = qr/$exclude_regex/;
|
2009-01-02 07:57:14 +01:00
|
|
|
while (<$nm_fd>) {
|
2009-04-09 23:02:53 +02:00
|
|
|
study;
|
2009-04-12 05:19:52 +02:00
|
|
|
my ($file, $member, $symbol) = m%^([^:]*):([^:]*(?=:))?.* T (.*)%o;
|
|
|
|
next if !defined($symbol) || $symbol =~ $exclude_regex;
|
|
|
|
if ($file ne $libdll) {
|
|
|
|
$match_syms{$symbol} = 1;
|
|
|
|
} elsif ($match_syms{$symbol} ? !$inverse : $inverse) {
|
|
|
|
$extract{$member} = 1;
|
2009-04-09 23:02:53 +02:00
|
|
|
}
|
2009-01-02 07:57:14 +01:00
|
|
|
}
|
|
|
|
close $nm_fd;
|
|
|
|
|
2009-04-09 23:02:53 +02:00
|
|
|
%extract or die "$0: couldn't find symbols for $lib\n";
|
|
|
|
|
2009-04-14 17:10:28 +02:00
|
|
|
my $dir = tempdir(CLEANUP => 1);
|
2009-01-02 07:57:14 +01:00
|
|
|
|
2009-04-09 23:02:53 +02:00
|
|
|
chdir $dir;
|
|
|
|
# print join(' ', '+', $ar, 'x', sort keys %extract), "\n";
|
|
|
|
my $res = system $ar, 'x', $libdll, sort keys %extract;
|
|
|
|
die "$0: $ar extraction exited with non-zero status\n" if $res;
|
|
|
|
unlink $lib;
|
2009-04-12 07:11:08 +02:00
|
|
|
$res = system $ar, 'crus', $lib, sort keys %extract;
|
|
|
|
unlink keys %extract;
|
|
|
|
die "$0: ar creation of $lib exited with non-zero status\n" if $res;
|
|
|
|
exit 0;
|