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