barcat

   1 #!/usr/bin/perl -CA
   2 use 5.018;
   3 use warnings;
   4 use utf8;
   5 use List::Util qw( min max sum );
   6 use open qw( :std :utf8 );
   7 use experimental qw( lexical_subs );
   8
   9 our $VERSION = '1.05';
  10
  11 use Getopt::Long '2.33', qw( :config gnu_getopt );
  12 my %opt;
  13 GetOptions(\%opt,
  14         'color|c!',
  15         'C' => sub { $opt{color} = 0 },
  16         'field|f=s' => sub {
  17                 eval {
  18                         local $_ = $_[1];
  19                         $opt{anchor} = /^[0-9]+$/ ? qr/(?:\S*\h+){$_}\K/ : qr/$_/;
  20                 } or die $@ =~ s/(?: at .+)?$/ for option $_[0]/r;
  21         },
  22         'human-readable|H!',
  23         'interval|t:i',
  24         'trim|length|l=s' => sub {
  25                 my ($optname, $optval) = @_;
  26                 $optval =~ s/%$// and $opt{trimpct}++;
  27                 $optval =~ m/^-?[0-9]+$/ or die(
  28                         "Value \"$optval\" invalid for option $optname",
  29                         " (number or percentage expected)\n"
  30                 );
  31                 $opt{trim} = $optval;
  32         },
  33         'value-length=i',
  34         'hidemin=i',
  35         'hidemax=i',
  36         'limit|L=s' => sub {
  37                 my ($optname, $optval) = @_;
  38                 $optval ||= 0;
  39                 ($opt{hidemin}, $opt{hidemax}) =
  40                 $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die(
  41                         "Value \"$optval\" invalid for option limit",
  42                         " (range expected)\n"
  43                 );
  44         },
  45         'markers|m=s',
  46         'graph-format=s' => sub {
  47                 $opt{'graph-format'} = substr $_[1], 0, 1;
  48         },
  49         'spark:s' => sub {
  50                 $opt{spark} = [split //, $_[1] || '⎽▁▂▃▄▅▆▇█'];
  51         },
  52         'stat|s!',
  53         'signal-stat=s',
  54         'unmodified|u!',
  55         'width|w=i',
  56         'usage|h' => sub {
  57                 local $/;
  58                 my $pod = readline *DATA;
  59                 $pod =~ s/^=over\K/ 22/m;  # indent options list
  60                 $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
  61
  62                 require Pod::Usage;
  63                 my $parser = Pod::Usage->new;
  64                 $parser->select('SYNOPSIS', 'OPTIONS');
  65                 $parser->output_string(\my $contents);
  66                 $parser->parse_string_document($pod);
  67
  68                 $contents =~ s/\n(?=\n\h)//msg;  # strip space between items
  69                 print $contents;
  70                 exit;
  71         },
  72         'help|?'  => sub {
  73                 require Pod::Usage;
  74                 Pod::Usage::pod2usage(
  75                         -exitval => 0, -perldocopt => '-oman', -verbose => 2,
  76                 );
  77         },
  78 ) or exit 64;  # EX_USAGE
  79
  80 $opt{width} ||= $ENV{COLUMNS} || 80;
  81 $opt{color} //= -t *STDOUT;  # enable on tty
  82 $opt{'graph-format'} //= '-';
  83 $opt{trim}   *= $opt{width} / 100 if $opt{trimpct};
  84 $opt{units}   = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
  85 $opt{anchor} //= qr/\A/;
  86 $opt{'value-length'} = 6 if $opt{units};
  87 $opt{'value-length'} = 1 if $opt{unmodified};
  88 $opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT';
  89
  90 my (@lines, @values, @order);
  91
  92 $SIG{$_} = \&show_stat for $opt{'signal-stat'} || ();
  93 $SIG{ALRM} = sub {
  94         show_lines();
  95         alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
  96 };
  97
  98 if (defined $opt{interval}) {
  99         $opt{interval} ||= 1;
 100         alarm $opt{interval} if $opt{interval} > 0;
 101
 102         eval {
 103                 require Tie::Array::Sorted;
 104                 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
 105         } or warn $@, "Expect slowdown with large datasets!\n";
 106 }
 107
 108 $SIG{INT} = sub {
 109         $SIG{INT} = 'DEFAULT';  # reset for subsequent attempts
 110         exit if !$.;
 111         'IGNORE' # continue after assumed eof
 112 };
 113
 114 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
 115 while (readline) {
 116         s/\r?\n\z//;
 117         s/^\h*// unless $opt{unmodified};
 118         push @values, s/$valmatch/\n/ && $1;
 119         push @order, $1 if length $1;
 120         if (defined $opt{trim} and defined $1) {
 121                 my $trimpos = abs $opt{trim};
 122                 $trimpos -= length $1 if $opt{unmodified};
 123                 if ($trimpos <= 1) {
 124                         $_ = substr $_, 0, 2;
 125                 }
 126                 elsif (length > $trimpos) {
 127                         substr($_, $trimpos - 1) = '…';
 128                 }
 129         }
 130         push @lines, $_;
 131         show_lines() if defined $opt{interval} and $opt{interval} < 0
 132                 and $. % $opt{interval} == 0;
 133 }
 134
 135 $SIG{INT} = 'DEFAULT';
 136
 137 sub color {
 138         $opt{color} and defined $_[0] or return '';
 139         return "\e[$_[0]m" if defined wantarray;
 140         $_ = color(@_) . $_ . color(0) if defined;
 141 }
 142
 143 sub show_lines {
 144
 145 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
 146 @lines and @lines > $nr or return;
 147 @lines or return;
 148 @lines > $nr or return unless $opt{hidemin};
 149
 150 @order = sort { $b <=> $a } @order unless tied @order;
 151 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
 152 my $minval = min $order[-1] // (), 0;
 153 my $lenval = $opt{'value-length'} // max map { length } @order;
 154 my $len    = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
 155         max map { length $values[$_] && length $lines[$_] }
 156                 0 .. min $#lines, $opt{hidemax} || ();  # left padding
 157 my $size   = ($maxval - $minval) &&
 158         ($opt{width} - $lenval - $len) / ($maxval - $minval);  # bar multiplication
 159
 160 my @barmark;
 161 if ($opt{markers} // 1 and $size > 0) {
 162         my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
 163         $barmark[ (sum(@order) / @order - $minval) * $size ] = '=';  # average
 164         $barmark[ orderpos($#order * .31731) ] = '>';
 165         $barmark[ orderpos($#order * .68269) ] = '<';
 166         $barmark[ orderpos($#order / 2) ] = '+';  # mean
 167         $barmark[ -$minval * $size ] = '|' if $minval < 0;  # zero
 168         color(36) for @barmark;
 169
 170         state $lastmax = $maxval;
 171         if ($maxval > $lastmax) {
 172                 print ' ' x ($lenval + $len);
 173                 printf color(90);
 174                 printf '%-*s',
 175                         ($lastmax - $minval) * $size + .5,
 176                         '-' x (($values[$nr - 1] - $minval) * $size);
 177                 print color(92);
 178                 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
 179                 print color(0);
 180                 $lastmax = $maxval;
 181         }
 182 }
 183
 184 @lines > $nr or return if $opt{hidemin};
 185
 186 sub sival {
 187         my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
 188         my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
 189         sprintf('%3.*f%1s',
 190                 $float && ($unit % 3) == ($unit < 0),  # tenths
 191                 $_[0] / 1000 ** int($unit/3),   # number
 192                 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
 193         );
 194 }
 195
 196 while ($nr <= $#lines) {
 197         $nr >= $opt{hidemax} and last if defined $opt{hidemax};
 198         my $val = $values[$nr];
 199
 200         if ($opt{spark}) {
 201                 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
 202                 next;
 203         }
 204
 205         if (length $val) {
 206                 my $color = !$opt{color} ? undef :
 207                         $val == $order[0] ? 32 : # max
 208                         $val == $order[-1] ? 31 : # min
 209                         90;
 210                 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
 211                 color($color) for $val;
 212         }
 213         my $line = $lines[$nr] =~ s/\n/$val/r;
 214         printf '%-*s', $len + length($val), $line;
 215         print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
 216         say '';
 217 }
 218 continue {
 219         $nr++;
 220 }
 221 say '' if $opt{spark};
 222
 223 }
 224 show_lines();
 225
 226 sub show_stat {
 227         if ($opt{hidemin} or $opt{hidemax}) {
 228                 $opt{hidemin} ||= 1;
 229                 $opt{hidemax} ||= @lines;
 230                 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
 231         }
 232         if (@order) {
 233                 my $total = sum @order;
 234                 printf '%s total', color(1) . $total . color(0);
 235                 printf ' in %d values', scalar @values;
 236                 printf(' (%s min, %s avg, %s max)',
 237                         color(31) . $order[-1] . color(0),
 238                         color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
 239                         color(32) . $order[0] . color(0),
 240                 );
 241         }
 242         say '';
 243 }
 244 show_stat() if $opt{stat};
 245
 246 __END__
 247 =encoding utf8
 248
 249 =head1 NAME
 250
 251 barcat - graph to visualize input values
 252
 253 =head1 SYNOPSIS
 254
 255 B<barcat> [<options>] [<input>]
 256
 257 =head1 DESCRIPTION
 258
 259 Visualizes relative sizes of values read from input (file(s) or STDIN).
 260 Contents are concatenated similar to I<cat>,
 261 but numbers are reformatted and a bar graph is appended to each line.
 262
 263 Don't worry, barcat does not drink and divide.
 264 It can has various options for input and output (re)formatting,
 265 but remains limited to one-dimensional charts.
 266 For more complex graphing needs
 267 you'll need a larger animal like I<gnuplot>.
 268
 269 =head1 OPTIONS
 270
 271 =over
 272
 273 =item -c, --[no-]color
 274
 275 Force colored output of values and bar markers.
 276 Defaults on if output is a tty,
 277 disabled otherwise such as when piped or redirected.
 278
 279 =item -f, --field=(<number>|<regexp>)
 280
 281 Compare values after a given number of whitespace separators,
 282 or matching a regular expression.
 283
 284 Unspecified or I<-f0> means values are at the start of each line.
 285 With I<-f1> the second word is taken instead.
 286 A string can indicate the starting position of a value
 287 (such as I<-f:> if preceded by colons),
 288 or capture the numbers itself,
 289 for example I<-f'(\d+)'> for the first digits anywhere.
 290
 291 =item -H, --human-readable
 292
 293 Format values using SI unit prefixes,
 294 turning long numbers like I<12356789> into I<12.4M>.
 295 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
 296 Short integers are aligned but kept without decimal point.
 297
 298 =item -t, --interval[=(<seconds>|-<lines>)]
 299
 300 Output partial progress every given number of seconds or input lines.
 301 An update can also be forced by sending a I<SIGALRM> alarm signal.
 302
 303 =item -l, --length=[-]<size>[%]
 304
 305 Trim line contents (between number and bars)
 306 to a maximum number of characters.
 307 The exceeding part is replaced by an abbreviation sign,
 308 unless C<--length=0>.
 309
 310 Prepend a dash (i.e. make negative) to enforce padding
 311 regardless of encountered contents.
 312
 313 =item -L, --limit=(<count>|<start>-[<end>])
 314
 315 Stop output after a number of lines.
 316 All input is still counted and analyzed for statistics,
 317 but disregarded for padding and bar size.
 318
 319 =item --graph-format=<character>
 320
 321 Glyph to repeat for the graph line.
 322 Defaults to a dash C<->.
 323
 324 =item -m, --markers=
 325
 326 Statistical positions to indicate on bars.
 327 Cannot be customized yet,
 328 only disabled by providing an empty argument.
 329
 330 Any value enables all marker characters:
 331
 332 =over 2
 333
 334 =item B<=>
 335
 336 Average:
 337 the sum of all values divided by the number of counted lines.
 338
 339 =item B<+>
 340
 341 Mean, median:
 342 the middle value or average between middle values.
 343
 344 =item B<<>
 345
 346 Standard deviation left of the mean.
 347 Only 16% of all values are lower.
 348
 349 =item B<< > >>
 350
 351 Standard deviation right of the mean.
 352 The part between B<< <--> >> encompass all I<normal> results,
 353 or 68% of all entries.
 354
 355 =back
 356
 357 =item -s, --stat
 358
 359 Total statistics after all data.
 360
 361 =item -u, --unmodified
 362
 363 Do not reformat values, keeping leading whitespace.
 364 Keep original value alignment, which may be significant in some programs.
 365
 366 =item --value-length=<size>
 367
 368 Reserved space for numbers.
 369
 370 =item -w, --width=<columns>
 371
 372 Override the maximum number of columns to use.
 373 Appended graphics will extend to fill up the entire screen.
 374
 375 =item -h, --usage
 376
 377 Overview of available options.
 378
 379 =item --help
 380
 381 Full documentation
 382 rendered by perldoc.
 383
 384 =item --version
 385
 386 Version information.
 387
 388 =back
 389
 390 =head1 EXAMPLES
 391
 392 Draw a sine wave:
 393
 394     seq 30 | awk '{print sin($1/10)}' | barcat
 395
 396 Compare file sizes (with human-readable numbers):
 397
 398     du -d0 -b * | barcat -H
 399
 400 Memory usage of user processes with long names truncated:
 401
 402     ps xo %mem,pid,cmd | barcat -l40
 403
 404 Monitor network latency from prefixed results:
 405
 406     ping google.com | barcat -f'time=\K' -t
 407
 408 Commonly used after counting, for example users on the current server:
 409
 410     users | sed 's/ /\n/g' | sort | uniq -c | barcat
 411
 412 Letter frequencies in text files:
 413
 414     cat /usr/share/games/fortunes/*.u8 |
 415     perl -CS -nE 'say for grep length, split /\PL*/, uc' |
 416     sort | uniq -c | barcat
 417
 418 Number of HTTP requests per day:
 419
 420     cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat
 421
 422 Any kind of database query with counts, preserving returned alignment:
 423
 424     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
 425     psql -t | barcat -u
 426
 427 Earthquakes worldwide magnitude 1+ in the last 24 hours:
 428
 429     https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
 430     column -tns, | graph -f4 -u -l80%
 431
 432 External datasets, like movies per year:
 433
 434     curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
 435     perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
 436
 437 But please get I<jq> to process JSON
 438 and replace the manual selection by C<< jq '.[].year' >>.
 439
 440 Pokémon height comparison:
 441
 442     curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
 443     jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
 444
 445 USD/EUR exchange rate from CSV provided by the ECB:
 446
 447     curl https://sdw.ecb.europa.eu/export.do \
 448          -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
 449     grep '^[12]' | barcat -f',\K' --value-length=7
 450
 451 Total population history from the World Bank dataset (XML):
 452 External datasets, like total population in XML from the World Bank:
 453
 454     curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
 455     xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
 456     sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
 457
 458 And of course various Git statistics, such commit count by year:
 459
 460     git log --pretty=%ci | cut -b-4 | uniq -c | barcat
 461
 462 Or the top 3 most frequent authors with statistics over all:
 463
 464     git shortlog -sn | barcat -L3 -s
 465
 466 Activity of the last days (substitute date C<-v-{}d> on BSD):
 467
 468     ( git log --pretty=%ci --since=30day | cut -b-10
 469       seq 0 30 | xargs -i date +%F -d-{}day ) |
 470     sort | uniq -c | awk '$1--' | graph --spark
 471
 472 =head1 AUTHOR
 473
 474 Mischa POSLAWSKY <perl@shiar.org>
 475
 476 =head1 LICENSE
 477
 478 GPL3+.