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