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