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