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