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