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