Hello community,
here is the log from the commit of package perl-Module-ScanDeps for
openSUSE:Factory checked in at 2018-09-24 13:11:57
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Module-ScanDeps (Old)
and /work/SRC/openSUSE:Factory/.perl-Module-ScanDeps.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Module-ScanDeps"
Mon Sep 24 13:11:57 2018 rev:22 rq:636833 version:1.25
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Module-ScanDeps/perl-Module-ScanDeps.changes
2017-07-21 22:47:29.856823301 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Module-ScanDeps.new/perl-Module-ScanDeps.changes
2018-09-24 13:12:08.609824520 +0200
@@ -1,0 +2,25 @@
+Thu Sep 20 05:37:29 UTC 2018 - Stephan Kulow <[email protected]>
+
+- updated to 1.25
+ see /usr/share/doc/packages/perl-Module-ScanDeps/Changes
+
+ 1.25 2018-08-18
+
+ - Merge pull request #2 from shawnlaffan/master, thanx Shawn!
+
+ continue scanning one-liners when use if, autouse or >5.010 found
+
+ - Fix how data obtained from compiling or executing a file
+ is incorporated (_info2rv).
+
+ Sanitize all pathnames to use slash (instead of backslash):
+ - members of @INC
+ - keys and values of %INC
+ - members of @dl_shared_objects
+ This should make stripping @INC prefixes finally work.
+
+ - Add %Preload rule for FFI::Platypus
+
+ - Add bugtracker to META.yml
+
+-------------------------------------------------------------------
Old:
----
Module-ScanDeps-1.24.tar.gz
New:
----
Module-ScanDeps-1.25.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Module-ScanDeps.spec ++++++
--- /var/tmp/diff_new_pack.T8pZUy/_old 2018-09-24 13:12:09.053823737 +0200
+++ /var/tmp/diff_new_pack.T8pZUy/_new 2018-09-24 13:12:09.053823737 +0200
@@ -1,7 +1,7 @@
#
# spec file for package perl-Module-ScanDeps
#
-# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -12,16 +12,16 @@
# license that conforms to the Open Source Definition (Version 1.9)
# published by the Open Source Initiative.
-# Please submit bugfixes or comments via http://bugs.opensuse.org/
+# Please submit bugfixes or comments via https://bugs.opensuse.org/
#
Name: perl-Module-ScanDeps
-Version: 1.24
+Version: 1.25
Release: 0
%define cpan_name Module-ScanDeps
Summary: Recursively scan Perl code for dependencies
-License: Artistic-1.0 or GPL-1.0+
+License: Artistic-1.0 OR GPL-1.0-or-later
Group: Development/Libraries/Perl
Url: http://search.cpan.org/dist/Module-ScanDeps/
Source0:
https://cpan.metacpan.org/authors/id/R/RS/RSCHUPP/%{cpan_name}-%{version}.tar.gz
++++++ Module-ScanDeps-1.24.tar.gz -> Module-ScanDeps-1.25.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Module-ScanDeps-1.24/Changes
new/Module-ScanDeps-1.25/Changes
--- old/Module-ScanDeps-1.24/Changes 2017-06-28 19:08:23.000000000 +0200
+++ new/Module-ScanDeps-1.25/Changes 2018-08-17 22:41:44.000000000 +0200
@@ -1,3 +1,22 @@
+1.25 2018-08-18
+
+- Merge pull request #2 from shawnlaffan/master, thanx Shawn!
+
+ continue scanning one-liners when use if, autouse or >5.010 found
+
+- Fix how data obtained from compiling or executing a file
+ is incorporated (_info2rv).
+
+ Sanitize all pathnames to use slash (instead of backslash):
+ - members of @INC
+ - keys and values of %INC
+ - members of @dl_shared_objects
+ This should make stripping @INC prefixes finally work.
+
+- Add %Preload rule for FFI::Platypus
+
+- Add bugtracker to META.yml
+
1.24 2017-06-28
- Merge pull request from Salvador Fandiño (salva), thx!
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Module-ScanDeps-1.24/MANIFEST
new/Module-ScanDeps-1.25/MANIFEST
--- old/Module-ScanDeps-1.24/MANIFEST 2017-06-28 19:09:15.000000000 +0200
+++ new/Module-ScanDeps-1.25/MANIFEST 2018-08-17 23:53:16.000000000 +0200
@@ -66,6 +66,5 @@
t/data/use_lib.pl
t/rt90869.t
t/Utils.pm
-wip/scan_dlls.pl
META.yml Module YAML meta-data (added by
MakeMaker)
META.json Module JSON meta-data (added by
MakeMaker)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Module-ScanDeps-1.24/META.json
new/Module-ScanDeps-1.25/META.json
--- old/Module-ScanDeps-1.24/META.json 2017-06-28 19:09:15.000000000 +0200
+++ new/Module-ScanDeps-1.25/META.json 2018-08-17 23:53:15.000000000 +0200
@@ -4,7 +4,7 @@
"Audrey Tang <[email protected]>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter
version 2.150010",
+ "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter
version 2.150010",
"license" : [
"perl_5"
],
@@ -54,13 +54,16 @@
},
"release_status" : "stable",
"resources" : {
+ "bugtracker" : {
+ "web" : "https://rt.cpan.org/Dist/Display.html?Queue=Module-ScanDeps";
+ },
"repository" : {
"type" : "git",
"url" : "git://github.com/rschupp/Module-ScanDeps.git",
"web" : "https://github.com/rschupp/Module-ScanDeps";
},
- "x_MailingList" : "[email protected]"
+ "x_MailingList" : "mailto:[email protected]";
},
- "version" : "1.24",
- "x_serialization_backend" : "JSON::PP version 2.27300_01"
+ "version" : "1.25",
+ "x_serialization_backend" : "JSON::PP version 2.27400_02"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Module-ScanDeps-1.24/META.yml
new/Module-ScanDeps-1.25/META.yml
--- old/Module-ScanDeps-1.24/META.yml 2017-06-28 19:09:15.000000000 +0200
+++ new/Module-ScanDeps-1.25/META.yml 2018-08-17 23:53:15.000000000 +0200
@@ -9,7 +9,7 @@
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter
version 2.150010'
+generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version
2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -31,7 +31,8 @@
perl: '5.008001'
version: '0'
resources:
- MailingList: [email protected]
+ MailingList: mailto:[email protected]
+ bugtracker: https://rt.cpan.org/Dist/Display.html?Queue=Module-ScanDeps
repository: git://github.com/rschupp/Module-ScanDeps.git
-version: '1.24'
+version: '1.25'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Module-ScanDeps-1.24/Makefile.PL
new/Module-ScanDeps-1.25/Makefile.PL
--- old/Module-ScanDeps-1.24/Makefile.PL 2016-12-21 20:09:16.000000000
+0100
+++ new/Module-ScanDeps-1.25/Makefile.PL 2018-08-12 14:10:11.000000000
+0200
@@ -36,7 +36,8 @@
url => 'git://github.com/rschupp/Module-ScanDeps.git',
web => 'https://github.com/rschupp/Module-ScanDeps',
},
- MailingList => '[email protected]',
+ MailingList => 'mailto:[email protected]',
+ bugtracker => { web =>
'https://rt.cpan.org/Dist/Display.html?Queue=Module-ScanDeps' },
},
no_index => {
package => [qw( Module::ScanDeps::Cache Module::ScanDeps::DataFeed )],
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Module-ScanDeps-1.24/lib/Module/ScanDeps.pm
new/Module-ScanDeps-1.25/lib/Module/ScanDeps.pm
--- old/Module-ScanDeps-1.24/lib/Module/ScanDeps.pm 2017-06-28
19:02:47.000000000 +0200
+++ new/Module-ScanDeps-1.25/lib/Module/ScanDeps.pm 2018-08-17
22:41:44.000000000 +0200
@@ -4,7 +4,7 @@
use warnings;
use vars qw( $VERSION @EXPORT @EXPORT_OK @ISA $CurrentPackage @IncludeLibs
$ScanFileRE );
-$VERSION = '1.24';
+$VERSION = '1.25';
@EXPORT = qw( scan_deps scan_deps_runtime );
@EXPORT_OK = qw( scan_line scan_chunk add_deps scan_deps_runtime
path_to_inc_name );
@@ -332,6 +332,7 @@
'ExtUtils/MakeMaker.pm' => sub {
grep /\bMM_/, _glob_in_inc('ExtUtils', 1);
},
+ 'FFI/Platypus' => 'sub',
'File/Basename.pm' => [qw( re.pm )],
'File/BOM.pm' => [qw( Encode/Unicode.pm )],
'File/HomeDir.pm' => 'sub',
@@ -736,16 +737,14 @@
foreach my $file (@$files) {
next unless $file =~ $ScanFileRE;
- my ($inchash, $dl_shared_objects, $incarray) =
_compile_or_execute($file);
- _merge_rv(_make_rv($inchash, $dl_shared_objects, $incarray), $rv);
+ _merge_rv(_info2rv(_compile_or_execute($file)), $rv);
}
}
elsif ($execute) {
foreach my $file (@$files) {
$execute = [] unless ref $execute; # make sure it's an array ref
- my ($inchash, $dl_shared_objects, $incarray) =
_compile_or_execute($file, $execute);
- _merge_rv(_make_rv($inchash, $dl_shared_objects, $incarray), $rv);
+ _merge_rv(_info2rv(_compile_or_execute($file, $execute)), $rv);
}
}
@@ -798,20 +797,22 @@
$line =~ s/\s*#.*$//;
$line =~ s/[\\\/]+/\//g;
+ CHUNK:
foreach (split(/;/, $line)) {
s/^\s*//;
if (/^package\s+(\w+)/) {
$CurrentPackage = $1;
$CurrentPackage =~ s{::}{/}g;
- return;
+ next CHUNK;
}
# use VERSION:
if (/^(?:use|require)\s+v?(\d[\d\._]*)/) {
# include feature.pm if we have 5.9.5 or better
if (version->new($1) >= version->new("5.9.5")) {
# seems to catch 5.9, too (but not 5.9.4)
- return "feature.pm";
+ $found{"feature.pm"}++;
+ next CHUNK;
}
}
@@ -846,7 +847,9 @@
return if $@ or !defined $module;
};
$module =~ s{::}{/}g;
- return ("$pragma.pm", "$module.pm");
+ $found{"$pragma.pm"}++;
+ $found{"$module.pm"}++;
+ next CHUNK;
}
if (my ($how, $libs) = /^(use \s+ lib \s+ | (?:unshift|push) \s+ \@INC
\s+ ,) (.+)/x)
@@ -862,7 +865,7 @@
unshift(@INC, $_) if -d $_;
}
}
- next;
+ next CHUNK;
}
$found{$_}++ for scan_chunk($_);
@@ -1326,24 +1329,27 @@
sub _compile_or_execute {
my ($file, $execute) = @_;
+ local $ENV{MSD_ORIGINAL_FILE} = $file;
+
my ($ih, $instrumented_file) = File::Temp::tempfile(UNLINK => 1);
+ my (undef, $data_file) = File::Temp::tempfile(UNLINK => 1);
+ local $ENV{MSD_DATA_FILE} = $data_file;
+
# 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.
- local $ENV{MSD_ORIGINAL_FILE} = $file;
print $ih <<'...';
BEGIN { my $_0 = $ENV{MSD_ORIGINAL_FILE}; *0 = \$_0; }
...
- my (undef, $data_file) = File::Temp::tempfile(UNLINK => 1);
- local $ENV{MSD_DATA_FILE} = $data_file;
-
# 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 $ih $execute ? "END\n" : "CHECK\n", <<'...';
+ print $ih
+ $execute ? "END\n" : "CHECK\n",
+ <<'...';
{
# save %INC etc so that requires below don't pollute them
my %_INC = %INC;
@@ -1354,7 +1360,6 @@
require Cwd;
require DynaLoader;
require Data::Dumper;
- require B;
require Config;
while (my ($k, $v) = each %_INC)
@@ -1382,17 +1387,20 @@
@_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 @dlls = grep { defined $_ && -e $_ }
Module::ScanDeps::DataFeed::_dl_shared_objects();
+ my @shared_objects = @dlls;
+ push @shared_objects, grep { s/\Q.$dlext\E$/\.bs/ && -e $_ } @dlls;
+ # write data file
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";
+ print $fh Data::Dumper::Dumper(
+ {
+ '%INC' => \%_INC,
+ '@INC' => \@_INC,
+ dl_shared_objects => \@shared_objects,
+ });
close $fh;
sub Module::ScanDeps::DataFeed::_dl_shared_objects {
@@ -1448,40 +1456,45 @@
: "SYSTEM ERROR in compiling $file: $rc"
unless $rc == 0;
- return _extract_info($data_file);
+ my $info = do $data_file
+ or die "error extracting info from -c/-x file: ", ($@ || "can't read
$data_file: $!");
+
+ return $info;
}
# create a new hashref, applying fixups
-sub _make_rv {
- my ($inchash, $dl_shared_objects, $inc_array) = @_;
+sub _info2rv {
+ my ($info) = @_;
my $rv = {};
- my @newinc = map(quotemeta($_), @$inc_array);
- my $inc = join('|', sort { length($b) <=> length($a) } @newinc);
- # don't pack lib/c:/ or lib/C:/
- $inc = qr/$inc/i if(is_insensitive_fs());
+
+ my $incs = join('|', sort { length($b) <=> length($a) }
+ map { s:\\:/:g; quotemeta($_) } @{
$info->{'@INC'} });
+ my $i = is_insensitive_fs() ? "i" : "";
+ my $strip_inc_prefix = qr{^(?$i:$incs)/};
require File::Spec;
- foreach my $key (keys(%$inchash)) {
- my $newkey = $key;
- $newkey =~ s"^(?:(?:$inc)/?)""sg if
File::Spec->file_name_is_absolute($newkey);
+ while (my ($key, $path) = each %{ $info->{'%INC'} }) {
+ $path =~ s:\\:/:g;
+ $key =~ s:\\:/:g;
+ $key =~ s/$strip_inc_prefix// if
File::Spec->file_name_is_absolute($key);
- $rv->{$newkey} = {
+ $rv->{$key} = {
'used_by' => [],
- 'file' => $inchash->{$key},
- 'type' => _gettype($inchash->{$key}),
+ 'file' => $path,
+ 'type' => _gettype($path),
'key' => $key
};
}
- foreach my $dl_file (@$dl_shared_objects) {
- my $key = $dl_file;
- $key =~ s"^(?:(?:$inc)/?)""s;
+ foreach my $path (@{ $info->{dl_shared_objects} }) {
+ $path =~ s:\\:/:g;
+ (my $key = $path) =~ s/$strip_inc_prefix//;
$rv->{$key} = {
'used_by' => [],
- 'file' => $dl_file,
+ 'file' => $path,
'type' => 'shared',
'key' => $key
};
@@ -1490,22 +1503,6 @@
return $rv;
}
-sub _extract_info {
- my ($fname) = @_;
-
- use vars qw(%inchash @dl_shared_objects @incarray);
-
- unless (do $fname) {
- die "error extracting info from DataFeed file: ",
- $@ || "can't read $fname: $!";
- }
-
- my %ih = %inchash;
- my @dso = @dl_shared_objects;
- my @ia = @incarray;
- return (\%ih, \@dso, \@ia);
-}
-
sub _gettype {
my $name = shift;
my $dlext = quotemeta(dl_ext());
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Module-ScanDeps-1.24/t/16-scan_line.t
new/Module-ScanDeps-1.25/t/16-scan_line.t
--- old/Module-ScanDeps-1.24/t/16-scan_line.t 2016-11-21 18:48:53.000000000
+0100
+++ new/Module-ScanDeps-1.25/t/16-scan_line.t 2018-01-20 14:41:55.000000000
+0100
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 3;
+use Test::More tests => 7;
use Module::ScanDeps qw/scan_line/;
{
@@ -32,3 +32,36 @@
is($@,'');
}
+{ # use 5.010 in one-liners was only returning feature.pm (actually, 5.9.5
or higher)
+ my $chunk = 'use 5.010; use MyModule::PlaceHolder1;';
+ my @got = scan_line($chunk);
+ #diag @got;
+ my @expected = sort ('feature.pm', 'MyModule/PlaceHolder1.pm');
+ is_deeply (\@expected, [sort @got], 'got more than just feature.pm when "use
5.010" in one-liner');
+}
+
+{ # use 5.009 in one-liners should not return feature.pm
+ my $chunk = 'use 5.009; use MyModule::PlaceHolder1;';
+ my @got = scan_line($chunk);
+ #diag @got;
+ my @expected = sort ('MyModule/PlaceHolder1.pm');
+ is_deeply (\@expected, [sort @got], 'did not get feature.pm when "use 5.009"
in one-liner');
+}
+
+
+{ # avoid early return when pragma is found in one-liners
+ my $chunk = 'use if 1, MyModule::PlaceHolder2; use MyModule::PlaceHolder1;';
+ my @got = scan_line($chunk);
+ #diag @got;
+ my @expected = sort ('if.pm', 'MyModule/PlaceHolder1.pm',
'MyModule/PlaceHolder2.pm');
+ is_deeply (\@expected, [sort @got], 'if-pragma used in one-liner');
+}
+
+{ # avoid early return when pragma is found in one-liners
+ my $chunk = 'use autouse "MyModule::PlaceHolder2"; use
MyModule::PlaceHolder1;';
+ my @got = scan_line($chunk);
+ #diag @got;
+ my @expected = sort ('autouse.pm', 'MyModule/PlaceHolder1.pm',
'MyModule/PlaceHolder2.pm');
+ is_deeply (\@expected, [sort @got], 'autouse pragma used in one-liner');
+}
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Module-ScanDeps-1.24/t/7-check-dynaloader.t
new/Module-ScanDeps-1.25/t/7-check-dynaloader.t
--- old/Module-ScanDeps-1.24/t/7-check-dynaloader.t 2016-11-21
18:48:53.000000000 +0100
+++ new/Module-ScanDeps-1.25/t/7-check-dynaloader.t 2017-07-01
17:08:16.000000000 +0200
@@ -7,6 +7,7 @@
use Module::ScanDeps;
use DynaLoader;
use File::Temp;
+use Data::Dumper;
plan skip_all => "No dynamic loading available in your version of perl"
unless $Config::Config{usedl};
@@ -29,49 +30,53 @@
my $modfname = defined &DynaLoader::mod2fname ?
DynaLoader::mod2fname(\@modparts) : $modparts[-1];
my $auto_path = join('/', 'auto', @modparts,
"$modfname.$Config::Config{dlext}");
- check_bundle_path($module, $auto_path, ".pl", <<"...",
-use $module;
-1;
-...
+ check_bundle_path($module, $auto_path,
sub { scan_deps(
files => [ $_[0] ],
recurse => 0);
- }
- );
- check_bundle_path($module, $auto_path, ".pm", <<"...",
-package Bar;
+ },
+ ".pl", <<"...",
use $module;
1;
...
+ );
+ check_bundle_path($module, $auto_path,
sub { scan_deps_runtime(
files => [ $_[0] ],
recurse => 0,
compile => 1);
- }
+ },
+ ".pm", <<"...",
+package Bar;
+use $module;
+1;
+...
);
- check_bundle_path($module, $auto_path, ".pl", <<"...",
+ check_bundle_path($module, $auto_path,
+ sub { scan_deps_runtime(
+ files => [ $_[0] ],
+ recurse => 0,
+ execute => 1);
+ },
+ ".pl", <<"...",
# no way in hell can this detected by static analysis :)
my \$req = join("", qw( r e q u i r e ));
eval "\$req $module";
exit(0);
...
+ );
+ check_bundle_path($module, $auto_path,
sub { scan_deps_runtime(
files => [ $_[0] ],
recurse => 0,
- execute => 1);
- }
- );
- check_bundle_path($module, $auto_path, ".pl", <<"...",
+ execute => [ $module ]);
+ },
+ ".pl", <<"...",
# no way in hell can this detected by static analysis :)
my \$req = join("", qw( r e q u i r e ));
eval "\$req \$_" foreach \@ARGV;
exit(0);
...
- sub { scan_deps_runtime(
- files => [ $_[0] ],
- recurse => 0,
- execute => [ $module ]);
- }
);
}
@@ -79,19 +84,25 @@
# NOTE: check_bundle_path runs 2 tests
sub check_bundle_path {
- my ($module, $auto_path, $suffix, $code, $scan) = @_;
+ my ($module, $auto_path, $scan, $suffix, $source) = @_;
my ($fh, $filename) = File::Temp::tempfile( UNLINK => 1, SUFFIX => $suffix
);
- print $fh $code, "\n" or die $!;
+ print $fh $source, "\n" or die $!;
close $fh;
my $rv = $scan->($filename);
+ my $line = (caller())[2];
+
my ( $entry ) = grep { /^\Q$auto_path\E$/ } keys %$rv;
- ok( $entry, "$module: found some key that looks like it pulled in its
shared lib (auto_path=$auto_path)" );
+ ok($entry,
+ "check_bundle_path:$line: $module: ".
+ "found some key that looks like it pulled in its shared lib
(auto_path=$auto_path)\n".
+ Dumper($rv));
# Actually we accept anything that ends with $auto_path.
- ok($rv->{$entry}->{file} =~ m{/\Q$auto_path\E$},
- "$module: the full bundle path we got ($rv->{$entry}->{file}) looks
legit" );
+ ok($rv->{$entry}{file} =~ m{/\Q$auto_path\E$},
+ "check_bundle_path:$line: $module: ".
+ "the full bundle path we got \"$rv->{$entry}{file}\" looks legit");
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Module-ScanDeps-1.24/wip/scan_dlls.pl
new/Module-ScanDeps-1.25/wip/scan_dlls.pl
--- old/Module-ScanDeps-1.24/wip/scan_dlls.pl 2016-11-21 18:48:53.000000000
+0100
+++ new/Module-ScanDeps-1.25/wip/scan_dlls.pl 1970-01-01 01:00:00.000000000
+0100
@@ -1,236 +0,0 @@
-#!/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);
- }
-}
