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