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