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                 # abbreviate <variable> indicators
  86                 $pod =~ s/\Q>.../s>/g;
  87                 $pod =~ s/<(?:number|count|seconds)>/N/g;
  88                 $pod =~ s/<character(s?)>/\Uchar$1/g;
  89                 $pod =~ s/\Q | /|/g;
  90                 $pod =~ s/(?<!\w)<([a-z]+)>/\U$1/g;  # uppercase
  91
  92                 require Pod::Usage;
  93                 my $parser = Pod::Usage->new(USAGE_OPTIONS => {
  94                         -indent => 2, -width => 78,
  95                 });
  96                 $parser->select('SYNOPSIS', 'OPTIONS');
  97                 $parser->output_string(\my $contents);
  98                 $parser->parse_string_document($pod);
  99
 100                 $contents =~ s/\n(?=\n\h)//msg;  # strip space between items
 101                 print $contents;
 102                 exit;
 103         },
 104         'help|?'  => sub {
 105                 require Pod::Usage;
 106                 Pod::Usage::pod2usage(
 107                         -exitval => 0, -perldocopt => '-oman', -verbose => 2,
 108                 );
 109         },
 110 ) or exit 64;  # EX_USAGE
 111
 112 $opt{width} ||= $ENV{COLUMNS} || qx(tput cols) || 80 unless $opt{spark};
 113 $opt{color} //= -t *STDOUT;  # enable on tty
 114 $opt{'graph-format'} //= '-';
 115 $opt{trim}   *= $opt{width} / 100 if $opt{trimpct};
 116 $opt{units}   = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
 117 $opt{anchor} //= qr/\A/;
 118 $opt{'value-length'} = 6 if $opt{units};
 119 $opt{'value-length'} = 1 if $opt{unmodified};
 120 $opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT';
 121 $opt{markers} //= '=avg >31.73v <68.27v +50v |0';
 122 $opt{palette} //= $opt{color} && [31, 90, 32];
 123 $opt{input} = @ARGV && $ARGV[0] =~ m/\A[-0-9]/ ? \@ARGV : undef
 124         and undef $opt{interval};
 125
 126 my (@lines, @values, @order);
 127
 128 $SIG{$_} = \&show_stat for $opt{'signal-stat'} || ();
 129 $SIG{ALRM} = sub {
 130         show_lines();
 131         alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
 132 };
 133 $SIG{INT} = \&show_exit;
 134
 135 if (defined $opt{interval}) {
 136         $opt{interval} ||= 1;
 137         alarm $opt{interval} if $opt{interval} > 0;
 138
 139         eval {
 140                 require Tie::Array::Sorted;
 141                 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
 142         } or warn $@, "Expect slowdown with large datasets!\n";
 143 }
 144
 145 my $valmatch = qr<
 146         $opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)
 147 >x;
 148 while (defined ($_ = $opt{input} ? shift @{ $opt{input} } : readline)) {
 149         s/\r?\n\z//;
 150         s/^\h*// unless $opt{unmodified};
 151         push @values, s/$valmatch/\n/ && $1;
 152         push @order, $1 if length $1;
 153         if (defined $opt{trim} and defined $1) {
 154                 my $trimpos = abs $opt{trim};
 155                 $trimpos -= length $1 if $opt{unmodified};
 156                 if ($trimpos <= 1) {
 157                         $_ = substr $_, 0, 2;
 158                 }
 159                 elsif (length > $trimpos) {
 160                         substr($_, $trimpos - 1) = '…';
 161                 }
 162         }
 163         push @lines, $_;
 164         show_lines() if defined $opt{interval} and $opt{interval} < 0
 165                 and $. % $opt{interval} == 0;
 166 }
 167
 168 if ($opt{'zero-missing'}) {
 169         push @values, (0) x 10;
 170 }
 171
 172 $SIG{INT} = 'DEFAULT';
 173
 174 sub color {
 175         $opt{color} and defined $_[0] or return '';
 176         return "\e[$_[0]m" if defined wantarray;
 177         $_ = color(@_) . $_ . color(0) if defined;
 178 }
 179
 180 sub show_lines {
 181
 182 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
 183 @lines and @lines > $nr or return;
 184 @lines or return;
 185 @lines > $nr or return unless $opt{hidemin};
 186
 187 @order = sort { $b <=> $a } @order unless tied @order;
 188 my $maxval = $opt{maxval} // (
 189         $opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] :
 190         $order[0]
 191 ) // 0;
 192 my $minval = $opt{minval} // min $order[-1] // (), 0;
 193 my $range = $maxval - $minval;
 194 my $lenval = $opt{'value-length'} // max map { length } @order;
 195 my $len    = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
 196         max map { length $values[$_] && length $lines[$_] }
 197                 0 .. min $#lines, $opt{hidemax} || ();  # left padding
 198 my $size   = $range &&
 199         ($opt{width} - $lenval - $len) / $range;  # bar multiplication
 200
 201 my @barmark;
 202 if ($opt{markers} and $size > 0) {
 203         for my $markspec (split /\h/, $opt{markers}) {
 204                 my ($char, $func) = split //, $markspec, 2;
 205                 my $pos = eval {
 206                         if ($func eq 'avg') {
 207                                 return sum(@order) / @order;
 208                         }
 209                         elsif ($func =~ /\A([0-9.]+)v\z/) {
 210                                 my $index = $#order * $1 / 100;
 211                                 return ($order[$index] + $order[$index + .5]) / 2;
 212                         }
 213                         else {
 214                                 return $func;
 215                         }
 216                 } - $minval;
 217                 $pos >= 0 or next;
 218                 color(36) for $barmark[$pos * $size] = $char;
 219         }
 220
 221         state $lastmax = $maxval;
 222         if ($maxval > $lastmax) {
 223                 print ' ' x ($lenval + $len);
 224                 printf color(90);
 225                 printf '%-*s',
 226                         ($lastmax - $minval) * $size + .5,
 227                         '-' x (($values[$nr - 1] - $minval) * $size);
 228                 print color(92);
 229                 say '+' x (($range - $lastmax) * $size + .5);
 230                 print color(0);
 231                 $lastmax = $maxval;
 232         }
 233 }
 234
 235 @lines > $nr or return if $opt{hidemin};
 236
 237 sub sival {
 238         my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
 239         my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
 240         sprintf('%3.*f%1s',
 241                 $float && ($unit % 3) == ($unit < 0),  # tenths
 242                 $_[0] / 1000 ** int($unit/3),   # number
 243                 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
 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                 $opt{hidemin} ||= 1;
 296                 $opt{hidemax} ||= @lines;
 297                 printf '%s of ', sum(grep {length} @values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 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 bold 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
 452 =item --spark[=<glyphs>]
 453
 454 Replace lines by I<sparklines>,
 455 single characters corresponding to input values.
 456 A specified sequence of unicode characters will be used for
 457 Of a specified sequence of unicode characters,
 458 the first one will be used for non-values,
 459 the last one for the maximum,
 460 the second (if any) for the minimum,
 461 and any remaining will be distributed over the range of values.
 462 Unspecified, block fill glyphs U+2581-2588 will be used.
 463
 464 =item -s, --stat
 465
 466 Total statistics after all data.
 467
 468 =item -u, --unmodified
 469
 470 Do not reformat values, keeping leading whitespace.
 471 Keep original value alignment, which may be significant in some programs.
 472
 473 =item --value-length=<size>
 474
 475 Reserved space for numbers.
 476
 477 =item -w, --width=<columns>
 478
 479 Override the maximum number of columns to use.
 480 Appended graphics will extend to fill up the entire screen.
 481
 482 =item -h, --usage
 483
 484 Overview of available options.
 485
 486 =item --help
 487
 488 Full documentation
 489 rendered by perldoc.
 490
 491 =item --version
 492
 493 Version information.
 494
 495 =back
 496
 497 =head1 EXAMPLES
 498
 499 Draw a sine wave:
 500
 501     seq 30 | awk '{print sin($1/10)}' | barcat
 502
 503 Compare file sizes (with human-readable numbers):
 504
 505     du -d0 -b * | barcat -H
 506
 507 Memory usage of user processes with long names truncated:
 508
 509     ps xo %mem,pid,cmd | barcat -l40
 510
 511 Monitor network latency from prefixed results:
 512
 513     ping google.com | barcat -f'time=\K' -t
 514
 515 Commonly used after counting, for example users on the current server:
 516
 517     users | tr ' ' '\n' | sort | uniq -c | barcat
 518
 519 Letter frequencies in text files:
 520
 521     cat /usr/share/games/fortunes/*.u8 |
 522     perl -CS -nE 'say for grep length, split /\PL*/, uc' |
 523     sort | uniq -c | barcat
 524
 525 Number of HTTP requests per day:
 526
 527     cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat
 528
 529 Any kind of database query with counts, preserving returned alignment:
 530
 531     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
 532     psql -t | barcat -u
 533
 534 Earthquakes worldwide magnitude 1+ in the last 24 hours:
 535
 536     https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
 537     column -tns, | graph -f4 -u -l80%
 538
 539 External datasets, like movies per year:
 540
 541     curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
 542     perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
 543
 544 But please get I<jq> to process JSON
 545 and replace the manual selection by C<< jq '.[].year' >>.
 546
 547 Pokémon height comparison:
 548
 549     curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
 550     jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
 551
 552 USD/EUR exchange rate from CSV provided by the ECB:
 553
 554     curl https://sdw.ecb.europa.eu/export.do \
 555          -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
 556     grep '^[12]' | barcat -f',\K' --value-length=7
 557
 558 Total population history in XML from the World Bank:
 559
 560     curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
 561     xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
 562     sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
 563
 564 And of course various Git statistics, such commit count by year:
 565
 566     git log --pretty=%ci | cut -b-4 | uniq -c | barcat
 567
 568 Or the top 3 most frequent authors with statistics over all:
 569
 570     git shortlog -sn | barcat -L3 -s
 571
 572 Sparkline graphics of simple input given as inline parameters:
 573
 574         barcat --spark= 3 1 4 1 5 0 9 2 4
 575
 576 Activity graph of the last days (substitute date C<-v-{}d> on BSD):
 577
 578     ( git log --pretty=%ci --since=30day | cut -b-10
 579       seq 0 30 | xargs -i date +%F -d-{}day ) |
 580     sort | uniq -c | awk '$1--' | graph --spark
 581
 582 =head1 AUTHOR
 583
 584 Mischa POSLAWSKY <perl@shiar.org>
 585
 586 =head1 LICENSE
 587
 588 GPL3+.