App-PP-Autolink
view release on metacpan or search on metacpan
lib/App/PP/Autolink.pm view on Meta::CPAN
# reassemble the arg list
my $argv_linkers = $self->{argv_linkers};
my $args_array = $self->{args_to_pass_to_pp};
my @args_for_pp = (
(map {("--link" => $_)} @$argv_linkers),
@$args_array,
);
my $method = $self->{autolink_list_method};
say 'Scanning dependent dynamic libs';
my @dll_list = $self->$method;
my $alien_sys_installs = $self->{alien_sys_installs};
# two-step process to get unique paths
my %tmp = map {($_ => '--link')} (@dll_list, @$alien_sys_installs);
my @links = reverse %tmp;
if (@$alien_sys_installs) {
say 'Alien sys dlls added: ' . join ' ', @$alien_sys_installs;
say '';
}
else {
say "No alien system dlls detected\n";
}
say 'Detected link list: ' . join ' ', grep {$_ ne '--link'} @links;
say '';
my @aliens = uniq @{$self->{alien_deps}};
my @alien_deps = map {; '-M' => $_} @aliens;
say 'Detected aliens: ' . join ' ', sort @aliens;
say '';
my @command = (
'pp',
@links,
#"--cachedeps=$cache_file",
@alien_deps,
@args_for_pp,
);
say 'CMD: ' . join ' ', @command;
system (@command) == 0
or die "system @command failed: $?";
return;
}
sub get_autolink_list {
my ($self) = @_;
lib/App/PP/Autolink.pm view on Meta::CPAN
# and no longer extant folders
my $system_root = $ENV{SystemRoot} || $ENV{WINDIR};
@system_paths
= map {path($_)->stringify} # otherwise we hit issues on SP5.36
grep {$_ and $_ =~ m|^\Q$system_root\E|i}
@exe_path;
@exe_path
= map {path($_)->stringify}
grep {$_ and (-e $_) and $_ !~ m|^\Q$system_root\E|i}
@exe_path;
#say "PATHS: " . join ' ', @exe_path;
}
# what to skip for linux or mac?
# get all the DLLs in the path - saves repeated searching lower down
my @dll_files
= map {$_->stringify}
map {path($_)->children ( qr /$Config::Config{so}$/)}
@exe_path;
if (CASE_INSENSITIVE_OS) {
lib/App/PP/Autolink.pm view on Meta::CPAN
foreach my $file (@dll_files) {
my $basename = path($file)->basename;
$dll_file_hash{$basename} //= $file; # we only want the first in the path
}
# lc is dirty and underhanded
# - need to find a different approach to get
# canonical file name while handling case,
# poss Win32::GetLongPathName
say "Getting dependent DLLs";
my @dlls = @$argv_linkers;
push @dlls,
$self->get_dep_dlls;
if (CASE_INSENSITIVE_OS) {
@dlls = map {path ($_)->stringify} map {lc $_} @dlls;
}
#say join "\n", @dlls;
my $re_skippers = $self->get_dll_skipper_regexp();
my %full_list;
my %searched_for;
my $iter = 0;
my @missing;
DLL_CHECK:
while (1) {
$iter++;
say "DLL check iter: $iter";
#say join ' ', @dlls;
my ( $stdout, $stderr, $exit ) = capture {
system( $OBJDUMP, '-p', @dlls );
};
if( $exit ) {
$stderr =~ s{\s+$}{};
warn "(@dlls):$exit: $stderr ";
exit;
}
@dlls = $stdout =~ /DLL.Name:\s*(\S+)/gmi;
lib/App/PP/Autolink.pm view on Meta::CPAN
# extra grep appears wasteful but useful for debug
# since we can easily disable it
@dlls
= sort
grep {!exists $full_list{$_}}
grep {$_ !~ /$re_skippers/}
uniq
@dlls;
if (!@dlls) {
say 'no more DLLs';
last DLL_CHECK;
}
my @dll2;
foreach my $file (@dlls) {
next if $searched_for{$file};
if (exists $dll_file_hash{$file}) {
push @dll2, $dll_file_hash{$file};
}
lib/App/PP/Autolink.pm view on Meta::CPAN
if (@missing) {
my @missing2;
MISSING:
foreach my $file (uniq @missing) {
next MISSING
if any {; -e "$_/$file"} @system_paths;
push @missing2, $file;
}
if (@missing2) {
say STDERR "\nUnable to locate these DLLS, packed script might not work: "
. join ' ', sort {$a cmp $b} @missing2;
say '';
}
}
return wantarray ? @l2 : \@l2;
}
sub _resolve_rpath_mac {
my ($source, $target) = @_;
say "Resolving rpath for $source wrt $target";
# clean up the target
$target =~ s|\@rpath/||;
my @results = qx /otool -l $source/;
while (my $line = shift @results) {
last if $line =~ /LC_RPATH/;
}
my @lc_rpath_chunk;
while (my $line = shift @results) {
lib/App/PP/Autolink.pm view on Meta::CPAN
push @checked_paths, $path;
}
}
# should handle multiple paths
return $checked_paths[0];
}
sub _resolve_loader_path_mac {
my ($source, $target) = @_;
say "Resolving loader_path for $source wrt $target";
my $source_path = path($source)->parent->stringify;
$target =~ s/\@loader_path/$source_path/;
return $target;
}
sub get_autolink_list_macos {
my ($self) = @_;
my $argv_linkers = $self->{argv_linkers};
lib/App/PP/Autolink.pm view on Meta::CPAN
my %seen;
my @target_libs = (
@$argv_linkers,
@bundle_list,
#'/usr/local/opt/libffi/lib/libffi.6.dylib',
#($pixbuf_query_loader,
#find_so_files ($gdk_pixbuf_dir) ) if $pack_gdkpixbuf,
);
while (my $lib = shift @target_libs) {
say "otool -L $lib";
my @lib_arr = qx /otool -L $lib/;
warn qq["otool -L $lib" failed\n]
if not $? == 0;
shift @lib_arr; # first result is dylib we called otool on
DEP_LIB:
foreach my $line (@lib_arr) {
$line =~ /^\s+(.+?)\s/;
my $dylib = $1;
if ($dylib =~ /\@rpath/i) {
my $orig_name = $dylib;
$dylib = _resolve_rpath_mac($lib, $dylib);
if (!defined $dylib) {
say STDERR "Cannot resolve rpath for $orig_name, dependency of $lib";
next DEP_LIB;
}
}
elsif ($dylib =~ /\@loader_path/) {
my $orig_name = $dylib;
$dylib = _resolve_loader_path_mac($lib, $dylib);
}
next if $seen{$dylib};
next if $dylib =~ m{^/System}; # skip system libs
#next if $dylib =~ m{^/usr/lib/system};
next if $dylib =~ m{^/usr/lib/libSystem};
next if $dylib =~ m{^/usr/lib/};
next if $dylib =~ m{\Qdarwin-thread-multi-2level/auto/share/dist/Alien\E}; # another alien
say "adding $dylib for $lib";
push @libs_to_pack, $dylib;
$seen{$dylib}++;
# add this dylib to the search set
push @target_libs, $dylib;
}
}
@libs_to_pack = sort @libs_to_pack;
return wantarray ? @libs_to_pack : \@libs_to_pack;
lib/App/PP/Autolink.pm view on Meta::CPAN
my %seen;
my $RE_skip = $self->get_ldd_skipper_regexp;
my @target_libs = (
@$argv_linkers,
@bundle_list,
);
while (my $lib = shift @target_libs) {
if ($lib =~ $RE_skip) {
say "skipping $lib";
next;
}
say "ldd $lib";
my $out = qx /ldd $lib/;
warn qq["ldd $lib" failed\n]
if not $? == 0;
# much of this logic is from PAR::Packer
# https://github.com/rschupp/PAR-Packer/blob/04a133b034448adeb5444af1941a5d7947d8cafb/myldr/find_files_to_embed/ldd.pl#L47
my %dlls = $out =~ /^ \s* (\S+) \s* => \s* ( \/ \S+ ) /gmx;
DLL:
foreach my $name (keys %dlls) {
#say "$name, $dlls{$name}";
if ($seen{$name} or $name =~ $RE_skip) {
delete $dlls{$name};
next DLL;
}
$seen{$name}++;
my $path = path($dlls{$name})->realpath;
#say "Checking $name => $path";
if (not -r $path) {
warn qq[# ldd reported strange path: $path\n];
delete $dlls{$name};
}
elsif (
#$path =~ m{^(?:/usr)?/lib(?:32|64)?/} # system lib
$path =~ $RE_skip
or $path =~ m{\Qdarwin-thread-multi-2level/auto/share/dist/Alien\E} # alien in share
or $name =~ m{^lib(?:c|gcc_s|stdc\+\+)\.} # should already be packed?
) {
#say "skipping $name => $path";
#warn "re1" if $path =~ m{^(?:/usr)?/lib(?:32|64)/};
#warn "re2" if $path =~ m{\Qdarwin-thread-multi-2level/auto/share/dist/Alien\E};
#warn "re3" if $name =~ m{^lib(?:gcc_s|stdc\+\+)\.};
delete $dlls{$name};
}
}
push @target_libs, sort values %dlls;
push @libs_to_pack, sort values %dlls;
}
lib/App/PP/Autolink.pm view on Meta::CPAN
files => [ $script ],
recurse => 1,
execute => !$no_execute_flag,
# cache_file => $cache_file,
);
#my @lib_paths
# = map {path($_)->absolute}
# grep {defined} # needed?
# @Config{qw /installsitearch installvendorarch installarchlib/};
#say join ' ', @lib_paths;
my @lib_paths
= reverse sort {length $a <=> length $b}
map {path($_)->absolute}
@INC;
my $paths = join '|', map {quotemeta} map {path($_)->stringify} @lib_paths;
my $inc_path_re = qr /^($paths)/i;
#say $inc_path_re;
#say "DEPS HASH:" . join "\n", keys %$deps_hash;
my %dll_hash;
my @aliens;
foreach my $package (keys %$deps_hash) {
my $details = $deps_hash->{$package};
my @uses = @{$details->{uses} // []};
if ($details->{key} =~ m{^Alien/.+\.pm$}) {
push @aliens, $package;
}
elsif ($details->{key} =~ m{^Gtk}) {
# we need to check the pixbuf loaders
lib/App/PP/Autolink.pm view on Meta::CPAN
ALIEN:
foreach my $package (@aliens) {
next if $package =~ m{^Alien/(Base|Build)};
my $package_inc_name = $package;
$package =~ s{/}{::}g;
$package =~ s/\.pm$//;
if (!$INC{$package_inc_name}) {
# if the execute flag was off then try to load the package
eval "require $package";
if ($@) {
say "Unable to require $package, skipping (error is $@)";
next ALIEN;
}
}
# some older aliens might do different things
next ALIEN if !$package->isa ('Alien::Base');
say "Finding dynamic libs for $package";
foreach my $path ($package->dynamic_libs) {
# warn $path;
$dll_hash{$path}++;
}
if ($package->install_type eq 'system') {
push @$alien_sys_installs, $package->dynamic_libs;
}
push @{$self->{alien_deps}}, $package;
}
my @dll_list = sort keys %dll_hash;
return wantarray ? @dll_list : \@dll_list;
}
sub process_gdk_pixbuf_loaders {
my ($self) = @_;
say 'Scanning gdk-pixbuf-query-loaders result';
my $ql = which 'gdk-pixbuf-query-loaders';
return if !$ql;
my $pixbuf_parent_path = path ($ql)->parent->parent;
my @res =
map {path $_}
grep {$_ =~ /$RE_DLL_EXT$/}
( run in 0.841 second using v1.01-cache-2.11-cpan-a1f116cd669 )