Add ropeylog (SBo-specific, produces maintainer status report).

1 files changed, 293 insertions, 0 deletions

diff --git a/ropeylog b/ropeylog
new file mode 100755
index 0000000..b48b7f3
--- /dev/null
+++ b/ropeylog
@@ -0,0 +1,293 @@
+#!/usr/bin/perl -w
+
+use JSON::XS;
+use POSIX 'strftime';
+
+($SELF = $0) =~ s,.*/,,;
+$user_agent = 'Mozilla/5.0 (compatible; ropeylog-repology-bot/1.0; +https://github.com/SlackBuildsOrg/slackbuilds)';
+
+$git_root = $ENV{SBO_GITROOT} || "/slackbuilds/www/slackbuilds/15.0/";
+
+###############
+
+sub make_api_url {
+	my $last = shift;
+	my $url = "https://repology.org/api/v1/projects/";
+	$url .= "$last/" if defined $last;
+	$url .= "?status=outdated&inrepo=slackbuilds";
+}
+
+sub wget {
+	my $url = shift;
+	my $output = shift;
+
+	my $cmd =
+		"wget --compression=gzip --user-agent '$user_agent' -O$output '$url'";
+
+	warn "$cmd\n";
+
+	system($cmd);
+	sleep 1;
+}
+
+sub download {
+	my $firstpkg = $_[0] || "";
+	my $lastpkg = "";
+	my $filename = sprintf("%s/%03d.json", $cache_dir, $_[1]);
+
+	wget(make_api_url($_[0]), $filename);
+
+	my $j = parse_one_file($filename);
+
+	for $proj (keys %{$j}) {
+		$lastpkg = $proj if $proj gt $lastpkg;
+	}
+
+	return (($lastpkg eq $firstpkg) ? undef : $lastpkg);
+}
+
+sub download_files {
+	my $lastpkg;
+	my $count = 1;
+
+	do {
+		$lastpkg = download($lastpkg, $count++);
+	} while defined $lastpkg;
+}
+
+###############
+
+sub read_file {
+	undef local $/;
+	local @ARGV = shift;
+	$_ = <>;
+}
+
+sub parse_one_file {
+	my $file = shift;
+	my $j;
+
+	eval { $j = decode_json(read_file($file)); };
+	die "failed to decode JSON: $@\n" if $@;
+
+	return $j;
+}
+
+sub parse_json_files {
+	die "$SELF: nothing to parse, run '$SELF download' first.\n"
+		unless -e "$cache_dir/001.json";
+
+	for(<$cache_dir/*.json>) {
+		my $j = parse_one_file($_);
+		for my $proj (keys %{$j}) {
+			my $arr = $$j{$proj};
+			for my $hr (@{$arr}) {
+				next unless $hr->{repo} eq 'slackbuilds';
+				my $catbuild = $hr->{visiblename};
+				$outdated{$catbuild}++ if $hr->{status} eq 'outdated';
+			}
+		}
+	}
+}
+
+###############
+
+sub read_info_file {
+	my $file = shift;
+
+	my $maint;
+	my $email;
+
+	open my $f, "<$file" or die $!;
+
+	while(<$f>) {
+		chomp;
+		if(/^MAINTAINER="(.*?)"/) {
+			$maint = $1;
+		} elsif(/^EMAIL="(.*?)"/) {
+			$email = $1;
+		}
+	}
+
+	close $f;
+
+	return ($maint, $email);
+}
+
+sub parse_info_files {
+	chdir($git_root) or die "$!";
+	my $files = `git ls-files '*/*/*.info'`;
+	for my $info (split /\n/, $files) {
+		$total_builds++;
+		my ($maintainer, $email) = read_info_file($info);
+		next if $email eq 'NOEMAIL'; # skip orphans
+		my $catbuild = $info;
+		$catbuild =~ s,/[^/]*$,,;
+		$name2email{$maintainer} = $email;
+		push @{$maintbuilds{$maintainer}}, $catbuild;
+	}
+	@maintainers = keys %name2email;
+}
+
+sub get_git_maintainers {
+	chdir($git_root) or die "$!";
+
+	open my $in, "git log --pretty=format:%h%x09%an%x09%ae%x09%as%x09%s|" or die $!;
+	while(<$in>) {
+		chomp;
+		my ($hash, $name, $email, $date, $catbuild, undef) = split /\t/, $_, 6;
+		$catbuild =~ s/:.*$//;
+
+		if(!defined($lastgitdate{$name})) {
+			$lastgitdate{$name} = $date;
+			$lastgithash{$name} = $hash;
+		}
+	}
+	close $in;
+}
+
+sub url_escape {
+	my $s = shift;
+	$s =~ s{[^-.0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz]}{sprintf("%%%x", ord($&))}ge;
+	return $s;
+}
+
+sub get_percent {
+	my $a = shift;
+	my $b = shift;
+
+	if(!$b) {
+		print "0";
+		return;
+	}
+
+	return sprintf("%d (%.1f%%)", $a, ($a / $b) * 100);
+}
+
+sub print_report {
+	my $stamp = strftime("%Y-%m-%d %H:%M:%S", gmtime);
+	my $maintcount = @maintainers;
+	print <<EOF;
+<!DOCTYPE html>
+<html>
+<head>
+<title>SBo maintainer status report</title>
+<meta charset="utf-8">
+<style>
+  table {border:1px solid;border-collapse:collapse}
+  th.m, td.m {text-align:left;padding:0.5rem;border:1px solid}
+  th.l, td.l {text-align:center;padding:0.5rem;border:1px solid}
+  th.s, td.s {text-align:center;padding:0.5rem;border:1px solid}
+  th.n, td.n {text-align:right;padding:0.5rem;border:1px solid}
+  th.o, td.o {text-align:right;padding:0.5rem;border:1px solid}
+  a.m {font-size:small}
+</style>
+</head>
+<body>
+<h1>SBo maintainer status report</h1>
+<p>Date: $stamp<br />
+SlackBuilds: $total_builds<br />
+Maintainers: $maintcount<br />
+</p>
+<table>
+<thead>
+<tr><th class="m">Maintainer</th><th class="l">Latest</th><th class="s">SlackBuilds</th><th class="n">Newest</th><th class="o">Out of date</th></tr>
+</thead>
+<tbody>
+EOF
+
+	for my $maintainer (sort { lc($a) cmp lc($b) } @maintainers) {
+		my $count = 0;
+		my $outdated_count = 0;
+		for(@{$maintbuilds{$maintainer}}) {
+			$count++;
+			$outdated_count++ if $outdated{$_};
+		}
+
+		my $newest = get_percent($count - $outdated_count, $count);
+		my $outdated = get_percent($outdated_count, $count);
+		my $maint_email = $name2email{$maintainer};
+
+		my $repology_link = "";
+		my $count_link = $count;
+		if(defined $maint_email) {
+			my $escmail = url_escape($maint_email);
+			my $escmaint = url_escape($maintainer);
+			$count_link = "<a class=\"s\" target=\"_blank\" href=\"https://slackbuilds.org/advsearch.php?stype=maint&q=$escmaint\">$count</a>";
+			if($maint_email =~ /\@/) {
+				$repology_link = "<a class=\"m\" target=\"_blank\" href=\"https://repology.org/projects/?maintainer=$escmail\">$maint_email</a>";
+			}
+		}
+
+		my $git_hash = $lastgithash{$maintainer};
+		my $git_date = $lastgitdate{$maintainer};
+		my $git_link = "";
+		if(defined $git_hash && defined $git_date) {
+			$git_link = "<a class=\"c\" target=\"_blank\" href=\"https://git.slackbuilds.org/slackbuilds/commit/?id=$git_hash\">$git_date</a>";
+		}
+
+		print <<EOF;
+<tr>
+  <td class="m">$maintainer<br />$repology_link</td>
+  <td class="l">$git_link</td>
+  <td class="s">$count_link</td>
+  <td class="n">$newest</td>
+  <td class="o">$outdated</td>
+</tr>
+EOF
+	}
+
+	print <<EOF;
+</tbody>
+</table>
+</body>
+</html>
+EOF
+}
+
+# Report looks like this:
+# https://slackbuilds.org/maintainer_status.html
+
+# SBo maintainer status report
+
+# Date: YYYY-MM-DD HH:MM:SS
+# Slackbuilds: NNNNN
+# Maintainers: NNN
+
+# Rest is a table with 4 columns:
+# Maintainer  Latest  SlackBuilds  Newest  Out of date
+
+# The maintainer column has name and email, and the email is a repology link:
+# http://repology.org/projects/?maintainer=<email>
+# IMO, there should be mailto: links here too, maybe use 📬
+
+# Latest is YYYY-MM-DD, and it's a link to:
+# https://git.slackbuilds.org/slackbuilds/commit/?id=<commit>
+
+# SlackBuilds is a count only. This should be a link to an advsearch
+# by maintainer.
+
+# Newest is a count and percentage.
+
+# Out of date is a count and percentage.
+
+#
+# main()
+$cache_dir = "$ENV{HOME}/.$SELF";
+system("mkdir -p $cache_dir");
+
+if(@ARGV) {
+	if($ARGV[0] eq 'download') {
+		for(<$cache_dir/*.json>) {
+			unlink $_;
+		}
+		download_files();
+		exit 0;
+	} else {
+		die "unknown command $ARGV[0]\n";
+	}
+}
+parse_json_files();
+parse_info_files();
+get_git_maintainers();
+print_report();