barcat

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