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