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