mirror of
https://github.com/darlinghq/darling-python.git
synced 2024-11-26 21:51:04 +00:00
61 lines
1.6 KiB
Perl
61 lines
1.6 KiB
Perl
#!/usr/bin/perl
|
|
|
|
# This file, along with the GNUmakefile, works around a verification
|
|
# error caused by a UFS bug (stripping a multi-link file breaks the link, and
|
|
# sometimes causes the wrong file to be stripped/unstripped). By using this
|
|
# "strip" perl script, it not only causes the correct file to be stripped, but
|
|
# also preserves the link.
|
|
|
|
use strict;
|
|
use File::Basename ();
|
|
use File::stat ();
|
|
use File::Temp ();
|
|
use Getopt::Long ();
|
|
use POSIX ();
|
|
|
|
my %argtype = (
|
|
A => '',
|
|
R => '=s',
|
|
S => '',
|
|
X => '',
|
|
c => '',
|
|
d => '=s',
|
|
i => '',
|
|
n => '',
|
|
o => '=s',
|
|
r => '',
|
|
s => '=s',
|
|
u => '',
|
|
x => '',
|
|
);
|
|
my $cp = 'cp';
|
|
my $MyName = File::Basename::basename($0);
|
|
my $strip = '/usr/bin/strip';
|
|
|
|
my %args;
|
|
Getopt::Long::Configure(qw(no_permute bundling_override no_ignore_case));
|
|
Getopt::Long::GetOptions(\%args, map {"$_$argtype{$_}"} keys(%argtype));
|
|
|
|
shift(@ARGV) if $ARGV[0] eq '-';
|
|
exec($strip) unless scalar(@ARGV) > 0;
|
|
|
|
my $st;
|
|
foreach my $f (@ARGV) {
|
|
if(defined($st = File::stat::stat($f)) && POSIX::S_ISREG($st->mode)
|
|
&& $st->nlink > 1) {
|
|
my $tmp = File::Temp->new(TEMPLATE => 'stripXXXXXX', DIR => '/var/tmp');
|
|
die "$MyName: Can't create temp file\n" unless defined($tmp);
|
|
system($cp, $f, $tmp->filename) == 0 or exit($?);
|
|
system($strip,
|
|
(map {$argtype{$_} eq '' ? "-$_" : ("-$_", $args{$_})} keys(%args)),
|
|
$tmp->filename
|
|
) == 0 or exit($?);
|
|
system($cp, $tmp->filename, $f) == 0 or exit($?);
|
|
} else {
|
|
system($strip,
|
|
(map {$argtype{$_} eq '' ? "-$_" : ("-$_", $args{$_})} keys(%args)),
|
|
$f
|
|
) == 0 or exit($?);
|
|
}
|
|
}
|