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} || 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);
241 print color($opt{palette}->[ $rel * $#{$opt{palette}} ]) if $opt{palette};
242 print $opt{spark}->[ $rel * $#{$opt{spark}} ];
247 my $color = !$opt{palette} ? undef :
248 $val == $order[0] ? $opt{palette}->[-1] : # max
249 $val == $order[-1] ? $opt{palette}->[0] : # min
250 $opt{palette}->[ $rel * ($#{$opt{palette}} - 1) + 1 ];
251 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
252 color($color) for $val;
254 my $line = $lines[$nr] =~ s/\n/$val/r;
255 printf '%-*s', $len + length($val), $line;
256 print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
262 say $opt{palette} ? color(0) : '' if $opt{spark};
267 if ($opt{hidemin} or $opt{hidemax}) {
269 $opt{hidemax} ||= @lines;
270 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
273 my $total = sum @order;
274 printf '%s total', color(1) . $total . color(0);
275 printf ' in %d values', scalar @values;
276 printf(' (%s min, %s avg, %s max)',
277 color(31) . $order[-1] . color(0),
278 color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
279 color(32) . $order[0] . color(0),
287 show_stat() if $opt{stat};
288 exit 130 if @_; # 0x80+signo
299 barcat - graph to visualize input values
303 B<barcat> [<options>] [<input>]
307 Visualizes relative sizes of values read from input (file(s) or STDIN).
308 Contents are concatenated similar to I<cat>,
309 but numbers are reformatted and a bar graph is appended to each line.
311 Don't worry, barcat does not drink and divide.
312 It can has various options for input and output (re)formatting,
313 but remains limited to one-dimensional charts.
314 For more complex graphing needs
315 you'll need a larger animal like I<gnuplot>.
321 =item -c, --[no-]color
323 Force colored output of values and bar markers.
324 Defaults on if output is a tty,
325 disabled otherwise such as when piped or redirected.
327 =item -f, --field=(<number>|<regexp>)
329 Compare values after a given number of whitespace separators,
330 or matching a regular expression.
332 Unspecified or I<-f0> means values are at the start of each line.
333 With I<-f1> the second word is taken instead.
334 A string can indicate the starting position of a value
335 (such as I<-f:> if preceded by colons),
336 or capture the numbers itself,
337 for example I<-f'(\d+)'> for the first digits anywhere.
341 Prepend a chart axis with minimum and maximum values labeled.
343 =item -H, --human-readable
345 Format values using SI unit prefixes,
346 turning long numbers like I<12356789> into I<12.4M>.
347 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
348 Short integers are aligned but kept without decimal point.
350 =item -t, --interval[=(<seconds>|-<lines>)]
352 Output partial progress every given number of seconds or input lines.
353 An update can also be forced by sending a I<SIGALRM> alarm signal.
355 =item -l, --length=[-]<size>[%]
357 Trim line contents (between number and bars)
358 to a maximum number of characters.
359 The exceeding part is replaced by an abbreviation sign,
360 unless C<--length=0>.
362 Prepend a dash (i.e. make negative) to enforce padding
363 regardless of encountered contents.
365 =item -L, --limit=(<count>|<start>-[<end>])
367 Stop output after a number of lines.
368 All input is still counted and analyzed for statistics,
369 but disregarded for padding and bar size.
371 =item --graph-format=<character>
373 Glyph to repeat for the graph line.
374 Defaults to a dash C<->.
376 =item -m, --markers=<format>
378 Statistical positions to indicate on bars.
379 A single indicator glyph precedes each position:
385 Exact value to match on the axis.
386 A vertical bar at the zero crossing is displayed by I<|0>
388 For example I<:3.14> would show a colon at pi.
390 =item <percentage>I<v>
392 Ranked value at the given percentile.
393 The default shows I<+> at I<50v> for the mean or median;
394 the middle value or average between middle values.
395 One standard deviation right of the mean is at about I<68.3v>.
396 The default includes I<< >31.73v <68.27v >>
397 to encompass all I<normal> results, or 68% of all entries, by B<< <--> >>.
402 the sum of all values divided by the number of counted lines.
403 Indicated by default as I<=>.
407 =item --min=<number>, --max=<number>
409 Bars extend from 0 or the minimum value if lower,
410 to the largest value encountered.
411 These options can be set to customize this range.
413 =item --palette=(<preset> | <color>...)
415 Override colors of parsed numbers.
416 Can be any CSI escape, such as I<90> for default dark grey,
417 or alternatively I<1;30> for bold black.
419 In case of additional colors,
420 the last is used for values equal to the maximum, the first for minima.
421 If unspecified, these are green and red respectively (I<31 90 32>).
423 =item --spark[=<glyphs>]
425 Replace lines by I<sparklines>,
426 single characters corresponding to input values.
427 A specified sequence of unicode characters will be used for
428 Of a specified sequence of unicode characters,
429 the first one will be used for non-values,
430 the last one for the maximum,
431 the second (if any) for the minimum,
432 and any remaining will be distributed over the range of values.
433 Unspecified, block fill glyphs U+2581-2588 will be used.
437 Total statistics after all data.
439 =item -u, --unmodified
441 Do not reformat values, keeping leading whitespace.
442 Keep original value alignment, which may be significant in some programs.
444 =item --value-length=<size>
446 Reserved space for numbers.
448 =item -w, --width=<columns>
450 Override the maximum number of columns to use.
451 Appended graphics will extend to fill up the entire screen.
455 Overview of available options.
472 seq 30 | awk '{print sin($1/10)}' | barcat
474 Compare file sizes (with human-readable numbers):
476 du -d0 -b * | barcat -H
478 Memory usage of user processes with long names truncated:
480 ps xo %mem,pid,cmd | barcat -l40
482 Monitor network latency from prefixed results:
484 ping google.com | barcat -f'time=\K' -t
486 Commonly used after counting, for example users on the current server:
488 users | sed 's/ /\n/g' | sort | uniq -c | barcat
490 Letter frequencies in text files:
492 cat /usr/share/games/fortunes/*.u8 |
493 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
494 sort | uniq -c | barcat
496 Number of HTTP requests per day:
498 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
500 Any kind of database query with counts, preserving returned alignment:
502 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
505 Earthquakes worldwide magnitude 1+ in the last 24 hours:
507 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
508 column -tns, | graph -f4 -u -l80%
510 External datasets, like movies per year:
512 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
513 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
515 But please get I<jq> to process JSON
516 and replace the manual selection by C<< jq '.[].year' >>.
518 Pokémon height comparison:
520 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
521 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
523 USD/EUR exchange rate from CSV provided by the ECB:
525 curl https://sdw.ecb.europa.eu/export.do \
526 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
527 grep '^[12]' | barcat -f',\K' --value-length=7
529 Total population history from the World Bank dataset (XML):
530 External datasets, like total population in XML from the World Bank:
532 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
533 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
534 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
536 And of course various Git statistics, such commit count by year:
538 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
540 Or the top 3 most frequent authors with statistics over all:
542 git shortlog -sn | barcat -L3 -s
544 Activity of the last days (substitute date C<-v-{}d> on BSD):
546 ( git log --pretty=%ci --since=30day | cut -b-10
547 seq 0 30 | xargs -i date +%F -d-{}day ) |
548 sort | uniq -c | awk '$1--' | graph --spark
552 Mischa POSLAWSKY <perl@shiar.org>