toolbox/lint-all-readme.pl

   1 #!/usr/bin/perl
   2
   3 # lint-all-readme.pl - lint all projects' explicit README files
   4 # Copyright (C) 2021 Kyle J. McKay.
   5 # All rights reserved.
   6 # License GPLv2+: GNU GPL version 2 or later.
   7 # www.gnu.org/licenses/gpl-2.0.html
   8 # This is free software: you are free to change and redistribute it.
   9 # There is NO WARRANTY, to the extent permitted by law.
  10
  11 use strict;
  12 use warnings;
  13 use vars qw($VERSION);
  14 BEGIN {*VERSION = \'1.0.1'}
  15 use File::Basename qw(basename);
  16 use Cwd qw(realpath);
  17 use lib "__BASEDIR__";
  18 use Girocco::Config;
  19 use Girocco::Util;
  20 use Girocco::CLIUtil;
  21 use Girocco::Project;
  22 my $bn; BEGIN {$bn = basename(__FILE__)}
  23
  24 exit(&main(@ARGV)||0);
  25
  26 our $help;
  27 BEGIN {$help = <<'HELP'}
  28 Usage: %s [--help] [--dry-run] [<projname>]...
  29        --help           show this help
  30        --dry-run        show projects that need updating but don't update them
  31        -P/--progress    show progress on STDERR (default if STDERR is a tty)
  32        -q/--quiet       suppress warning messages
  33
  34        <projname>...    if given, only operate on these projects
  35
  36        Exit status will always be non-zero if any readme files fail to lint.
  37 HELP
  38
  39 sub lint_project_readmes {
  40         my $dryrun = shift;
  41         my $show_progress = shift;
  42         my $quiet = shift;
  43         my %allprojs = map({$_ => 1} Girocco::Project::get_full_list());
  44         my @projs = ();
  45         if (@_) {
  46                 my $root = $Girocco::Config::reporoot;
  47                 $root =~ s,/+$,,;
  48                 $root ne "" or $root = "/";
  49                 $root = realpath($root);
  50                 $root = $1 if $root =~ m|^(/.+)$|;
  51                 my %seen = ();
  52                 foreach (@_) {
  53                         exists($seen{$_}) and next;
  54                         if (!exists($allprojs{$_})) {
  55                                 s,/+$,,;
  56                                 $_ ne "" or $_ = "/";
  57                                 -d $_ and $_ = realpath($_);
  58                                 s,^\Q$root\E/,,;
  59                                 s,^/+,,;
  60                                 $_ = $1 if $_ =~ m|^(.+)$|;
  61                                 s,\.git$,,;
  62                                 exists($seen{$_}) and next;
  63                                 if (!exists($allprojs{$_})) {
  64                                         $seen{$_} = 1;
  65                                         warn "$_: unknown to Girocco (not in etc/group)\n"
  66                                                 unless $quiet;
  67                                         next;
  68                                 }
  69                         }
  70                         $seen{$_} = 1;
  71                         push(@projs, $_);
  72                 }
  73         } else {
  74                 @projs = sort({lc($a) cmp lc($b) || $a cmp $b} keys(%allprojs));
  75         }
  76         my @outdated = ();
  77         my @badlint = ();
  78         my $bd = $Girocco::Config::reporoot . '/';
  79         my $progress = Girocco::CLIUtil::Progress->new(
  80                 $show_progress ? scalar(@projs) : 0,
  81                 "Checking project readme files");
  82         my $cnt = 0;
  83         foreach (@projs) {
  84                 ++$cnt;
  85                 $progress->update($cnt);
  86                 my $pd = $bd . $_ . '.git';
  87                 -d $pd or next; # just ignore any phantoms
  88                 my $proj = undef;
  89                 eval { $proj = Girocco::Project->load($_); 1; } && $proj or
  90                         next; # just ignore unloadable projects
  91                 my $readme = $proj->{README};
  92                 defined($readme) or $readme = "";
  93                 chomp($readme);
  94                 my ($cnt, $err) = $proj->_lint_readme(0);
  95                 if ($cnt) {
  96                         push(@badlint, $_);
  97                         $progress->emit("$_: error: $err");
  98                         next;
  99                 }
 100                 my $newreadme = $proj->{README};
 101                 defined($newreadme) or $newreadme = "";
 102                 chomp($newreadme);
 103                 $readme eq $newreadme and next;
 104                 if ($dryrun) {
 105                         push(@outdated, $_);
 106                         $progress->emit("$_: needs update");
 107                 } else {
 108                         push(@outdated, $_);
 109                         $proj->_property_fput("READMEDATA", $proj->{READMEDATA}, 1);
 110                         $proj->_property_fput("README", $proj->{README}, -e "$pd/README.html");
 111                         $proj->_property_fput("rmtype", $proj->{rmtype}, 1);
 112                         $proj->_set_changed;
 113                         $progress->emit("$_: updated");
 114                 }
 115         }
 116         return {count => scalar(@projs), outdated => \@outdated,
 117                 badlint => \@badlint};
 118 }
 119
 120 sub dohelp {
 121         my $fd = shift;
 122         my $ec = shift;
 123         printf $fd "%s version %s\n", $bn, $VERSION;
 124         printf $fd $help, $bn;
 125         exit $ec;
 126 }
 127
 128 sub main {
 129         local *ARGV = \@_;
 130         my ($quiet, $dryrun, $help);
 131         my $progress = -t STDERR;
 132         {
 133                 shift, $quiet=1, redo if @ARGV && $ARGV[0] =~ /^(?:-q|--quiet)$/i;
 134                 shift, $dryrun=1, redo if @ARGV && $ARGV[0] =~ /^(?:-n|--dry-run)$/i;
 135                 shift, $help=1, redo if @ARGV && $ARGV[0] =~ /^(?:-h|--help)$/i;
 136                 shift, $progress=1, redo if @ARGV && $ARGV[0] =~ /^(?:-P|--progress)$/i;
 137                 shift, $progress=0, redo if @ARGV && $ARGV[0] =~ /^(?:--no-progress)$/i;
 138         }
 139         $help || (@ARGV && $ARGV[0] =~ /^-/) and dohelp($help ? \*STDOUT : \*STDERR, !$help);
 140         nice_me(18);
 141         my $results = lint_project_readmes(!!$dryrun, $progress, $quiet, @ARGV);
 142         printf "Total: %d  %s: %d  Lintfail: %d\n",
 143                 $results->{count},
 144                 $dryrun ? "Outdated" : "Updated", scalar(@{$results->{outdated}}),
 145                 scalar(@{$results->{badlint}});
 146         exit @{$results->{badlint}} ? 1 : 0;
 147 }