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