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