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