Tools/scripts/chkversion.pl: Fix and modernize

chkversion.pl was broken in a number of ways, including looking for CVS-style Id
lines in svn headers, not being updated for pkgng, etc.

This commit fixes those, and adopts some modern Perl practices.

NOTE: The $PKG_VERSION env var is renamed to $PKG. This should be a no-op for most
people (in the sense of it didn't work before, and the default should work for
pretty much everybody).

1 files changed, 97 insertions, 102 deletions

diff --git a/Tools/scripts/chkversion.pl b/Tools/scripts/chkversion.pl
index cff77ac1f39d..e85963e20710 100755
--- a/Tools/scripts/chkversion.pl
+++ b/Tools/scripts/chkversion.pl
@@ -28,7 +28,7 @@
 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 #
-# $FreeBSD$
+# $FreeBSD: head/Tools/scripts/chkversion.pl 562503 2021-01-24 18:42:29Z adamw $
 #
 # MAINTAINER=   portmgr@FreeBSD.org
 #
@@ -64,20 +64,25 @@
 # out by SVN, every entry is listed with a record of the last SVN commit.
 #
 
-require 5.005;
+use v5.20;
 use strict;
 use warnings;
-use POSIX;
-use File::Find;
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
 use Cwd 'abs_path';
+use File::Find;
+use List::Util qw(first);
+use POSIX;
 
 my $portsdir    = $ENV{PORTSDIR}        // '/usr/ports';
 my $versiondir  = $ENV{VERSIONDIR}      // '/var/db/chkversion';
 my $svnblame    = exists $ENV{SVNBLAME};
 my $allports    = exists $ENV{ALLPORTS};
 
-my $watchre     = $ENV{WATCH_REGEX}     // '';
-my $watchmre    = $ENV{WATCHM_REGEX}    // '';
+my $watch_re    = $ENV{WATCH_REGEX}     // '';
+my $watchm_re   = $ENV{WATCHM_REGEX}    // '';
 my $returnpath  = $ENV{RETURNPATH}      // '';
 my $h_from      = $ENV{HEADER_FROM}     // $ENV{USER} . '@' . ($ENV{HOST} // `/bin/hostname`);
 my $h_replyto   = $ENV{HEADER_REPLYTO}  // $h_from;
@@ -90,14 +95,11 @@ my $cc_mntnr    = exists $ENV{CC_MAINTAINER};
 
 my $make        = '/usr/bin/make';
 my $svn         = '/usr/local/bin/svn';
-my $pkg_version =
-    $ENV{PKG_VERSION} && -x $ENV{PKG_VERSION} ? $ENV{PKG_VERSION}
-  : -x '/usr/local/sbin/pkg_version' ? '/usr/local/sbin/pkg_version'
-  : '/usr/sbin/pkg_version';
 my $sendmail    = '/usr/sbin/sendmail';
