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