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