path: root/ropeylog

#!/usr/bin/perl -w

# Defaults for the -g, -o, -v options:
$git_root = $ENV{SBO_GITROOT} || "/slackbuilds/www/slackbuilds/15.0/";
$outdir = "$ENV{HOME}/www";
$verbose = 0;

###############
# This shouldn't need changing.
$user_agent = 'Mozilla/5.0 (compatible; ropeylog-repology-bot/1.0; +https://github.com/SlackBuildsOrg/slackbuilds)';

###############

use JSON::XS;                  # from SBo perl-JSON-XS
use POSIX qw/strftime getcwd/; # bundled with Slackware's perl
use Getopt::Long;              # ditto

($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 warning {
	warn "$SELF: warning: " . join(" ", @_). "\n";
}

sub fatal {
	die "$SELF: fatal: " . join(" ", @_). "\n";
}

sub info {
	return unless $verbose;
	warn "$SELF: " . join(" ", @_). "\n";
}

###############

sub usage {
	print <<EOF;
$SELF - generate SBo Maintainer Status reports (HTML)

Usage: $SELF [-d] [-g <git-dir>] [-o <output-dir>] [-s] [-v] 

Generates HTML maintainer status reports, suitable for use on the
SlackBuilds.org site.

The HTML pages are written to the [output-dir] directory. If any file
already exists, it is backed up with a .bak extension.

EOF

	print scalar @reports . " reports are generated:\n\n";
	printf "%20s | %-s\n", "Sorted by", "Filename";
	printf "%20s + %-s\n", "-" x 20, "-" x 35;
	for(@reports) {
		printf "%20s | %-s\n", $_->[0], get_page_name($_->[1]);
	}
	print <<EOF;

Options:

  -d, --download
    Download fresh package status data from repology.org.
    Without this option, cached data from ~/.ropeylog/ is used.

  -o <output-dir>, --output-dir=<output-dir>
    Write HTML reports to this directory. The default is:
    $outdir

  -g <git-dir>
    Read .info files and git logs from this tree. The default is:
    $git_root

  -s, --save-json
    Save the JSON data downloaded from repology.org. Only useful
    for debugging purposes.

  -v, --verbose
    Print verbose information on what ropeylog is doing, including
    download progress from wget. Only useful for debugging.
EOF

}

###############

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";
}

# note to self: wget needs to write to an actual file, not stdout,
# because repology's json api doesn't support continuing, if the
# transfer dies part of the way through. wgetting to stdout results
# in incomplete files if that happens.
sub wget {
	my $url = shift;
	my $file = shift;

	my $q = $verbose ? "" : "-q";
	my $cmd =
		"wget $q --compression=gzip --user-agent '$user_agent' -O$file '$url'";

	info "$cmd";

	system($cmd);

	undef local $/;
	open my $f, "<$file" or fatal $!;
	my $resp = <$f>;
	close $f;
	unlink $file unless $save_json;

	info "sleeping 1s to comply with repology.org spec";
	sleep 1;

	return $resp;
}

sub download {
	my $firstpkg = $_[0] || "";
	my $count = $_[1];
	my $lastpkg = "";

	my $filename = sprintf("%s/%03d.json", $cache_dir, $count);
	my $json = wget(make_api_url($_[0]), $filename);

	eval { $j = decode_json($json); };
	fatal "failed to decode JSON: $@\n" if $@;

	for $proj (keys %{$j}) {
		$lastpkg = $proj if $proj gt $lastpkg;
		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';
		}
	}

	return (($lastpkg eq $firstpkg) ? undef : $lastpkg);
}

sub download_json_files {
	info "downloading JSON results from repology.org";
	my $lastpkg;
	my $count = 1;

	do {
		$lastpkg = download($lastpkg, $count++);
	} while defined $lastpkg;
}

###############

sub get_cache_filename {
	return "$cache_dir/outdated";
}

sub write_cache {
	my $fname = get_cache_filename();
	info "saving outdated build list to cache: $fname";
	open my $f, ">$fname" or fatal "$fname: $!";
	for my $pkg (sort { $a cmp $b } keys %outdated) {
		print $f $pkg . "\n";
	}
	close $f;
}

sub read_cache {
	my $fname = get_cache_filename();
	info "loading outdated build list from cache: $fname";
	open my $f, "<$fname" or fatal "$fname: $!\n*** You must run '$SELF -d' to initialize the cache.";
	while(<$f>) {
		chomp;
		$outdated{$_}++;
	}
	close $f;
}

###############

sub read_info_file {
	my $file = shift;

	my $maint;
	my $email;

	open my $f, "<$git_root/$file" or die $!;

	while(<$f>) {
		chomp;
		if(/^MAINTAINER="(.*?)"/) {
			$maint = $1;
		} elsif(/^EMAIL="(.*?)"/) {
			$email = $1;
		}
	}

	close $f;

	return ($maint, $email);
}

sub parse_info_files {
	info "reading info files from $git_root";
	my $files = `git $git_args ls-files '*/*/*.info'`;
	for my $info (split /\n/, $files) {
		$total_builds++;
		my ($maintainer, $email) = read_info_file($info);
		if($email eq 'NOEMAIL') {
			$total_orphans++;
			next;
		}
		my $catbuild = $info;
		$catbuild =~ s,/[^/]*$,,;
		$name2email{$maintainer} = $email;
		$lastgitdate{$maintainer} = $lastgithash{$maintainer} = 0;
		push @{$maintbuilds{$maintainer}}, $catbuild;
	}
	@maintainers = keys %name2email;
	info "read $total_builds .info files, " . @maintainers . " maintainers"
}

sub parse_git_log {
	info "reading & parsing git log";

	open my $in, "git $git_args 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(!($lastgitdate{$name})) {
			$lastgitdate{$name} = $date;
			$lastgithash{$name} = $hash;
		}
	}
	close $in;
}

###############

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;
	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_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}
  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>
<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">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 $sortfunc @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\" 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;
			}
		}

		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
}

sub get_page_name {
	return "maintainer_status$_[0].html";
}

sub print_all_reports {
	for my $rep (@reports) {
		my ($title, $fname, $sortfunc) = @$rep;

		$fname = "$outdir/" . get_page_name($fname);

		open my $f, ">$fname.new" or die $!;
		my $oldf = select $f;
		print_report($title, $sortfunc);
		select $oldf;
		close $f;

		rename $fname, $fname . ".bak";
		rename $fname . ".new", $fname;
	}
}

###############

# main()
Getopt::Long::Configure("bundling");
GetOptions(
	"download|d"    => \$do_download,
	"save-json|s"   => \$save_json,
	"git-dir|g"     => \$git_root,
	"output-dir|o"  => \$outdir,
	"help|h"        => sub { usage(); exit 0; },
	"verbose|v"     => \$verbose,
);

$start_time = time;

$cache_dir = "$ENV{HOME}/.$SELF";
system("mkdir -p $cache_dir $outdir");
fatal "can't create $cache_dir" unless -d $cache_dir;
fatal "can't create $cache_dir" unless -d $outdir;
info "\$cache_dir: $cache_dir";
info "\$outdir: $outdir";

$git_args = "--work-tree $git_root --git-dir $git_root/.git";
info "\$git_args: $git_args";

if($do_download) {
	download_json_files();
	write_cache();
} else {
	read_cache();
}

parse_info_files();
parse_git_log();
print_all_reports();

info "elapsed time: " . (time - $start_time) . " sec";
exit 0;