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