[pkgsrc/trunk]: pkgsrc/pkgtools/pkglint/files - Improved detection of valid s...

[rillig <rillig%pkgsrc.org@localhost>]

details:   https://anonhg.NetBSD.org/pkgsrc/rev/27386327fc5d
branches:  trunk
changeset: 504156:27386327fc5d
user:      rillig <rillig%pkgsrc.org@localhost>
date:      Tue Dec 06 01:07:20 2005 +0000

description:
- Improved detection of valid shell words once more.
- Rewrote the code for loading the deprecated.map file. It is only
  loaded once now. The code that checks for use of deprecated variables
  can handle multiple variables in a single line now.

diffstat:

 pkgtools/pkglint/files/pkglint.pl |  82 ++++++++++++++++++++++++--------------
 1 files changed, 52 insertions(+), 30 deletions(-)

diffs (118 lines):

diff -r ef4257bb2529 -r 27386327fc5d pkgtools/pkglint/files/pkglint.pl
--- a/pkgtools/pkglint/files/pkglint.pl Mon Dec 05 23:55:01 2005 +0000
+++ b/pkgtools/pkglint/files/pkglint.pl Tue Dec 06 01:07:20 2005 +0000
@@ -11,7 +11,7 @@
 # Freely redistributable.  Absolutely no warranty.
 #
 # From Id: portlint.pl,v 1.64 1998/02/28 02:34:05 itojun Exp
-# $NetBSD: pkglint.pl,v 1.417 2005/12/05 23:50:16 rillig Exp $
+# $NetBSD: pkglint.pl,v 1.418 2005/12/06 01:07:20 rillig Exp $
 #
 # This version contains lots of changes necessary for NetBSD packages
 # done by:
@@ -765,7 +765,7 @@
        |       \"(?:\\.|[^\"\\])*\"
        |       \`[^\`]*\`
        |       \\.
-       |       \$\{[^}]+\}
+       |       \$\{[^\$}]+\}
        |       [^'\"\\\s;&\|<>\#]
        )+ | ;;? | &&? | \|\|? | <<? | >>? | \#.*)"sx;
 
@@ -942,6 +942,34 @@
        return ($get_make_vars_typemap_result = $vartypes);
 }
 
+my $get_deprecated_map_result = undef;
+sub get_deprecated_map() {
+       my ($fname, $lines, $vars);
+
+       if (defined($get_deprecated_map_result)) {
+               return $get_deprecated_map_result;
+       }
+
+       $fname = conf_datadir."/deprecated.map";
+       if (!($lines = load_file($fname))) {
+               log_fatal($fname, NO_LINE_NUMBER, "Cannot be read.");
+       }
+
+       $vars = {};
+       foreach my $line (@{$lines}) {
+               if ($line->text =~ qr"^#" || $line->text =~ qr"^\s*$") {
+                       # Ignore empty and comment lines.
+
+               } elsif ($line->text =~ qr"^(\S+)\s+(.*)$") {
+                       $vars->{$1} = $2;
+
+               } else {
+                       $line->log_fatal("Unknown line format.");
+               }
+       }
+       return ($get_deprecated_map_result = $vars);
+}
+
 my $load_dist_sites_url2name = undef;
 my $load_dist_sites_names = undef;
 sub load_dist_sites() {
@@ -2230,39 +2258,33 @@
 
 sub checklines_deprecated_variables($) {
        my ($lines) = @_;
-       my ($fname) = (conf_datadir."/deprecated.map");
-       my ($deprecated, $varnames, $varuse_regex, %vars);
-
-       if (!($deprecated = load_file($fname))) {
-               log_error($fname, NO_LINE_NUMBER, "Cannot be read.");
-               return;
-       }
-
-       %vars = ();
-       foreach my $line (@{$deprecated}) {
-               if ($line->text =~ qr"^#" || $line->text =~ qr"^\s*$") {
-                       next;
-
-               } elsif ($line->text =~ qr"^(\S+)\s+(.*)$") {
-                       $vars{$1} = $2;
-
-               } else {
-                       $line->log_fatal("Unknown line format.");
-               }
-       }
-       $varnames = join("|", sort(keys(%vars)));
-       $varuse_regex = qr"\$\{(${varnames})[:}]";
+       my ($vars, $varnames, $regex_varuse);
+
+       $vars = get_deprecated_map();
+       $varnames = join("|", sort(keys(%{$vars})));
+       $regex_varuse = qr"\$\{(${varnames})[:}]";
 
        foreach my $line (@{$lines}) {
+               my ($rest);
+
                if ($line->text =~ regex_varassign) {
-                       my ($varname, undef, $value) = ($1, $2, $3);
-                       if (exists($vars{$varname})) {
-                               $line->log_warning("${varname} is deprecated. $vars{$varname}");
+                       my ($varname) = ($1);
+                       $rest = $3;
+                       if (exists($vars->{$varname})) {
+                               $line->log_warning("Definition of ${varname} is deprecated. $vars->{$varname}");
                        }
 
-                       if ($value =~ $varuse_regex) {
-                               my ($varuse_name) = ($1);
-                               $line->log_warning("Use of ${varuse_name} is deprecated. $vars{$varuse_name}");
+               } elsif ($line->text =~ regex_shellcmd) {
+                       ($rest) = ($1);
+               }
+
+               if (defined($rest)) {
+                       while ($rest =~ s/$regex_varuse//) {
+                               my ($varname) = ($1);
+
+                               if (exists($vars->{$varname})) {
+                                       $line->log_warning("Use of ${varname} is deprecated. $vars->{$varname}");
+                               }
                        }
                }
        }