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