diff options
| -rw-r--r-- | TODO | 10 | ||||
| -rwxr-xr-x | greypool | 257 | ||||
| -rwxr-xr-x | ropeylog | 468 |
3 files changed, 673 insertions, 62 deletions
@@ -1,9 +1,7 @@ TODO list for greypool - handle the case where a project has more than one maintainer... - or no maintainer. this does't happen with SlackBuilds.org. - -- handle ^C gracefully during wget downloads. + or no maintainer. this doesn't happen with SlackBuilds.org. - improve the interactive config: - cache the repo list? @@ -20,15 +18,9 @@ TODO list for greypool - HTML: allow setting font and font size in config file -- allow user-specified stylesheet for HTML. I am not a web designer, nor - do I want to be. - - handle (unlikely) possibility of commas in CSV fields. is there a single universally-supported correct way to do this? -- transforms in config file. regex to change my version number into - what repology tracks. - Maybe: - allow multiple repos in config file. check them all by default, add @@ -17,13 +17,26 @@ BEGIN { eval { require JSON::PP; JSON::PP->import(); }; if($@) { # should never happen on Slackware: - die "$SELF: couldn't load either JSON::XS or JSON::PP\n"; + warn "$SELF: couldn't load either JSON::XS or JSON::PP\n"; + $modules_failed++; } } + eval { require Getopt::Long; Getopt::Long->import(); }; + if($@) { + warn "$SELF: couldn't load Getopt::Long perl module\n"; + $modules_failed++; + } + eval { require POSIX; POSIX->import('strftime') }; + if($@) { + warn "$SELF: couldn't load POSIX perl module\n"; + $modules_failed++; + } + + if($modules_failed) { + die "$SELF: Failed to load required perl module(s)\n"; + } } -use Getopt::Long; -use POSIX 'strftime'; use feature 'unicode_strings'; $VERSION = "0.0.0"; @@ -68,7 +81,9 @@ sub read_file { sub parse_opts { Getopt::Long::Configure("bundling"); GetOptions( - "verbose|v" => sub { $verbosity = 2; }, + "all|a" => \$show_all, + "stylesheet|s" => \$css_file, + "verbose|v" => sub { $verbose = 2; }, "force|f" => \$force_download, "html|h" => \$html, "html-fragment|H" => \$html_frag, @@ -78,13 +93,15 @@ sub parse_opts { "doc|help" => sub { exec("perldoc $0"); }, "man" => sub { exec("pod2man --stderr -s1 -cgreypool -r$VERSION $0"); }, "color|colour|c" => \$color_output, - "mono|no-color|no-colour|m" => sub { $color_output = 0; }, + "mono|no-color|no-colour|m" => sub { $color_output = 0; $mono = 1; }, "config-dir|C=s" => \$privdir, - "quiet|q" => sub { $verbosity = 0; }, + "quiet|q" => sub { $verbose = 0; }, + "no-pager|P" => \$no_pager, ) or fatal("error in command line options (try --help)."); $html = 1 if $html_frag; $html = 0 if $csv_output; + $color_output = 1 if $html && !$mono; fatal "can't use -f/--force and -n/--cached together" if $force_download && $no_download; @@ -92,7 +109,6 @@ sub parse_opts { $email = shift @ARGV; fatal "extra junk on the command line after '$email'" if @ARGV; - $color_output = -t STDOUT unless defined $color_output; $privdir = $ENV{HOME} . "/.greypool" unless defined $privdir; $config_file = $privdir . "/config"; $css_file = $privdir . "/style.css"; @@ -300,7 +316,9 @@ sub parse_transform { my $junk; ($pkg, $subst, $junk) = split /\s+/, $_[0]; - fatal "$config_file:$.: trailing junk on transform line" if $junk; + if(defined $junk || !defined $subst || !defined $pkg) { + fatal "$config_file:$.: transform requires exactly 2 arguments"; + } eval 'my $i = ""; $i =~ ' . $subst . ';'; if($@) { @@ -318,11 +336,33 @@ sub parse_mask { $masked{$pkg} = \@versions if @versions; } +sub parse_color { + for($_[0]) { + /^[y1t]/i && do { $config_color = 1; return; }; + /^[n0f]/i && do { $config_color = 0; return; }; + /^a/i && do { $config_color = undef; return; }; + fatal "$config_file:$.: color must be 'yes', 'no', or 'auto'."; + } +} + +sub parse_pager { + $pager = $_[0]; +} + +sub find_config_file { + my $file = shift; + if($file =~ m,^/,) { + return $file; + } else { + return "$privdir/$file"; + } +} + sub read_config_file { - create_default_config() unless -e $config_file; - info "reading config from $config_file"; + my $file = shift; + info "reading config from $file"; - open my $f, "<$config_file" or fatal $!; + open my $f, "<$file" or fatal $!; while(<$f>) { chomp; @@ -332,7 +372,7 @@ sub read_config_file { s/\s+$//; # trim trailing whitespace (my $key, $val) = split /\s+/, $_, 2; - fatal "$config_file line $. malformed (no spaces)" unless defined $val; + fatal "$file line $. malformed (no spaces)" unless defined $val; for(lc $key) { my $ok; @@ -342,11 +382,33 @@ sub read_config_file { /ignore/ && do { $ok++; $ignore{$_}++ for split /\s+/, $val; }; /mask/ && do { $ok++; parse_mask($val); }; /transform/ && do { $ok++; parse_transform($val) }; + /include/ && do { + read_config_file(find_config_file($val)); + next; + }; + /color/ && do { $ok++; parse_color($val); }; + /pager/ && do { $ok++; parse_pager($val); }; fatal "$config_file line $. malformed (unknown key '$_')" unless $ok; } } close $f; +} +sub print_config_summary { + warn <<EOF; +config summary: +cachedir: $cachedir + email: $email + repo: $repo +EOF + my $i = join(" ", keys %ignore); + warn " ignored: $i \n" if $i; + for(keys %masked) { + warn " masked $_ versions: " . join(",", @{$masked{$_}}) . "\n"; + } +} + +sub apply_config { fatal "no email given on the command line or in the config file" unless defined $email; @@ -355,19 +417,18 @@ sub read_config_file { $cachedir = $privdir . "/cache/$email"; $cachestampfile = $cachedir . "/stamp"; - if($verbose > 1) { - warn <<EOF; -config summary: -cachedir: $cachedir - email: $email - repo: $repo -EOF - my $i = join(" ", keys %ignore); - warn " ignored: $i \n" if $i; - for(keys %masked) { - warn " masked $_ versions: " . join(",", @{$masked{$_}}) . "\n"; - } + if(defined($config_color)) { + $color_output = $config_color unless defined $color_output; + } else { + $color_output = -t STDOUT; + } + + if(!$html && !defined($no_pager) && defined($pager) && -t STDOUT) { + open $outfh, "|$pager" or fatal "can't execute pager"; + select $outfh; } + + print_config_summary() if $verbose > 1; } sub decode_file { @@ -456,6 +517,7 @@ sub transformed_versions_eq { } sub ignored_or_masked { + return 0 if $show_all; my $i = shift; for(qw/name projname/) { @@ -501,6 +563,10 @@ sub stamp_cache { sub check_cache { mkdir_p $cachedir; return if cache_ok() || $no_download; + invalidate_cache(); +} + +sub invalidate_cache { for(<$cachedir/*>) { unlink $_; } @@ -542,8 +608,13 @@ sub download { "'$url'"; debug $cmd; + + $SIG{INT} = sub { invalidate_cache(); fatal "exiting due to ^C"; exit 1; }; my $status = system($cmd); + $SIG{INT} = 'DEFAULT'; + if($status) { + invalidate_cache(); fatal "wget failed, exit status " . ($status >> 8); } sleep 1; # repology wants to limit requests to 1 per sec. @@ -583,6 +654,7 @@ sub generate_report { ####### report printing stuff sub create_default_css { + debug "$css_file doesn't exist, creating"; open my $f, ">$css_file" or fatal "$css_file: $!"; print $f <<EOF; body { color: #ffffff; background-color: #000000; } @@ -602,6 +674,7 @@ sub print_css { if(! -e $css_file) { create_default_css(); } + debug "reading stylesheet from $css_file"; print read_file($css_file); } @@ -613,13 +686,13 @@ sub print_report_header { <html> <head> <meta name="Generator" content="$SELF/$VERSION"> -<style> -EOF - print_css(); - print <<EOF; -</style> -<title> EOF + if($color_output) { + print "<style>\n"; + print_css(); + print "</style>\n"; + } + print "<title>\n"; } print "Repology status report for $email ($repo repository)\n\n"; print "</title>\n</head>\n<body>\n" if $html; @@ -690,7 +763,7 @@ sub print_report_footer { if($count && !$html) { print $count . " package" . ($count == 1 ? "" : "s") . " out of date.\n"; } - print "</body></html>" if $html && (!$html_frag); + print "</body></html>\n" if $html && (!$html_frag); } ####### ANSI color stuff @@ -714,7 +787,9 @@ sub colorize { parse_opts(); mkdir_p($privdir); create_wgetrc(); -read_config_file(); +create_default_config() unless -e $config_file; +read_config_file($config_file); +apply_config(); check_cache(); generate_report(); stamp_cache(); @@ -755,6 +830,11 @@ Bundling options is supported, e.g. B<-qf> is the same as B<-q -f>. =over 4 +=item B<-a>, B<--all> + +Show all packages; ignore any I<ignore> or I<mask> directives in +the config file. + =item B<-c>, B<--color>, B<--colour> Colorize the output. For HTML output, this is already the default. For @@ -763,8 +843,9 @@ tty device (e.g. not redirected to a file). =item B<-m>, B<--mono> B<--no-color>, B<--no-colour> -Do no colorize the output, even if stdout is a terminal. This also -produces monochrome HTML pages, with the B<-h> / B<--html> option. +Do not colorize the plain text output, even if stdout is a terminal. +This also produces monochrome (unstyled) HTML pages, with the +B<-h> / B<--html> option. =item B<-C>, B<--config-dir> I<directory> @@ -792,8 +873,8 @@ is not a web designer and doesn't want to be one. =item B<-H>, B<--html-fragment> -Like B<--html>, but I<just> the HTML table (no header, body tag, etc). -Suitable for embedding in another HTML page. +Like B<--html>, but I<just> the HTML table (no header, stylesheet, +body tag, etc). Suitable for embedding in another HTML page. =item B<-C>, B<--csv> @@ -801,11 +882,24 @@ Comma-separated value output. The first line is a "header" with the field names; the rest of the output is one line per package. This would fail if someone put a comma in a version number... I<*shrug*> +=item B<-s> I<css-file>, B<--stylesheet> I<css-file> + +Embed I<css-file> in the HTML report. Default is +B<~/.greypool/style.css>. Has no effect without the B<--html> +option. If the file doesn't exist, it will be created, with the +default stylesheet. Note that there's no support for an external +stylesheet (e.g. B<<link stylesheet="...">>). + =item B<-q>, B<--quiet> Don't print any messages to standard error, except errors and warning. +=item B<-P>, B<--no-pager> + +Ignores B<pager> from the config file; output is sent directly to the +terminal. + =item B<-v>, B<--verbose> Print extra informational messages about what B<greypool> is doing, @@ -818,7 +912,10 @@ Print B<greypool> version and exit. =item B<--help> -Display documentation using your pager. +Display documentation using your pager: either B<PAGER> from the +environment, or B<less> if it's not set. This I<doesn't> use the pager +defined in your config file, since the config file doesn't get read +when B<--help> is used. =item B<--man> @@ -840,10 +937,10 @@ with spaces. =over 4 -=item B<repo> +=item B<repo> I<repository> -Limit the search to one specific repository. This key is required, -and there's no command-line option to override it. +The repository this config file is for. This key is required, and +there's no command-line option to override it. This key can only have one value, and can only occur once in the config file. @@ -852,7 +949,7 @@ If you maintain packages for more than one distribution, you'll have to create separate config directories for each one, and call B<greypool> with the B<--config-dir> or B<-C> option. -=item B<email> +=item B<email> I<email-address> The default email address to use, if one isn't provided on the command line. This key can only have one value, and can only @@ -866,7 +963,7 @@ Example: email urchlay@slackware.uk -=item B<ignore> +=item B<ignore> I<package ...> This key can have multiple values, and can occur multiple times. Use it to list packages whose status you don't want to check. Examples would @@ -887,7 +984,7 @@ Note that the above could also be written as: ignore evince gst-plugins-bad-nonfree -=item B<mask> +=item B<mask> I<package> I<version ...> This key can occur multiple times, and must have at least two values. Use it to pretend a particular version of a project doesn't exist. @@ -901,7 +998,27 @@ Multiple versions can be listed on one mask line: mask somepackage 1.2 1.3 1.4 -=item B<pkgurl> +=item B<transform> I<package> I<substitution> + +Sometimes, repology's version number for a project doesn't quite +match the version number you used for your package, even though +they're the same version. Example: your "foo" version number is +1.2.3+20260101, for a package that's built from the 1.2.3 source +plus the latest patches from upstream git as of Jan 1, 2026. +But repology lists it simply as 20260101. You can work around +this, like so: + + transform foo s/1\.2\.3\+// + +Note that the last argument is executable Perl code. If it's not valid +Perl, B<greypool> will show an error message and fail to run. + +You're expected to use a simple regex substitution here. Yes, you +could insert any code you wanted to, which can cause all kinds of +problems. So don't do that unless you I<really> know what you're doing +and have a I<very> good reason for it. + +=item B<pkgurl> I<URL> Optional. When generating HTML output, if this is set, the distro package names in the HTML will be clickable links that go to the @@ -913,27 +1030,55 @@ Example: pkgurl https://slackbuilds.org/repository/15.0/$NAME/ +=item B<include> I<file> + +Include a config file, which will be parsed as though it occurred +inline in the current file. This can be useful for e.g. ignoring +packages you've updated recently, but the updates haven't been picked +up by reology yet. The filename can be a full path (used as-is), or +else it will be treated as relative to the config directory. + +=item B<color> I<yes> | I<no> | I<auto> + +Whether to colorize output. Default is I<auto>, meaning yes if +standard output is a terminal, otherwise no. + +This sets the default, but you can still use the B<-c> / B<--color> +or B<-m> / B<--mono> options to override. + +=item B<pager> I<command> + +If this is set, and standard output is a terminal, and the B<-h> / +B<--html> option was not used, output will be piped to I<command>. +There is no default for this. + +If you want colorized output in the pager, try B<color yes> and +B<pager less -MR>. + =back =head1 NOTES =head2 Required Perl Modules +B<greypool> requires the B<POSIX>, B<Getopt::Long>, and either the +B<JSON::PP> or B<JSON::XS> modules. + +B<JSON::XS> is highly recommended. It runs about 20 times as fast as +B<JSON::PP>. However, either will work. + If you get this error message on startup: - greypool: couldn't load either JSON::XS or JSON::PP + greypool: Failed to load required perl module(s) -...then you should install your OS's package for the JSON::XS perl module. -On Slackware, this is B<perl-JSON-XS> from SlackBuilds.org. For other -distributions, repology.org will tell you: +...you'll have to install the missing modules. Depending on your +distribution, some or all of the modules may be bundled with the main +perl package, or you may have to install them separately. B<POSIX> +usually is bundled. For the others, see: https://repology.org/project/perl%3Ajson-xs/versions -You will also need the B<POSIX> perl module, which is usually bundled -with the main perl package, and the B<Getopt::Long> module which -is bundled on some distributions. See: - - https://repology.org/projects/?search=perl%3Agetopt-long + https://repology.org/project/perl%3Agetopt-long/versions =head2 External Binaries @@ -964,6 +1109,12 @@ create it, with default settings for a custom user agent and with gzip compression enabled. Ideally, you shouldn't need to change anything here, but it's available if needed. +=item B<style.css> + +The default stylesheet to embed in the HTML report. Will be created +the first time it's needed, if it doesn't exist. This can be changed +with the B<-s> / B<--stylesheet> option. + =item B<cache/> Contains one cache directory per email address that's been checked. diff --git a/ropeylog b/ropeylog new file mode 100755 index 0000000..66aae99 --- /dev/null +++ b/ropeylog @@ -0,0 +1,468 @@ +#!/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> " . + "<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; |