ropeylog: generate 5 reports with different sort orders.

1 files changed, 131 insertions, 38 deletions

diff --git a/ropeylog b/ropeylog
index b48b7f3..481d83b 100755
--- a/ropeylog
+++ b/ropeylog
@@ -1,13 +1,47 @@
 #!/usr/bin/perl -w
 
-use JSON::XS;
-use POSIX 'strftime';
+###############
+# These 2 are configurable, change as needed:
 
-($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/";
 
+$outdir = "$ENV{HOME}/www";
+
+###############
+
+use JSON::XS;                  # from SBo perl-JSON-XS
+use POSIX qw/strftime getcwd/; # bundled with Slackware's perl
+
+($SELF = $0) =~ s,.*/,,;
+
+@reports = (
+	[ "Maintainer", '', \&sort_abc ],
+	[ "Last Git (+)", '-bygit_up', \&sort_git_up ],
+	[ "Last Git (-)", '-bygit_down', \&sort_git_down ],
+	[ "Num Builds (+)", '-bynum_up', \&sort_num_up ],
+	[ "Num Builds (-)", '-bynum_down', \&sort_num_down ],
+);
+
+###############
+
+sub usage {
+	print <<EOF;
+$SELF - generate SBo Maintainer Status report (HTML)
+
+Usage: $SELF [-d] [output-dir]
+
+With the -d option, fresh package status data is fetched from
+repology.org. Without it, the most recent data (cached in
+~/.ropeylog/) is used.
+
+The HTML pages are written to the [output-dir] directory. If any file
+already exists, it is backed up with a .bak extension.
+
+EOF
+}
+
 ###############
 
 sub make_api_url {
@@ -46,7 +80,7 @@ sub download {
 	return (($lastpkg eq $firstpkg) ? undef : $lastpkg);
 }
 
-sub download_files {
+sub download_json_files {
 	my $lastpkg;
 	my $count = 1;
 
@@ -115,21 +149,28 @@ sub read_info_file {
 }
 
 sub parse_info_files {
+	my $olddir = getcwd();
 	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
+		if($email eq 'NOEMAIL') {
+			$total_orphans++;
+			next;
+		}
 		my $catbuild = $info;
 		$catbuild =~ s,/[^/]*$,,;
 		$name2email{$maintainer} = $email;
+		$lastgitdate{$maintainer} = $lastgithash{$maintainer} = 0;
 		push @{$maintbuilds{$maintainer}}, $catbuild;
 	}
+	chdir($olddir);
 	@maintainers = keys %name2email;
 }
 
 sub get_git_maintainers {
+	my $olddir = getcwd();
 	chdir($git_root) or die "$!";
 
 	open my $in, "git log --pretty=format:%h%x09%an%x09%ae%x09%as%x09%s|" or die $!;
@@ -138,14 +179,39 @@ sub get_git_maintainers {
 		my ($hash, $name, $email, $date, $catbuild, undef) = split /\t/, $_, 6;
 		$catbuild =~ s/:.*$//;
 
-		if(!defined($lastgitdate{$name})) {
+		if(!($lastgitdate{$name})) {
 			$lastgitdate{$name} = $date;
 			$lastgithash{$name} = $hash;
 		}
 	}
 	close $in;
+	chdir($olddir);
+}
+
+###############
+
+sub sort_abc {
+	lc($a) cmp lc($b);
+}
+
+sub sort_git_up {
+	$lastgitdate{$a} cmp $lastgitdate{$b};
+}
+
+sub sort_git_down {
+	$lastgitdate{$b} cmp $lastgitdate{$a};
 }
 
+sub sort_num_up {
+   scalar(@{$maintbuilds{$a}}) <=> scalar(@{$maintbuilds{$b}});
+}
+
+sub sort_num_down {
+   scalar(@{$maintbuilds{$b}}) <=> scalar(@{$maintbuilds{$a}});
+}
+
+###############
+
 sub url_escape {
 	my $s = shift;
 	$s =~ s{[^-.0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz]}{sprintf("%%%x", ord($&))}ge;
@@ -164,14 +230,34 @@ sub get_percent {
 	return sprintf("%d (%.1f%%)", $a, ($a / $b) * 100);
 }
 
+sub print_sort_links {
+	for my $r (@reports) {
+		my $page = get_page_name($r->[1]);
+		print <<EOF;
+Sort by <a href="$page">$r->[0]</a><br />
+EOF
+	}
+}
+
 sub print_report {
+	my $title = shift;
+	my $sortfunc = shift;
+
 	my $stamp = strftime("%Y-%m-%d %H:%M:%S", gmtime);
 	my $maintcount = @maintainers;
+	my $total_outdated = keys %outdated;
+	my $print_uptodate = get_percent($total_builds - $total_outdated, $total_builds);
+	my $print_outdated = get_percent($total_outdated, $total_builds);
+
+	$total_orphans ||= 0;
+	my $print_orphaned = get_percent($total_orphans, $total_builds);
+
 	print <<EOF;
 <!DOCTYPE html>
 <html>
 <head>
 <title>SBo maintainer status report</title>
+<meta name="Generator" content="ropeylog/0.0.0">
 <meta charset="utf-8">
 <style>
   table {border:1px solid;border-collapse:collapse}
@@ -185,18 +271,27 @@ sub print_report {
 </head>
 <body>
 <h1>SBo maintainer status report</h1>
+<h2>Sorted by $title</h2>
+EOF
+
+	print_sort_links();
+
+print <<EOF;
 <p>Date: $stamp<br />
 SlackBuilds: $total_builds<br />
 Maintainers: $maintcount<br />
+Total up-to-date builds: $print_uptodate<br />
+Total outdated builds: $print_outdated<br />
+Orphaned builds: $print_orphaned<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>
+<tr><th class="m">Maintainer</th><th class="l">Last git</th><th class="s">SlackBuilds</th><th class="n">Up to date</th><th class="o">Out of date</th></tr>
 </thead>
 <tbody>
 EOF
 
-	for my $maintainer (sort { lc($a) cmp lc($b) } @maintainers) {
+	for my $maintainer (sort $sortfunc @maintainers) {
 		my $count = 0;
 		my $outdated_count = 0;
 		for(@{$maintbuilds{$maintainer}}) {
@@ -215,7 +310,11 @@ EOF
 			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>";
+				$repology_link =
+					"<a class=\"m\" href=\"mailto:$escmail\">✉</a>&nbsp;" .
+					"<a class=\"m\" target=\"_blank\" href=\"https://repology.org/projects/?maintainer=$escmail\">$maint_email</a>";
+			} else {
+				$repology_link = $maint_email;
 			}
 		}
 
@@ -245,49 +344,43 @@ EOF
 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.
+sub get_page_name {
+	return "maintainer_status$_[0].html";
+}
 
-# Newest is a count and percentage.
+sub print_all_reports {
+	for my $rep (@reports) {
+		my ($title, $fname, $sortfunc) = @$rep;
+		$fname = "$outdir/" . get_page_name($fname);
+		open my $f, ">$fname" or die $!;
+		my $oldf = select $f;
+		print_report($title, $sortfunc);
+		select $oldf;
+		close $f;
+	}
+}
 
-# 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') {
+	if($ARGV[0] eq '-d') {
+		shift;
 		for(<$cache_dir/*.json>) {
 			unlink $_;
 		}
-		download_files();
+		download_json_files();
+	} elsif($ARGV[0] =~ /help/) {
+		usage();
 		exit 0;
-	} else {
-		die "unknown command $ARGV[0]\n";
 	}
 }
+$outdir = $ARGV[0] if $ARGV[0];
+
 parse_json_files();
 parse_info_files();
 get_git_maintainers();
-print_report();
+print_all_reports();