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