Lib/std/book-cmark/bin/stats

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # stats
   5 # File ID: STDuuidDTS
   6 #
   7 # Display word count statistics
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2015– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of
  12 # file for legal stuff.
  13 #=======================================================================
  14
  15 use strict;
  16 use warnings;
  17 use Getopt::Long;
  18
  19 local $| = 1;
  20
  21 our %Opt = (
  22
  23     'colour' => 0,
  24     'data' => 0,
  25     'help' => 0,
  26     'quiet' => 0,
  27     'verbose' => 0,
  28     'version' => 0,
  29
  30 );
  31
  32 our $progname = $0;
  33 $progname =~ s/^.*\/(.*?)$/$1/;
  34 our $VERSION = '0.2.1';
  35
  36 Getopt::Long::Configure('bundling');
  37 GetOptions(
  38
  39     'colour|c' => \$Opt{'colour'},
  40     'data' => \$Opt{'data'},
  41     'help|h' => \$Opt{'help'},
  42     'quiet|q+' => \$Opt{'quiet'},
  43     'verbose|v+' => \$Opt{'verbose'},
  44     'version' => \$Opt{'version'},
  45
  46 ) || die("$progname: Option error. Use -h for help.\n");
  47
  48 $Opt{'verbose'} -= $Opt{'quiet'};
  49 $Opt{'help'} && usage(0);
  50 if ($Opt{'version'}) {
  51     print_version();
  52     exit(0);
  53 }
  54
  55 my $sql_error = 0; # Set to !0 if some sqlite3 error happened
  56
  57 exit(main());
  58
  59 sub main {
  60     # {{{
  61     my $Retval = 0;
  62     my $data = '';
  63
  64     if ($Opt{'data'}) {
  65         print(format_data(join('', <>)));
  66         return(0);
  67     }
  68
  69     my $lockdir = "dat/STDprojnameDTS.lock";
  70     my $did_wait = 0;
  71     until (mkdir($lockdir)) {
  72         msg(0, "$progname: $lockdir: Waiting for lockdir");
  73         sleep(2);
  74         $did_wait = 1;
  75     }
  76     if ($did_wait) {
  77         msg(0, "$progname: Lockdir aquired");
  78     }
  79
  80     if (-e "dat/STDprojnameDTS.spar") {
  81         warn("$progname: dat/STDprojnameDTS.spar already exists\n");
  82         rmdir($lockdir);
  83         return(1);
  84     }
  85
  86     my $tmpfile = "dat/.STDprojnameDTS.spar.$$.tmp";
  87     system("sqlite3 $tmpfile <dat/STDprojnameDTS.sql");
  88     rename($tmpfile, "dat/STDprojnameDTS.spar");
  89     my $spardata = `spar -d dat -s STDprojnameDTS`;
  90     my $currdb = $spardata; # Current value stored in the database
  91     $currdb =~ s/^.*?\n(.*?)\n.*$/$1/s;
  92     msg(1, "currdb after regexp = '$currdb'");
  93     $currdb = int($currdb);
  94     msg(1, "currdb = '$currdb'");
  95     $data = format_data(join('', <>));
  96     my $totwords = word_count($data);
  97     if ($currdb != $totwords) {
  98         $spardata = `spar -d dat -s STDprojnameDTS -c $totwords`;
  99     }
 100     my $spar = $spardata; # Current goal to reach
 101     $spar =~ s/\n.*$//s;
 102     my $spartime = $spardata; # Days, hours, minutes, etc behind/ahead
 103     $spartime =~ s/^.*\n(.*?),.*?\n$/$1/s;
 104     my $currstat = $totwords - $spar;
 105
 106     my $C_BOLD = '';
 107     my $C_GREEN = '';
 108     my $C_RED = '';
 109     my $C_RESET = '';
 110
 111     if ($Opt{'colour'}) {
 112         $C_BOLD = `tput bold`;
 113         $C_GREEN = `tput setaf 2`;
 114         $C_RED = `tput setaf 1`;
 115         $C_RESET = `tput sgr0`;
 116     }
 117
 118     my $textcol = $C_BOLD . ($currstat < 0 ? $C_RED : $C_GREEN);
 119
 120     printf(
 121         "Status: %s%.2f %s(%s%s%s)\n" .
 122         "Words: %u\n" .
 123         "Goal: %.2f\n",
 124         $textcol,
 125         $currstat,
 126         $C_RESET,
 127         $textcol,
 128         $spartime,
 129         $C_RESET,
 130         $totwords,
 131         $spar,
 132     );
 133     system("sqlite3 dat/STDprojnameDTS.spar .dump >$tmpfile");
 134     rename($tmpfile, "dat/STDprojnameDTS.sql");
 135     unlink("dat/STDprojnameDTS.spar");
 136     rmdir($lockdir);
 137
 138     return $Retval;
 139     # }}}
 140 } # main()
 141
 142 sub format_data {
 143     # {{{
 144     my $data = shift;
 145     $data =~ s/^.*?TEXT_BEGIN\s+-->\s*//s;
 146     $data =~ s/\s*<!--\s+TEXT_END.*?$//s;
 147     $data =~ s/<!--.*?-->//gs;
 148     msg(4, "data = '$data'");
 149     return($data);
 150     # }}}
 151 } # format_data()
 152
 153 sub sql {
 154     # {{{
 155     my ($db, $sql) = @_;
 156     my @retval = ();
 157
 158     msg(3, "sql(): db = '$db'");
 159     local(*CHLD_IN, *CHLD_OUT, *CHLD_ERR);
 160
 161     $sql_error = 0;
 162     my $pid = open3(*CHLD_IN, *CHLD_OUT, *CHLD_ERR, "sqlite3", $db) or (
 163         $sql_error = 1,
 164         msg(0, "sql(): open3() error: $!"),
 165         return("sql() error"),
 166     );
 167     msg(3, "sql(): sql = '$sql'");
 168     print(CHLD_IN "$sql\n") or msg(0, "sql(): print CHLD_IN error: $!");
 169     close(CHLD_IN);
 170     @retval = <CHLD_OUT>;
 171     msg(3, "sql(): retval = '" . join('|', @retval) . "'");
 172     my @child_stderr = <CHLD_ERR>;
 173     if (scalar(@child_stderr)) {
 174         msg(0, "sqlite3 error: " . join('', @child_stderr));
 175         $sql_error = 1;
 176     }
 177     return(join('', @retval));
 178     # }}}
 179 } # sql()
 180
 181 sub word_count {
 182     # {{{
 183     my $data = shift;
 184     $data =~ s/\s+/\n/sg;
 185     my $retval = scalar(split(/\s+/, $data));
 186     return($retval);
 187     # }}}
 188 } # word_count()
 189
 190 sub print_version {
 191     # Print program version {{{
 192     print("$progname $VERSION\n");
 193     return;
 194     # }}}
 195 } # print_version()
 196
 197 sub usage {
 198     # Send the help message to stdout {{{
 199     my $Retval = shift;
 200
 201     if ($Opt{'verbose'}) {
 202         print("\n");
 203         print_version();
 204     }
 205     print(<<"END");
 206
 207 Display word count statistics
 208
 209 Usage: $progname [options] [file [files [...]]]
 210
 211 Options:
 212
 213   -c, --colour
 214     Use colour in output; red if behind schedule, green if ahead.
 215   --data
 216     Output text data instead of displaying stats.
 217   -h, --help
 218     Show this help.
 219   -q, --quiet
 220     Be more quiet. Can be repeated to increase silence.
 221   -v, --verbose
 222     Increase level of verbosity. Can be repeated.
 223   --version
 224     Print version information.
 225
 226 END
 227     exit($Retval);
 228     # }}}
 229 } # usage()
 230
 231 sub msg {
 232     # Print a status message to stderr based on verbosity level {{{
 233     my ($verbose_level, $Txt) = @_;
 234
 235     if ($Opt{'verbose'} >= $verbose_level) {
 236         print(STDERR "$progname: $Txt\n");
 237     }
 238     return;
 239     # }}}
 240 } # msg()
 241
 242 __END__
 243
 244 # This program is free software; you can redistribute it and/or modify
 245 # it under the terms of the GNU General Public License as published by
 246 # the Free Software Foundation; either version 2 of the License, or (at
 247 # your option) any later version.
 248 #
 249 # This program is distributed in the hope that it will be useful, but
 250 # WITHOUT ANY WARRANTY; without even the implied warranty of
 251 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 252 # See the GNU General Public License for more details.
 253 #
 254 # You should have received a copy of the GNU General Public License
 255 # along with this program.
 256 # If not, see L<http://www.gnu.org/licenses/>.
 257
 258 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :