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