view release on metacpan or  search on metacpan

lib/App/PP/Autolink.pm  view on Meta::CPAN

    }

    #  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};

    my $OTOOL = which('otool')  or die "otool not found";
    
    my @bundle_list = $self->get_dep_dlls;
    my @libs_to_pack;
    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;
}

sub get_autolink_list_ldd {
    my ($self) = @_;
    
    my $argv_linkers = $self->{argv_linkers};
    
    my @bundle_list = $self->get_dep_dlls;
    my @libs_to_pack;
    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;
    }

    @libs_to_pack = sort @libs_to_pack;
    
    return wantarray ? @libs_to_pack : \@libs_to_pack;
}


#  needed for gdkpixbuf, when we support it 
sub find_so_files {
    my ($self, $target_dir) = @_;
    return if !defined $target_dir;

    my @files = File::Find::Rule->extras({ follow => 1, follow_skip=>2 })
                             ->file()
                             ->name( qr/\.so$/ )
                             ->in( $target_dir );
    return wantarray ? @files : \@files;
}

sub get_ldd_skipper_regexp {
    my ($self) = @_;
    my @skip = qw /libm libc libpthread libdl/;
    my $sk = join '|', @skip;
    my $qr_skip = qr {\b(?:$sk)\.$Config::Config{so}};
    
    return $qr_skip;
}

sub get_dll_skipper_regexp {
    my ($self) = @_;
    
    #  PAR packs these automatically these days.
    my @skip = qw /
        perl5\d\d
        libstdc\+\+\-6
        libgcc_s_seh\-1
        libwinpthread\-1
        libgcc_s_sjlj\-1
    /;
    my $sk = join '|', @skip;
    my $qr_skip = qr /^(?:$sk)$RE_DLL_EXT$/;
    return $qr_skip;
}

#  find dependent dlls
#  could also adapt some of Module::ScanDeps::_compile_or_execute
#  as it handles more edge cases
sub get_dep_dlls {
    my ($self) = @_;

    my $script = $self->{script_fullname};
    my $no_execute_flag = $self->{no_execute_flag};
    my $alien_sys_installs = $self->{alien_sys_installs};
    # my $cache_file = $self->{cache_file};

    my $deps_hash = scan_deps(
        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
            my @pixbuf_loaders = $self->process_gdk_pixbuf_loaders;
            push @uses, @pixbuf_loaders;
        }

        push @uses, $package
          if $details->{file} =~ $RE_DLL_EXT;

        next if !@uses;
        
        foreach my $dll (grep {$_ =~ $RE_DLL_EXT} @uses) {

lib/App/PP/Autolink.pm  view on Meta::CPAN

}

1;

__END__

=head1 NAME

pp_autolink - Run the pp (PAR Packager) utility while automatically finding dynamic libs to link

=head1 SYNOPSIS

pp_autolink S<--link some_dll> S<pp_opts> S<[ I<scriptfile> ]>

=head1 EXAMPLES

Note: As with L<pp>, when running on Microsoft Windows, the F<a.out> below will be
replaced by F<a.exe> instead.

    #  Pack 'hello.pl' into executable 'a.out'
    % pp_autolink hello.pl
    
    #  Pack 'hello.pl' into executable 'hello'
    #  (or 'hello.exe' on Win32)
    % pp_autolink -o hello hello.pl
                                
    #  pack hello.pl and its dependent dynamic libs,
    #  as well as some.dylib and other.dylib,
    #  and their dependent dynamic libs
    % pp_autolink --link some.dylib --link other.dylib -o hello hello.pl
    
    #  Args other than --link are passed on to the pp call
    #  e.g., extra modules in the include path
    #  (these are not currently checked by pp_autolink)
    % pp_autolink -M Foo::Bar hello      

    #  pp_autolink also supports the @file syntax for args
    #  Pack 'hello.pl' but read _additional_
    #  options from file 'file'
    % pp_autolink @file hello.pl         

=head1 DESCRIPTION

I<L<pp>> creates standalone executables from Perl programs.
However, it does not pack dynamic libs by default, and a general
source of angst is that dynamic libs have dependencies that must
be traced and also packed for the packed executable to be usable on
a "clean" system.

F<pp_autolink> is an attempt to automate this packing process.

All F<pp_autolink> does is recursively check all dynamic libs used by a perl script
and add them to the L<pp> call using C<--link> command line arguments.

Depending on your system it will use the I<ldd>, I<objdump> or I<otool>
utilities to find dependent libs.

It will also check dynamic libs used by Aliens if they are detected
and inherit from L<Alien::Base>.

Note that testing is currently very threadbare,
so please report issues.  Pull requests are very welcome.

=head1 OPTIONS

As with L<pp>, options are available in a I<short> form and a I<long> form.  For
example, these lines are equivalent:

    % pp_autolink -l some.dll output.exe input.pl
    % pp_autolink --link some.dll --output output.exe input.pl

All other options are passed on to the pp call.
See the L<pp|pp documentation> for full details.  


=head1 ENVIRONMENT

=over 4

=item PP_OPTS

The PP_OPTS environment variable, used by L<pp>, is ignored.
Since all pp_autolink does is wrangle dynamic libs and then add them to a pp call,
it will still be used for the final executable. 


=back

=head1 SEE ALSO

L<pp>, L<PAR>, L<PAR::Packer>, L<Module::ScanDeps>

L<Getopt::Long>, L<Getopt::ArgvFile>

=head1 ACKNOWLEDGMENTS

The initial version of pp_autolink was adapted
from the L<pp_simple|https://www.perlmonks.org/?node_id=1148802> utility.


=head1 AUTHORS

Shawn Laffan E<lt>shawnlaffan@gmail.comE<gt>,


Please submit bug reports to L<https://github.com/shawnlaffan/perl-pp-autolink/issues>.

=head1 COPYRIGHT

Copyright 2017-2020 by Shawn Laffan
E<lt>shawnlaffan@gmail.comE<gt>.


This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See F<LICENSE>.

=cut