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];
116 my (@lines, @values, @order);
118 $SIG{$_} = \&show_stat for $opt{'signal-stat'} || ();
121 alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
123 $SIG{INT} = \&show_exit;
125 if (defined $opt{interval}) {
126 $opt{interval} ||= 1;
127 alarm $opt{interval} if $opt{interval} > 0;
130 require Tie::Array::Sorted;
131 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
132 } or warn $@, "Expect slowdown with large datasets!\n";
135 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
138 s/^\h*// unless $opt{unmodified};
139 push @values, s/$valmatch/\n/ && $1;
140 push @order, $1 if length $1;
141 if (defined $opt{trim} and defined $1) {
142 my $trimpos = abs $opt{trim};
143 $trimpos -= length $1 if $opt{unmodified};
145 $_ = substr $_, 0, 2;
147 elsif (length > $trimpos) {
148 substr($_, $trimpos - 1) = '…';
152 show_lines() if defined $opt{interval} and $opt{interval} < 0
153 and $. % $opt{interval} == 0;
156 $SIG{INT} = 'DEFAULT';
159 $opt{color} and defined $_[0] or return '';
160 return "\e[$_[0]m" if defined wantarray;
161 $_ = color(@_) . $_ . color(0) if defined;
166 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
167 @lines and @lines > $nr or return;
169 @lines > $nr or return unless $opt{hidemin};
171 @order = sort { $b <=> $a } @order unless tied @order;
172 my $maxval = $opt{maxval} // ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
173 my $minval = $opt{minval} // min $order[-1] // (), 0;
174 my $lenval = $opt{'value-length'} // max map { length } @order;
175 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
176 max map { length $values[$_] && length $lines[$_] }
177 0 .. min $#lines, $opt{hidemax} || (); # left padding
178 my $size = ($maxval - $minval) &&
179 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
182 if ($opt{markers} and $size > 0) {
183 for my $markspec (split /\h/, $opt{markers}) {
184 my ($char, $func) = split //, $markspec, 2;
186 if ($func eq 'avg') {
187 return sum(@order) / @order;
189 elsif ($func =~ /\A([0-9.]+)v\z/) {
190 my $index = $#order * $1 / 100;
191 return ($order[$index] + $order[$index + .5]) / 2;
198 color(36) for $barmark[$pos * $size] = $char;
201 state $lastmax = $maxval;
202 if ($maxval > $lastmax) {
203 print ' ' x ($lenval + $len);
206 ($lastmax - $minval) * $size + .5,
207 '-' x (($values[$nr - 1] - $minval) * $size);
209 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
215 @lines > $nr or return if $opt{hidemin};
218 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
219 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
221 $float && ($unit % 3) == ($unit < 0), # tenths
222 $_[0] / 1000 ** int($unit/3), # number
223 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
228 color(31), sprintf('%*s', $lenval, $minval),
229 color(90), '-', color(36), '+',
230 color(32), sprintf('%*s', $size * ($maxval - $minval) - 3, $maxval),
231 color(90), '-', color(36), '+',
235 while ($nr <= $#lines) {
236 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
237 my $val = $values[$nr];
238 my $rel = length $val && ($val - $minval) / ($maxval - $minval);
239 my $color = !length $val || !$opt{palette} ? undef :
240 $val == $order[0] ? $opt{palette}->[-1] : # max
241 $val == $order[-1] ? $opt{palette}->[0] : # min
242 $opt{palette}->[ $rel * ($#{$opt{palette}} - 1) + 1 ];
245 print color($color), $opt{spark}->[
247 $val == $order[0] ? -1 : # max
248 $val == $order[-1] ? 1 : # min
249 $#{$opt{spark}} < 3 ? 1 :
250 $rel * ($#{$opt{spark}} - 3) + 2.5
256 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
257 color($color) for $val;
259 my $line = $lines[$nr] =~ s/\n/$val/r;
260 printf '%-*s', $len + length($val), $line;
261 print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
267 say $opt{palette} ? color(0) : '' if $opt{spark};
272 if ($opt{hidemin} or $opt{hidemax}) {
274 $opt{hidemax} ||= @lines;
275 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
278 my $total = sum @order;
279 printf '%s total', color(1) . $total . color(0);
280 printf ' in %d values', scalar @values;
281 printf(' (%s min, %s avg, %s max)',
282 color(31) . $order[-1] . color(0),
283 color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
284 color(32) . $order[0] . color(0),
292 show_stat() if $opt{stat};
293 exit 130 if @_; # 0x80+signo
304 barcat - graph to visualize input values
308 B<barcat> [<options>] [<input>]
312 Visualizes relative sizes of values read from input (file(s) or STDIN).
313 Contents are concatenated similar to I<cat>,
314 but numbers are reformatted and a bar graph is appended to each line.
316 Don't worry, barcat does not drink and divide.
317 It can has various options for input and output (re)formatting,
318 but remains limited to one-dimensional charts.
319 For more complex graphing needs
320 you'll need a larger animal like I<gnuplot>.
326 =item -c, --[no-]color
328 Force colored output of values and bar markers.
329 Defaults on if output is a tty,
330 disabled otherwise such as when piped or redirected.
332 =item -f, --field=(<number>|<regexp>)
334 Compare values after a given number of whitespace separators,
335 or matching a regular expression.
337 Unspecified or I<-f0> means values are at the start of each line.
338 With I<-f1> the second word is taken instead.
339 A string can indicate the starting position of a value
340 (such as I<-f:> if preceded by colons),
341 or capture the numbers itself,
342 for example I<-f'(\d+)'> for the first digits anywhere.
346 Prepend a chart axis with minimum and maximum values labeled.
348 =item -H, --human-readable
350 Format values using SI unit prefixes,
351 turning long numbers like I<12356789> into I<12.4M>.
352 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
353 Short integers are aligned but kept without decimal point.
355 =item -t, --interval[=(<seconds>|-<lines>)]
357 Output partial progress every given number of seconds or input lines.
358 An update can also be forced by sending a I<SIGALRM> alarm signal.
360 =item -l, --length=[-]<size>[%]
362 Trim line contents (between number and bars)
363 to a maximum number of characters.
364 The exceeding part is replaced by an abbreviation sign,
365 unless C<--length=0>.
367 Prepend a dash (i.e. make negative) to enforce padding
368 regardless of encountered contents.
370 =item -L, --limit=(<count>|<start>-[<end>])
372 Stop output after a number of lines.
373 All input is still counted and analyzed for statistics,
374 but disregarded for padding and bar size.
376 =item --graph-format=<character>
378 Glyph to repeat for the graph line.
379 Defaults to a dash C<->.
381 =item -m, --markers=<format>
383 Statistical positions to indicate on bars.
384 A single indicator glyph precedes each position:
390 Exact value to match on the axis.
391 A vertical bar at the zero crossing is displayed by I<|0>
393 For example I<:3.14> would show a colon at pi.
395 =item <percentage>I<v>
397 Ranked value at the given percentile.
398 The default shows I<+> at I<50v> for the mean or median;
399 the middle value or average between middle values.
400 One standard deviation right of the mean is at about I<68.3v>.
401 The default includes I<< >31.73v <68.27v >>
402 to encompass all I<normal> results, or 68% of all entries, by B<< <--> >>.
407 the sum of all values divided by the number of counted lines.
408 Indicated by default as I<=>.
412 =item --min=<number>, --max=<number>
414 Bars extend from 0 or the minimum value if lower,
415 to the largest value encountered.
416 These options can be set to customize this range.
418 =item --palette=(<preset> | <color>...)
420 Override colors of parsed numbers.
421 Can be any CSI escape, such as I<90> for default dark grey,
422 or alternatively I<1;30> for bold black.
424 In case of additional colors,
425 the last is used for values equal to the maximum, the first for minima.
426 If unspecified, these are green and red respectively (I<31 90 32>).
428 =item --spark[=<glyphs>]
430 Replace lines by I<sparklines>,
431 single characters corresponding to input values.
432 A specified sequence of unicode characters will be used for
433 Of a specified sequence of unicode characters,
434 the first one will be used for non-values,
435 the last one for the maximum,
436 the second (if any) for the minimum,
437 and any remaining will be distributed over the range of values.
438 Unspecified, block fill glyphs U+2581-2588 will be used.
442 Total statistics after all data.
444 =item -u, --unmodified
446 Do not reformat values, keeping leading whitespace.
447 Keep original value alignment, which may be significant in some programs.
449 =item --value-length=<size>
451 Reserved space for numbers.
453 =item -w, --width=<columns>
455 Override the maximum number of columns to use.
456 Appended graphics will extend to fill up the entire screen.
460 Overview of available options.
477 seq 30 | awk '{print sin($1/10)}' | barcat
479 Compare file sizes (with human-readable numbers):
481 du -d0 -b * | barcat -H
483 Memory usage of user processes with long names truncated:
485 ps xo %mem,pid,cmd | barcat -l40
487 Monitor network latency from prefixed results:
489 ping google.com | barcat -f'time=\K' -t
491 Commonly used after counting, for example users on the current server:
493 users | sed 's/ /\n/g' | sort | uniq -c | barcat
495 Letter frequencies in text files:
497 cat /usr/share/games/fortunes/*.u8 |
498 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
499 sort | uniq -c | barcat
501 Number of HTTP requests per day:
503 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
505 Any kind of database query with counts, preserving returned alignment:
507 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
510 Earthquakes worldwide magnitude 1+ in the last 24 hours:
512 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
513 column -tns, | graph -f4 -u -l80%
515 External datasets, like movies per year:
517 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
518 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
520 But please get I<jq> to process JSON
521 and replace the manual selection by C<< jq '.[].year' >>.
523 Pokémon height comparison:
525 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
526 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
528 USD/EUR exchange rate from CSV provided by the ECB:
530 curl https://sdw.ecb.europa.eu/export.do \
531 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
532 grep '^[12]' | barcat -f',\K' --value-length=7
534 Total population history from the World Bank dataset (XML):
535 External datasets, like total population in XML from the World Bank:
537 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
538 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
539 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
541 And of course various Git statistics, such commit count by year:
543 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
545 Or the top 3 most frequent authors with statistics over all:
547 git shortlog -sn | barcat -L3 -s
549 Activity of the last days (substitute date C<-v-{}d> on BSD):
551 ( git log --pretty=%ci --since=30day | cut -b-10
552 seq 0 30 | xargs -i date +%F -d-{}day ) |
553 sort | uniq -c | awk '$1--' | graph --spark
557 Mischa POSLAWSKY <perl@shiar.org>