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