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