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