5 use List::Util qw( min max sum );
6 use open qw( :std :utf8 );
7 use experimental qw( lexical_subs );
11 use Getopt::Long '2.33', qw( :config gnu_getopt );
15 'C' => sub { $opt{color} = 0 },
19 $opt{anchor} = /^[0-9]+$/ ? qr/(?:\S*\h+){$_}\K/ : qr/$_/;
20 } or die $@ =~ s/(?: at .+)?$/ for option $_[0]/r;
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"
39 my ($optname, $optval) = @_;
41 ($opt{hidemin}, $opt{hidemax}) =
42 $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die(
43 "Value \"$optval\" invalid for option limit",
49 'graph-format=s' => sub {
50 $opt{'graph-format'} = substr $_[1], 0, 1;
53 $opt{spark} = [split //, $_[1] || ' ▁▂▃▄▅▆▇█'];
57 fire => [qw( 90 31 91 33 93 97 96 )],
58 fire88 => [map {"38;5;$_"} qw(
59 80 32 48 64 68 72 76 77 78 79 47
61 fire256=> [map {"38;5;$_"} qw(
63 202 208 214 220 226 227 228 229 230 231 159
65 ramp88 => [map {"38;5;$_"} qw(
66 64 65 66 67 51 35 39 23 22 26 25 28
68 whites => [qw( 1;30 0;37 1;37 )],
69 greys => [map {"38;5;$_"} 52, 235..255, 47],
70 }->{$_[1]} // [ split /[^0-9;]/, $_[1] ];
77 say "barcat version $VERSION";
82 my $pod = readline *DATA;
83 $pod =~ s/^=over\K/ 22/m; # indent options list
84 $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
87 my $parser = Pod::Usage->new;
88 $parser->select('SYNOPSIS', 'OPTIONS');
89 $parser->output_string(\my $contents);
90 $parser->parse_string_document($pod);
92 $contents =~ s/\n(?=\n\h)//msg; # strip space between items
98 Pod::Usage::pod2usage(
99 -exitval => 0, -perldocopt => '-oman', -verbose => 2,
102 ) or exit 64; # EX_USAGE
104 $opt{width} ||= $ENV{COLUMNS} || qx(tput cols) || 80;
105 $opt{color} //= -t *STDOUT; # enable on tty
106 $opt{'graph-format'} //= '-';
107 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
108 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
109 $opt{anchor} //= qr/\A/;
110 $opt{'value-length'} = 6 if $opt{units};
111 $opt{'value-length'} = 1 if $opt{unmodified};
112 $opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT';
113 $opt{markers} //= '=avg >31.73v <68.27v +50v |0';
114 $opt{palette} //= $opt{color} && [31, 90, 32];
115 $opt{input} = @ARGV && $ARGV[0] =~ m/\A[-0-9]/ ? \@ARGV : undef;
117 my (@lines, @values, @order);
119 $SIG{$_} = \&show_stat for $opt{'signal-stat'} || ();
122 alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
124 $SIG{INT} = \&show_exit;
126 if (defined $opt{interval}) {
127 $opt{interval} ||= 1;
128 alarm $opt{interval} if $opt{interval} > 0;
131 require Tie::Array::Sorted;
132 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
133 } or warn $@, "Expect slowdown with large datasets!\n";
136 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
137 while (defined ($_ = $opt{input} ? shift @{ $opt{input} } : readline)) {
139 s/^\h*// unless $opt{unmodified};
140 push @values, s/$valmatch/\n/ && $1;
141 push @order, $1 if length $1;
142 if (defined $opt{trim} and defined $1) {
143 my $trimpos = abs $opt{trim};
144 $trimpos -= length $1 if $opt{unmodified};
146 $_ = substr $_, 0, 2;
148 elsif (length > $trimpos) {
149 substr($_, $trimpos - 1) = '…';
153 show_lines() if defined $opt{interval} and $opt{interval} < 0
154 and $. % $opt{interval} == 0;
157 $SIG{INT} = 'DEFAULT';
160 $opt{color} and defined $_[0] or return '';
161 return "\e[$_[0]m" if defined wantarray;
162 $_ = color(@_) . $_ . color(0) if defined;
167 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
168 @lines and @lines > $nr or return;
170 @lines > $nr or return unless $opt{hidemin};
172 @order = sort { $b <=> $a } @order unless tied @order;
173 my $maxval = $opt{maxval} // ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
174 my $minval = $opt{minval} // min $order[-1] // (), 0;
175 my $lenval = $opt{'value-length'} // max map { length } @order;
176 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
177 max map { length $values[$_] && length $lines[$_] }
178 0 .. min $#lines, $opt{hidemax} || (); # left padding
179 my $size = ($maxval - $minval) &&
180 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
183 if ($opt{markers} and $size > 0) {
184 for my $markspec (split /\h/, $opt{markers}) {
185 my ($char, $func) = split //, $markspec, 2;
187 if ($func eq 'avg') {
188 return sum(@order) / @order;
190 elsif ($func =~ /\A([0-9.]+)v\z/) {
191 my $index = $#order * $1 / 100;
192 return ($order[$index] + $order[$index + .5]) / 2;
199 color(36) for $barmark[$pos * $size] = $char;
202 state $lastmax = $maxval;
203 if ($maxval > $lastmax) {
204 print ' ' x ($lenval + $len);
207 ($lastmax - $minval) * $size + .5,
208 '-' x (($values[$nr - 1] - $minval) * $size);
210 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
216 @lines > $nr or return if $opt{hidemin};
219 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
220 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
222 $float && ($unit % 3) == ($unit < 0), # tenths
223 $_[0] / 1000 ** int($unit/3), # number
224 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
229 color(31), sprintf('%*s', $lenval, $minval),
230 color(90), '-', color(36), '+',
231 color(32), sprintf('%*s', $size * ($maxval - $minval) - 3, $maxval),
232 color(90), '-', color(36), '+',
236 while ($nr <= $#lines) {
237 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
238 my $val = $values[$nr];
239 my $rel = length $val && ($val - $minval) / ($maxval - $minval);
240 my $color = !length $val || !$opt{palette} ? undef :
241 $val == $order[0] ? $opt{palette}->[-1] : # max
242 $val == $order[-1] ? $opt{palette}->[0] : # min
243 $opt{palette}->[ $rel * ($#{$opt{palette}} - 1) + 1 ];
246 print color($color), $opt{spark}->[
248 $val == $order[0] ? -1 : # max
249 $val == $order[-1] ? 1 : # min
250 $#{$opt{spark}} < 3 ? 1 :
251 $rel * ($#{$opt{spark}} - 3) + 2.5
257 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
258 color($color) for $val;
260 my $line = $lines[$nr] =~ s/\n/$val/r;
261 printf '%-*s', $len + length($val), $line;
262 print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
268 say $opt{palette} ? color(0) : '' if $opt{spark};
273 if ($opt{hidemin} or $opt{hidemax}) {
275 $opt{hidemax} ||= @lines;
276 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
279 my $total = sum @order;
280 printf '%s total', color(1) . $total . color(0);
281 printf ' in %d values', scalar @values;
282 printf(' (%s min, %s avg, %s max)',
283 color(31) . $order[-1] . color(0),
284 color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
285 color(32) . $order[0] . color(0),
293 show_stat() if $opt{stat};
294 exit 130 if @_; # 0x80+signo
305 barcat - graph to visualize input values
309 B<barcat> [<options>] [<file>... | <numbers>]
313 Visualizes relative sizes of values read from input
314 (parameters, file(s) or STDIN).
315 Contents are concatenated similar to I<cat>,
316 but numbers are reformatted and a bar graph is appended to each line.
318 Don't worry, barcat does not drink and divide.
319 It can has various options for input and output (re)formatting,
320 but remains limited to one-dimensional charts.
321 For more complex graphing needs
322 you'll need a larger animal like I<gnuplot>.
328 =item -c, --[no-]color
330 Force colored output of values and bar markers.
331 Defaults on if output is a tty,
332 disabled otherwise such as when piped or redirected.
334 =item -f, --field=(<number>|<regexp>)
336 Compare values after a given number of whitespace separators,
337 or matching a regular expression.
339 Unspecified or I<-f0> means values are at the start of each line.
340 With I<-f1> the second word is taken instead.
341 A string can indicate the starting position of a value
342 (such as I<-f:> if preceded by colons),
343 or capture the numbers itself,
344 for example I<-f'(\d+)'> for the first digits anywhere.
348 Prepend a chart axis with minimum and maximum values labeled.
350 =item -H, --human-readable
352 Format values using SI unit prefixes,
353 turning long numbers like I<12356789> into I<12.4M>.
354 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
355 Short integers are aligned but kept without decimal point.
357 =item -t, --interval[=(<seconds>|-<lines>)]
359 Output partial progress every given number of seconds or input lines.
360 An update can also be forced by sending a I<SIGALRM> alarm signal.
362 =item -l, --length=[-]<size>[%]
364 Trim line contents (between number and bars)
365 to a maximum number of characters.
366 The exceeding part is replaced by an abbreviation sign,
367 unless C<--length=0>.
369 Prepend a dash (i.e. make negative) to enforce padding
370 regardless of encountered contents.
372 =item -L, --limit[=(<count> | <start>-[<end>])]
374 Stop output after a number of lines.
375 All input is still counted and analyzed for statistics,
376 but disregarded for padding and bar size.
378 =item --graph-format=<character>
380 Glyph to repeat for the graph line.
381 Defaults to a dash C<->.
383 =item -m, --markers=<format>
385 Statistical positions to indicate on bars.
386 A single indicator glyph precedes each position:
392 Exact value to match on the axis.
393 A vertical bar at the zero crossing is displayed by I<|0>
395 For example I<:3.14> would show a colon at pi.
397 =item <percentage>I<v>
399 Ranked value at the given percentile.
400 The default shows I<+> at I<50v> for the mean or median;
401 the middle value or average between middle values.
402 One standard deviation right of the mean is at about I<68.3v>.
403 The default includes I<< >31.73v <68.27v >>
404 to encompass all I<normal> results, or 68% of all entries, by B<< <--> >>.
409 the sum of all values divided by the number of counted lines.
410 Indicated by default as I<=>.
414 =item --min=<number>, --max=<number>
416 Bars extend from 0 or the minimum value if lower,
417 to the largest value encountered.
418 These options can be set to customize this range.
420 =item --palette=(<preset> | <color>...)
422 Override colors of parsed numbers.
423 Can be any CSI escape, such as I<90> for default dark grey,
424 or alternatively I<1;30> for bold black.
426 In case of additional colors,
427 the last is used for values equal to the maximum, the first for minima.
428 If unspecified, these are green and red respectively (I<31 90 32>).
430 =item --spark[=<glyphs>]
432 Replace lines by I<sparklines>,
433 single characters corresponding to input values.
434 A specified sequence of unicode characters will be used for
435 Of a specified sequence of unicode characters,
436 the first one will be used for non-values,
437 the last one for the maximum,
438 the second (if any) for the minimum,
439 and any remaining will be distributed over the range of values.
440 Unspecified, block fill glyphs U+2581-2588 will be used.
444 Total statistics after all data.
446 =item -u, --unmodified
448 Do not reformat values, keeping leading whitespace.
449 Keep original value alignment, which may be significant in some programs.
451 =item --value-length=<size>
453 Reserved space for numbers.
455 =item -w, --width=<columns>
457 Override the maximum number of columns to use.
458 Appended graphics will extend to fill up the entire screen.
462 Overview of available options.
479 seq 30 | awk '{print sin($1/10)}' | barcat
481 Compare file sizes (with human-readable numbers):
483 du -d0 -b * | barcat -H
485 Memory usage of user processes with long names truncated:
487 ps xo %mem,pid,cmd | barcat -l40
489 Monitor network latency from prefixed results:
491 ping google.com | barcat -f'time=\K' -t
493 Commonly used after counting, for example users on the current server:
495 users | sed 's/ /\n/g' | sort | uniq -c | barcat
497 Letter frequencies in text files:
499 cat /usr/share/games/fortunes/*.u8 |
500 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
501 sort | uniq -c | barcat
503 Number of HTTP requests per day:
505 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
507 Any kind of database query with counts, preserving returned alignment:
509 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
512 Earthquakes worldwide magnitude 1+ in the last 24 hours:
514 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
515 column -tns, | graph -f4 -u -l80%
517 External datasets, like movies per year:
519 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
520 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
522 But please get I<jq> to process JSON
523 and replace the manual selection by C<< jq '.[].year' >>.
525 Pokémon height comparison:
527 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
528 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
530 USD/EUR exchange rate from CSV provided by the ECB:
532 curl https://sdw.ecb.europa.eu/export.do \
533 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
534 grep '^[12]' | barcat -f',\K' --value-length=7
536 Total population history from the World Bank dataset (XML):
537 External datasets, like total population in XML from the World Bank:
539 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
540 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
541 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
543 And of course various Git statistics, such commit count by year:
545 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
547 Or the top 3 most frequent authors with statistics over all:
549 git shortlog -sn | barcat -L3 -s
551 Activity of the last days (substitute date C<-v-{}d> on BSD):
553 ( git log --pretty=%ci --since=30day | cut -b-10
554 seq 0 30 | xargs -i date +%F -d-{}day ) |
555 sort | uniq -c | awk '$1--' | graph --spark
559 Mischa POSLAWSKY <perl@shiar.org>