barcat

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