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
 360
 361 Replace lines by I<sparklines>,
 362 single characters corresponding to input values.
 363
 364 =item -s, --stat
 365
 366 Total statistics after all data.
 367
 368 =item -u, --unmodified
 369
 370 Do not reformat values, keeping leading whitespace.
 371 Keep original value alignment, which may be significant in some programs.
 372
 373 =item --value-length=<size>
 374
 375 Reserved space for numbers.
 376
 377 =item -w, --width=<columns>
 378
 379 Override the maximum number of columns to use.
 380 Appended graphics will extend to fill up the entire screen.
 381
 382 =item -h, --usage
 383
 384 Overview of available options.
 385
 386 =item --help
 387
 388 Full documentation
 389 rendered by perldoc.
 390
 391 =item --version
 392
 393 Version information.
 394
 395 =back
 396
 397 =head1 EXAMPLES
 398
 399 Draw a sine wave:
 400
 401     seq 30 | awk '{print sin($1/10)}' | barcat
 402
 403 Compare file sizes (with human-readable numbers):
 404
 405     du -d0 -b * | barcat -H
 406
 407 Memory usage of user processes with long names truncated:
 408
 409     ps xo %mem,pid,cmd | barcat -l40
 410
 411 Monitor network latency from prefixed results:
 412
 413     ping google.com | barcat -f'time=\K' -t
 414
 415 Commonly used after counting, for example users on the current server:
 416
 417     users | sed 's/ /\n/g' | sort | uniq -c | barcat
 418
 419 Letter frequencies in text files:
 420
 421     cat /usr/share/games/fortunes/*.u8 |
 422     perl -CS -nE 'say for grep length, split /\PL*/, uc' |
 423     sort | uniq -c | barcat
 424
 425 Number of HTTP requests per day:
 426
 427     cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat
 428
 429 Any kind of database query with counts, preserving returned alignment:
 430
 431     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
 432     psql -t | barcat -u
 433
 434 Earthquakes worldwide magnitude 1+ in the last 24 hours:
 435
 436     https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
 437     column -tns, | graph -f4 -u -l80%
 438
 439 External datasets, like movies per year:
 440
 441     curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
 442     perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
 443
 444 But please get I<jq> to process JSON
 445 and replace the manual selection by C<< jq '.[].year' >>.
 446
 447 Pokémon height comparison:
 448
 449     curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
 450     jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
 451
 452 USD/EUR exchange rate from CSV provided by the ECB:
 453
 454     curl https://sdw.ecb.europa.eu/export.do \
 455          -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
 456     grep '^[12]' | barcat -f',\K' --value-length=7
 457
 458 Total population history from the World Bank dataset (XML):
 459 External datasets, like total population in XML from the World Bank:
 460
 461     curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
 462     xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
 463     sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
 464
 465 And of course various Git statistics, such commit count by year:
 466
 467     git log --pretty=%ci | cut -b-4 | uniq -c | barcat
 468
 469 Or the top 3 most frequent authors with statistics over all:
 470
 471     git shortlog -sn | barcat -L3 -s
 472
 473 Activity of the last days (substitute date C<-v-{}d> on BSD):
 474
 475     ( git log --pretty=%ci --since=30day | cut -b-10
 476       seq 0 30 | xargs -i date +%F -d-{}day ) |
 477     sort | uniq -c | awk '$1--' | graph --spark
 478
 479 =head1 AUTHOR
 480
 481 Mischa POSLAWSKY <perl@shiar.org>
 482
 483 =head1 LICENSE
 484
 485 GPL3+.