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