5 use List::Util qw( min max sum );
6 use open qw( :std :utf8 );
10 use Getopt::Long '2.33', qw( :config gnu_getopt );
14 'C' => sub { $opt{color} = 0 },
18 $opt{anchor} = /^[0-9]+$/ ? qr/(?:\S*\h+){$_}\K/ : qr/$_/;
19 } or die $@ =~ s/(?: at .+)?$/ for option $_[0]/r;
23 'trim|length|l=s' => sub {
24 my ($optname, $optval) = @_;
25 $optval =~ s/%$// and $opt{trimpct}++;
26 $optval =~ m/^-?[0-9]+$/ or die(
27 "Value \"$optval\" invalid for option $optname",
28 " (number or percentage expected)\n"
38 my ($optname, $optval) = @_;
40 ($opt{hidemin}, $opt{hidemax}) =
41 $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die(
42 "Value \"$optval\" invalid for option limit",
48 'graph-format=s' => sub {
49 $opt{'graph-format'} = substr $_[1], 0, 1;
52 $opt{spark} = [split //, $_[1] || ' ▁▂▃▄▅▆▇█'];
56 fire => [qw( 90 31 91 33 93 97 96 )],
57 fire88 => [map {"38;5;$_"} qw(
58 80 32 48 64 68 72 76 77 78 79 47
60 fire256=> [map {"38;5;$_"} qw(
62 202 208 214 220 226 227 228 229 230 231 159
64 ramp88 => [map {"38;5;$_"} qw(
65 64 65 66 67 51 35 39 23 22 26 25 28
67 whites => [qw( 1;30 0;37 1;37 )],
68 greys => [map {"38;5;$_"} 52, 235..255, 47],
69 }->{$_[1]} // [ split /[^0-9;]/, $_[1] ];
76 say "barcat version $VERSION";
81 my $pod = readline *DATA;
82 $pod =~ s/^=over\K/ 25/m; # indent options list
83 $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
84 $pod =~ s/[.,](?=\n)//g; # trailing punctuation
85 $pod =~ s/^=item \K(?=--)/____/gm; # align long options
86 # abbreviate <variable> indicators
87 $pod =~ s/\Q>.../s>/g;
88 $pod =~ s/<(?:number|count|seconds)>/N/g;
89 $pod =~ s/<character(s?)>/\Uchar$1/g;
91 $pod =~ s/(?<!\w)<([a-z]+)>/\U$1/g; # uppercase
94 my $parser = Pod::Usage->new(USAGE_OPTIONS => {
95 -indent => 2, -width => 78,
97 $parser->select('SYNOPSIS', 'OPTIONS');
98 $parser->output_string(\my $contents);
99 $parser->parse_string_document($pod);
101 $contents =~ s/\n(?=\n\h)//msg; # strip space between items
102 $contents =~ s/^ \K____/ /gm; # nbsp substitute
108 Pod::Usage::pod2usage(
109 -exitval => 0, -perldocopt => '-oman', -verbose => 2,
112 ) or exit 64; # EX_USAGE
114 $opt{width} ||= $ENV{COLUMNS} || qx(tput cols) || 80 unless $opt{spark};
115 $opt{color} //= -t *STDOUT; # enable on tty
116 $opt{'graph-format'} //= '-';
117 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
118 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
119 $opt{anchor} //= qr/\A/;
120 $opt{'value-length'} = 6 if $opt{units};
121 $opt{'value-length'} = 1 if $opt{unmodified};
122 $opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT';
123 $opt{markers} //= '=avg >31.73v <68.27v +50v |0';
124 $opt{palette} //= $opt{color} && [31, 90, 32];
125 $opt{hidemin} = ($opt{hidemin} || 1) - 1;
126 $opt{input} = @ARGV && $ARGV[0] =~ m/\A[-0-9]/ ? \@ARGV : undef
127 and undef $opt{interval};
129 my (@lines, @values, @order);
131 $SIG{$_} = \&show_stat for $opt{'signal-stat'} || ();
134 alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
136 $SIG{INT} = \&show_exit;
138 if (defined $opt{interval}) {
139 $opt{interval} ||= 1;
140 alarm $opt{interval} if $opt{interval} > 0;
143 require Tie::Array::Sorted;
144 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
145 } or warn $@, "Expect slowdown with large datasets!\n";
149 $opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)
151 while (defined ($_ = $opt{input} ? shift @{ $opt{input} } : readline)) {
153 s/^\h*// unless $opt{unmodified};
154 push @values, s/$valmatch/\n/ && $1;
155 push @order, $1 if length $1;
156 if (defined $opt{trim} and defined $1) {
157 my $trimpos = abs $opt{trim};
158 $trimpos -= length $1 if $opt{unmodified};
160 $_ = substr $_, 0, 2;
162 elsif (length > $trimpos) {
163 substr($_, $trimpos - 1) = '…';
167 show_lines() if defined $opt{interval} and $opt{interval} < 0
168 and $. % $opt{interval} == 0;
171 if ($opt{'zero-missing'}) {
172 push @values, (0) x 10;
175 $SIG{INT} = 'DEFAULT';
178 $opt{color} and defined $_[0] or return '';
179 return "\e[$_[0]m" if defined wantarray;
180 $_ = color(@_) . $_ . color(0) if defined;
184 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
185 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
187 $float && ($unit % 3) == ($unit < 0), # tenths
188 $_[0] / 1000 ** int($unit/3), # number
189 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
195 state $nr = $opt{hidemin};
197 @lines > $nr or return;
199 @order = sort { $b <=> $a } @order unless tied @order;
200 my $maxval = $opt{maxval} // (
201 $opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] :
204 my $minval = $opt{minval} // min $order[-1] // (), 0;
205 my $range = $maxval - $minval;
206 my $lenval = $opt{'value-length'} // max map { length } @order;
207 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
208 max map { length $values[$_] && length $lines[$_] }
209 0 .. min $#lines, $opt{hidemax} || (); # left padding
211 ($opt{width} - $lenval - $len) / $range; # bar multiplication
214 if ($opt{markers} and $size > 0) {
215 for my $markspec (split /\h/, $opt{markers}) {
216 my ($char, $func) = split //, $markspec, 2;
218 if ($func eq 'avg') {
219 return sum(@order) / @order;
221 elsif ($func =~ /\A([0-9.]+)v\z/) {
222 my $index = $#order * $1 / 100;
223 return ($order[$index] + $order[$index + .5]) / 2;
230 color(36) for $barmark[$pos * $size] = $char;
233 state $lastmax = $maxval;
234 if ($maxval > $lastmax) {
235 print ' ' x ($lenval + $len);
238 ($lastmax - $minval) * $size + .5,
239 '-' x (($values[$nr - 1] - $minval) * $size);
241 say '+' x (($range - $lastmax) * $size + .5);
248 color(31), sprintf('%*s', $lenval, $minval),
249 color(90), '-', color(36), '+',
250 color(32), sprintf('%*s', $size * $range - 3, $maxval),
251 color(90), '-', color(36), '+',
255 while ($nr <= $#lines) {
256 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
257 my $val = $values[$nr];
258 my $rel = length $val && $range && ($val - $minval) / $range;
259 my $color = !length $val || !$opt{palette} ? undef :
260 $val == $order[0] ? $opt{palette}->[-1] : # max
261 $val == $order[-1] ? $opt{palette}->[0] : # min
262 $opt{palette}->[ $rel * ($#{$opt{palette}} - 1) + 1 ];
265 say '' if $opt{width} and $nr and $nr % $opt{width} == 0;
266 print color($color), $opt{spark}->[
268 $val == $order[0] ? -1 : # max
269 $val == $order[-1] ? 1 : # min
270 $#{$opt{spark}} < 3 ? 1 :
271 $rel * ($#{$opt{spark}} - 3) + 2.5
277 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
278 color($color) for $val;
280 my $line = $lines[$nr] =~ s/\n/$val/r;
281 printf '%-*s', $len + length($val), $line;
282 print $barmark[$_] // $opt{'graph-format'}
283 for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
289 say $opt{palette} ? color(0) : '' if $opt{spark};
294 if ($opt{hidemin} or $opt{hidemax}) {
295 printf '%s of ', sum(grep { length }
296 @values[$opt{hidemin} .. ($opt{hidemax} || @lines) - 1]
300 my $total = sum @order;
301 printf '%s total', color(1) . sprintf('%.8g', $total) . color(0);
302 printf ' in %d values', scalar @order;
303 printf ' over %d lines', scalar @lines if @order != @lines;
304 printf(' (%s min, %s avg, %s max)',
305 color(31) . $order[-1] . color(0),
306 color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
307 color(32) . $order[0] . color(0),
315 show_stat() if $opt{stat};
316 exit 130 if @_; # 0x80+signo
327 barcat - graph to visualize input values
331 B<barcat> [<options>] [<file>... | <numbers>]
335 Visualizes relative sizes of values read from input
336 (parameters, file(s) or STDIN).
337 Contents are concatenated similar to I<cat>,
338 but numbers are reformatted and a bar graph is appended to each line.
340 Don't worry, barcat does not drink and divide.
341 It can has various options for input and output (re)formatting,
342 but remains limited to one-dimensional charts.
343 For more complex graphing needs
344 you'll need a larger animal like I<gnuplot>.
350 =item -c, --[no-]color
352 Force colored output of values and bar markers.
353 Defaults on if output is a tty,
354 disabled otherwise such as when piped or redirected.
356 =item -f, --field=(<number> | <regexp>)
358 Compare values after a given number of whitespace separators,
359 or matching a regular expression.
361 Unspecified or I<-f0> means values are at the start of each line.
362 With I<-f1> the second word is taken instead.
363 A string can indicate the starting position of a value
364 (such as I<-f:> if preceded by colons),
365 or capture the numbers itself,
366 for example I<-f'(\d+)'> for the first digits anywhere.
370 Prepend a chart axis with minimum and maximum values labeled.
372 =item -H, --human-readable
374 Format values using SI unit prefixes,
375 turning long numbers like I<12356789> into I<12.4M>.
376 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
377 Short integers are aligned but kept without decimal point.
379 =item -t, --interval[=(<seconds> | -<lines>)]
381 Output partial progress every given number of seconds or input lines.
382 An update can also be forced by sending a I<SIGALRM> alarm signal.
384 =item -l, --length=[-]<size>[%]
386 Trim line contents (between number and bars)
387 to a maximum number of characters.
388 The exceeding part is replaced by an abbreviation sign,
389 unless C<--length=0>.
391 Prepend a dash (i.e. make negative) to enforce padding
392 regardless of encountered contents.
394 =item -L, --limit[=(<count> | <start>-[<end>])]
396 Stop output after a number of lines.
397 All input is still counted and analyzed for statistics,
398 but disregarded for padding and bar size.
400 =item --graph-format=<character>
402 Glyph to repeat for the graph line.
403 Defaults to a dash C<->.
405 =item -m, --markers=<format>
407 Statistical positions to indicate on bars.
408 A single indicator glyph precedes each position:
414 Exact value to match on the axis.
415 A vertical bar at the zero crossing is displayed by I<|0>
417 For example I<:3.14> would show a colon at pi.
419 =item <percentage>I<v>
421 Ranked value at the given percentile.
422 The default shows I<+> at I<50v> for the mean or median;
423 the middle value or average between middle values.
424 One standard deviation right of the mean is at about I<68.3v>.
425 The default includes I<< >31.73v <68.27v >>
426 to encompass all I<normal> results, or 68% of all entries, by B<< <--> >>.
431 the sum of all values divided by the number of counted lines.
432 Indicated by default as I<=>.
436 =item --min=<number>, --max=<number>
438 Bars extend from 0 or the minimum value if lower,
439 to the largest value encountered.
440 These options can be set to customize this range.
442 =item --palette=(<preset> | <color>...)
444 Override colors of parsed numbers.
445 Can be any CSI escape, such as I<90> for default dark grey,
446 or alternatively I<1;30> for bright black.
448 In case of additional colors,
449 the last is used for values equal to the maximum, the first for minima.
450 If unspecified, these are green and red respectively (I<31 90 32>).
452 =item --spark[=<characters>]
454 Replace lines by I<sparklines>,
455 single characters corresponding to input values.
456 A specified sequence of unicode characters will be used for
457 Of a specified sequence of unicode characters,
458 the first one will be used for non-values,
459 the last one for the maximum,
460 the second (if any) for the minimum,
461 and any remaining will be distributed over the range of values.
462 Unspecified, block fill glyphs U+2581-2588 will be used.
466 Total statistics after all data.
468 =item -u, --unmodified
470 Do not reformat values, keeping leading whitespace.
471 Keep original value alignment, which may be significant in some programs.
473 =item --value-length=<size>
475 Reserved space for numbers.
477 =item -w, --width=<columns>
479 Override the maximum number of columns to use.
480 Appended graphics will extend to fill up the entire screen.
484 Overview of available options.
501 seq 30 | awk '{print sin($1/10)}' | barcat
503 Compare file sizes (with human-readable numbers):
505 du -d0 -b * | barcat -H
507 Memory usage of user processes with long names truncated:
509 ps xo %mem,pid,cmd | barcat -l40
511 Monitor network latency from prefixed results:
513 ping google.com | barcat -f'time=\K' -t
515 Commonly used after counting, for example users on the current server:
517 users | tr ' ' '\n' | sort | uniq -c | barcat
519 Letter frequencies in text files:
521 cat /usr/share/games/fortunes/*.u8 |
522 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
523 sort | uniq -c | barcat
525 Number of HTTP requests per day:
527 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
529 Any kind of database query with counts, preserving returned alignment:
531 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
534 Earthquakes worldwide magnitude 1+ in the last 24 hours:
536 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
537 column -tns, | graph -f4 -u -l80%
539 External datasets, like movies per year:
541 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
542 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
544 But please get I<jq> to process JSON
545 and replace the manual selection by C<< jq '.[].year' >>.
547 Pokémon height comparison:
549 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
550 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
552 USD/EUR exchange rate from CSV provided by the ECB:
554 curl https://sdw.ecb.europa.eu/export.do \
555 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
556 grep '^[12]' | barcat -f',\K' --value-length=7
558 Total population history in XML from the World Bank:
560 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
561 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
562 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
564 And of course various Git statistics, such commit count by year:
566 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
568 Or the top 3 most frequent authors with statistics over all:
570 git shortlog -sn | barcat -L3 -s
572 Sparkline graphics of simple input given as inline parameters:
574 barcat --spark= 3 1 4 1 5 0 9 2 4
576 Activity graph of the last days (substitute date C<-v-{}d> on BSD):
578 ( git log --pretty=%ci --since=30day | cut -b-10
579 seq 0 30 | xargs -i date +%F -d-{}day ) |
580 sort | uniq -c | awk '$1--' | graph --spark
584 Mischa POSLAWSKY <perl@shiar.org>