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-+', $lenval, $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 --header
 301
 302 Prepend a chart axis with minimum and maximum values labeled.
 303
 304 =item -H, --human-readable
 305
 306 Format values using SI unit prefixes,
 307 turning long numbers like I<12356789> into I<12.4M>.
 308 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
 309 Short integers are aligned but kept without decimal point.
 310
 311 =item -t, --interval[=(<seconds>|-<lines>)]
 312
 313 Output partial progress every given number of seconds or input lines.
 314 An update can also be forced by sending a I<SIGALRM> alarm signal.
 315
 316 =item -l, --length=[-]<size>[%]
 317
 318 Trim line contents (between number and bars)
 319 to a maximum number of characters.
 320 The exceeding part is replaced by an abbreviation sign,
 321 unless C<--length=0>.
 322
 323 Prepend a dash (i.e. make negative) to enforce padding
 324 regardless of encountered contents.
 325
 326 =item -L, --limit=(<count>|<start>-[<end>])
 327
 328 Stop output after a number of lines.
 329 All input is still counted and analyzed for statistics,
 330 but disregarded for padding and bar size.
 331
 332 =item --graph-format=<character>
 333
 334 Glyph to repeat for the graph line.
 335 Defaults to a dash C<->.
 336
 337 =item -m, --markers=
 338
 339 Statistical positions to indicate on bars.
 340 Cannot be customized yet,
 341 only disabled by providing an empty argument.
 342
 343 Any value enables all marker characters:
 344
 345 =over 2
 346
 347 =item B<=>
 348
 349 Average:
 350 the sum of all values divided by the number of counted lines.
 351
 352 =item B<+>
 353
 354 Mean, median:
 355 the middle value or average between middle values.
 356
 357 =item B<<>
 358
 359 Standard deviation left of the mean.
 360 Only 16% of all values are lower.
 361
 362 =item B<< > >>
 363
 364 Standard deviation right of the mean.
 365 The part between B<< <--> >> encompass all I<normal> results,
 366 or 68% of all entries.
 367
 368 =back
 369
 370 =item --spark[=<glyphs>]
 371
 372 Replace lines by I<sparklines>,
 373 single characters corresponding to input values.
 374 A specified sequence of unicode characters will be used for
 375 Of a specified sequence of unicode characters,
 376 the first one will be used for non-values,
 377 the last one for the maximum,
 378 the second (if any) for the minimum,
 379 and any remaining will be distributed over the range of values.
 380 Unspecified, block fill glyphs U+2581-2588 will be used.
 381
 382 =item -s, --stat
 383
 384 Total statistics after all data.
 385
 386 =item -u, --unmodified
 387
 388 Do not reformat values, keeping leading whitespace.
 389 Keep original value alignment, which may be significant in some programs.
 390
 391 =item --value-length=<size>
 392
 393 Reserved space for numbers.
 394
 395 =item -w, --width=<columns>
 396
 397 Override the maximum number of columns to use.
 398 Appended graphics will extend to fill up the entire screen.
 399
 400 =item -h, --usage
 401
 402 Overview of available options.
 403
 404 =item --help
 405
 406 Full documentation
 407 rendered by perldoc.
 408
 409 =item --version
 410
 411 Version information.
 412
 413 =back
 414
 415 =head1 EXAMPLES
 416
 417 Draw a sine wave:
 418
 419     seq 30 | awk '{print sin($1/10)}' | barcat
 420
 421 Compare file sizes (with human-readable numbers):
 422
 423     du -d0 -b * | barcat -H
 424
 425 Memory usage of user processes with long names truncated:
 426
 427     ps xo %mem,pid,cmd | barcat -l40
 428
 429 Monitor network latency from prefixed results:
 430
 431     ping google.com | barcat -f'time=\K' -t
 432
 433 Commonly used after counting, for example users on the current server:
 434
 435     users | sed 's/ /\n/g' | sort | uniq -c | barcat
 436
 437 Letter frequencies in text files:
 438
 439     cat /usr/share/games/fortunes/*.u8 |
 440     perl -CS -nE 'say for grep length, split /\PL*/, uc' |
 441     sort | uniq -c | barcat
 442
 443 Number of HTTP requests per day:
 444
 445     cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat
 446
 447 Any kind of database query with counts, preserving returned alignment:
 448
 449     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
 450     psql -t | barcat -u
 451
 452 Earthquakes worldwide magnitude 1+ in the last 24 hours:
 453
 454     https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
 455     column -tns, | graph -f4 -u -l80%
 456
 457 External datasets, like movies per year:
 458
 459     curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
 460     perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
 461
 462 But please get I<jq> to process JSON
 463 and replace the manual selection by C<< jq '.[].year' >>.
 464
 465 Pokémon height comparison:
 466
 467     curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
 468     jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
 469
 470 USD/EUR exchange rate from CSV provided by the ECB:
 471
 472     curl https://sdw.ecb.europa.eu/export.do \
 473          -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
 474     grep '^[12]' | barcat -f',\K' --value-length=7
 475
 476 Total population history from the World Bank dataset (XML):
 477 External datasets, like total population in XML from the World Bank:
 478
 479     curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
 480     xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
 481     sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
 482
 483 And of course various Git statistics, such commit count by year:
 484
 485     git log --pretty=%ci | cut -b-4 | uniq -c | barcat
 486
 487 Or the top 3 most frequent authors with statistics over all:
 488
 489     git shortlog -sn | barcat -L3 -s
 490
 491 Activity of the last days (substitute date C<-v-{}d> on BSD):
 492
 493     ( git log --pretty=%ci --since=30day | cut -b-10
 494       seq 0 30 | xargs -i date +%F -d-{}day ) |
 495     sort | uniq -c | awk '$1--' | graph --spark
 496
 497 =head1 AUTHOR
 498
 499 Mischa POSLAWSKY <perl@shiar.org>
 500
 501 =head1 LICENSE
 502
 503 GPL3+.