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