diff options
| -rwxr-xr-x | ropeylog | 293 |
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(); |