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 sprintf ' %*s-+%*s-+', $len, $minval, $size * ($maxval - $minval) - 3, $maxval if $opt{header};
 197
 198 while ($nr <= $#lines) {
 199         $nr >= $opt{hidemax} and last if defined $opt{hidemax};
 200         my $val = $values[$nr];
 201
 202         if ($opt{spark}) {
 203                 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
 204                 next;
 205         }
 206
 207         if (length $val) {
 208                 my $color = !$opt{color} ? undef :
 209                         $val == $order[0] ? 32 : # max
 210                         $val == $order[-1] ? 31 : # min
 211                         90;
 212                 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
 213                 color($color) for $val;
 214         }
 215         my $line = $lines[$nr] =~ s/\n/$val/r;
 216         printf '%-*s', $len + length($val), $line;
 217         print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
 218         say '';
 219 }
 220 continue {
 221         $nr++;
 222 }
 223 say '' if $opt{spark};
 224
 225 }
 226
 227 sub show_stat {
 228         if ($opt{hidemin} or $opt{hidemax}) {
 229                 $opt{hidemin} ||= 1;
 230                 $opt{hidemax} ||= @lines;
 231                 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
 232         }
 233         if (@order) {
 234                 my $total = sum @order;
 235                 printf '%s total', color(1) . $total . color(0);
 236                 printf ' in %d values', scalar @values;
 237                 printf(' (%s min, %s avg, %s max)',
 238                         color(31) . $order[-1] . color(0),
 239                         color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
 240                         color(32) . $order[0] . color(0),
 241                 );
 242         }
 243         say '';
 244 }
 245
 246 sub show_exit {
 247         show_lines();
 248         show_stat() if $opt{stat};
 249         exit 130 if @_;  # 0x80+signo
 250         exit;
 251 }
 252
 253 show_exit();
 254
 255 __END__
 256 =encoding utf8
 257
 258 =head1 NAME
 259
 260 barcat - graph to visualize input values
 261
 262 =head1 SYNOPSIS
 263
 264 B<barcat> [<options>] [<input>]
 265
 266 =head1 DESCRIPTION
 267
 268 Visualizes relative sizes of values read from input (file(s) or STDIN).
 269 Contents are concatenated similar to I<cat>,
 270 but numbers are reformatted and a bar graph is appended to each line.
 271
 272 Don't worry, barcat does not drink and divide.
 273 It can has various options for input and output (re)formatting,
 274 but remains limited to one-dimensional charts.
 275 For more complex graphing needs
 276 you'll need a larger animal like I<gnuplot>.
 277
 278 =head1 OPTIONS
 279
 280 =over
 281
 282 =item -c, --[no-]color
 283
 284 Force colored output of values and bar markers.
 285 Defaults on if output is a tty,
 286 disabled otherwise such as when piped or redirected.
 287
 288 =item -f, --field=(<number>|<regexp>)
 289
 290 Compare values after a given number of whitespace separators,
 291 or matching a regular expression.
 292
 293 Unspecified or I<-f0> means values are at the start of each line.
 294 With I<-f1> the second word is taken instead.
 295 A string can indicate the starting position of a value
 296 (such as I<-f:> if preceded by colons),
 297 or capture the numbers itself,
 298 for example I<-f'(\d+)'> for the first digits anywhere.
 299
 300 =item -H, --human-readable
 301
 302 Format values using SI unit prefixes,
 303 turning long numbers like I<12356789> into I<12.4M>.
 304 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
 305 Short integers are aligned but kept without decimal point.
 306
 307 =item -t, --interval[=(<seconds>|-<lines>)]
 308
 309 Output partial progress every given number of seconds or input lines.
 310 An update can also be forced by sending a I<SIGALRM> alarm signal.
 311
 312 =item -l, --length=[-]<size>[%]
 313
 314 Trim line contents (between number and bars)
 315 to a maximum number of characters.
 316 The exceeding part is replaced by an abbreviation sign,
 317 unless C<--length=0>.
 318
 319 Prepend a dash (i.e. make negative) to enforce padding
 320 regardless of encountered contents.
 321
 322 =item -L, --limit=(<count>|<start>-[<end>])
 323
 324 Stop output after a number of lines.
 325 All input is still counted and analyzed for statistics,
 326 but disregarded for padding and bar size.
 327
 328 =item --graph-format=<character>
 329
 330 Glyph to repeat for the graph line.
 331 Defaults to a dash C<->.
 332
 333 =item -m, --markers=
 334
 335 Statistical positions to indicate on bars.
 336 Cannot be customized yet,
 337 only disabled by providing an empty argument.
 338
 339 Any value enables all marker characters:
 340
 341 =over 2
 342
 343 =item B<=>
 344
 345 Average:
 346 the sum of all values divided by the number of counted lines.
 347
 348 =item B<+>
 349
 350 Mean, median:
 351 the middle value or average between middle values.
 352
 353 =item B<<>
 354
 355 Standard deviation left of the mean.
 356 Only 16% of all values are lower.
 357
 358 =item B<< > >>
 359
 360 Standard deviation right of the mean.
 361 The part between B<< <--> >> encompass all I<normal> results,
 362 or 68% of all entries.
 363
 364 =back
 365
 366 =item -s, --stat
 367
 368 Total statistics after all data.
 369
 370 =item -u, --unmodified
 371
 372 Do not reformat values, keeping leading whitespace.
 373 Keep original value alignment, which may be significant in some programs.
 374
 375 =item --value-length=<size>
 376
 377 Reserved space for numbers.
 378
 379 =item -w, --width=<columns>
 380
 381 Override the maximum number of columns to use.
 382 Appended graphics will extend to fill up the entire screen.
 383
 384 =item -h, --usage
 385
 386 Overview of available options.
 387
 388 =item --help
 389
 390 Full documentation
 391 rendered by perldoc.
 392
 393 =item --version
 394
 395 Version information.
 396
 397 =back
 398
 399 =head1 EXAMPLES
 400
 401 Draw a sine wave:
 402
 403     seq 30 | awk '{print sin($1/10)}' | barcat
 404
 405 Compare file sizes (with human-readable numbers):
 406
 407     du -d0 -b * | barcat -H
 408
 409 Memory usage of user processes with long names truncated:
 410
 411     ps xo %mem,pid,cmd | barcat -l40
 412
 413 Monitor network latency from prefixed results:
 414
 415     ping google.com | barcat -f'time=\K' -t
 416
 417 Commonly used after counting, for example users on the current server:
 418
 419     users | sed 's/ /\n/g' | sort | uniq -c | barcat
 420
 421 Letter frequencies in text files:
 422
 423     cat /usr/share/games/fortunes/*.u8 |
 424     perl -CS -nE 'say for grep length, split /\PL*/, uc' |
 425     sort | uniq -c | barcat
 426
 427 Number of HTTP requests per day:
 428
 429     cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat
 430
 431 Any kind of database query with counts, preserving returned alignment:
 432
 433     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
 434     psql -t | barcat -u
 435
 436 Earthquakes worldwide magnitude 1+ in the last 24 hours:
 437
 438     https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
 439     column -tns, | graph -f4 -u -l80%
 440
 441 External datasets, like movies per year:
 442
 443     curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
 444     perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
 445
 446 But please get I<jq> to process JSON
 447 and replace the manual selection by C<< jq '.[].year' >>.
 448
 449 Pokémon height comparison:
 450
 451     curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
 452     jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
 453
 454 USD/EUR exchange rate from CSV provided by the ECB:
 455
 456     curl https://sdw.ecb.europa.eu/export.do \
 457          -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
 458     grep '^[12]' | barcat -f',\K' --value-length=7
 459
 460 Total population history from the World Bank dataset (XML):
 461 External datasets, like total population in XML from the World Bank:
 462
 463     curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
 464     xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
 465     sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
 466
 467 And of course various Git statistics, such commit count by year:
 468
 469     git log --pretty=%ci | cut -b-4 | uniq -c | barcat
 470
 471 Or the top 3 most frequent authors with statistics over all:
 472
 473     git shortlog -sn | barcat -L3 -s
 474
 475 Activity of the last days (substitute date C<-v-{}d> on BSD):
 476
 477     ( git log --pretty=%ci --since=30day | cut -b-10
 478       seq 0 30 | xargs -i date +%F -d-{}day ) |
 479     sort | uniq -c | awk '$1--' | graph --spark
 480
 481 =head1 AUTHOR
 482
 483 Mischa POSLAWSKY <perl@shiar.org>
 484
 485 =head1 LICENSE
 486
 487 GPL3+.