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 -s, --stat
 364
 365 Total statistics after all data.
 366
 367 =item -u, --unmodified
 368
 369 Do not reformat values, keeping leading whitespace.
 370 Keep original value alignment, which may be significant in some programs.
 371
 372 =item --value-length=<size>
 373
 374 Reserved space for numbers.
 375
 376 =item -w, --width=<columns>
 377
 378 Override the maximum number of columns to use.
 379 Appended graphics will extend to fill up the entire screen.
 380
 381 =item -h, --usage
 382
 383 Overview of available options.
 384
 385 =item --help
 386
 387 Full documentation
 388 rendered by perldoc.
 389
 390 =item --version
 391
 392 Version information.
 393
 394 =back
 395
 396 =head1 EXAMPLES
 397
 398 Draw a sine wave:
 399
 400     seq 30 | awk '{print sin($1/10)}' | barcat
 401
 402 Compare file sizes (with human-readable numbers):
 403
 404     du -d0 -b * | barcat -H
 405
 406 Memory usage of user processes with long names truncated:
 407
 408     ps xo %mem,pid,cmd | barcat -l40
 409
 410 Monitor network latency from prefixed results:
 411
 412     ping google.com | barcat -f'time=\K' -t
 413
 414 Commonly used after counting, for example users on the current server:
 415
 416     users | sed 's/ /\n/g' | sort | uniq -c | barcat
 417
 418 Letter frequencies in text files:
 419
 420     cat /usr/share/games/fortunes/*.u8 |
 421     perl -CS -nE 'say for grep length, split /\PL*/, uc' |
 422     sort | uniq -c | barcat
 423
 424 Number of HTTP requests per day:
 425
 426     cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat
 427
 428 Any kind of database query with counts, preserving returned alignment:
 429
 430     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
 431     psql -t | barcat -u
 432
 433 Earthquakes worldwide magnitude 1+ in the last 24 hours:
 434
 435     https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
 436     column -tns, | graph -f4 -u -l80%
 437
 438 External datasets, like movies per year:
 439
 440     curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
 441     perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
 442
 443 But please get I<jq> to process JSON
 444 and replace the manual selection by C<< jq '.[].year' >>.
 445
 446 Pokémon height comparison:
 447
 448     curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
 449     jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
 450
 451 USD/EUR exchange rate from CSV provided by the ECB:
 452
 453     curl https://sdw.ecb.europa.eu/export.do \
 454          -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
 455     grep '^[12]' | barcat -f',\K' --value-length=7
 456
 457 Total population history from the World Bank dataset (XML):
 458 External datasets, like total population in XML from the World Bank:
 459
 460     curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
 461     xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
 462     sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
 463
 464 And of course various Git statistics, such commit count by year:
 465
 466     git log --pretty=%ci | cut -b-4 | uniq -c | barcat
 467
 468 Or the top 3 most frequent authors with statistics over all:
 469
 470     git shortlog -sn | barcat -L3 -s
 471
 472 Activity of the last days (substitute date C<-v-{}d> on BSD):
 473
 474     ( git log --pretty=%ci --since=30day | cut -b-10
 475       seq 0 30 | xargs -i date +%F -d-{}day ) |
 476     sort | uniq -c | awk '$1--' | graph --spark
 477
 478 =head1 AUTHOR
 479
 480 Mischa POSLAWSKY <perl@shiar.org>
 481
 482 =head1 LICENSE
 483
 484 GPL3+.