Date: Tue, 26 Jan 2021 16:50:39 +0000 (UTC) From: Adam Weinberger <adamw@FreeBSD.org> To: ports-committers@freebsd.org, svn-ports-all@freebsd.org, svn-ports-head@freebsd.org Subject: svn commit: r562715 - head/Tools/scripts Message-ID: <202101261650.10QGodar086015@repo.freebsd.org>
next in thread | raw e-mail | index | archive | help
Author: adamw Date: Tue Jan 26 16:50:39 2021 New Revision: 562715 URL: https://svnweb.freebsd.org/changeset/ports/562715 Log: 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). Modified: head/Tools/scripts/chkversion.pl (contents, props changed) Modified: head/Tools/scripts/chkversion.pl ============================================================================== --- head/Tools/scripts/chkversion.pl Tue Jan 26 16:44:50 2021 (r562714) +++ head/Tools/scripts/chkversion.pl Tue Jan 26 16:50:39 2021 (r562715) @@ -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); +my $starttime = strftime "%a %b %e %G %k:%M:%S %Z", localtime; -sub readfrom { - my $dir = shift; - - 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;
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?202101261650.10QGodar086015>