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