summaryrefslogtreecommitdiff
path: root/pkgtools
diff options
context:
space:
mode:
authorschmonz <schmonz@pkgsrc.org>2013-03-26 15:08:28 +0000
committerschmonz <schmonz@pkgsrc.org>2013-03-26 15:08:28 +0000
commit162e744ca1da996850a47ee38ed8fa8e44f5cacf (patch)
tree0bf1a0d691f001e6f2e6068c10d3cd7b0db053c4 /pkgtools
parent3e23961f27b7b4a6a407cfe87d06c8f58ccabe08 (diff)
downloadpkgsrc-162e744ca1da996850a47ee38ed8fa8e44f5cacf.tar.gz
Extract PkgLint::* to files, then inline them.
These bits of non-main functionality are distracting to the casual reader, and also to your intrepid refactorer. Since we recently added some characterization tests that run the pkglint executable against real packages, we can safely extract bits of code to separate files and prove nothing broke in the move. Instead of installing the new Perl modules where pkglint can find them at runtime, I've added a build step to inline them right back where they used to be (same order and everything). This is a little annoying, but less annoying than suddenly needing to deal with Perl runtime paths just for these few tiny modules. Also, loading modules at runtime would affect pkglint's performance, and I don't yet have performance tests to prove that this would be fine (or not), so I can't safely do it. No functional change intended.
Diffstat (limited to 'pkgtools')
-rw-r--r--pkgtools/pkglint/Makefile16
-rw-r--r--pkgtools/pkglint/files/PkgLint/CVS_Entry.pm20
-rw-r--r--pkgtools/pkglint/files/PkgLint/Change.pm20
-rw-r--r--pkgtools/pkglint/files/PkgLint/FileUtil.pm167
-rw-r--r--pkgtools/pkglint/files/PkgLint/Line.pm214
-rw-r--r--pkgtools/pkglint/files/PkgLint/Logging.pm136
-rw-r--r--pkgtools/pkglint/files/PkgLint/SimpleMatch.pm42
-rw-r--r--pkgtools/pkglint/files/PkgLint/SubstContext.pm197
-rw-r--r--pkgtools/pkglint/files/PkgLint/Type.pm102
-rw-r--r--pkgtools/pkglint/files/PkgLint/Util.pm95
-rw-r--r--pkgtools/pkglint/files/PkgLint/VarUseContext.pm69
-rw-r--r--pkgtools/pkglint/files/build.pl25
-rw-r--r--pkgtools/pkglint/files/pkglint.pl1063
13 files changed, 1108 insertions, 1058 deletions
diff --git a/pkgtools/pkglint/Makefile b/pkgtools/pkglint/Makefile
index a38dd5a0eb4..111e21a1185 100644
--- a/pkgtools/pkglint/Makefile
+++ b/pkgtools/pkglint/Makefile
@@ -1,4 +1,4 @@
-# $NetBSD: Makefile,v 1.424 2013/01/19 22:51:11 schmonz Exp $
+# $NetBSD: Makefile,v 1.425 2013/03/26 15:08:28 schmonz Exp $
# Note: if you update the version number, please have a look at the
# changes between the CVS tag "pkglint_current" and HEAD.
@@ -22,7 +22,6 @@ PKG_INSTALLATION_TYPES= overwrite pkgviews
WRKSRC= ${WRKDIR}
NO_CHECKSUM= yes
-NO_BUILD= yes
USE_LANGUAGES= # none
AUTO_MKDIRS= yes
@@ -30,8 +29,7 @@ AUTO_MKDIRS= yes
SUBST_CLASSES+= pkglint
SUBST_STAGE.pkglint= post-configure
-SUBST_FILES.pkglint+= pkglint.pl pkglint.t
-SUBST_FILES.pkglint+= plist-clash.pl
+SUBST_FILES.pkglint+= build.pl pkglint.pl pkglint.t plist-clash.pl
.if defined(BATCH)
SUBST_SED.pkglint+= -e s\|@PKGSRCDIR@\|/usr/pkgsrc\|g
.else
@@ -49,10 +47,16 @@ SUBST_SED.pkglint+= -e s\|@DATADIR@\|${PREFIX}/share/pkglint\|g
quick-install:
${RM} -rf ${WRKSRC}
${MKDIR} ${WRKSRC}
- ${MAKE} do-extract subst-pkglint do-install selftest clean
+ ${MAKE} do-extract subst-pkglint do-build do-install selftest clean
do-extract:
- cd ${FILESDIR} && ${CP} pkglint.0 pkglint.1 pkglint.pl pkglint.t plist-clash.pl ${WRKSRC}
+ cd ${FILESDIR} && ${CP} build.pl pkglint.0 pkglint.1 pkglint.pl pkglint.t plist-clash.pl ${WRKSRC}
+ mkdir ${WRKSRC}/PkgLint
+ cd ${FILESDIR} && ${CP} PkgLint/*.pm ${WRKSRC}/PkgLint
+
+do-build:
+ cd ${WRKSRC} && ${PERL5} build.pl < pkglint.pl > pkglint.pl.inlined \
+ && mv pkglint.pl.inlined pkglint.pl
do-test:
cd ${WRKSRC} && prove pkglint.t
diff --git a/pkgtools/pkglint/files/PkgLint/CVS_Entry.pm b/pkgtools/pkglint/files/PkgLint/CVS_Entry.pm
new file mode 100644
index 00000000000..8feb414951f
--- /dev/null
+++ b/pkgtools/pkglint/files/PkgLint/CVS_Entry.pm
@@ -0,0 +1,20 @@
+package PkgLint::CVS_Entry;
+#==========================================================================
+# A CVS_Entry represents one line from a CVS/Entries file.
+#==========================================================================
+
+use enum qw(FNAME REVISION MTIME TAG);
+
+sub new($$$$$) {
+ my ($class, $fname, $revision, $date, $tag) = @_;
+ my $self = [ $fname, $revision, $date, $tag ];
+ bless($self, $class);
+ return $self;
+}
+sub fname($) { return shift()->[FNAME]; }
+sub revision($) { return shift()->[REVISION]; }
+sub mtime($) { return shift()->[MTIME]; }
+sub tag($) { return shift()->[TAG]; }
+#== End of PkgLint::CVS_Entry =============================================
+
+1;
diff --git a/pkgtools/pkglint/files/PkgLint/Change.pm b/pkgtools/pkglint/files/PkgLint/Change.pm
new file mode 100644
index 00000000000..b68c5286d73
--- /dev/null
+++ b/pkgtools/pkglint/files/PkgLint/Change.pm
@@ -0,0 +1,20 @@
+package PkgLint::Change;
+#==========================================================================
+# A change entry from doc/CHANGES-*
+#==========================================================================
+
+sub new($$$$$$) {
+ my ($class, $line, $action, $pkgpath, $version, $author, $date) = @_;
+ my $self = [ $line, $action, $pkgpath, $version, $author, $date ];
+ bless($self, $class);
+ return $self;
+}
+sub line($) { return shift()->[0]; }
+sub action($) { return shift()->[1]; }
+sub pkgpath($) { return shift()->[2]; }
+sub version($) { return shift()->[3]; }
+sub author($) { return shift()->[4]; }
+sub date($) { return shift()->[5]; }
+#== End of PkgLint::Change ================================================
+
+1;
diff --git a/pkgtools/pkglint/files/PkgLint/FileUtil.pm b/pkgtools/pkglint/files/PkgLint/FileUtil.pm
new file mode 100644
index 00000000000..ad7d1945396
--- /dev/null
+++ b/pkgtools/pkglint/files/PkgLint/FileUtil.pm
@@ -0,0 +1,167 @@
+package PkgLint::FileUtil;
+#==========================================================================
+# This package provides subroutines for loading and saving line-oriented
+# files. The load_file() subroutine loads a file completely into memory,
+# optionally handling continuation line folding. The load_lines() subrou-
+# tine is an abbreviation for the common case of loading files without
+# continuation lines. The save_autofix_changes() subroutine examines an
+# array of lines if some of them have changed. It then saves the modified
+# files.
+#==========================================================================
+use strict;
+use warnings;
+
+BEGIN {
+ use Exporter;
+ use vars qw(@ISA @EXPORT_OK);
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(
+ load_file load_lines
+ save_autofix_changes
+ );
+
+ import PkgLint::Util qw(
+ false true
+ );
+ import PkgLint::Logging qw(
+ NO_LINE_NUMBER
+ log_error log_note
+ );
+}
+
+sub load_physical_lines($) {
+ my ($fname) = @_;
+ my ($physlines, $line, $lineno);
+
+ $physlines = [];
+ open(F, "< $fname") or return undef;
+ $lineno = 0;
+ while (defined($line = <F>)) {
+ $lineno++;
+ push(@{$physlines}, [$lineno, $line]);
+ }
+ close(F) or return undef;
+ return $physlines;
+}
+
+sub get_logical_line($$$) {
+ my ($fname, $lines, $ref_lineno) = @_;
+ my ($value, $lineno, $first, $firstlineno, $lastlineno, $physlines);
+
+ $value = "";
+ $first = true;
+ $lineno = ${$ref_lineno};
+ $firstlineno = $lines->[$lineno]->[0];
+ $physlines = [];
+
+ for (; $lineno <= $#{$lines}; $lineno++) {
+ if ($lines->[$lineno]->[1] =~ m"^([ \t]*)(.*?)([ \t]*)(\\?)\n?$") {
+ my ($indent, $text, $outdent, $cont) = ($1, $2, $3, $4);
+
+ if ($first) {
+ $value .= $indent;
+ $first = false;
+ }
+
+ $value .= $text;
+ push(@{$physlines}, $lines->[$lineno]);
+
+ if ($cont eq "\\") {
+ $value .= " ";
+ } else {
+ $value .= $outdent;
+ last;
+ }
+ }
+ }
+
+ if ($lineno > $#{$lines}) {
+ # The last line in the file is a continuation line
+ $lineno--;
+ }
+ $lastlineno = $lines->[$lineno]->[0];
+ ${$ref_lineno} = $lineno + 1;
+
+ return PkgLint::Line->new($fname,
+ $firstlineno == $lastlineno
+ ? $firstlineno
+ : "$firstlineno--$lastlineno",
+ $value,
+ $physlines);
+}
+
+sub load_lines($$) {
+ my ($fname, $fold_backslash_lines) = @_;
+ my ($physlines, $seen_newline, $loglines);
+
+ $physlines = load_physical_lines($fname);
+ if (!$physlines) {
+ return false;
+ }
+
+ $seen_newline = true;
+ $loglines = [];
+ if ($fold_backslash_lines) {
+ for (my $lineno = 0; $lineno <= $#{$physlines}; ) {
+ push(@{$loglines}, get_logical_line($fname, $physlines, \$lineno));
+ }
+ } else {
+ foreach my $physline (@{$physlines}) {
+ my $text = $physline->[1];
+
+ $text =~ s/\n$//;
+ push(@{$loglines}, PkgLint::Line->new($fname, $physline->[0], $text, [$physline]));
+ }
+ }
+
+ if (0 <= $#{$physlines} && $physlines->[-1]->[1] !~ m"\n$") {
+ log_error($fname, $physlines->[-1]->[0], "File must end with a newline.");
+ }
+
+ return $loglines;
+}
+
+sub load_file($) {
+ my ($fname) = @_;
+
+ return load_lines($fname, false);
+}
+
+sub save_autofix_changes($) {
+ my ($lines) = @_;
+
+ my (%changed, %physlines);
+
+ foreach my $line (@{$lines}) {
+ if ($line->is_changed) {
+ $changed{$line->fname}++;
+ }
+ push(@{$physlines{$line->fname}}, @{$line->physlines});
+ }
+
+ foreach my $fname (sort(keys(%changed))) {
+ my $new = "${fname}.pkglint.tmp";
+
+ if (!open(F, ">", $new)) {
+ log_error($new, NO_LINE_NUMBER, "$!");
+ next;
+ }
+ foreach my $physline (@{$physlines{$fname}}) {
+ print F ($physline->[1]);
+ }
+ if (!close(F)) {
+ log_error($new, NO_LINE_NUMBER, "$!");
+ next;
+ }
+
+ if (!rename($new, $fname)) {
+ log_error($fname, NO_LINE_NUMBER, "$!");
+ next;
+ }
+ log_note($fname, NO_LINE_NUMBER, "Has been autofixed. Please re-run pkglint.");
+ }
+}
+
+#== End of PkgLint::FileUtil ==============================================
+
+1;
diff --git a/pkgtools/pkglint/files/PkgLint/Line.pm b/pkgtools/pkglint/files/PkgLint/Line.pm
new file mode 100644
index 00000000000..a4b8e4720ea
--- /dev/null
+++ b/pkgtools/pkglint/files/PkgLint/Line.pm
@@ -0,0 +1,214 @@
+#==========================================================================
+# When files are read in by pkglint, they are interpreted in terms of
+# lines. For Makefiles, line continuations are handled properly, allowing
+# multiple physical lines to end in a single logical line. For other files
+# there is a 1:1 translation.
+#
+# A difference between the physical and the logical lines is that the
+# physical lines include the line end sequence, whereas the logical lines
+# do not.
+#
+# A logical line is a class having the read-only fields C<file>,
+# C<lines>, C<text>, C<physlines> and C<is_changed>, as well as some
+# methods for printing diagnostics easily.
+#
+# Some other methods allow modification of the physical lines, but leave
+# the logical line (the C<text>) untouched. These methods are used in the
+# --autofix mode.
+#
+# A line can have some "extra" fields that allow the results of parsing to
+# be saved under a name.
+#==========================================================================
+package PkgLint::Line;
+
+BEGIN {
+ import PkgLint::Util qw(
+ false true
+ assert
+ );
+}
+
+use enum qw(FNAME LINES TEXT PHYSLINES CHANGED BEFORE AFTER EXTRA);
+
+sub new($$$$) {
+ my ($class, $fname, $lines, $text, $physlines) = @_;
+ my ($self) = ([$fname, $lines, $text, $physlines, false, [], [], {}]);
+ bless($self, $class);
+ return $self;
+}
+
+sub fname($) { return shift()->[FNAME]; }
+sub lines($) { return shift()->[LINES]; }
+sub text($) { return shift()->[TEXT]; }
+# Note: physlines is _not_ a simple getter method.
+sub is_changed($) { return shift()->[CHANGED]; }
+
+# querying, getting and setting the extra values.
+sub has($$) {
+ my ($self, $name) = @_;
+ return exists($self->[EXTRA]->{$name});
+}
+sub get($$) {
+ my ($self, $name) = @_;
+ assert(exists($self->[EXTRA]->{$name}), "Field ${name} does not exist.");
+ return $self->[EXTRA]->{$name};
+}
+sub set($$$) {
+ my ($self, $name, $value) = @_;
+ assert(!exists($self->[EXTRA]->{$name}), "Field ${name} already exists.");
+
+ # Make sure that the line does not become a cyclic data structure.
+ my $type = ref($value);
+ if ($type eq "") {
+ # ok
+ } elsif ($type eq "ARRAY") {
+ foreach my $element (@{$value}) {
+ my $element_type = ref($element);
+ assert($element_type eq "" || $element_type eq "PkgLint::SimpleMatch",
+ "Invalid array data type: name=${name}, type=${element_type}.");
+ }
+ } else {
+ assert(false, "Invalid data: name=${name}, value=${value}.");
+ }
+
+ $self->[EXTRA]->{$name} = $value;
+}
+
+sub physlines($) {
+ my ($self) = @_;
+ return [@{$self->[BEFORE]}, @{$self->[PHYSLINES]}, @{$self->[AFTER]}];
+}
+
+# Only for PkgLint::String support
+sub substring($$$$) {
+ my ($self, $line, $start, $end) = @_;
+
+ return substr($self->[PHYSLINES]->[$line]->[1], $start, $end);
+}
+
+sub show_source($$) {
+ my ($self, $out) = @_;
+
+ if (PkgLint::Logging::get_show_source_flag()) {
+ foreach my $line (@{$self->physlines}) {
+ print $out ("> " . $line->[1]);
+ }
+ }
+}
+
+sub log_fatal($$) {
+ my ($self, $text) = @_;
+
+ $self->show_source(*STDERR);
+ PkgLint::Logging::log_fatal($self->fname, $self->[LINES], $text);
+}
+sub log_error($$) {
+ my ($self, $text) = @_;
+
+ $self->show_source(*STDOUT);
+ PkgLint::Logging::log_error($self->fname, $self->[LINES], $text);
+}
+sub log_warning($$) {
+ my ($self, $text) = @_;
+
+ $self->show_source(*STDOUT);
+ PkgLint::Logging::log_warning($self->fname, $self->[LINES], $text);
+}
+sub log_note($$) {
+ my ($self, $text) = @_;
+
+ $self->show_source(*STDOUT);
+ PkgLint::Logging::log_note($self->fname, $self->[LINES], $text);
+}
+sub log_debug($$) {
+ my ($self, $text) = @_;
+
+ $self->show_source(*STDOUT);
+ PkgLint::Logging::log_debug($self->fname, $self->[LINES], $text);
+}
+sub explain_error($@) {
+ my ($self, @texts) = @_;
+
+ PkgLint::Logging::explain_error($self->fname, $self->[LINES], @texts);
+}
+sub explain_warning($@) {
+ my ($self, @texts) = @_;
+
+ PkgLint::Logging::explain_warning($self->fname, $self->[LINES], @texts);
+}
+sub explain_note($@) {
+ my ($self, @texts) = @_;
+
+ PkgLint::Logging::explain_note($self->fname, $self->[LINES], @texts);
+}
+sub explain_info($@) {
+ my ($self, @texts) = @_;
+
+ PkgLint::Logging::explain_info($self->fname, $self->[LINES], @texts);
+}
+
+sub to_string($) {
+ my ($self) = @_;
+
+ return $self->fname . ":" . $self->[LINES] . ": " . $self->[TEXT];
+}
+
+sub prepend_before($$) {
+ my ($self, $text) = @_;
+
+ unshift(@{$self->[BEFORE]}, [0, "$text\n"]);
+ $self->[CHANGED] = true;
+}
+sub append_before($$) {
+ my ($self, $text) = @_;
+
+ push(@{$self->[BEFORE]}, [0, "$text\n"]);
+ $self->[CHANGED] = true;
+}
+sub prepend_after($$) {
+ my ($self, $text) = @_;
+
+ unshift(@{$self->[AFTER]}, [0, "$text\n"]);
+ $self->[CHANGED] = true;
+}
+sub append_after($$) {
+ my ($self, $text) = @_;
+
+ push(@{$self->[AFTER]}, [0, "$text\n"]);
+ $self->[CHANGED] = true;
+}
+sub delete($) {
+ my ($self) = @_;
+
+ $self->[PHYSLINES] = [];
+ $self->[CHANGED] = true;
+}
+sub replace($$$) {
+ my ($self, $from, $to) = @_;
+ my $phys = $self->[PHYSLINES];
+
+ foreach my $i (0..$#{$phys}) {
+ if ($phys->[$i]->[0] != 0 && $phys->[$i]->[1] =~ s/\Q$from\E/$to/g) {
+ $self->[CHANGED] = true;
+ }
+ }
+}
+sub replace_regex($$$) {
+ my ($self, $from_re, $to) = @_;
+ my $phys = $self->[PHYSLINES];
+
+ foreach my $i (0..$#{$phys}) {
+ if ($phys->[$i]->[0] != 0 && $phys->[$i]->[1] =~ s/$from_re/$to/) {
+ $self->[CHANGED] = true;
+ }
+ }
+}
+sub set_text($$) {
+ my ($self, $text) = @_;
+ $self->[PHYSLINES] = [[0, "$text\n"]];
+ $self->[CHANGED] = true;
+}
+
+#== End of PkgLint::Line ==================================================
+
+1;
diff --git a/pkgtools/pkglint/files/PkgLint/Logging.pm b/pkgtools/pkglint/files/PkgLint/Logging.pm
new file mode 100644
index 00000000000..4e84c61d114
--- /dev/null
+++ b/pkgtools/pkglint/files/PkgLint/Logging.pm
@@ -0,0 +1,136 @@
+package PkgLint::Logging;
+#==========================================================================
+# This package provides subroutines for printing messages to the user in a
+# common format. The subroutines all have the parameters C<$fname>,
+# C<$lineno> and C<$message>. In case there's no appropriate filename for
+# the message, NO_FILE may be passed, likewise for C<$lineno> and
+# NO_LINES. Before printing, the filename is normalized, that is,
+# "/foo/bar/../../" components are removed, as well as "." components.
+# At the end of the program, the subroutine print_summary_and_exit should
+# be called.
+#
+# Examples:
+# log_error(NO_FILE, NO_LINES, "Invalid command line.");
+# log_warning($fname, NO_LINES, "Not found.");
+# log_debug($fname, $lineno, sprintf("invalid character (0x%02x).", $c));
+#==========================================================================
+
+use strict;
+use warnings;
+BEGIN {
+ use Exporter;
+ use vars qw(@ISA @EXPORT_OK);
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(
+ NO_FILE NO_LINE_NUMBER NO_LINES
+ log_fatal log_error log_warning log_note log_debug
+ explain_error explain_warning explain_info
+ print_summary_and_exit
+ set_explain set_gcc_output_format
+ get_show_source_flag set_show_source_flag
+ );
+ import PkgLint::Util qw(
+ false true
+ normalize_pathname
+ );
+}
+
+use constant NO_FILE => undef;
+use constant NO_LINE_NUMBER => undef;
+use constant NO_LINES => undef;
+
+use enum qw(:LL_ FATAL ERROR WARNING NOTE DEBUG);
+
+use constant traditional_type => ["FATAL", "ERROR", "WARN", "NOTE", "DEBUG"];
+use constant gcc_type => ["fatal", "error", "warning", "note", "debug"];
+
+my $errors = 0;
+my $warnings = 0;
+my $gcc_output_format = false;
+my $explain_flag = false;
+my $show_source_flag = false;
+
+sub strxvis($) {
+ my ($s) = @_;
+
+ $s =~ s/([^\x09\x20-\x7e])/"\\x" . unpack("H*", $1)/eg;
+ return $s;
+}
+
+sub log_message { # no prototype due to Perl weirdness
+ my ($level, $fname, $lineno, $message) = @_;
+ my ($text, $sep);
+
+ if (defined($fname)) {
+ $fname = normalize_pathname($fname);
+ }
+
+ $text = "";
+ $sep = "";
+ if (!$gcc_output_format) {
+ $text .= "${sep}" . traditional_type->[$level] . ":";
+ $sep = " ";
+ }
+ if (defined($fname)) {
+ $text .= defined($lineno)
+ ? "${sep}${fname}:${lineno}"
+ : "${sep}${fname}";
+ $sep = ": ";
+ }
+ if ($gcc_output_format) {
+ $text .= "${sep}" . gcc_type->[$level] . ":";
+ $sep = " ";
+ }
+ if (defined($message)) {
+ $text .= $sep . strxvis($message);
+ $sep = "";
+ }
+
+ if ($level == LL_FATAL) {
+ print STDERR ("${text}\n");
+ } else {
+ print STDOUT ("${text}\n");
+ }
+}
+
+sub log_fatal($$$) { log_message(LL_FATAL, @_); exit(1); }
+sub log_error($$$) { log_message(LL_ERROR, @_); $errors++; }
+sub log_warning($$$) { log_message(LL_WARNING, @_); $warnings++; }
+sub log_note($$$) { log_message(LL_NOTE, @_); }
+sub log_debug($$$) { log_message(LL_DEBUG, @_); }
+
+sub explain { # no prototype due to Perl weirdness
+ my ($loglevel, $fname, $lines, @texts) = @_;
+ my $out = ($loglevel == LL_FATAL) ? *STDERR : *STDOUT;
+
+ if ($explain_flag) {
+ foreach my $text ("", @texts, "") {
+ print $out ("\t${text}\n");
+ }
+ }
+}
+sub explain_error($$@) { explain(LL_ERROR, @_); }
+sub explain_warning($$@) { explain(LL_WARNING, @_); }
+sub explain_note($$@) { explain(LL_NOTE, @_); }
+
+sub print_summary_and_exit($) {
+ my ($quiet) = @_;
+
+ if (!$quiet) {
+ if ($errors != 0 || $warnings != 0) {
+ print("$errors errors and $warnings warnings found." . ($explain_flag ? "" : " (Use -e for more details.)") . "\n");
+ } else {
+ print "looks fine.\n";
+ }
+ }
+ exit($errors != 0);
+}
+
+sub set_explain() { $explain_flag = true; }
+sub set_gcc_output_format() { $gcc_output_format = true; }
+sub get_show_source_flag() { return $show_source_flag; }
+sub set_show_source_flag() { $show_source_flag = true; }
+
+#== End of PkgLint::Logging ===============================================
+
+1;
diff --git a/pkgtools/pkglint/files/PkgLint/SimpleMatch.pm b/pkgtools/pkglint/files/PkgLint/SimpleMatch.pm
new file mode 100644
index 00000000000..e3db828432e
--- /dev/null
+++ b/pkgtools/pkglint/files/PkgLint/SimpleMatch.pm
@@ -0,0 +1,42 @@
+#==========================================================================
+# A SimpleMatch is the result of applying a regular expression to a Perl
+# scalar value. It can return the range and the text of the captured
+# groups.
+#==========================================================================
+package PkgLint::SimpleMatch;
+
+use enum qw(STRING STARTS ENDS N);
+
+sub new($$) {
+ my ($class, $string, $starts, $ends) = @_;
+ my ($self) = ([$string, [@{$starts}], [@{$ends}], $#{$ends}]);
+ bless($self, $class);
+ return $self;
+}
+
+sub string($) { return shift()->[STRING]; }
+sub n($) { return shift()->[N]; }
+
+sub has($$) {
+ my ($self, $n) = @_;
+
+ return 0 <= $n && $n <= $self->n
+ && defined($self->[STARTS]->[$n])
+ && defined($self->[ENDS]->[$n]);
+}
+
+sub text($$) {
+ my ($self, $n) = @_;
+
+ my $start = $self->[STARTS]->[$n];
+ my $end = $self->[ENDS]->[$n];
+ return substr($self->string, $start, $end - $start);
+}
+
+sub range($$) {
+ my ($self, $n) = @_;
+
+ return ($self->[STARTS]->[$n], $self->[ENDS]->[$n]);
+}
+
+1;
diff --git a/pkgtools/pkglint/files/PkgLint/SubstContext.pm b/pkgtools/pkglint/files/PkgLint/SubstContext.pm
new file mode 100644
index 00000000000..fc9fbd637ef
--- /dev/null
+++ b/pkgtools/pkglint/files/PkgLint/SubstContext.pm
@@ -0,0 +1,197 @@
+package PkgLint::SubstContext;
+#==========================================================================
+# This class records the state of a block of variable assignments that make
+# up a SUBST class. As these variable assignments are not easy to get right
+# unless you do it every day, and the possibility of typos is high, pkglint
+# provides additional checks for them.
+#==========================================================================
+
+BEGIN {
+ import PkgLint::Util qw(
+ false true
+ );
+ import PkgLint::Logging qw(
+ log_warning
+ );
+}
+
+use enum qw(:SUBST_ ID CLASS STAGE MESSAGE FILES SED VARS FILTER_CMD);
+
+sub new($) {
+ my ($class) = @_;
+ my ($self) = ([undef, undef, undef, undef, [], [], [], undef]);
+ bless($self, $class);
+ return $self;
+}
+
+sub subst_class($) { return shift()->[SUBST_CLASS]; }
+sub subst_stage($) { return shift()->[SUBST_STAGE]; }
+sub subst_message($) { return shift()->[SUBST_MESSAGE]; }
+sub subst_files($) { return shift()->[SUBST_FILES]; }
+sub subst_sed($) { return shift()->[SUBST_SED]; }
+sub subst_vars($) { return shift()->[SUBST_VARS]; }
+sub subst_filter_cmd($) { return shift()->[SUBST_FILTER_CMD]; }
+sub subst_id($) { return shift()->[SUBST_ID]; }
+
+sub init($) {
+ my ($self) = @_;
+
+ $self->[SUBST_ID] = undef;
+ $self->[SUBST_CLASS] = undef;
+ $self->[SUBST_STAGE] = undef;
+ $self->[SUBST_MESSAGE] = undef;
+ $self->[SUBST_FILES] = [];
+ $self->[SUBST_SED] = [];
+ $self->[SUBST_VARS] = [];
+ $self->[SUBST_FILTER_CMD] = undef;
+}
+
+sub check_end($$) {
+ my ($self, $line) = @_;
+
+ return unless defined($self->subst_id);
+
+ if (!defined($self->subst_class)) {
+ $main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_CLASSES missing.");
+ }
+ if (!defined($self->subst_stage)) {
+ $main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_STAGE missing.");
+ }
+ if (@{$self->subst_files} == 0) {
+ $main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_FILES missing.");
+ }
+ if (@{$self->subst_sed} == 0 && @{$self->subst_vars} == 0 && !defined($self->subst_filter_cmd)) {
+ $main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_SED or SUBST_VARS missing.");
+ }
+ $self->init();
+}
+
+sub is_complete($) {
+ my ($self) = @_;
+
+ return false unless defined($self->subst_id);
+ return false unless defined($self->subst_class);
+ return false unless defined($self->subst_files);
+ return false if @{$self->subst_sed} == 0 && @{$self->subst_vars} == 0;
+ return true;
+}
+
+sub check_varassign($$$$$) {
+ my ($self, $line, $varname, $op, $value) = @_;
+ my ($varbase, $varparam, $id);
+
+ if ($varname eq "SUBST_CLASSES") {
+
+ if ($value =~ m"^(\S+)\s") {
+ $main::opt_warn_extra and $line->log_warning("Please add only one class at a time to SUBST_CLASSES.");
+ $self->[SUBST_CLASS] = $1;
+ $self->[SUBST_ID] = $1;
+
+ } else {
+ if (defined($self->subst_class)) {
+ $main::opt_warn_extra and $line->log_warning("SUBST_CLASSES should only appear once in a SUBST block.");
+ }
+ $self->[SUBST_CLASS] = $value;
+ $self->[SUBST_ID] = $value;
+ }
+ return;
+ }
+
+ $id = $self->subst_id;
+
+ if ($varname =~ m"^(SUBST_(?:STAGE|MESSAGE|FILES|SED|VARS|FILTER_CMD))\.([\-\w_]+)$") {
+ ($varbase, $varparam) = ($1, $2);
+
+ if (!defined($id)) {
+ $main::opt_warn_extra and $line->log_note("SUBST_CLASSES should precede the definition of ${varbase}.${varparam}.");
+
+ $id = $self->[SUBST_ID] = $varparam;
+ }
+ } else {
+ if (defined($id)) {
+ $main::opt_warn_extra and $line->log_warning("Foreign variable in SUBST block.");
+ }
+ return;
+ }
+
+ if ($varparam ne $id) {
+
+ # XXX: This code sometimes produces weird warnings. See
+ # meta-pkgs/xorg/Makefile.common 1.41 for an example.
+ if ($self->is_complete()) {
+ $self->check_end($line);
+
+ # The following assignment prevents an additional warning,
+ # but from a technically viewpoint, it is incorrect.
+ $self->[SUBST_CLASS] = $varparam;
+ $self->[SUBST_ID] = $varparam;
+ $id = $varparam;
+ } else {
+ $main::opt_warn_extra and $line->log_warning("Variable parameter \"${varparam}\" does not match SUBST class \"${id}\".");
+ }
+ }
+
+ if ($varbase eq "SUBST_STAGE") {
+ if (defined($self->subst_stage)) {
+ $main::opt_warn_extra and $line->log_warning("Duplicate definition of SUBST_STAGE.${id}.");
+ } else {
+ $self->[SUBST_STAGE] = $value;
+ }
+
+ } elsif ($varbase eq "SUBST_MESSAGE") {
+ if (defined($self->subst_message)) {
+ $main::opt_warn_extra and $line->log_warning("Duplicate definition of SUBST_MESSAGE.${id}.");
+ } else {
+ $self->[SUBST_MESSAGE] = $value;
+ }
+
+ } elsif ($varbase eq "SUBST_FILES") {
+ if (@{$self->subst_files} > 0) {
+ if ($op ne "+=") {
+ $main::opt_warn_extra and $line->log_warning("All but the first SUBST_FILES line should use the \"+=\" operator.");
+ }
+ }
+ push(@{$self->subst_files}, $value);
+
+ } elsif ($varbase eq "SUBST_SED") {
+ if (@{$self->subst_sed} > 0) {
+ if ($op ne "+=") {
+ $main::opt_warn_extra and $line->log_warning("All but the first SUBST_SED line should use the \"+=\" operator.");
+ }
+ }
+ push(@{$self->subst_sed}, $value);
+
+ } elsif ($varbase eq "SUBST_FILTER_CMD") {
+ if (defined($self->subst_filter_cmd)) {
+ $main::opt_warn_extra and $line->log_warning("Duplicate definition of SUBST_FILTER_CMD.${id}.");
+ } else {
+ $self->[SUBST_FILTER_CMD] = $value;
+ }
+
+ } elsif ($varbase eq "SUBST_VARS") {
+ if (@{$self->subst_vars} > 0) {
+ if ($op ne "+=") {
+ $main::opt_warn_extra and $line->log_warning("All but the first SUBST_VARS line should use the \"+=\" operator.");
+ }
+ }
+ push(@{$self->subst_vars}, $value);
+
+ } else {
+ $main::opt_warn_extra and $line->log_warning("Foreign variable in SUBST block.");
+ }
+}
+
+sub to_string($) {
+ my ($self) = @_;
+
+ return sprintf("SubstContext(%s %s %s %s %s %s)",
+ (defined($self->subst_class) ? $self->subst_class : "(undef)"),
+ (defined($self->subst_stage) ? $self->subst_stage : "(undef)"),
+ (defined($self->subst_message) ? $self->subst_message : "(undef)"),
+ scalar(@{$self->subst_files}),
+ scalar(@{$self->subst_sed}),
+ (defined($self->subst_id) ? $self->subst_id : "(undef)"));
+}
+#== End of PkgLint::SubstContext ==========================================
+
+1;
diff --git a/pkgtools/pkglint/files/PkgLint/Type.pm b/pkgtools/pkglint/files/PkgLint/Type.pm
new file mode 100644
index 00000000000..3f542620c4e
--- /dev/null
+++ b/pkgtools/pkglint/files/PkgLint/Type.pm
@@ -0,0 +1,102 @@
+package PkgLint::Type;
+#==========================================================================
+# A Type in pkglint is a combination of a data type and a permission
+# specification. Further details can be found in the chapter ``The pkglint
+# type system'' of the pkglint book.
+#==========================================================================
+
+BEGIN {
+ import PkgLint::Util qw(
+ false true
+ );
+ import PkgLint::Logging qw(
+ log_warning NO_LINES
+ );
+ use Exporter;
+ use vars qw(@ISA @EXPORT_OK);
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(
+ LK_NONE LK_INTERNAL LK_EXTERNAL
+ GUESSED NOT_GUESSED
+ );
+}
+
+use enum qw(KIND_OF_LIST BASIC_TYPE ACLS IS_GUESSED);
+use enum qw(:LK_ NONE INTERNAL EXTERNAL);
+use enum qw(:ACLE_ SUBJECT_RE PERMS);
+use enum qw(NOT_GUESSED GUESSED);
+
+sub new($$$) {
+ my ($class, $kind_of_list, $basic_type, $acls, $guessed) = @_;
+ my ($self) = ([$kind_of_list, $basic_type, $acls, $guessed]);
+ bless($self, $class);
+ return $self;
+}
+
+sub kind_of_list($) { return shift()->[KIND_OF_LIST]; }
+sub basic_type($) { return shift()->[BASIC_TYPE]; }
+# no getter method for acls
+sub is_guessed($) { return shift()->[IS_GUESSED]; }
+
+sub perms($$) {
+ my ($self, $fname) = @_;
+ my ($perms);
+
+ foreach my $acl_entry (@{$self->[ACLS]}) {
+ if ($fname =~ $acl_entry->[ACLE_SUBJECT_RE]) {
+ return $acl_entry->[ACLE_PERMS];
+ }
+ }
+ return undef;
+}
+
+# Returns the union of all possible permissions. This can be used to
+# check whether a variable may be defined or used at all, or if it is
+# read-only.
+sub perms_union($) {
+ my ($self) = @_;
+ my ($perms);
+
+ $perms = "";
+ foreach my $acl_entry(@{$self->[ACLS]}) {
+ $perms .= $acl_entry->[ACLE_PERMS];
+ }
+ return $perms;
+}
+
+# Returns whether the type is considered an external list. All external
+# lists are, of course, as well as some other data types that are not
+# defined as lists to make the implementation of checkline_mk_vartype
+# easier.
+sub is_practically_a_list($) {
+ my ($self) = @_;
+
+ return ($self->kind_of_list == LK_EXTERNAL) ? true
+ : ($self->kind_of_list == LK_INTERNAL) ? false
+ : ($self->basic_type eq "BuildlinkPackages") ? true
+ : ($self->basic_type eq "SedCommands") ? true
+ : ($self->basic_type eq "ShellCommand") ? true
+ : false;
+}
+
+# Returns whether variables of this type may be extended using the "+="
+# operator.
+sub may_use_plus_eq($) {
+ my ($self) = @_;
+
+ return ($self->kind_of_list != LK_NONE) ? true
+ : ($self->basic_type eq "AwkCommand") ? true
+ : ($self->basic_type eq "BuildlinkPackages") ? true
+ : ($self->basic_type eq "SedCommands") ? true
+ : false;
+}
+
+sub to_string($) {
+ my ($self) = @_;
+
+ return (["", "InternalList of ", "List of "]->[$self->kind_of_list]) . $self->basic_type;
+}
+
+#== End of PkgLint::Type ==================================================
+
+1;
diff --git a/pkgtools/pkglint/files/PkgLint/Util.pm b/pkgtools/pkglint/files/PkgLint/Util.pm
new file mode 100644
index 00000000000..2edecf8b330
--- /dev/null
+++ b/pkgtools/pkglint/files/PkgLint/Util.pm
@@ -0,0 +1,95 @@
+package PkgLint::Util;
+#==========================================================================
+# This package is a catch-all for subroutines that are not application-spe-
+# cific. Currently it contains the boolean constants C<false> and C<true>,
+# as well as a function to print text in a table format, and a function
+# that converts an array into a hash. The latter is just for convenience
+# because I don't know of a Perl operator similar to qw() that can be used
+# for creating a hash.
+#==========================================================================
+BEGIN {
+ use Exporter;
+ use vars qw(@ISA @EXPORT_OK);
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(
+ assert
+ false true dont_know doesnt_matter
+ array_to_hash normalize_pathname print_table
+ );
+}
+
+use enum qw(false true dont_know doesnt_matter);
+
+sub assert($$) {
+ my ($cond, $msg) = @_;
+ my (@callers, $n);
+
+ if (!$cond) {
+ print STDERR ("FATAL: Assertion failed: ${msg}.\n");
+
+ for ($n = 0; my @info = caller($n); $n++) {
+ push(@callers, [$info[2], $info[3]]);
+ }
+
+ for (my $i = $#callers; $i >= 0; $i--) {
+ my $info = $callers[$i];
+ printf STDERR (" line %4d called %s\n", $info->[0], $info->[1]);
+ }
+ exit(1);
+ }
+}
+
+# Prints the C<$table> on the C<$out> stream. The C<$table> shall be an
+# array of rows, each row shall be an array of cells, and each cell shall
+# be a string.
+sub print_table($$) {
+ my ($out, $table) = @_;
+ my (@width) = ();
+ foreach my $row (@{$table}) {
+ foreach my $i (0..$#{$row}) {
+ if (!defined($width[$i]) || length($row->[$i]) > $width[$i]) {
+ $width[$i] = length($row->[$i]);
+ }
+ }
+ }
+ foreach my $row (@{$table}) {
+ my ($max) = ($#{$row});
+ foreach my $i (0..$max) {
+ if ($i != 0) {
+ print $out (" ");
+ }
+ print $out ($row->[$i]);
+ if ($i != $max) {
+ print $out (" " x ($width[$i] - length($row->[$i])));
+ }
+ }
+ print $out ("\n");
+ }
+}
+
+sub array_to_hash(@) {
+ my ($result) = {};
+
+ foreach my $arg (@_) {
+ $result->{$arg} = 1;
+ }
+ return $result;
+}
+
+sub normalize_pathname($) {
+ my ($fname) = @_;
+
+ # strip "." path components
+ $fname =~ s,^(?:\./)+,,;
+ $fname =~ s,/(?:\./)+,/,g;
+ $fname =~ s,/+,/,g;
+
+ # strip intermediate "../.." path components
+ while ($fname =~ s,/[^.][^/]*/[^.][^/]*/\.\./\.\./,/,) {
+ }
+
+ return $fname;
+}
+#== End of PkgLint::Util ==================================================
+
+1;
diff --git a/pkgtools/pkglint/files/PkgLint/VarUseContext.pm b/pkgtools/pkglint/files/PkgLint/VarUseContext.pm
new file mode 100644
index 00000000000..308f809f410
--- /dev/null
+++ b/pkgtools/pkglint/files/PkgLint/VarUseContext.pm
@@ -0,0 +1,69 @@
+package PkgLint::VarUseContext;
+#==========================================================================
+# This class represents the various contexts in which make(1) variables can
+# appear in pkgsrc. Further details can be found in the chapter ``The
+# pkglint type system'' of the pkglint book.
+#==========================================================================
+
+BEGIN {
+ import PkgLint::Util qw(
+ false true
+ );
+ import PkgLint::Logging qw(
+ log_warning NO_LINES
+ );
+ use Exporter;
+ use vars qw(@ISA @EXPORT_OK);
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(
+ VUC_TIME_UNKNOWN VUC_TIME_LOAD VUC_TIME_RUN
+ VUC_TYPE_UNKNOWN
+ VUC_SHELLWORD_UNKNOWN VUC_SHELLWORD_PLAIN VUC_SHELLWORD_DQUOT
+ VUC_SHELLWORD_SQUOT VUC_SHELLWORD_BACKT VUC_SHELLWORD_FOR
+ VUC_EXTENT_UNKNOWN VUC_EXTENT_FULL VUC_EXTENT_WORD
+ VUC_EXTENT_WORD_PART
+ );
+}
+
+use enum qw(TIME TYPE SHELLWORD EXTENT);
+use enum qw(:VUC_TIME_ UNKNOWN LOAD RUN);
+use constant VUC_TYPE_UNKNOWN => undef;
+use enum qw(:VUC_SHELLWORD_ UNKNOWN PLAIN DQUOT SQUOT BACKT FOR);
+use enum qw(:VUC_EXTENT_ UNKNOWN FULL WORD WORD_PART);
+
+my $pool = {};
+
+sub new($$$$$) {
+ my ($class, $time, $type, $shellword, $extent) = @_;
+ my ($self) = ([$time, $type, $shellword, $extent]);
+ bless($self, $class);
+ return $self;
+}
+sub new_from_pool($$$$$) {
+ my ($class, $time, $type, $shellword, $extent) = @_;
+ my $key = "${time}-${type}-${shellword}-${extent}";
+
+ if (!exists($pool->{$key})) {
+ $pool->{$key} = $class->new($time, $type, $shellword, $extent);
+ }
+ return $pool->{$key};
+}
+
+sub time($) { return shift()->[TIME]; }
+sub type($) { return shift()->[TYPE]; }
+sub shellword($) { return shift()->[SHELLWORD]; }
+sub extent($) { return shift()->[EXTENT]; }
+
+sub to_string($) {
+ my ($self) = @_;
+
+ return sprintf("(%s %s %s %s)",
+ ["unknown-time", "load-time", "run-time"]->[$self->time],
+ (defined($self->type) ? $self->type->to_string() : "no-type"),
+ ["none", "plain", "squot", "dquot", "backt", "for"]->[$self->shellword],
+ ["unknown", "full", "word", "word-part"]->[$self->extent]);
+}
+
+#== End of PkgLint::VarUseContext =========================================
+
+1;
diff --git a/pkgtools/pkglint/files/build.pl b/pkgtools/pkglint/files/build.pl
new file mode 100644
index 00000000000..97caff3b4c0
--- /dev/null
+++ b/pkgtools/pkglint/files/build.pl
@@ -0,0 +1,25 @@
+#! @PERL@
+# $NetBSD: build.pl,v 1.1 2013/03/26 15:08:29 schmonz Exp $
+#
+
+use strict;
+use warnings;
+
+sub readfile {
+ my $file = shift;
+
+ local $/ = undef;
+ open(my $in, "<", $file) || die "failed to read $file: $!";
+ my $contents = <$in>;
+ close($in) || die "failed to read $file: $!";
+
+ return $contents;
+}
+
+while (my $line = <>) {
+ if ($line =~ /^use PkgLint::(.+);$/) {
+ print readfile("PkgLint/$1.pm");
+ } else {
+ print $line;
+ }
+}
diff --git a/pkgtools/pkglint/files/pkglint.pl b/pkgtools/pkglint/files/pkglint.pl
index 64095b195a2..ec860241749 100644
--- a/pkgtools/pkglint/files/pkglint.pl
+++ b/pkgtools/pkglint/files/pkglint.pl
@@ -1,5 +1,5 @@
#! @PERL@
-# $NetBSD: pkglint.pl,v 1.850 2013/03/06 12:30:01 obache Exp $
+# $NetBSD: pkglint.pl,v 1.851 2013/03/26 15:08:29 schmonz Exp $
#
# pkglint - static analyzer and checker for pkgsrc packages
@@ -34,1057 +34,16 @@
use strict;
use warnings;
-package PkgLint::Util;
-#==========================================================================
-# This package is a catch-all for subroutines that are not application-spe-
-# cific. Currently it contains the boolean constants C<false> and C<true>,
-# as well as a function to print text in a table format, and a function
-# that converts an array into a hash. The latter is just for convenience
-# because I don't know of a Perl operator similar to qw() that can be used
-# for creating a hash.
-#==========================================================================
-BEGIN {
- use Exporter;
- use vars qw(@ISA @EXPORT_OK);
- @ISA = qw(Exporter);
- @EXPORT_OK = qw(
- assert
- false true dont_know doesnt_matter
- array_to_hash normalize_pathname print_table
- );
-}
-
-use enum qw(false true dont_know doesnt_matter);
-
-sub assert($$) {
- my ($cond, $msg) = @_;
- my (@callers, $n);
-
- if (!$cond) {
- print STDERR ("FATAL: Assertion failed: ${msg}.\n");
-
- for ($n = 0; my @info = caller($n); $n++) {
- push(@callers, [$info[2], $info[3]]);
- }
-
- for (my $i = $#callers; $i >= 0; $i--) {
- my $info = $callers[$i];
- printf STDERR (" line %4d called %s\n", $info->[0], $info->[1]);
- }
- exit(1);
- }
-}
-
-# Prints the C<$table> on the C<$out> stream. The C<$table> shall be an
-# array of rows, each row shall be an array of cells, and each cell shall
-# be a string.
-sub print_table($$) {
- my ($out, $table) = @_;
- my (@width) = ();
- foreach my $row (@{$table}) {
- foreach my $i (0..$#{$row}) {
- if (!defined($width[$i]) || length($row->[$i]) > $width[$i]) {
- $width[$i] = length($row->[$i]);
- }
- }
- }
- foreach my $row (@{$table}) {
- my ($max) = ($#{$row});
- foreach my $i (0..$max) {
- if ($i != 0) {
- print $out (" ");
- }
- print $out ($row->[$i]);
- if ($i != $max) {
- print $out (" " x ($width[$i] - length($row->[$i])));
- }
- }
- print $out ("\n");
- }
-}
-
-sub array_to_hash(@) {
- my ($result) = {};
-
- foreach my $arg (@_) {
- $result->{$arg} = 1;
- }
- return $result;
-}
-
-sub normalize_pathname($) {
- my ($fname) = @_;
-
- # strip "." path components
- $fname =~ s,^(?:\./)+,,;
- $fname =~ s,/(?:\./)+,/,g;
- $fname =~ s,/+,/,g;
-
- # strip intermediate "../.." path components
- while ($fname =~ s,/[^.][^/]*/[^.][^/]*/\.\./\.\./,/,) {
- }
-
- return $fname;
-}
-#== End of PkgLint::Util ==================================================
-
-package PkgLint::Logging;
-#==========================================================================
-# This package provides subroutines for printing messages to the user in a
-# common format. The subroutines all have the parameters C<$fname>,
-# C<$lineno> and C<$message>. In case there's no appropriate filename for
-# the message, NO_FILE may be passed, likewise for C<$lineno> and
-# NO_LINES. Before printing, the filename is normalized, that is,
-# "/foo/bar/../../" components are removed, as well as "." components.
-# At the end of the program, the subroutine print_summary_and_exit should
-# be called.
-#
-# Examples:
-# log_error(NO_FILE, NO_LINES, "Invalid command line.");
-# log_warning($fname, NO_LINES, "Not found.");
-# log_debug($fname, $lineno, sprintf("invalid character (0x%02x).", $c));
-#==========================================================================
-
-use strict;
-use warnings;
-BEGIN {
- use Exporter;
- use vars qw(@ISA @EXPORT_OK);
- @ISA = qw(Exporter);
- @EXPORT_OK = qw(
- NO_FILE NO_LINE_NUMBER NO_LINES
- log_fatal log_error log_warning log_note log_debug
- explain_error explain_warning explain_info
- print_summary_and_exit
- set_explain set_gcc_output_format
- get_show_source_flag set_show_source_flag
- );
- import PkgLint::Util qw(
- false true
- normalize_pathname
- );
-}
-
-use constant NO_FILE => undef;
-use constant NO_LINE_NUMBER => undef;
-use constant NO_LINES => undef;
-
-use enum qw(:LL_ FATAL ERROR WARNING NOTE DEBUG);
-
-use constant traditional_type => ["FATAL", "ERROR", "WARN", "NOTE", "DEBUG"];
-use constant gcc_type => ["fatal", "error", "warning", "note", "debug"];
-
-my $errors = 0;
-my $warnings = 0;
-my $gcc_output_format = false;
-my $explain_flag = false;
-my $show_source_flag = false;
-
-sub strxvis($) {
- my ($s) = @_;
-
- $s =~ s/([^\x09\x20-\x7e])/"\\x" . unpack("H*", $1)/eg;
- return $s;
-}
-
-sub log_message { # no prototype due to Perl weirdness
- my ($level, $fname, $lineno, $message) = @_;
- my ($text, $sep);
-
- if (defined($fname)) {
- $fname = normalize_pathname($fname);
- }
-
- $text = "";
- $sep = "";
- if (!$gcc_output_format) {
- $text .= "${sep}" . traditional_type->[$level] . ":";
- $sep = " ";
- }
- if (defined($fname)) {
- $text .= defined($lineno)
- ? "${sep}${fname}:${lineno}"
- : "${sep}${fname}";
- $sep = ": ";
- }
- if ($gcc_output_format) {
- $text .= "${sep}" . gcc_type->[$level] . ":";
- $sep = " ";
- }
- if (defined($message)) {
- $text .= $sep . strxvis($message);
- $sep = "";
- }
-
- if ($level == LL_FATAL) {
- print STDERR ("${text}\n");
- } else {
- print STDOUT ("${text}\n");
- }
-}
-
-sub log_fatal($$$) { log_message(LL_FATAL, @_); exit(1); }
-sub log_error($$$) { log_message(LL_ERROR, @_); $errors++; }
-sub log_warning($$$) { log_message(LL_WARNING, @_); $warnings++; }
-sub log_note($$$) { log_message(LL_NOTE, @_); }
-sub log_debug($$$) { log_message(LL_DEBUG, @_); }
-
-sub explain { # no prototype due to Perl weirdness
- my ($loglevel, $fname, $lines, @texts) = @_;
- my $out = ($loglevel == LL_FATAL) ? *STDERR : *STDOUT;
-
- if ($explain_flag) {
- foreach my $text ("", @texts, "") {
- print $out ("\t${text}\n");
- }
- }
-}
-sub explain_error($$@) { explain(LL_ERROR, @_); }
-sub explain_warning($$@) { explain(LL_WARNING, @_); }
-sub explain_note($$@) { explain(LL_NOTE, @_); }
-
-sub print_summary_and_exit($) {
- my ($quiet) = @_;
-
- if (!$quiet) {
- if ($errors != 0 || $warnings != 0) {
- print("$errors errors and $warnings warnings found." . ($explain_flag ? "" : " (Use -e for more details.)") . "\n");
- } else {
- print "looks fine.\n";
- }
- }
- exit($errors != 0);
-}
-
-sub set_explain() { $explain_flag = true; }
-sub set_gcc_output_format() { $gcc_output_format = true; }
-sub get_show_source_flag() { return $show_source_flag; }
-sub set_show_source_flag() { $show_source_flag = true; }
-
-#== End of PkgLint::Logging ===============================================
-
-#==========================================================================
-# A SimpleMatch is the result of applying a regular expression to a Perl
-# scalar value. It can return the range and the text of the captured
-# groups.
-#==========================================================================
-package PkgLint::SimpleMatch;
-
-use enum qw(STRING STARTS ENDS N);
-
-sub new($$) {
- my ($class, $string, $starts, $ends) = @_;
- my ($self) = ([$string, [@{$starts}], [@{$ends}], $#{$ends}]);
- bless($self, $class);
- return $self;
-}
-
-sub string($) { return shift()->[STRING]; }
-sub n($) { return shift()->[N]; }
-
-sub has($$) {
- my ($self, $n) = @_;
-
- return 0 <= $n && $n <= $self->n
- && defined($self->[STARTS]->[$n])
- && defined($self->[ENDS]->[$n]);
-}
-
-sub text($$) {
- my ($self, $n) = @_;
-
- my $start = $self->[STARTS]->[$n];
- my $end = $self->[ENDS]->[$n];
- return substr($self->string, $start, $end - $start);
-}
-
-sub range($$) {
- my ($self, $n) = @_;
-
- return ($self->[STARTS]->[$n], $self->[ENDS]->[$n]);
-}
-
-#==========================================================================
-# When files are read in by pkglint, they are interpreted in terms of
-# lines. For Makefiles, line continuations are handled properly, allowing
-# multiple physical lines to end in a single logical line. For other files
-# there is a 1:1 translation.
-#
-# A difference between the physical and the logical lines is that the
-# physical lines include the line end sequence, whereas the logical lines
-# do not.
-#
-# A logical line is a class having the read-only fields C<file>,
-# C<lines>, C<text>, C<physlines> and C<is_changed>, as well as some
-# methods for printing diagnostics easily.
-#
-# Some other methods allow modification of the physical lines, but leave
-# the logical line (the C<text>) untouched. These methods are used in the
-# --autofix mode.
-#
-# A line can have some "extra" fields that allow the results of parsing to
-# be saved under a name.
-#==========================================================================
-package PkgLint::Line;
-
-BEGIN {
- import PkgLint::Util qw(
- false true
- assert
- );
-}
-
-use enum qw(FNAME LINES TEXT PHYSLINES CHANGED BEFORE AFTER EXTRA);
-
-sub new($$$$) {
- my ($class, $fname, $lines, $text, $physlines) = @_;
- my ($self) = ([$fname, $lines, $text, $physlines, false, [], [], {}]);
- bless($self, $class);
- return $self;
-}
-
-sub fname($) { return shift()->[FNAME]; }
-sub lines($) { return shift()->[LINES]; }
-sub text($) { return shift()->[TEXT]; }
-# Note: physlines is _not_ a simple getter method.
-sub is_changed($) { return shift()->[CHANGED]; }
-
-# querying, getting and setting the extra values.
-sub has($$) {
- my ($self, $name) = @_;
- return exists($self->[EXTRA]->{$name});
-}
-sub get($$) {
- my ($self, $name) = @_;
- assert(exists($self->[EXTRA]->{$name}), "Field ${name} does not exist.");
- return $self->[EXTRA]->{$name};
-}
-sub set($$$) {
- my ($self, $name, $value) = @_;
- assert(!exists($self->[EXTRA]->{$name}), "Field ${name} already exists.");
-
- # Make sure that the line does not become a cyclic data structure.
- my $type = ref($value);
- if ($type eq "") {
- # ok
- } elsif ($type eq "ARRAY") {
- foreach my $element (@{$value}) {
- my $element_type = ref($element);
- assert($element_type eq "" || $element_type eq "PkgLint::SimpleMatch",
- "Invalid array data type: name=${name}, type=${element_type}.");
- }
- } else {
- assert(false, "Invalid data: name=${name}, value=${value}.");
- }
-
- $self->[EXTRA]->{$name} = $value;
-}
-
-sub physlines($) {
- my ($self) = @_;
- return [@{$self->[BEFORE]}, @{$self->[PHYSLINES]}, @{$self->[AFTER]}];
-}
-
-# Only for PkgLint::String support
-sub substring($$$$) {
- my ($self, $line, $start, $end) = @_;
-
- return substr($self->[PHYSLINES]->[$line]->[1], $start, $end);
-}
-
-sub show_source($$) {
- my ($self, $out) = @_;
-
- if (PkgLint::Logging::get_show_source_flag()) {
- foreach my $line (@{$self->physlines}) {
- print $out ("> " . $line->[1]);
- }
- }
-}
-
-sub log_fatal($$) {
- my ($self, $text) = @_;
-
- $self->show_source(*STDERR);
- PkgLint::Logging::log_fatal($self->fname, $self->[LINES], $text);
-}
-sub log_error($$) {
- my ($self, $text) = @_;
-
- $self->show_source(*STDOUT);
- PkgLint::Logging::log_error($self->fname, $self->[LINES], $text);
-}
-sub log_warning($$) {
- my ($self, $text) = @_;
-
- $self->show_source(*STDOUT);
- PkgLint::Logging::log_warning($self->fname, $self->[LINES], $text);
-}
-sub log_note($$) {
- my ($self, $text) = @_;
-
- $self->show_source(*STDOUT);
- PkgLint::Logging::log_note($self->fname, $self->[LINES], $text);
-}
-sub log_debug($$) {
- my ($self, $text) = @_;
-
- $self->show_source(*STDOUT);
- PkgLint::Logging::log_debug($self->fname, $self->[LINES], $text);
-}
-sub explain_error($@) {
- my ($self, @texts) = @_;
-
- PkgLint::Logging::explain_error($self->fname, $self->[LINES], @texts);
-}
-sub explain_warning($@) {
- my ($self, @texts) = @_;
-
- PkgLint::Logging::explain_warning($self->fname, $self->[LINES], @texts);
-}
-sub explain_note($@) {
- my ($self, @texts) = @_;
-
- PkgLint::Logging::explain_note($self->fname, $self->[LINES], @texts);
-}
-sub explain_info($@) {
- my ($self, @texts) = @_;
-
- PkgLint::Logging::explain_info($self->fname, $self->[LINES], @texts);
-}
-
-sub to_string($) {
- my ($self) = @_;
-
- return $self->fname . ":" . $self->[LINES] . ": " . $self->[TEXT];
-}
-
-sub prepend_before($$) {
- my ($self, $text) = @_;
-
- unshift(@{$self->[BEFORE]}, [0, "$text\n"]);
- $self->[CHANGED] = true;
-}
-sub append_before($$) {
- my ($self, $text) = @_;
-
- push(@{$self->[BEFORE]}, [0, "$text\n"]);
- $self->[CHANGED] = true;
-}
-sub prepend_after($$) {
- my ($self, $text) = @_;
-
- unshift(@{$self->[AFTER]}, [0, "$text\n"]);
- $self->[CHANGED] = true;
-}
-sub append_after($$) {
- my ($self, $text) = @_;
-
- push(@{$self->[AFTER]}, [0, "$text\n"]);
- $self->[CHANGED] = true;
-}
-sub delete($) {
- my ($self) = @_;
-
- $self->[PHYSLINES] = [];
- $self->[CHANGED] = true;
-}
-sub replace($$$) {
- my ($self, $from, $to) = @_;
- my $phys = $self->[PHYSLINES];
-
- foreach my $i (0..$#{$phys}) {
- if ($phys->[$i]->[0] != 0 && $phys->[$i]->[1] =~ s/\Q$from\E/$to/g) {
- $self->[CHANGED] = true;
- }
- }
-}
-sub replace_regex($$$) {
- my ($self, $from_re, $to) = @_;
- my $phys = $self->[PHYSLINES];
-
- foreach my $i (0..$#{$phys}) {
- if ($phys->[$i]->[0] != 0 && $phys->[$i]->[1] =~ s/$from_re/$to/) {
- $self->[CHANGED] = true;
- }
- }
-}
-sub set_text($$) {
- my ($self, $text) = @_;
- $self->[PHYSLINES] = [[0, "$text\n"]];
- $self->[CHANGED] = true;
-}
-
-#== End of PkgLint::Line ==================================================
-
-package PkgLint::FileUtil;
-#==========================================================================
-# This package provides subroutines for loading and saving line-oriented
-# files. The load_file() subroutine loads a file completely into memory,
-# optionally handling continuation line folding. The load_lines() subrou-
-# tine is an abbreviation for the common case of loading files without
-# continuation lines. The save_autofix_changes() subroutine examines an
-# array of lines if some of them have changed. It then saves the modified
-# files.
-#==========================================================================
-use strict;
-use warnings;
-
-BEGIN {
- use Exporter;
- use vars qw(@ISA @EXPORT_OK);
- @ISA = qw(Exporter);
- @EXPORT_OK = qw(
- load_file load_lines
- save_autofix_changes
- );
-
- import PkgLint::Util qw(
- false true
- );
- import PkgLint::Logging qw(
- NO_LINE_NUMBER
- log_error log_note
- );
-}
-
-sub load_physical_lines($) {
- my ($fname) = @_;
- my ($physlines, $line, $lineno);
-
- $physlines = [];
- open(F, "< $fname") or return undef;
- $lineno = 0;
- while (defined($line = <F>)) {
- $lineno++;
- push(@{$physlines}, [$lineno, $line]);
- }
- close(F) or return undef;
- return $physlines;
-}
-
-sub get_logical_line($$$) {
- my ($fname, $lines, $ref_lineno) = @_;
- my ($value, $lineno, $first, $firstlineno, $lastlineno, $physlines);
-
- $value = "";
- $first = true;
- $lineno = ${$ref_lineno};
- $firstlineno = $lines->[$lineno]->[0];
- $physlines = [];
-
- for (; $lineno <= $#{$lines}; $lineno++) {
- if ($lines->[$lineno]->[1] =~ m"^([ \t]*)(.*?)([ \t]*)(\\?)\n?$") {
- my ($indent, $text, $outdent, $cont) = ($1, $2, $3, $4);
-
- if ($first) {
- $value .= $indent;
- $first = false;
- }
-
- $value .= $text;
- push(@{$physlines}, $lines->[$lineno]);
-
- if ($cont eq "\\") {
- $value .= " ";
- } else {
- $value .= $outdent;
- last;
- }
- }
- }
-
- if ($lineno > $#{$lines}) {
- # The last line in the file is a continuation line
- $lineno--;
- }
- $lastlineno = $lines->[$lineno]->[0];
- ${$ref_lineno} = $lineno + 1;
-
- return PkgLint::Line->new($fname,
- $firstlineno == $lastlineno
- ? $firstlineno
- : "$firstlineno--$lastlineno",
- $value,
- $physlines);
-}
-
-sub load_lines($$) {
- my ($fname, $fold_backslash_lines) = @_;
- my ($physlines, $seen_newline, $loglines);
-
- $physlines = load_physical_lines($fname);
- if (!$physlines) {
- return false;
- }
-
- $seen_newline = true;
- $loglines = [];
- if ($fold_backslash_lines) {
- for (my $lineno = 0; $lineno <= $#{$physlines}; ) {
- push(@{$loglines}, get_logical_line($fname, $physlines, \$lineno));
- }
- } else {
- foreach my $physline (@{$physlines}) {
- my $text = $physline->[1];
-
- $text =~ s/\n$//;
- push(@{$loglines}, PkgLint::Line->new($fname, $physline->[0], $text, [$physline]));
- }
- }
-
- if (0 <= $#{$physlines} && $physlines->[-1]->[1] !~ m"\n$") {
- log_error($fname, $physlines->[-1]->[0], "File must end with a newline.");
- }
-
- return $loglines;
-}
-
-sub load_file($) {
- my ($fname) = @_;
-
- return load_lines($fname, false);
-}
-
-sub save_autofix_changes($) {
- my ($lines) = @_;
-
- my (%changed, %physlines);
-
- foreach my $line (@{$lines}) {
- if ($line->is_changed) {
- $changed{$line->fname}++;
- }
- push(@{$physlines{$line->fname}}, @{$line->physlines});
- }
-
- foreach my $fname (sort(keys(%changed))) {
- my $new = "${fname}.pkglint.tmp";
-
- if (!open(F, ">", $new)) {
- log_error($new, NO_LINE_NUMBER, "$!");
- next;
- }
- foreach my $physline (@{$physlines{$fname}}) {
- print F ($physline->[1]);
- }
- if (!close(F)) {
- log_error($new, NO_LINE_NUMBER, "$!");
- next;
- }
-
- if (!rename($new, $fname)) {
- log_error($fname, NO_LINE_NUMBER, "$!");
- next;
- }
- log_note($fname, NO_LINE_NUMBER, "Has been autofixed. Please re-run pkglint.");
- }
-}
-
-#== End of PkgLint::FileUtil ==============================================
-
-package PkgLint::Type;
-#==========================================================================
-# A Type in pkglint is a combination of a data type and a permission
-# specification. Further details can be found in the chapter ``The pkglint
-# type system'' of the pkglint book.
-#==========================================================================
-
-BEGIN {
- import PkgLint::Util qw(
- false true
- );
- import PkgLint::Logging qw(
- log_warning NO_LINES
- );
- use Exporter;
- use vars qw(@ISA @EXPORT_OK);
- @ISA = qw(Exporter);
- @EXPORT_OK = qw(
- LK_NONE LK_INTERNAL LK_EXTERNAL
- GUESSED NOT_GUESSED
- );
-}
-
-use enum qw(KIND_OF_LIST BASIC_TYPE ACLS IS_GUESSED);
-use enum qw(:LK_ NONE INTERNAL EXTERNAL);
-use enum qw(:ACLE_ SUBJECT_RE PERMS);
-use enum qw(NOT_GUESSED GUESSED);
-
-sub new($$$) {
- my ($class, $kind_of_list, $basic_type, $acls, $guessed) = @_;
- my ($self) = ([$kind_of_list, $basic_type, $acls, $guessed]);
- bless($self, $class);
- return $self;
-}
-
-sub kind_of_list($) { return shift()->[KIND_OF_LIST]; }
-sub basic_type($) { return shift()->[BASIC_TYPE]; }
-# no getter method for acls
-sub is_guessed($) { return shift()->[IS_GUESSED]; }
-
-sub perms($$) {
- my ($self, $fname) = @_;
- my ($perms);
-
- foreach my $acl_entry (@{$self->[ACLS]}) {
- if ($fname =~ $acl_entry->[ACLE_SUBJECT_RE]) {
- return $acl_entry->[ACLE_PERMS];
- }
- }
- return undef;
-}
-
-# Returns the union of all possible permissions. This can be used to
-# check whether a variable may be defined or used at all, or if it is
-# read-only.
-sub perms_union($) {
- my ($self) = @_;
- my ($perms);
-
- $perms = "";
- foreach my $acl_entry(@{$self->[ACLS]}) {
- $perms .= $acl_entry->[ACLE_PERMS];
- }
- return $perms;
-}
-
-# Returns whether the type is considered an external list. All external
-# lists are, of course, as well as some other data types that are not
-# defined as lists to make the implementation of checkline_mk_vartype
-# easier.
-sub is_practically_a_list($) {
- my ($self) = @_;
-
- return ($self->kind_of_list == LK_EXTERNAL) ? true
- : ($self->kind_of_list == LK_INTERNAL) ? false
- : ($self->basic_type eq "BuildlinkPackages") ? true
- : ($self->basic_type eq "SedCommands") ? true
- : ($self->basic_type eq "ShellCommand") ? true
- : false;
-}
-
-# Returns whether variables of this type may be extended using the "+="
-# operator.
-sub may_use_plus_eq($) {
- my ($self) = @_;
-
- return ($self->kind_of_list != LK_NONE) ? true
- : ($self->basic_type eq "AwkCommand") ? true
- : ($self->basic_type eq "BuildlinkPackages") ? true
- : ($self->basic_type eq "SedCommands") ? true
- : false;
-}
-
-sub to_string($) {
- my ($self) = @_;
-
- return (["", "InternalList of ", "List of "]->[$self->kind_of_list]) . $self->basic_type;
-}
-
-#== End of PkgLint::Type ==================================================
-
-package PkgLint::VarUseContext;
-#==========================================================================
-# This class represents the various contexts in which make(1) variables can
-# appear in pkgsrc. Further details can be found in the chapter ``The
-# pkglint type system'' of the pkglint book.
-#==========================================================================
-
-BEGIN {
- import PkgLint::Util qw(
- false true
- );
- import PkgLint::Logging qw(
- log_warning NO_LINES
- );
- use Exporter;
- use vars qw(@ISA @EXPORT_OK);
- @ISA = qw(Exporter);
- @EXPORT_OK = qw(
- VUC_TIME_UNKNOWN VUC_TIME_LOAD VUC_TIME_RUN
- VUC_TYPE_UNKNOWN
- VUC_SHELLWORD_UNKNOWN VUC_SHELLWORD_PLAIN VUC_SHELLWORD_DQUOT
- VUC_SHELLWORD_SQUOT VUC_SHELLWORD_BACKT VUC_SHELLWORD_FOR
- VUC_EXTENT_UNKNOWN VUC_EXTENT_FULL VUC_EXTENT_WORD
- VUC_EXTENT_WORD_PART
- );
-}
-
-use enum qw(TIME TYPE SHELLWORD EXTENT);
-use enum qw(:VUC_TIME_ UNKNOWN LOAD RUN);
-use constant VUC_TYPE_UNKNOWN => undef;
-use enum qw(:VUC_SHELLWORD_ UNKNOWN PLAIN DQUOT SQUOT BACKT FOR);
-use enum qw(:VUC_EXTENT_ UNKNOWN FULL WORD WORD_PART);
-
-my $pool = {};
-
-sub new($$$$$) {
- my ($class, $time, $type, $shellword, $extent) = @_;
- my ($self) = ([$time, $type, $shellword, $extent]);
- bless($self, $class);
- return $self;
-}
-sub new_from_pool($$$$$) {
- my ($class, $time, $type, $shellword, $extent) = @_;
- my $key = "${time}-${type}-${shellword}-${extent}";
-
- if (!exists($pool->{$key})) {
- $pool->{$key} = $class->new($time, $type, $shellword, $extent);
- }
- return $pool->{$key};
-}
-
-sub time($) { return shift()->[TIME]; }
-sub type($) { return shift()->[TYPE]; }
-sub shellword($) { return shift()->[SHELLWORD]; }
-sub extent($) { return shift()->[EXTENT]; }
-
-sub to_string($) {
- my ($self) = @_;
-
- return sprintf("(%s %s %s %s)",
- ["unknown-time", "load-time", "run-time"]->[$self->time],
- (defined($self->type) ? $self->type->to_string() : "no-type"),
- ["none", "plain", "squot", "dquot", "backt", "for"]->[$self->shellword],
- ["unknown", "full", "word", "word-part"]->[$self->extent]);
-}
-
-#== End of PkgLint::VarUseContext =========================================
-
-package PkgLint::SubstContext;
-#==========================================================================
-# This class records the state of a block of variable assignments that make
-# up a SUBST class. As these variable assignments are not easy to get right
-# unless you do it every day, and the possibility of typos is high, pkglint
-# provides additional checks for them.
-#==========================================================================
-
-BEGIN {
- import PkgLint::Util qw(
- false true
- );
- import PkgLint::Logging qw(
- log_warning
- );
-}
-
-use enum qw(:SUBST_ ID CLASS STAGE MESSAGE FILES SED VARS FILTER_CMD);
-
-sub new($) {
- my ($class) = @_;
- my ($self) = ([undef, undef, undef, undef, [], [], [], undef]);
- bless($self, $class);
- return $self;
-}
-
-sub subst_class($) { return shift()->[SUBST_CLASS]; }
-sub subst_stage($) { return shift()->[SUBST_STAGE]; }
-sub subst_message($) { return shift()->[SUBST_MESSAGE]; }
-sub subst_files($) { return shift()->[SUBST_FILES]; }
-sub subst_sed($) { return shift()->[SUBST_SED]; }
-sub subst_vars($) { return shift()->[SUBST_VARS]; }
-sub subst_filter_cmd($) { return shift()->[SUBST_FILTER_CMD]; }
-sub subst_id($) { return shift()->[SUBST_ID]; }
-
-sub init($) {
- my ($self) = @_;
-
- $self->[SUBST_ID] = undef;
- $self->[SUBST_CLASS] = undef;
- $self->[SUBST_STAGE] = undef;
- $self->[SUBST_MESSAGE] = undef;
- $self->[SUBST_FILES] = [];
- $self->[SUBST_SED] = [];
- $self->[SUBST_VARS] = [];
- $self->[SUBST_FILTER_CMD] = undef;
-}
-
-sub check_end($$) {
- my ($self, $line) = @_;
-
- return unless defined($self->subst_id);
-
- if (!defined($self->subst_class)) {
- $main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_CLASSES missing.");
- }
- if (!defined($self->subst_stage)) {
- $main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_STAGE missing.");
- }
- if (@{$self->subst_files} == 0) {
- $main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_FILES missing.");
- }
- if (@{$self->subst_sed} == 0 && @{$self->subst_vars} == 0 && !defined($self->subst_filter_cmd)) {
- $main::opt_warn_extra and $line->log_warning("Incomplete SUBST block: SUBST_SED or SUBST_VARS missing.");
- }
- $self->init();
-}
-
-sub is_complete($) {
- my ($self) = @_;
-
- return false unless defined($self->subst_id);
- return false unless defined($self->subst_class);
- return false unless defined($self->subst_files);
- return false if @{$self->subst_sed} == 0 && @{$self->subst_vars} == 0;
- return true;
-}
-
-sub check_varassign($$$$$) {
- my ($self, $line, $varname, $op, $value) = @_;
- my ($varbase, $varparam, $id);
-
- if ($varname eq "SUBST_CLASSES") {
-
- if ($value =~ m"^(\S+)\s") {
- $main::opt_warn_extra and $line->log_warning("Please add only one class at a time to SUBST_CLASSES.");
- $self->[SUBST_CLASS] = $1;
- $self->[SUBST_ID] = $1;
-
- } else {
- if (defined($self->subst_class)) {
- $main::opt_warn_extra and $line->log_warning("SUBST_CLASSES should only appear once in a SUBST block.");
- }
- $self->[SUBST_CLASS] = $value;
- $self->[SUBST_ID] = $value;
- }
- return;
- }
-
- $id = $self->subst_id;
-
- if ($varname =~ m"^(SUBST_(?:STAGE|MESSAGE|FILES|SED|VARS|FILTER_CMD))\.([\-\w_]+)$") {
- ($varbase, $varparam) = ($1, $2);
-
- if (!defined($id)) {
- $main::opt_warn_extra and $line->log_note("SUBST_CLASSES should precede the definition of ${varbase}.${varparam}.");
-
- $id = $self->[SUBST_ID] = $varparam;
- }
- } else {
- if (defined($id)) {
- $main::opt_warn_extra and $line->log_warning("Foreign variable in SUBST block.");
- }
- return;
- }
-
- if ($varparam ne $id) {
-
- # XXX: This code sometimes produces weird warnings. See
- # meta-pkgs/xorg/Makefile.common 1.41 for an example.
- if ($self->is_complete()) {
- $self->check_end($line);
-
- # The following assignment prevents an additional warning,
- # but from a technically viewpoint, it is incorrect.
- $self->[SUBST_CLASS] = $varparam;
- $self->[SUBST_ID] = $varparam;
- $id = $varparam;
- } else {
- $main::opt_warn_extra and $line->log_warning("Variable parameter \"${varparam}\" does not match SUBST class \"${id}\".");
- }
- }
-
- if ($varbase eq "SUBST_STAGE") {
- if (defined($self->subst_stage)) {
- $main::opt_warn_extra and $line->log_warning("Duplicate definition of SUBST_STAGE.${id}.");
- } else {
- $self->[SUBST_STAGE] = $value;
- }
-
- } elsif ($varbase eq "SUBST_MESSAGE") {
- if (defined($self->subst_message)) {
- $main::opt_warn_extra and $line->log_warning("Duplicate definition of SUBST_MESSAGE.${id}.");
- } else {
- $self->[SUBST_MESSAGE] = $value;
- }
-
- } elsif ($varbase eq "SUBST_FILES") {
- if (@{$self->subst_files} > 0) {
- if ($op ne "+=") {
- $main::opt_warn_extra and $line->log_warning("All but the first SUBST_FILES line should use the \"+=\" operator.");
- }
- }
- push(@{$self->subst_files}, $value);
-
- } elsif ($varbase eq "SUBST_SED") {
- if (@{$self->subst_sed} > 0) {
- if ($op ne "+=") {
- $main::opt_warn_extra and $line->log_warning("All but the first SUBST_SED line should use the \"+=\" operator.");
- }
- }
- push(@{$self->subst_sed}, $value);
-
- } elsif ($varbase eq "SUBST_FILTER_CMD") {
- if (defined($self->subst_filter_cmd)) {
- $main::opt_warn_extra and $line->log_warning("Duplicate definition of SUBST_FILTER_CMD.${id}.");
- } else {
- $self->[SUBST_FILTER_CMD] = $value;
- }
-
- } elsif ($varbase eq "SUBST_VARS") {
- if (@{$self->subst_vars} > 0) {
- if ($op ne "+=") {
- $main::opt_warn_extra and $line->log_warning("All but the first SUBST_VARS line should use the \"+=\" operator.");
- }
- }
- push(@{$self->subst_vars}, $value);
-
- } else {
- $main::opt_warn_extra and $line->log_warning("Foreign variable in SUBST block.");
- }
-}
-
-sub to_string($) {
- my ($self) = @_;
-
- return sprintf("SubstContext(%s %s %s %s %s %s)",
- (defined($self->subst_class) ? $self->subst_class : "(undef)"),
- (defined($self->subst_stage) ? $self->subst_stage : "(undef)"),
- (defined($self->subst_message) ? $self->subst_message : "(undef)"),
- scalar(@{$self->subst_files}),
- scalar(@{$self->subst_sed}),
- (defined($self->subst_id) ? $self->subst_id : "(undef)"));
-}
-#== End of PkgLint::SubstContext ==========================================
-
-package CVS_Entry;
-#==========================================================================
-# A CVS_Entry represents one line from a CVS/Entries file.
-#==========================================================================
-
-use enum qw(FNAME REVISION MTIME TAG);
-
-sub new($$$$$) {
- my ($class, $fname, $revision, $date, $tag) = @_;
- my $self = [ $fname, $revision, $date, $tag ];
- bless($self, $class);
- return $self;
-}
-sub fname($) { return shift()->[FNAME]; }
-sub revision($) { return shift()->[REVISION]; }
-sub mtime($) { return shift()->[MTIME]; }
-sub tag($) { return shift()->[TAG]; }
-#== End of CVS_Entry ======================================================
-
-package PkgLint::Change;
-#==========================================================================
-# A change entry from doc/CHANGES-*
-#==========================================================================
-
-sub new($$$$$$) {
- my ($class, $line, $action, $pkgpath, $version, $author, $date) = @_;
- my $self = [ $line, $action, $pkgpath, $version, $author, $date ];
- bless($self, $class);
- return $self;
-}
-sub line($) { return shift()->[0]; }
-sub action($) { return shift()->[1]; }
-sub pkgpath($) { return shift()->[2]; }
-sub version($) { return shift()->[3]; }
-sub author($) { return shift()->[4]; }
-sub date($) { return shift()->[5]; }
-#== End of PkgLint::Change ================================================
+use PkgLint::Util;
+use PkgLint::Logging;
+use PkgLint::SimpleMatch;
+use PkgLint::Line;
+use PkgLint::FileUtil;
+use PkgLint::Type;
+use PkgLint::VarUseContext;
+use PkgLint::SubstContext;
+use PkgLint::CVS_Entry;
+use PkgLint::Change;
package main;
#==========================================================================