+my $pkg         = first { -x $_ } ($ENV{PKG} // '', '/usr/local/sbin/pkg', '/usr/sbin/pkg');
 
-my $watch_re    = join '|', split ' ', $watchre;
-my $watchm_re   = join '|', split ' ', $watchmre;
+$watch_re  =~ s/ /|/g;
+$watchm_re =~ s/ /|/g;
 
 -d $portsdir or die "Can't find ports tree at $portsdir.\n";
 $portsdir = abs_path($portsdir);
@@ -105,19 +107,19 @@ $portsdir = abs_path($portsdir);
 my $versionfile = "$versiondir/VERSIONS";
 my $useindex    = !-w $versiondir;
 
-my $starttime = strftime("%a %b %e %G %k:%M:%S %Z",localtime);
-
-sub readfrom {
-    my $dir = shift;
+my $starttime = strftime "%a %b %e %G %k:%M:%S %Z", localtime;
 
-    if (!open CHILD, '-|') {
-        open STDERR, '>/dev/null';
+# @output_lines = readfrom(dir, cmd, arg1, arg2, ...)
+sub readfrom($dir, @cmd) {
+    my $CHILD;
+    if (!open $CHILD, '-|') {
+        open STDERR, '>', '/dev/null';
         chdir $dir if $dir;
-        exec @_;
+        exec @cmd;
         die;
     }
-    my @childout = <CHILD>;
-    close CHILD;
+    my @childout = <$CHILD>;
+    close $CHILD;
 
     map chomp, @childout;
 
@@ -125,22 +127,23 @@ sub readfrom {
 }
 
 foreach (qw(ARCH OPSYS OSREL OSVERSION UID)) {
-    my @cachedenv = readfrom $portsdir, $make, "-V$_";
+    my @cachedenv = readfrom($portsdir, $make, "-V$_");
     $ENV{$_} = $cachedenv[0];
 }
 
+# These map a 2-dir path (editors/vim) to variables set in
+# that port's Makefile
 my %pkgname;
 my %pkgorigin;
 my %masterdir;
 my %pkgmntnr;
 
-sub wanted {
-    return
-      if !-d;
+sub wanted() {
+    return unless -d;
 
+    # Skip directories we shouldn't descend into
     if (/^.svn$/
-        || $File::Find::name =~
-          m"^$portsdir/(?:Mk|Templates|Tools|distfiles|packages)$"os
+        || $File::Find::name =~ m"^$portsdir/(?:Mk|Templates|Tools|distfiles|packages)$"os
         || $File::Find::name =~ m"^$portsdir/[^/]+/pkg$"os)
     {
         $File::Find::prune = 1;
@@ -148,14 +151,15 @@ sub wanted {
     elsif ($File::Find::name =~ m"^$portsdir/([^/]+/[^/]+)$"os) {
         $File::Find::prune = 1;
         if (-f "$File::Find::name/Makefile") {
-            my @makevar = readfrom $File::Find::name,
-              $make, '-VPKGORIGIN', '-VPKGNAME', '-VMAINTAINER', '-VMASTERDIR';
+            my @makevar = readfrom $File::Find::name, $make, qw(-VPKGORIGIN -VPKGNAME -VMAINTAINER -VMASTERDIR);
 
+            # $1 is the current 2-dir path
             if ($#makevar == 3 && $makevar[1]) {
-                $pkgorigin{$1} = $makevar[0]
-                  if $1 ne $makevar[0];
-                $pkgname{$1} = $makevar[1];
-                $pkgmntnr{$1} = $makevar[2];
+                # %pkgorigin is the list of dirs that gets monitored. Only monitor a
+                # path if it matches the PKGORIGIN.
+                $pkgorigin{$1} = $makevar[0] if $1 ne $makevar[0];
+                $pkgname{$1}   = $makevar[1];
+                $pkgmntnr{$1}  = $makevar[2];
                 $masterdir{$1} = $makevar[3];
             }
         }
@@ -166,23 +170,20 @@ if ($allports) {
     find(\&wanted, $portsdir);
 }
 else {
-    my @categories = split ' ', readfrom $portsdir, $make, '-VSUBDIR';
+    my @categories = split ' ' => readfrom($portsdir, $make, '-VSUBDIR');
 
     foreach my $category (@categories) {
-        -f "$portsdir/$category/Makefile" || next;
-        my @ports = split ' ',
-          readfrom "$portsdir/$category", $make, '-VSUBDIR';
+        next unless -f "$portsdir/$category/Makefile";
+        my @ports = split ' ' => readfrom("$portsdir/$category", $make, '-VSUBDIR');
         foreach (map "$category/$_", @ports) {
-            -f "$portsdir/$_/Makefile" || next;
+            next unless -f "$portsdir/$_/Makefile";
 
-            my @makevar = readfrom "$portsdir/$_",
-              $make, '-VPKGORIGIN', '-VPKGNAME', '-VMAINTAINER', '-VMASTERDIR';
+            my @makevar = readfrom "$portsdir/$_", $make, qw(-VPKGORIGIN -VPKGNAME -VMAINTAINER -VMASTERDIR);
 
             next if $#makevar != 3 || ! $makevar[1];
-            $pkgorigin{$_} = $makevar[0]
-              if $_ ne $makevar[0];
-            $pkgname{$_} = $makevar[1];
-            $pkgmntnr{$_} = $makevar[2];
+            $pkgorigin{$_} = $makevar[0] if $_ ne $makevar[0];
+            $pkgname{$_}   = $makevar[1];
+            $pkgmntnr{$_}  = $makevar[2];
             $masterdir{$_} = $makevar[3];
         }
     }
@@ -197,14 +198,18 @@ if ($useindex) {
     $versionfile = "$portsdir/$indexname";
 }
 
-open VERSIONS, "<$versionfile";
-
-while (<VERSIONS>) {
+# Read in the old (expected) values
+open my $VERSIONS, '<', $versionfile;
+while (<$VERSIONS>) {
     chomp;
     next if /^(#|$)/;
+
+    # These are the old (expected) values
     my ($origin, $version, $maintainer);
+
     if ($useindex) {
-        ($origin, $version, $maintainer) = (split /\|/)[1,0,5];
+        ($origin, $version, $maintainer) = (split '|')[1,0,5];
+        # Only keep the 2-dir path (editors/vim)
         $origin =~ s,^.*/([^/]+/[^/]+)/?$,$1,;
     }
     else {
@@ -217,9 +222,9 @@ while (<VERSIONS>) {
         $newversion =~ s/^.*-//;
         $oldversion =~ s/^.*-//;
 
-        my $result = $newversion eq $oldversion ? '=' : readfrom '',
-          $pkg_version, '-t', $newversion, $oldversion;
-        $result //= '';
+        # If the two values differ, use `pkg version` to find which one is bigger
+        my $result = $newversion eq $oldversion ? '='
+                   : readfrom '', $pkg, 'version', '-t', $newversion, $oldversion;
 
         $watched{$origin} = "$version -> $pkgname{$origin}"
           if ($watch_re && $result ne '=' && $origin =~ /^(?:$watch_re)$/o);
@@ -238,44 +243,40 @@ while (<VERSIONS>) {
         $pkgmntnr{$origin} = $maintainer;
     }
 }
-close VERSIONS;
+close $VERSIONS;
 
 if (!$useindex) {
-    system 'mv', '-f', $versionfile, "$versionfile.bak";
+    rename $versionfile, "$versionfile.bak";
 
-    open VERSIONS, ">$versionfile";
+    open my $VERSIONS, '>', $versionfile;
     foreach (sort keys %pkgname) {
-        print VERSIONS "$_\t$pkgname{$_}\t$pkgmntnr{$_}\n";
+        print $VERSIONS "$_\t$pkgname{$_}\t$pkgmntnr{$_}\n";
     }
-    close VERSIONS;
+    close $VERSIONS;
 }
 
 my %revision;
 
-sub parsemakefile {
-    my ($portdir) = @_;
-    my ($r, $d, $a);
-
-    open MAKEFILE, "<$portdir/Makefile";
-    while (<MAKEFILE>) {
-        if (m'\$FreeBSD\: [^\$ ]+,v (\d+(?:\.\d+)+) (\d{4}(?:[/-]\d{2}){2} \d{2}(?::\d{2}){2}) (\w+) [\w ]+\$') {
-            ($r, $d, $a) = ($1, $2, $3);
+# Parses the $FreeBSD$ line to return revision, date, author
+sub parsemakefile($portdir) {
+    open my $MAKEFILE, '<', "$portdir/Makefile";
+    while (<$MAKEFILE>) {
+        if (m/^# \$FreeBSD: [^ ]+ (?<rev>\d{6}) (?<date>\d{4}-\d\d-\d\d) [\d:]+Z (?<author>\w+) \$$/) {
+            close $MAKEFILE;
+            return ($+{rev}, $+{date}, $+{author});
         }
     }
-    close MAKEFILE;
-
-    return ($r, $d, $a);
+    close $MAKEFILE;
 }
 
-sub getauthors {
-    my ($ports) = @_;
-
+sub getauthors($ports) {
     my %author;
     foreach my $origin (keys %{$ports}) {
         if (!$revision{$origin}) {
             my ($r, $d, $a) = parsemakefile "$portsdir/$origin";
             push @{$revision{$origin}}, $r;
             push @{$author{$origin}}, $a;
+
             if ($masterdir{$origin} ne "$portsdir/$origin") {
                 ($r, $d, $a) = parsemakefile $masterdir{$origin};
                 push @{$revision{$origin}}, $r;
@@ -288,31 +289,27 @@ sub getauthors {
     return %author;
 }
 
-sub printlog {
-    my ($fh, $portdir, $r) = @_;
-
+# Gets the Makefile log starting from the last known rev for a port
+sub printlog($fh, $portdir, $rev) {
     if ($svnblame && -d "$portsdir/.svn") {
-        my @svnlog = readfrom $portdir,
-          $svn, 'log', '-r' . ($r ? $r : '.'), 'Makefile';
+        my @svnlog = readfrom $portdir, $svn, 'log', ($rev ? "-r$rev" : ''), 'Makefile';
         foreach (@svnlog) {
-            my $in_log = /^-{28}$/ ... /^(-{28}|={77})$/;
+            my $in_log = /^-{20,}$/ ... /^(-{20,}|={70,})$/;
             print $fh "   | $_\n"
-              if ($in_log && $in_log != 1 && $in_log !~ /E0$/);
+              if ($in_log && $in_log ne 1 && $in_log !~ /E0$/);
         }
     }
 }
 
-sub blame {
-    my ($fh, $ports) = @_;
-
+sub blame($fh, $ports) {
     if (%{$ports}) {
         foreach my $origin (sort keys %{$ports}) {
             print $fh "- *$origin* <$pkgmntnr{$origin}>: $ports->{$origin}\n";
             printlog $fh, "$portsdir/$origin", $revision{$origin}[0];
             if ($masterdir{$origin} ne "$portsdir/$origin") {
                 my $master = $masterdir{$origin};
-                $master =~ s/^$portsdir\///o;
-                while ($master =~ s/(^|\/)[^\/]+\/\.\.(?:\/|$)/$1/) {}
+                $master =~ s|^$portsdir/||o;
+                while ($master =~ s!(^|/)[^/]+/\.\.(?:/|$)!$1!) {}
                 print $fh "  (master: $master)\n";
                 printlog $fh, $masterdir{$origin}, $revision{$origin}[1];
             }
@@ -322,10 +319,8 @@ sub blame {
     }
 }
 
-sub template {
-    my ($from, $rcpt, $replyto, $starttime, $ports) = @_;
-
-    my $portlist = join ', ', sort keys %{$ports};
+sub template($from, $rcpt, $replyto, $starttime, $ports) {
+    my $portlist = join ', ' => sort keys %{$ports};
     substr($portlist, 32) = '...'
         if length $portlist > 35;
 
@@ -344,34 +339,34 @@ sub template {
                 if $_;
         }
     }
-    my $cc = join ', ', sort keys %cclist;
+    my $cc = join ', ' => sort keys %cclist;
 
     my $header = '';
     while (<main::DATA>) {
         last if /^\.\n?$/;
-        $_ =~ s/%%FROM%%/$from/og;
-        $_ =~ s/%%RCPT%%/$rcpt/og;
-        $_ =~ s/%%CC%%/$cc/og;
-        $_ =~ s/%%REPLYTO%%/$replyto/og;
-        $_ =~ s/%%SUBJECT%%/$portlist/og;
-	$_ =~ s/%%STARTTIME%%/$starttime/og;
-        $header .= $_;
+        $header .= $_
+          =~ s/%%FROM%%/$from/ogr
+          =~ s/%%RCPT%%/$rcpt/ogr
+          =~ s/%%CC%%/$cc/ogr
+          =~ s/%%REPLYTO%%/$replyto/ogr
+          =~ s/%%SUBJECT%%/$portlist/ogr
+          =~ s/%%STARTTIME%%/$starttime/ogr;
     }
     return $header;
 }
 
-sub mail {
-    my ($template, $rcpt, $ports) = @_;
-
+sub mail($template, $rcpt, $ports) {
     if (%{$ports}) {
+        # If the RCPT_* variables are empty, just print the mail to STDOUT
         if ($rcpt) {
-            if (!open MAIL, '|-') {
-                exec $sendmail, '-oi', '-t', '-f', $returnpath;
+            my $MAIL;
+            if (!open $MAIL, '|-') {
+                exec $sendmail, qw(-oi -t -f), $returnpath;
                 die;
             }
-            print MAIL $template;
-            blame *MAIL, $ports;
-            close MAIL;
+            print $MAIL $template;
+            blame $MAIL, $ports;
+            close $MAIL;
         } else {
             $template =~ s/^.*?\n\n//os;
             print $template;