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