Added perlupd.

1 files changed, 92 insertions, 0 deletions

diff --git a/perlupd b/perlupd
new file mode 100755
index 0000000..781ae6e
--- /dev/null
+++ b/perlupd
@@ -0,0 +1,92 @@
+#!/usr/bin/perl -w
+
+# Most perl packages, it's obvious how to derive the CPAN module name
+# from the Slackware package name. The ones that aren't, list here:
+# 'CPAN' => 'SBo',
+%overrides = (
+	'Locale::Messages' => 'perl-libintl',
+	'CDDB_get' => 'perl-CDDB-get',
+	'Perl::Tidy' => 'perl-Tidy',
+	'Number::Bytes::Human' => 'perl-Number-Bites-Human',
+);
+
+$EMAIL = shift || 'urchlay@slackware.uk';
+$URL =  "http://www.cpan.org/modules/02packages.details.txt.gz";
+$BASE = "https://cpan.metacpan.org/authors/id/";
+
+$SBO_GITROOT = $ENV{SBO_GITROOT} || die "SBO_GITROOT not set in env\n";
+chdir($SBO_GITROOT) || die "can't cd to $SBO_GITROOT: $!\n";
+
+# as of 20260920, this is a 2.5MB download.
+open $pipe, "wget -qO- $URL | gzip -dc |" || die "can't run wget: $!\n";
+while(<$pipe>) {
+	chomp;
+	last if /^$/;
+}
+while(<$pipe>) {
+	chomp;
+	my($mod, $ver, $path) = split /\s+/;
+	next if $ver eq 'undef';
+
+	$ver =~ s,^v(\d),$1,; # v1.2.3 => 1.2.3
+	my $pkg = $overrides{$mod};
+
+	if(not defined $pkg) {
+		$pkg = "perl-$mod";
+		$pkg =~ s,::,-,g;
+	}
+
+	# $pkg is now e.g. perl-Foo-Bar
+	$versions{$pkg} = $ver;
+	$paths{$pkg} = $path;
+	$pkg = lc $pkg;
+	# $pkg is now e.g. perl-foo-bar
+	$versions{$pkg} = $ver;
+	$paths{$pkg} = $path;
+}
+close $pipe;
+
+open $pipe, "git grep -Fl '$EMAIL' 'perl/*/*.info' |" || die "can't get .info files: $!";
+
+$count = $unknown = $outdated = $uptodate = 0;
+while(<$pipe>) {
+	$count++;
+	chomp;
+	my(undef, $pkg, undef) = split /\//;
+	my $ver = get_info_ver($_);
+	my $newver = $versions{$pkg};
+	if(not defined $newver) {
+		$unknown++;
+		print "$pkg: can't get new version from CPAN info\n";
+	} elsif($ver ne $newver) {
+		print "$pkg: ver $ver, avail $newver  $BASE$paths{$pkg}\n";
+		$outdated++;
+	} else {
+		$uptodate++;
+	}
+}
+
+close $pipe;
+
+print <<EOF;
+=== $count builds: $uptodate up to date, $outdated outdated, $unknown unknown
+EOF
+
+exit($outdated != 0);
+
+sub get_info_ver {
+	my $info = shift;
+	my $ver;
+
+	open my $fh, "<", $info or die "can't open $info: $!\n";
+	while(<$fh>) {
+		if(/^VERSION="([^"]+)"/) {
+			$ver = $1;
+			last;
+		}
+	}
+	close $fh;
+
+	warn "can't get VERSION from $info\n" unless defined $ver;
+	return $ver;
+}