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