1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
|
From bc57e5072fc7ace1d206246999dd852652939335 Mon Sep 17 00:00:00 2001
From: rschupp <roderich.schupp@gmail.com>
Date: Mon, 21 Oct 2024 14:08:01 +0200
Subject: [PATCH] replace 'eval "..."' constructs
---
lib/Module/ScanDeps.pm | 122 ++++++++++++++++++++++++++---------------
1 file changed, 78 insertions(+), 44 deletions(-)
--- a/lib/Module/ScanDeps.pm
+++ b/lib/Module/ScanDeps.pm
@@ -880,41 +880,26 @@ sub scan_line {
# be specified for the "autouse" and "if" pragmas, e.g.
# use autouse Module => qw(func1 func2);
# use autouse "Module", qw(func1);
- # To avoid to parse them ourself, we simply try to eval the
- # string after the pragma (in a list context). The MODULE
- # should be the first ("autouse") or second ("if") element
- # of the list.
my $module;
- {
- no strict; no warnings;
- if ($pragma eq "autouse") {
- ($module) = eval $args;
- }
- else {
- # The syntax of the "if" pragma is
- # use if COND, MODULE => ARGUMENTS
- # The COND may contain undefined functions (i.e. undefined
- # in Module::ScanDeps' context) which would throw an
- # exception. Sneak "1 || " in front of COND so that
- # COND will not be evaluated. This will work in most
- # cases, but there are operators with lower precedence
- # than "||" which will cause this trick to fail.
- (undef, $module) = eval "1 || $args";
- }
- # punt if there was a syntax error
- return if $@ or !defined $module;
- };
- $module =~ s{::}{/}g;
- $found{"$pragma.pm"}++;
- $found{"$module.pm"}++;
+ if ($pragma eq "autouse") {
+ ($module) = _parse_module_list($args);
+ }
+ else {
+ # The syntax of the "if" pragma is
+ # use if COND, MODULE => ARGUMENTS
+ (undef, $module) = _parse_module_list($args);
+ }
+ $found{_mod2pm($pragma)}++;
+ $found{_mod2pm($module)}++ if $module;
next CHUNK;
}
- if (my ($how, $libs) = /^(use \s+ lib \s+ | (?:unshift|push) \s+ \@INC \s+ ,) (.+)/x)
+ if (my ($how, $libs) = /^(use \s+ lib \s+ | (?:unshift|push) \s+ \@INC \s*,\s*) (.+)/x)
{
my $archname = defined($Config{archname}) ? $Config{archname} : '';
my $ver = defined($Config{version}) ? $Config{version} : '';
- foreach my $dir (do { no strict; no warnings; eval $libs }) {
+ while ((my $dir, $libs) = _parse_libs($libs))
+ {
next unless defined $dir;
my @dirs = $dir;
push @dirs, "$dir/$ver", "$dir/$archname", "$dir/$ver/$archname"
@@ -932,6 +917,72 @@ sub scan_line {
return sort keys %found;
}
+# convert module name to file name
+sub _mod2pm {
+ my $mod = shift;
+ $mod =~ s!::!/!g;
+ return "$mod.pm";
+}
+
+# parse a comma-separated list of module names (as string literals or qw() lists)
+sub _parse_module_list {
+ my $list = shift;
+
+ # split $list on anything that's not a word character or ":"
+ # and ignore "q", "qq" and "qw"
+ return grep { length and !/^:|^q[qw]?$/ } split(/[^\w:]+/, $list);
+}
+
+# incrementally parse a comma separated list library paths:
+# returning a pair: the contents of the first strings literal and the remainder of the string
+# - for "string", 'string', q/string/, qq/string/ also unescape \\ and \<delimiter>)
+# - for qw(foo bar quux) return ("foo", qw(bar quux))
+# - otherwise skip over the first comma and return (undef, "remainder")
+# - return () if the string is exhausted
+# - as a special case, if the string starts with $FindBin::Bin, replace it with our $Bin
+sub _parse_libs {
+ local $_ = shift;
+
+ s/^[\s,]*//;
+ return if $_ eq "";
+
+ if (s/^(['"]) ((?:\\.|.)*?) \1//x) {
+ return (_unescape($1, $2), $_);
+ }
+ if (s/^qq? \s* (\W)//x) {
+ my $opening_delim = $1;
+ (my $closing_delim = $opening_delim) =~ tr:([{<:)]}>:;
+ s/^((?:\\.|.)*?) \Q$closing_delim\E//x;
+ return (_unescape($opening_delim, $1), $_);
+ }
+
+ if (s/^qw \s* (\W)//x) {
+ my $opening_delim = $1;
+ (my $closing_delim = $opening_delim) =~ tr:([{<:)]}>:;
+ s/^((?:\\.|.)*?) \Q$closing_delim\E//x;
+ my $contents = $1;
+ my @list = split(" ", $contents);
+ return (undef, $_) unless @list;
+ my $first = shift @list;
+ return (_unescape($opening_delim, $first),
+ @list ? "qw${opening_delim}@list${closing_delim}$_" : $_);
+ }
+
+ # nothing recognizable in the first list item, skip to the next
+ if (s/^.*? ,//x) {
+ return (undef, $_);
+ }
+ return; # list exhausted
+}
+
+sub _unescape {
+ my ($delim, $str) = @_;
+ $str =~ s/\\([\\\Q$delim\E])/$1/g;
+ $str =~ s/^\$FindBin::Bin\b/$FindBin::Bin/;
+
+ return $str;
+}
+
# short helper for scan_chunk
my %LoaderRegexp; # cache
sub _build_loader_regexp {
|