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