diff options
author | rillig <rillig> | 2008-11-04 21:45:13 +0000 |
---|---|---|
committer | rillig <rillig> | 2008-11-04 21:45:13 +0000 |
commit | 1021a6035353fbdcfc2351ce7e42d04bb5db3f5c (patch) | |
tree | 9b237d02ba15ae722fdefa96537ba4371a990065 /pkgtools/pkglint/files/pkglint.pl | |
parent | 41c05454e638981e04777ed2fcf377442afa746c (diff) | |
download | pkgsrc-1021a6035353fbdcfc2351ce7e42d04bb5db3f5c.tar.gz |
Added a check that detects a downgrade of a package. To do this, it
loads the changes in doc/CHANGES-*.
Diffstat (limited to 'pkgtools/pkglint/files/pkglint.pl')
-rw-r--r-- | pkgtools/pkglint/files/pkglint.pl | 111 |
1 files changed, 110 insertions, 1 deletions
diff --git a/pkgtools/pkglint/files/pkglint.pl b/pkgtools/pkglint/files/pkglint.pl index 5788767563c..dd65e94bcfb 100644 --- a/pkgtools/pkglint/files/pkglint.pl +++ b/pkgtools/pkglint/files/pkglint.pl @@ -1,5 +1,5 @@ #! @PERL@ -# $NetBSD: pkglint.pl,v 1.779 2008/10/20 11:09:07 rillig Exp $ +# $NetBSD: pkglint.pl,v 1.780 2008/11/04 21:45:13 rillig Exp $ # # pkglint - static analyzer and checker for pkgsrc packages @@ -1141,6 +1141,24 @@ 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 ================================================ package main; #========================================================================== @@ -2203,6 +2221,70 @@ sub get_wip_TODO_updates() { return $get_wip_TODO_updates_result; } +my $get_doc_CHANGES_docs = undef; # [ $fname, undef or $lines ] +sub get_doc_CHANGES($) { + my ($pkgpath) = @_; + + $opt_debug_trace and log_debug(NO_FILE, NO_LINES, "get_doc_CHANGES(\"$pkgpath\")"); + + # Make a reversed list of all the CHANGES-* files, but don't load + # them yet. + if (!defined($get_doc_CHANGES_docs)) { + opendir(DIR, "${cwd_pkgsrcdir}/doc") or die; + my @files = readdir(DIR); + closedir(DIR) or die; + foreach my $file (reverse sort @files) { + if ($file =~ m"^CHANGES-\d+$") { + push(@$get_doc_CHANGES_docs, [ $file, undef ]); + } + } + $opt_debug_misc and log_debug(NO_FILE, NO_LINES, "Found " . (scalar @$get_doc_CHANGES_docs) . " changes files."); + } + + # Scan the *-CHANGES files in reverse order until some action + # matches the package directory. + my @result = (); + foreach my $doc (@$get_doc_CHANGES_docs) { + if (!defined($doc->[1])) { + $opt_debug_misc and log_debug(NO_FILE, NO_LINES, "loading $doc->[0]"); + my $lines = load_file("${cwd_pkgsrcdir}/doc/$doc->[0]") or die; + + my @changes = (); + foreach my $line (@$lines) { + my $text = $line->text; + next unless $text =~ m"^\t[A-Z]"; + + if ($text =~ m"^\t(Updated) (\S+) to (\S+) \[(\S+) (\d\d\d\d-\d\d-\d\d)\]$") { + push(@changes, PkgLint::Change->new($line, $1, $2, $3, $4, $5)); + } elsif ($text =~ m"^\t(Added) (\S+) version (\S+) \[(\S+) (\d\d\d\d-\d\d-\d\d)\]$") { + push(@changes, PkgLint::Change->new($line, $1, $2, $3, $4, $5)); + } elsif ($text =~ m"^\t(Removed) (\S+) (?:successor (\S+) )?\[(\S+) (\d\d\d\d-\d\d-\d\d)\]$") { + push(@changes, PkgLint::Change->new($line, $1, $2, undef, $3, $4)); + } elsif ($text =~ m"^\t(Downgraded) (\S+) to (\S+) \[(\S+) (\d\d\d\d-\d\d-\d\d)\]$") { + push(@changes, PkgLint::Change->new($line, $1, $2, $3, $4, $5)); + } elsif ($text =~ m"^\t(Renamed|Moved) (\S+) to (\S+) \[(\S+) (\d\d\d\d-\d\d-\d\d)\]$") { + push(@changes, PkgLint::Change->new($line, $1, $2, $3, $4, $5)); + } else { + $line->log_warning("Unknown doc/CHANGES line: " . $line->text); + $line->explain_warning( +"Maybe some developer didn't stick to the conventions that have been", +"established by mk/misc/developer.mk?"); + } + } + $doc->[1] = \@changes; + } + + foreach my $change (@{$doc->[1]}) { + next unless $pkgpath eq $change->pkgpath; + push(@result, $change); + } + if (@result != 0) { + return @result; + } + } + return (); +} + sub get_suggested_package_updates() { return ($is_wip) @@ -3397,6 +3479,31 @@ sub checkword_absolute_pathname($$) { } } +sub checkpackage_possible_downgrade() { + + $opt_debug_trace and log_debug(NO_FILE, NO_LINES, "checkpackage_possible_downgrade"); + + return unless defined $effective_pkgname; + return unless $effective_pkgname =~ regex_pkgname; + my ($pkgbase, $pkgversion) = ($1, $2); + my $line = $effective_pkgname_line; + + my @changes = get_doc_CHANGES($pkgpath); + if (@changes == 0) { + $opt_debug_misc and $line->log_debug("No changes have been recorded for package $pkgpath."); + return; + } + + my $last_change = $changes[-1]; + return unless $last_change->action eq "Updated"; + + my $last_version = $last_change->version; + + if (dewey_cmp($pkgversion, "<", $last_version)) { + $line->log_warning("The package is being downgraded from $last_version to $pkgversion."); + } +} + # # Subroutines to check a single line. # @@ -6789,6 +6896,8 @@ sub checkfile_package_Makefile($$$) { $opt_debug_misc and $effective_pkgname_line->log_debug("Effective name=${effective_pkgname} base=${effective_pkgbase} version=${effective_pkgversion}."); } + checkpackage_possible_downgrade(); + if (!exists($pkgctx_vardef->{"COMMENT"})) { log_warning($fname, NO_LINE_NUMBER, "No COMMENT given."); } |