57 lines
		
	
	
		
			1.5 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			57 lines
		
	
	
		
			1.5 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
| #!/usr/bin/perl
 | |
| use Getopt::Long;
 | |
| use File::Temp qw'tempdir';
 | |
| use File::Basename;
 | |
| use File::Spec;
 | |
| use strict;
 | |
| 
 | |
| sub dllname($;$);
 | |
| 
 | |
| my $static;
 | |
| my $inverse;
 | |
| my @exclude;
 | |
| 
 | |
| 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);
 | |
| 
 | |
| $_ = File::Spec->rel2abs($_) for @ARGV;
 | |
| 
 | |
| my $libdll = shift;
 | |
| my $lib =  pop;
 | |
| 
 | |
| open my $nm_fd, '-|', $nm, '-Apg', '--defined-only', @ARGV, $libdll or
 | |
|   die "$0: execution of $nm for object files failed - $!\n";
 | |
| 
 | |
| my %match_syms = ();
 | |
| my $symfiles = ();
 | |
| my $lastfn;
 | |
| my %extract = ();
 | |
| my $exclude_regex = @exclude ? join('|', @exclude) : '\\UnLiKeLy//';
 | |
| $exclude_regex = qr/$exclude_regex/;
 | |
| while (<$nm_fd>) {
 | |
|     study;
 | |
|     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;
 | |
|      }
 | |
| }
 | |
| close $nm_fd;
 | |
| 
 | |
| %extract or die "$0: couldn't find symbols for $lib\n";
 | |
| 
 | |
| my $dir = tempdir(CLEANUP => 1);
 | |
| 
 | |
| 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;
 | |
| $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;
 |