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