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.0'}
  15 use File::Basename qw(basename);
  16 use lib "__BASEDIR__";
  17 use Girocco::Config;
  18 use Girocco::Util;
  19 use Girocco::CLIUtil;
  20 use Girocco::Project;
  21 my $bn; BEGIN {$bn = basename(__FILE__)}
  22
  23 {package Progress;
  24
  25 use Time::HiRes qw(gettimeofday);
  26
  27 sub fractime() { return scalar(gettimeofday) }
  28
  29 sub new {
  30         my $class = shift || __PACKAGE__;
  31         my $max = shift;
  32         defined($max) or $max = 100;
  33         my $title = shift;
  34         defined($title) or $title = "Progress";
  35         return bless {
  36                 title => $title,
  37                 max => $max,
  38                 cur => 0,
  39                 len => 0,
  40                 lastupd => fractime + 2
  41         }, $class;
  42 }
  43
  44 sub update {
  45         my $self = shift;
  46         !$self->{max} and return;
  47         my $newcur = shift;
  48         defined($newcur) or $newcur = $self->{cur} + 1;
  49         $newcur > $self->{max} and $newcur = $self->{max};
  50         $newcur >= $self->{cur} or $newcur = $self->{cur};
  51         my $now = fractime;
  52         if ($self->{lastupd} + 1 <= $now) {
  53                 $self->{lastupd} = $now;
  54                 if (!$self->{len} || $self->{cur} != $newcur) {
  55                         $self->{cur} = $newcur;
  56                         $self->show;
  57                 }
  58         }
  59 }
  60
  61 sub show {
  62         my $self = shift;
  63         delete $self->{wasvis};
  64         !$self->{max} and return;
  65         my $p = int((100 * $self->{cur} / $self->{max}) + 0.5);
  66         $p > 100 and $p = 100;
  67         $p == 100 && $self->{cur} < $self->{max} and $p = 99;
  68         my $status = sprintf("%s: %3d%% (%d/%d)", $self->{title},
  69                 $p, $self->{cur}, $self->{max});
  70         my $newlen = length($status);
  71         $self->{len} > $newlen and $status .= " " x ($self->{len} - $newlen);
  72         $status .= "\r";
  73         print STDERR $status;
  74         $self->{len} = $newlen;
  75 }
  76
  77 sub clear {
  78         my $self = shift;
  79         if ($self->{len}) {
  80                 print STDERR " " x $self->{len}, "\r";
  81                 $self->{len} = 0;
  82                 $self->{wasvis} = 1;
  83         }
  84 }
  85
  86 sub restore {
  87         my $self = shift;
  88         $self->{wasvis} and $self->show;
  89 }
  90
  91 sub DESTROY {
  92         my $self = shift;
  93         $self->clear;
  94 }
  95
  96 }# END package Progress
  97
  98 exit(&main(@ARGV)||0);
  99
 100 our $help;
 101 BEGIN {$help = <<'HELP'}
 102 Usage: %s [--help] [--dry-run]
 103        --help           show this help
 104        --dry-run        show projects that need updating but don't update them
 105        -P/--progress    show progress on STDERR (default if STDERR is a tty)
 106
 107        Exit status will always be non-zero if any readme files fail to lint.
 108 HELP
 109
 110 sub lint_project_readmes {
 111         my ($dryrun, $show_progress) = @_;
 112         my %allprojs = map({$_ => 1} Girocco::Project::get_full_list());
 113         my @allprojs = sort({lc($a) cmp lc($b)} keys(%allprojs));
 114         my @outdated = ();
 115         my @badlint = ();
 116         my $bd = $Girocco::Config::reporoot . '/';
 117         my $progress = Progress->new($show_progress ? scalar(@allprojs) : 0,
 118                 "Checking project readme files");
 119         my $cnt = 0;
 120         foreach (@allprojs) {
 121                 ++$cnt;
 122                 $progress->update($cnt);
 123                 $progress->restore;
 124                 my $pd = $bd . $_ . '.git';
 125                 -d $pd or next; # just ignore any phantoms
 126                 my $proj = undef;
 127                 eval { $proj = Girocco::Project->load($_); 1; } && $proj or
 128                         next; # just ignore unloadable projects
 129                 my $readme = $proj->{README};
 130                 defined($readme) or $readme = "";
 131                 chomp($readme);
 132                 my ($cnt, $err) = $proj->_lint_readme(0);
 133                 if ($cnt) {
 134                         push(@badlint, $_);
 135                         $progress->clear;
 136                         chomp($err);
 137                         print "$_: error: $err\n";
 138                         next;
 139                 }
 140                 my $newreadme = $proj->{README};
 141                 defined($newreadme) or $newreadme = "";
 142                 chomp($newreadme);
 143                 $readme eq $newreadme and next;
 144                 $progress->clear;
 145                 if ($dryrun) {
 146                         push(@outdated, $_);
 147                         print "$_: needs update\n";
 148                 } else {
 149                         push(@outdated, $_);
 150                         $proj->_property_fput("READMEDATA", $proj->{READMEDATA}, 1);
 151                         $proj->_property_fput("README", $proj->{README}, -e "$pd/README.html");
 152                         $proj->_property_fput("rmtype", $proj->{rmtype}, 1);
 153                         $proj->_set_changed;
 154                         print "$_: updated\n";
 155                 }
 156         }
 157         return {count => scalar(@allprojs), outdated => \@outdated,
 158                 badlint => \@badlint};
 159 }
 160
 161 sub dohelp {
 162         my $fd = shift;
 163         my $ec = shift;
 164         printf $fd "%s version %s\n", $bn, $VERSION;
 165         printf $fd $help, $bn;
 166         exit $ec;
 167 }
 168
 169 sub main {
 170         local *ARGV = \@_;
 171         my ($dryrun, $help);
 172         my $progress = -t STDERR;
 173         {
 174                 shift, $dryrun=1, redo if @ARGV && $ARGV[0] =~ /^(?:-n|--dry-run)$/i;
 175                 shift, $help=1, redo if @ARGV && $ARGV[0] =~ /^(?:-h|--help)$/i;
 176                 shift, $progress=1, redo if @ARGV && $ARGV[0] =~ /^(?:-P|--progress)$/i;
 177                 shift, $progress=0, redo if @ARGV && $ARGV[0] =~ /^(?:--no-progress)$/i;
 178         }
 179         !@ARGV && !$help or dohelp($help ? \*STDOUT : \*STDERR, !$help);
 180         select((select(STDERR),$|=1)[0]);
 181         select((select(STDOUT),$|=1)[0]);
 182         my $results = lint_project_readmes(!!$dryrun, $progress);
 183         printf "Total: %d  %s: %d  Lintfail: %d\n",
 184                 $results->{count},
 185                 $dryrun ? "Outdated" : "Updated", scalar(@{$results->{outdated}}),
 186                 scalar(@{$results->{badlint}});
 187         exit @{$results->{badlint}} ? 1 : 0;
 188 }