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