Hello community, here is the log from the commit of package perl-Module-ScanDeps for openSUSE:Factory checked in at 2015-10-12 10:01:51 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Module-ScanDeps (Old) and /work/SRC/openSUSE:Factory/.perl-Module-ScanDeps.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Module-ScanDeps" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Module-ScanDeps/perl-Module-ScanDeps.changes 2015-06-11 08:22:55.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Module-ScanDeps.new/perl-Module-ScanDeps.changes 2015-10-12 10:01:52.000000000 +0200 @@ -1,0 +2,56 @@ +Tue Oct 6 08:54:47 UTC 2015 - co...@suse.com + +- updated to 1.20 + see /usr/share/doc/packages/perl-Module-ScanDeps/Changes + + 1.20 2015-10-04 + + - Fix RT #107304: Newer versions of File::Path cause warning "_Inline for _Inline: No such file or directory at Module/ScanDeps.pm line 1339." + - drop the dubious call to rmtree() + + - Fix RT106142: Preload dependencies for PDL and PDL::NiceSlice + - adopted from a patch by Shawn Laffan, thanks Shawn! + + - Fix RT#106144: Preload dependencies for File::BOM) + - adopted from a patch by Shawn Laffan, thanks Shawn! + + - Revise our stance on utf8.pm: + + - A line of "use utf8;" just means "this file is encoded in UTF-8" + and should _not_ result in scanning utf8.pm which will pull in + the whole Unicode shebang (propery tables and what not). + Yes, utf8.pm _doesn contain "require utf8_heavy.pl", but only inside + an AUTOLOAD() that is _not_ triggered by calling functions + like utf8::is_utf8(). + + - OTOH the innocently looking one-liner + + perl -ne 'print if /\pN/' + + implicitly loads utf8.pm and triggers the AUTOLAD(). + + - So prevent utf8.pm from being scanned and make utf8_heavy.pl + the indicator for "I need the Unicode stuff" instead. + + - Cache the results of _get_preload('utf8_heavy.pl'). + + - Make %Preload "transitive" so that given + + my %Preload = ( + 'Foo.pm' => [ 'Bar.pm' ], + 'Bar.pm' => [ 'Quux.pm' ], + ... + ); + + scan_deps_static() register a dependency on Bar.pm _and_ + Quux.pm when it saw "use Foo;" + + - Minor changes: + - drop dubious %Preload of utf8.pm for SOAP::Lite and XML::Parser::Expat + - drop code for Perl < 5.008 as we require 5.8.1 already + - rework the implementation of -x/-c + - add add_preload_rule() to dynamically add a %Preload rule + - recognize constructs like "open FH, '<:via(Foo)', ..." + - upgrade to Module::Install 1.16 + +------------------------------------------------------------------- Old: ---- Module-ScanDeps-1.19.tar.gz New: ---- Module-ScanDeps-1.20.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Module-ScanDeps.spec ++++++ --- /var/tmp/diff_new_pack.Fz3bZL/_old 2015-10-12 10:01:52.000000000 +0200 +++ /var/tmp/diff_new_pack.Fz3bZL/_new 2015-10-12 10:01:52.000000000 +0200 @@ -17,7 +17,7 @@ Name: perl-Module-ScanDeps -Version: 1.19 +Version: 1.20 Release: 0 %define cpan_name Module-ScanDeps Summary: Recursively scan Perl code for dependencies ++++++ Module-ScanDeps-1.19.tar.gz -> Module-ScanDeps-1.20.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/Changes new/Module-ScanDeps-1.20/Changes --- old/Module-ScanDeps-1.19/Changes 2015-05-27 10:47:07.000000000 +0200 +++ new/Module-ScanDeps-1.20/Changes 2015-10-04 15:12:33.000000000 +0200 @@ -1,3 +1,53 @@ +1.20 2015-10-04 + +- Fix RT #107304: Newer versions of File::Path cause warning "_Inline for _Inline: No such file or directory at Module/ScanDeps.pm line 1339." + - drop the dubious call to rmtree() + +- Fix RT106142: Preload dependencies for PDL and PDL::NiceSlice + - adopted from a patch by Shawn Laffan, thanks Shawn! + +- Fix RT#106144: Preload dependencies for File::BOM) + - adopted from a patch by Shawn Laffan, thanks Shawn! + +- Revise our stance on utf8.pm: + + - A line of "use utf8;" just means "this file is encoded in UTF-8" + and should _not_ result in scanning utf8.pm which will pull in + the whole Unicode shebang (propery tables and what not). + Yes, utf8.pm _doesn contain "require utf8_heavy.pl", but only inside + an AUTOLOAD() that is _not_ triggered by calling functions + like utf8::is_utf8(). + + - OTOH the innocently looking one-liner + + perl -ne 'print if /\pN/' + + implicitly loads utf8.pm and triggers the AUTOLAD(). + + - So prevent utf8.pm from being scanned and make utf8_heavy.pl + the indicator for "I need the Unicode stuff" instead. + + - Cache the results of _get_preload('utf8_heavy.pl'). + +- Make %Preload "transitive" so that given + + my %Preload = ( + 'Foo.pm' => [ 'Bar.pm' ], + 'Bar.pm' => [ 'Quux.pm' ], + ... + ); + + scan_deps_static() register a dependency on Bar.pm _and_ + Quux.pm when it saw "use Foo;" + +- Minor changes: + - drop dubious %Preload of utf8.pm for SOAP::Lite and XML::Parser::Expat + - drop code for Perl < 5.008 as we require 5.8.1 already + - rework the implementation of -x/-c + - add add_preload_rule() to dynamically add a %Preload rule + - recognize constructs like "open FH, '<:via(Foo)', ..." + - upgrade to Module::Install 1.16 + 1.19 2015-05-27 - add %Preload rule for LWP::MediaTypes: data file LWP/media.types diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/MANIFEST new/Module-ScanDeps-1.20/MANIFEST --- old/Module-ScanDeps-1.19/MANIFEST 2013-12-21 13:05:26.000000000 +0100 +++ new/Module-ScanDeps-1.20/MANIFEST 2015-10-04 15:17:03.000000000 +0200 @@ -11,7 +11,6 @@ inc/Module/Install/WriteAll.pm lib/Module/ScanDeps.pm lib/Module/ScanDeps/Cache.pm -lib/Module/ScanDeps/DataFeed.pm Makefile.PL MANIFEST This list of files META.yml @@ -76,3 +75,4 @@ t/data/use_lib.pl t/rt90869.t t/Utils.pm +wip/scan_dlls.pl diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/META.yml new/Module-ScanDeps-1.20/META.yml --- old/Module-ScanDeps-1.19/META.yml 2015-05-27 10:49:06.000000000 +0200 +++ new/Module-ScanDeps-1.20/META.yml 2015-10-04 15:16:02.000000000 +0200 @@ -10,7 +10,7 @@ ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 -generated_by: 'Module::Install version 1.14' +generated_by: 'Module::Install version 1.16' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -34,4 +34,4 @@ resources: license: http://dev.perl.org/licenses/ repository: https://www.openfoundry.org/svn/par/Module-ScanDeps/trunk -version: '1.19' +version: '1.20' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/inc/Module/Install/Base.pm new/Module-ScanDeps-1.20/inc/Module/Install/Base.pm --- old/Module-ScanDeps-1.19/inc/Module/Install/Base.pm 2015-05-27 10:49:05.000000000 +0200 +++ new/Module-ScanDeps-1.20/inc/Module/Install/Base.pm 2015-10-04 15:16:02.000000000 +0200 @@ -4,7 +4,7 @@ use strict 'vars'; use vars qw{$VERSION}; BEGIN { - $VERSION = '1.14'; + $VERSION = '1.16'; } # Suspend handler for "redefined" warnings diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/inc/Module/Install/Can.pm new/Module-ScanDeps-1.20/inc/Module/Install/Can.pm --- old/Module-ScanDeps-1.19/inc/Module/Install/Can.pm 2015-05-27 10:49:05.000000000 +0200 +++ new/Module-ScanDeps-1.20/inc/Module/Install/Can.pm 2015-10-04 15:16:02.000000000 +0200 @@ -8,7 +8,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.14'; + $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/inc/Module/Install/Fetch.pm new/Module-ScanDeps-1.20/inc/Module/Install/Fetch.pm --- old/Module-ScanDeps-1.19/inc/Module/Install/Fetch.pm 2015-05-27 10:49:05.000000000 +0200 +++ new/Module-ScanDeps-1.20/inc/Module/Install/Fetch.pm 2015-10-04 15:16:02.000000000 +0200 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.14'; + $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/inc/Module/Install/Makefile.pm new/Module-ScanDeps-1.20/inc/Module/Install/Makefile.pm --- old/Module-ScanDeps-1.19/inc/Module/Install/Makefile.pm 2015-05-27 10:49:05.000000000 +0200 +++ new/Module-ScanDeps-1.20/inc/Module/Install/Makefile.pm 2015-10-04 15:16:02.000000000 +0200 @@ -8,7 +8,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.14'; + $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/inc/Module/Install/Metadata.pm new/Module-ScanDeps-1.20/inc/Module/Install/Metadata.pm --- old/Module-ScanDeps-1.19/inc/Module/Install/Metadata.pm 2015-05-27 10:49:05.000000000 +0200 +++ new/Module-ScanDeps-1.20/inc/Module/Install/Metadata.pm 2015-10-04 15:16:02.000000000 +0200 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.14'; + $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/inc/Module/Install/Scripts.pm new/Module-ScanDeps-1.20/inc/Module/Install/Scripts.pm --- old/Module-ScanDeps-1.19/inc/Module/Install/Scripts.pm 2015-05-27 10:49:05.000000000 +0200 +++ new/Module-ScanDeps-1.20/inc/Module/Install/Scripts.pm 2015-10-04 15:16:02.000000000 +0200 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.14'; + $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/inc/Module/Install/Win32.pm new/Module-ScanDeps-1.20/inc/Module/Install/Win32.pm --- old/Module-ScanDeps-1.19/inc/Module/Install/Win32.pm 2015-05-27 10:49:05.000000000 +0200 +++ new/Module-ScanDeps-1.20/inc/Module/Install/Win32.pm 2015-10-04 15:16:02.000000000 +0200 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.14'; + $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/inc/Module/Install/WriteAll.pm new/Module-ScanDeps-1.20/inc/Module/Install/WriteAll.pm --- old/Module-ScanDeps-1.19/inc/Module/Install/WriteAll.pm 2015-05-27 10:49:05.000000000 +0200 +++ new/Module-ScanDeps-1.20/inc/Module/Install/WriteAll.pm 2015-10-04 15:16:02.000000000 +0200 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.14'; + $VERSION = '1.16'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/inc/Module/Install.pm new/Module-ScanDeps-1.20/inc/Module/Install.pm --- old/Module-ScanDeps-1.19/inc/Module/Install.pm 2015-05-27 10:49:05.000000000 +0200 +++ new/Module-ScanDeps-1.20/inc/Module/Install.pm 2015-10-04 15:16:01.000000000 +0200 @@ -31,7 +31,7 @@ # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. - $VERSION = '1.14'; + $VERSION = '1.16'; # Storage for the pseudo-singleton $MAIN = undef; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/lib/Module/ScanDeps/DataFeed.pm new/Module-ScanDeps-1.20/lib/Module/ScanDeps/DataFeed.pm --- old/Module-ScanDeps-1.19/lib/Module/ScanDeps/DataFeed.pm 2015-01-19 15:23:18.000000000 +0100 +++ new/Module-ScanDeps-1.20/lib/Module/ScanDeps/DataFeed.pm 1970-01-01 01:00:00.000000000 +0100 @@ -1,106 +0,0 @@ -package Module::ScanDeps::DataFeed; - -use strict; -use vars qw( %_INC @_INC @_dl_shared_objects @_dl_modules $_0 ); - -require Cwd; -require DynaLoader; -require Data::Dumper; -require B; -require Config; - -# Write %_INC, @_INC etc to $filename -sub _dump_info -{ - my ($filename) = @_; - - while (my ($k, $v) = each %_INC) - { - # Notes: - # (1) An unsuccessful "require" may store an undefined value into %INC. - # (2) If a key in %INC was located via a CODE or ARRAY ref or - # blessed object in @INC the corresponding value in %INC contains - # the ref from @INC. - # (3) Some modules (e.g. Moose) fake entries in %INC, e.g. - # "Class/MOP/Class/Immutable/Moose/Meta/Class.pm" => "(set by Moose)" - # On some architectures (e.g. Windows) Cwd::abs_path() will throw - # an exception for such a pathname. - if (defined $v && !ref $v && -e $v) - { - $_INC{$k} = Cwd::abs_path($v); - } - else - { - delete $_INC{$k}; - } - } - - # drop refs from @_INC - @_INC = grep { !ref $_ } @_INC; - - my $dlext = $Config::Config{dlext}; - my @so = grep { defined $_ && -e $_ } _dl_shared_objects(); - my @bs = @so; - my @shared_objects = ( @so, grep { s/\Q.$dlext\E$/\.bs/ && -e $_ } @bs ); - - open my $fh, ">", $filename - or die "Couldn't open $filename: $!\n"; - print $fh Data::Dumper->Dump( - [\%_INC, \@_INC, \@shared_objects], - [qw(*inchash *incarray *dl_shared_objects)]); - print $fh "1;\n"; - close $fh; -} - -sub _dl_shared_objects { - if (@_dl_shared_objects) { - return @_dl_shared_objects; - } - elsif (@_dl_modules) { - return map { _dl_mod2filename($_) } @_dl_modules; - } - return; -} - -sub _dl_mod2filename { - my $mod = shift; - - return if $mod eq 'B'; - return unless defined &{"$mod\::bootstrap"}; - - my $dl_ext = $Config::Config{dlext}; - - # cf. DynaLoader.pm - my @modparts = split(/::/, $mod); - my $modfname = defined &DynaLoader::mod2fname ? DynaLoader::mod2fname(\@modparts) : $modparts[-1]; - my $modpname = join('/', @modparts); - - foreach my $dir (@_INC) { - my $file = "$dir/auto/$modpname/$modfname.$dl_ext"; - return $file if -r $file; - } - - return; -} - -1; - -__END__ - -# AUTHORS -# -# Edward S. Peschko <e...@pge.come>, -# Audrey Tang <c...@audreyt.org>, -# to a lesser degree Steffen Mueller <smuel...@cpan.org> -# -# COPYRIGHT -# -# Copyright 2004-2009 by Edward S. Peschko <e...@pge.com>, -# Audrey Tang <c...@audreyt.org>, -# Steffen Mueller <smuel...@cpan.org> -# -# This program is free software; you can redistribute it and/or modify it -# under the same terms as Perl itself. -# -# See <http://www.perl.com/perl/misc/Artistic.html - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/lib/Module/ScanDeps.pm new/Module-ScanDeps-1.20/lib/Module/ScanDeps.pm --- old/Module-ScanDeps-1.19/lib/Module/ScanDeps.pm 2015-05-21 17:39:05.000000000 +0200 +++ new/Module-ScanDeps-1.20/lib/Module/ScanDeps.pm 2015-10-04 14:56:12.000000000 +0200 @@ -4,7 +4,7 @@ use warnings; use vars qw( $VERSION @EXPORT @EXPORT_OK @ISA $CurrentPackage @IncludeLibs $ScanFileRE ); -$VERSION = '1.19'; +$VERSION = '1.20'; @EXPORT = qw( scan_deps scan_deps_runtime ); @EXPORT_OK = qw( scan_line scan_chunk add_deps scan_deps_runtime path_to_inc_name ); @@ -222,8 +222,7 @@ my %SeenRuntimeLoader; # Pre-loaded module dependencies {{{ -my %Preload; -%Preload = ( +my %Preload = ( 'AnyDBM_File.pm' => [qw( SDBM_File.pm )], 'AnyEvent.pm' => 'sub', 'Authen/SASL.pm' => 'sub', @@ -331,6 +330,7 @@ grep /\bMM_/, _glob_in_inc('ExtUtils', 1); }, 'File/Basename.pm' => [qw( re.pm )], + 'File/BOM.pm' => [qw( Encode/Unicode.pm )], 'File/HomeDir.pm' => 'sub', 'File/Spec.pm' => sub { require File::Spec; @@ -376,10 +376,7 @@ LWP/RobotPUA.pm LWP/RobotUA.pm ), }, - 'LWP/Parallel/UserAgent.pm' => sub { - qw( LWP/Parallel.pm ), - @{ _get_preload('LWP/Parallel.pm') } - }, + 'LWP/Parallel/UserAgent.pm' => [qw( LWP/Parallel.pm )], 'LWP/UserAgent.pm' => sub { return( qw( URI/URL.pm URI/http.pm LWP/Protocol/http.pm ), @@ -430,6 +427,7 @@ _glob_in_inc('PDF/API2/Basic/TTF', 1); }, 'PDF/Writer.pm' => 'sub', + 'PDL/NiceSlice.pm' => 'sub', 'Perl/Critic.pm' => 'sub', #not only Perl/Critic/Policy 'PerlIO.pm' => [ 'PerlIO/scalar.pm' ], 'Pod/Usage.pm' => sub { # from Pod::Usage (as of 1.61) @@ -460,9 +458,8 @@ termios.ph asm/termios.ph sys/termiox.ph sys/termios.ph sys/ttycom.ph ) ], 'SOAP/Lite.pm' => sub { - ($] >= 5.008 ? ('utf8.pm') : ()), _glob_in_inc('SOAP/Transport', 1), - _glob_in_inc('SOAP/Lite/Deserializer', 1), + _glob_in_inc('SOAP/Lite', 1), }, 'Socket/GetAddrInfo.pm' => 'sub', 'SQL/Parser.pm' => sub { @@ -498,13 +495,9 @@ 'Tk/FBox.pm' => [qw( Tk/folder.xpm Tk/file.xpm )], 'Tk/Getopt.pm' => [qw( Tk/openfolder.xpm Tk/win.xbm )], 'Tk/Toplevel.pm' => [qw( Tk/Wm.pm )], - 'Unicode/UCD.pm' => sub { @{ _get_preload('utf8.pm') } }, + 'Unicode/UCD.pm' => [qw( utf8_heavy.pl )], 'URI.pm' => sub { grep !/urn/, _glob_in_inc('URI', 1) }, - 'utf8.pm' => sub { - # Perl 5.6.x: "unicode", Perl 5.8.x and up: "unicore" - my $unicore = _find_in_inc('unicore/Name.pl') ? 'unicore' : 'unicode'; - return ('utf8_heavy.pl', map $_->{name}, _glob_in_inc($unicore, 0)); - }, + 'utf8_heavy.pl' => \&_unicore, 'Win32/EventLog.pm' => [qw( Win32/IPC.pm )], 'Win32/Exe.pm' => 'sub', 'Win32/TieRegistry.pm' => [qw( Win32API/Registry.pm )], @@ -514,9 +507,6 @@ _glob_in_inc('XML/Parser/Style', 1), _glob_in_inc('XML/Parser/Encodings', 1), }, - 'XML/Parser/Expat.pm' => sub { - ($] >= 5.008) ? ('utf8.pm') : (); - }, 'XML/SAX.pm' => [qw( XML/SAX/ParserDetails.ini ) ], 'XMLRPC/Lite.pm' => sub { _glob_in_inc('XMLRPC/Transport', 1),; @@ -687,12 +677,12 @@ warn_missing => $args->{warn_missing}, ); - my $preload = _get_preload($pm) or next; + my @preload = _get_preload($pm) or next; add_deps( used_by => $key, rv => $args->{rv}, - modules => $preload, + modules => \@preload, skip => $args->{skip}, warn_missing => $args->{warn_missing}, ); @@ -700,6 +690,9 @@ } # Top-level recursion handling {{{ + + # prevent utf8.pm from being scanned + $_skip->{$rv->{"utf8.pm"}{file}}++ if $rv->{"utf8.pm"}; while ($recurse) { my $count = keys %$rv; @@ -712,7 +705,7 @@ recurse => 0, cache_cb => $cache_cb, _skip => $_skip, - }) or ($args->{_deep} and return); + }); last if $count == keys %$rv; } @@ -784,7 +777,7 @@ next if $file =~ /(?:^|${pathsep})Term${pathsep}ReadLine\.pm$/; next if $file =~ /(?:^|${pathsep})Tcl${pathsep}Tk\W/; } - $SeenTk || do{$SeenTk = 1 if $pm =~ /Tk\.pm$/;}; + $SeenTk ||= $pm =~ /Tk\.pm$/; $found{$pm}++; } @@ -958,12 +951,16 @@ # check for stuff like # decode("klingon", ...) # open FH, "<:encoding(klingon)", ... - if (my ($io_layer, $encoding) = /(?:(:encoding)|\b(?:en|de)code)\(\s*['"]?([-\w]+)/) { - my @mods = qw( Encode.pm ); - my $ext = _find_encoding($encoding); # "external" Encode module - push @mods, $ext if $ext; - push @mods, qw( PerlIO.pm PerlIO/encoding.pm ) if $io_layer; - return \@mods; + if (my ($args) = /\b(?:open|binmode)\b(.*)/) { + my @mods; + push @mods, qw( PerlIO.pm PerlIO/encoding.pm Encode.pm ), _find_encoding($1) + if $args =~ /:encoding\((.*?)\)/; + push @mods, qw( PerlIO.pm PerlIO/via.pm ) + if $args =~ /:via\(/; + return \@mods if @mods; + } + if (/\b(?:en|de)code\(\s*['"]?([-\w]+)/) { + return [qw( Encode.pm ), _find_encoding($1)]; } return $1 if /\b do \s+ ([\w:\.\-\\\/\"\']*)/x; @@ -1184,6 +1181,12 @@ return @files; } +my $unicore_stuff; +sub _unicore { + $unicore_stuff ||= [ map $_->{name}, _glob_in_inc('unicore', 0) ]; + return @$unicore_stuff; +} + # App::Packer compatibility functions sub new { @@ -1281,6 +1284,12 @@ return $self->{info}; } +sub add_preload_rule { + my ($pm, $rule) = @_; + die qq[a preload rule for "$pm" already exists] if $Preload{$pm}; + $Preload{$pm} = $rule; +} + # scan_deps_runtime utility functions # compile $file if $execute is undef, @@ -1288,66 +1297,128 @@ sub _compile_or_execute { my ($perl, $file, $execute, $inchash, $dl_shared_objects, $incarray) = @_; - require Module::ScanDeps::DataFeed; - # ... so we can find it's full pathname in %INC - - my ($feed_fh, $feed_file) = File::Temp::tempfile(); - my $dump_file = "$feed_file.out"; - - require Data::Dumper; + my ($fh, $instrumented_file) = File::Temp::tempfile(); # spoof $0 (to $file) so that FindBin works as expected # NOTE: We don't directly assign to $0 as it has magic (i.e. # assigning has side effects and may actually fail, cf. perlvar(1)). # Instead we alias *0 to a package variable holding the correct value. - print $feed_fh "BEGIN {\n", - Data::Dumper->Dump([ $file ], [ "Module::ScanDeps::DataFeed::_0" ]), - "*0 = \\\$Module::ScanDeps::DataFeed::_0;\n", - "}\n"; + local $ENV{MSD_ORIGINAL_FILE} = $file; + print $fh <<'...'; +BEGIN { my $_0 = $ENV{MSD_ORIGINAL_FILE}; *0 = \$_0; } +... + + my (undef, $data_file) = File::Temp::tempfile(); + local $ENV{MSD_DATA_FILE} = $data_file; - print $feed_fh $execute ? "END {\n" : "CHECK {\n" ; # NOTE: When compiling the block will run as the last CHECK block; # when executing the block will run as the first END block and # the programs continues. + print $fh $execute ? "END\n" : "CHECK\n", <<'...'; +{ + # save %INC etc so that requires below don't pollute them + my %_INC = %INC; + my @_INC = @INC; + my @_dl_shared_objects = @DynaLoader::dl_shared_objects; + my @_dl_modules = @DynaLoader::dl_modules; - # correctly escape strings containing filenames - print $feed_fh map { "my $_" } Data::Dumper->Dump( - [ $INC{"Module/ScanDeps/DataFeed.pm"}, $dump_file ], - [ qw( datafeedpm dump_file ) ]); - - # save %INC etc so that further requires don't pollute them - print $feed_fh <<'...'; - %Module::ScanDeps::DataFeed::_INC = %INC; - @Module::ScanDeps::DataFeed::_INC = @INC; - @Module::ScanDeps::DataFeed::_dl_shared_objects = @DynaLoader::dl_shared_objects; - @Module::ScanDeps::DataFeed::_dl_modules = @DynaLoader::dl_modules; + require Cwd; + require DynaLoader; + require Data::Dumper; + require B; + require Config; - require $datafeedpm; + while (my ($k, $v) = each %_INC) + { + # NOTES: + # (1) An unsuccessful "require" may store an undefined value into %INC. + # (2) If a key in %INC was located via a CODE or ARRAY ref or + # blessed object in @INC the corresponding value in %INC contains + # the ref from @INC. + # (3) Some modules (e.g. Moose) fake entries in %INC, e.g. + # "Class/MOP/Class/Immutable/Moose/Meta/Class.pm" => "(set by Moose)" + # On some architectures (e.g. Windows) Cwd::abs_path() will throw + # an exception for such a pathname. + if (defined $v && !ref $v && -e $v) + { + $_INC{$k} = Cwd::abs_path($v); + } + else + { + delete $_INC{$k}; + } + } - Module::ScanDeps::DataFeed::_dump_info($dump_file); -} + # drop refs from @_INC + @_INC = grep { !ref $_ } @_INC; + + my $dlext = $Config::Config{dlext}; + my @so = grep { defined $_ && -e $_ } Module::ScanDeps::DataFeed::_dl_shared_objects(); + my @bs = @so; + my @shared_objects = ( @so, grep { s/\Q.$dlext\E$/\.bs/ && -e $_ } @bs ); + + my $data_file = $ENV{MSD_DATA_FILE}; + open my $fh, ">", $data_file + or die "Couldn't open $data_file: $!\n"; + print $fh Data::Dumper->Dump( + [ \%_INC, \@_INC, \@shared_objects ], + [qw( *inchash *incarray *dl_shared_objects )]); + print $fh "1;\n"; + close $fh; + + sub Module::ScanDeps::DataFeed::_dl_shared_objects { + if (@_dl_shared_objects) { + return @_dl_shared_objects; + } + elsif (@_dl_modules) { + return map { Module::ScanDeps::DataFeed::_dl_mod2filename($_) } @_dl_modules; + } + return; + } + + sub Module::ScanDeps::DataFeed::_dl_mod2filename { + my $mod = shift; + + return if $mod eq 'B'; + return unless defined &{"$mod\::bootstrap"}; + + my $dl_ext = $Config::Config{dlext}; + + # cf. DynaLoader.pm + my @modparts = split(/::/, $mod); + my $modfname = defined &DynaLoader::mod2fname ? DynaLoader::mod2fname(\@modparts) : $modparts[-1]; + my $modpname = join('/', @modparts); + + foreach my $dir (@_INC) { + my $file = "$dir/auto/$modpname/$modfname.$dl_ext"; + return $file if -r $file; + } + return; + } +} # END or CHECK ... # append the file to compile or execute { - open my $fhin, "<", $file or die "Couldn't open $file: $!"; - print $feed_fh qq[#line 1 "$file"\n], <$fhin>; - close $fhin; + open my $in, "<", $file or die "Couldn't open $file: $!"; + print $fh qq[#line 1 "$file"\n], <$in>; + close $in; } - close $feed_fh; + close $fh; - File::Path::rmtree( ['_Inline'], 0, 1); # XXX hack - + # run the instrumented file my @cmd = ($perl); push @cmd, "-c" unless $execute; push @cmd, map { "-I$_" } @IncludeLibs; - push @cmd, $feed_file; + push @cmd, $instrumented_file; push @cmd, @$execute if $execute; my $rc = system(@cmd); - _extract_info($dump_file, $inchash, $dl_shared_objects, $incarray) + _extract_info($data_file, $inchash, $dl_shared_objects, $incarray) if $rc == 0; - unlink($feed_file, $dump_file); + + unlink($instrumented_file, $data_file); + die $execute ? "SYSTEM ERROR in executing $file @$execute: $rc" : "SYSTEM ERROR in compiling $file: $rc" @@ -1495,17 +1566,32 @@ if not -f $module; } -sub _get_preload { +sub _get_preload1 { my $pm = shift; my $preload = $Preload{$pm} or return(); if ($preload eq 'sub') { $pm =~ s/\.p[mh]$//i; - $preload = [ _glob_in_inc($pm, 1) ]; + return _glob_in_inc($pm, 1); } elsif (UNIVERSAL::isa($preload, 'CODE')) { - $preload = [ $preload->($pm) ]; + return $preload->($pm); + } + return @$preload; +} + +sub _get_preload { + my ($pm, $seen) = @_; + $seen ||= {}; + $seen->{$pm}++; + my @preload; + + foreach $pm (_get_preload1($pm)) + { + next if $seen->{$pm}; + $seen->{$pm}++; + push @preload, $pm, _get_preload($pm, $seen); } - return $preload; + return @preload; } 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/t/17-private_methods.t new/Module-ScanDeps-1.20/t/17-private_methods.t --- old/Module-ScanDeps-1.19/t/17-private_methods.t 2012-02-21 16:25:41.000000000 +0100 +++ new/Module-ScanDeps-1.20/t/17-private_methods.t 2015-10-04 14:56:12.000000000 +0200 @@ -6,8 +6,6 @@ use Test::More tests => 1; use Module::ScanDeps (); -{ -my @array=sort (@{Module::ScanDeps::_get_preload('Event.pm')}); -ok(grep {$_ eq 'Event/idle.pm'} @array) or diag(join(', ',@array)); -} +my @deps = Module::ScanDeps::_get_preload('Event.pm'); +ok(grep {$_ eq 'Event/idle.pm'} @deps) or diag(join(', ',@deps)); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Module-ScanDeps-1.19/wip/scan_dlls.pl new/Module-ScanDeps-1.20/wip/scan_dlls.pl --- old/Module-ScanDeps-1.19/wip/scan_dlls.pl 1970-01-01 01:00:00.000000000 +0100 +++ new/Module-ScanDeps-1.20/wip/scan_dlls.pl 2015-10-04 14:56:12.000000000 +0200 @@ -0,0 +1,236 @@ +#!/usr/bin/perl + +# recursively find NEEDED (in the ELF sense) shared libraries +# for a given share library or for all installed Perl "glue" libraries + +use strict; +use warnings; + +use File::Spec; +use File::Find; +use File::Basename; + +package DLL +{ + use strict; + use warnings; + use Capture::Tiny qw(:all); + + our ($show_system_libs, $show_perl_libs); # default: don't show + + my @dll_path = File::Spec->path; # Windows + # my @dll_path = qw(/lib /lib/x86_64-linux-gnu /usr/lib /usr/lib/x86_64-linux-gnu); + # + $ENV{LD_LIBRARY_PATH} if set + # Linux (Debian multi-arch) + # maybe use "gcc -print-search-dirs" (pathnames may need canonicalization) + # install: /usr/lib/gcc/x86_64-linux-gnu/4.9/ + # programs: =/usr/lib/gcc/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/:/usr/lib/gcc/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/bin/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/bin/x86_64-linux-gnu/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/bin/ + # libraries: =/usr/lib/gcc/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/lib/x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/lib/x86_64-linux-gnu/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/lib/../lib/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/4.9/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../lib/:/lib/x86_64-linux-gnu/4.9/:/lib/x86_64-linux-gnu/:/lib/../lib/:/usr/lib/x86_64-linux-gnu/4.9/:/usr/lib/x86_64-linux-gnu/:/usr/lib/../lib/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/lib/:/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../:/lib/:/usr/lib/ + + require Tie::CPHash; + tie my %cache, "Tie::CPHash"; + + sub name { shift->{name} } + sub path { shift->{path} } + + + sub find # class method + { + my ($class, $name) = @_; + unless ($cache{$name}) + { + my $found; + foreach (@dll_path) + { + my $path = File::Spec->catfile($_, $name); + $found = $path, last if -e $path; + } + + $cache{$name} = bless { + name => $name, + path => $found, + }, $class; + } + return $cache{$name}; + } + + sub needed + { + my ($self, $path) = @_; + if (ref $self) + { + return @{ $self->{needed} } if $self->{needed}; + $path = $self->{path}; + die "can't find DLL $self->{name}" unless defined $path; + } + else + { + die __PACKAGE__."->needed: argument PATH missing" unless defined $path; + } + + my ($out, $err, $exit) = capture { system(qw( objdump -ax ), $path) }; + die qq["objdump -ax $path" failed: $err] unless $exit == 0; + + my @needed = map { __PACKAGE__->find($_) } + $out =~ /^\s*DLL Name:\s*(\S+)/gm; # Windows + # $out =~ /^\s*NEEDED\s+(\S+)/gm; # Linux + $self->{needed} = \@needed if ref $self; + return @needed; + } + + + sub depends + { + my ($self, $path) = @_; + if (ref $self) + { + $path = $self->{path}; + die "can't find DLL $self->{name}" unless defined $path; + } + else + { + die __PACKAGE__."->depends argument PATH missing" unless defined $path; + } + + tie my %seen, "Tie::CPHash"; + $seen{$self->name} = $self if ref $self; + _depends(\%seen, $self->needed($path)); + return values %seen; + } + + sub _depends + { + my ($seen, @needed) = @_; + + foreach (@needed) + { + next if $seen->{$_->name}; + if (defined $_->path) + { + next if $_->is_system_lib && !$show_system_libs; + next if $_->is_perl_lib && !$show_perl_libs; + } + + $seen->{$_->name} = $_; + _depends($seen, $_->needed) if defined $_->path; + } + } + + sub canon_path + { + my ($self) = @_; + return unless defined $_->path; + + return $_->{canon_path} ||= _canon_path($_->path); + } + + sub _canon_path + { + my ($path, $no_file) = @_; + + my ($vol, $dirs, $file) = File::Spec->splitpath($path, $no_file); + $dirs =~ s{[/\\]$}{}; + my $foo = join("/", $vol, File::Spec->splitdir($dirs), $file); + return lc $foo; + } + + my $system_root = _canon_path($ENV{SystemRoot}, 1); + + sub is_system_lib + { + my ($self) = @_; + my $canon_path = $_->canon_path or return; + return length $canon_path > length $system_root + && substr($canon_path, 0, length $system_root) eq $system_root; + } + + tie my %perl_libs, "Tie::CPHash"; + { + local $show_system_libs = 0; + local $show_perl_libs = 1; + $perl_libs{$_->name} = $_ foreach __PACKAGE__->depends($^X); + }; + + sub is_perl_lib { $perl_libs{shift->name} ? 1 : 0 } +} + + +# return a list of installed (ie. found below some directory in @INC) glue DLLs +sub find_all_installed_glue_dlls +{ + my @dlls; + + find(sub { push @dlls, $File::Find::name if /\.dll/i; }, + grep { my $auto; + !ref $_ && -d ($auto = File::Spec->catdir($_, "auto")) ? + $auto : () + } @INC); + + return @dlls; +} + + +# guess the Perl module from the pathname of a glue DLL +sub guess_module_from_glue_dll +{ + my ($path) = @_; + + # module Foo::Bar::Quux typically installs its glue DLL as + # .../auto/Foo/Bar/Quux/Quux.dll or + # .../auto/Foo/Bar/Quux/Quux.xs.dll + my ($vol, $dirs, $file) = File::Spec->splitpath($path); + $dirs =~ s{[/\\]$}{}; + $dirs =~ s{^(?:.*?[/\\])?auto[/\\]}{} + or warn(qq[DLL "$path": path doesn't contain "auto"\n]), return; + return join("::", File::Spec->splitdir($dirs)); +} + + +my $show_lib_path = 0; +sub show_lib +{ + my ($dll) = @_; + if ($show_lib_path) + { + printf "\t%s => %s\n", $dll->name, $dll->path || "(not found)"; + } + else + { + printf "\t%s\n", $dll->name; + } +} + +if (@ARGV) +{ + foreach (@ARGV) + { + print $_, "\n"; + show_lib($_) foreach DLL->depends($_); + } +} +else +{ + my %mod2dll; + my @non_mod_dlls; + foreach (find_all_installed_glue_dlls()) + { + my $mod = guess_module_from_glue_dll($_); + push(@non_mod_dlls, $_), next unless $mod; + $mod2dll{$mod} = $_; + } + + foreach my $mod (sort keys %mod2dll) + { + my $dll = $mod2dll{$mod}; + my @deps = DLL->depends($dll) or next; # suppress glue DLLs w/o dependencies + print "$mod ($dll)\n"; + show_lib($_) foreach @deps; + } + + print "\n"; + foreach my $dll (sort @non_mod_dlls) + { + print "$dll\n"; + show_lib($_) foreach DLL->depends($dll); + } +}