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"
37 my ($optname, $optval) = @_;
39 ($opt{hidemin}, $opt{hidemax}) =
40 $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die(
41 "Value \"$optval\" invalid for option limit",
47 'graph-format=s' => sub {
48 $opt{'graph-format'} = substr $_[1], 0, 1;
51 $opt{spark} = [split //, $_[1] || '▁▂▃▄▅▆▇█'];
58 say "barcat version $VERSION";
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;
68 my $parser = Pod::Usage->new;
69 $parser->select('SYNOPSIS', 'OPTIONS');
70 $parser->output_string(\my $contents);
71 $parser->parse_string_document($pod);
73 $contents =~ s/\n(?=\n\h)//msg; # strip space between items
79 Pod::Usage::pod2usage(
80 -exitval => 0, -perldocopt => '-oman', -verbose => 2,
83 ) or exit 64; # EX_USAGE
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';
95 my (@lines, @values, @order);
97 $SIG{$_} = \&show_stat for $opt{'signal-stat'} || ();
100 alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
102 $SIG{INT} = \&show_exit;
104 if (defined $opt{interval}) {
105 $opt{interval} ||= 1;
106 alarm $opt{interval} if $opt{interval} > 0;
109 require Tie::Array::Sorted;
110 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
111 } or warn $@, "Expect slowdown with large datasets!\n";
114 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
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};
124 $_ = substr $_, 0, 2;
126 elsif (length > $trimpos) {
127 substr($_, $trimpos - 1) = '…';
131 show_lines() if defined $opt{interval} and $opt{interval} < 0
132 and $. % $opt{interval} == 0;
135 $SIG{INT} = 'DEFAULT';
138 $opt{color} and defined $_[0] or return '';
139 return "\e[$_[0]m" if defined wantarray;
140 $_ = color(@_) . $_ . color(0) if defined;
145 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
146 @lines and @lines > $nr or return;
148 @lines > $nr or return unless $opt{hidemin};
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
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;
170 state $lastmax = $maxval;
171 if ($maxval > $lastmax) {
172 print ' ' x ($lenval + $len);
175 ($lastmax - $minval) * $size + .5,
176 '-' x (($values[$nr - 1] - $minval) * $size);
178 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
184 @lines > $nr or return if $opt{hidemin};
187 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
188 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
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]
196 say sprintf '%*s-+%*s-+', $lenval, $minval, $size * ($maxval - $minval) - 3, $maxval if $opt{header};
198 while ($nr <= $#lines) {
199 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
200 my $val = $values[$nr];
203 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
208 my $color = !$opt{color} ? undef :
209 $val == $order[0] ? 32 : # max
210 $val == $order[-1] ? 31 : # min
212 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
213 color($color) for $val;
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;
223 say '' if $opt{spark};
228 if ($opt{hidemin} or $opt{hidemax}) {
230 $opt{hidemax} ||= @lines;
231 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
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),
248 show_stat() if $opt{stat};
249 exit 130 if @_; # 0x80+signo
260 barcat - graph to visualize input values
264 B<barcat> [<options>] [<input>]
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.
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>.
282 =item -c, --[no-]color
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.
288 =item -f, --field=(<number>|<regexp>)
290 Compare values after a given number of whitespace separators,
291 or matching a regular expression.
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.
302 Prepend a chart axis with minimum and maximum values labeled.
304 =item -H, --human-readable
306 Format values using SI unit prefixes,
307 turning long numbers like I<12356789> into I<12.4M>.
308 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
309 Short integers are aligned but kept without decimal point.
311 =item -t, --interval[=(<seconds>|-<lines>)]
313 Output partial progress every given number of seconds or input lines.
314 An update can also be forced by sending a I<SIGALRM> alarm signal.
316 =item -l, --length=[-]<size>[%]
318 Trim line contents (between number and bars)
319 to a maximum number of characters.
320 The exceeding part is replaced by an abbreviation sign,
321 unless C<--length=0>.
323 Prepend a dash (i.e. make negative) to enforce padding
324 regardless of encountered contents.
326 =item -L, --limit=(<count>|<start>-[<end>])
328 Stop output after a number of lines.
329 All input is still counted and analyzed for statistics,
330 but disregarded for padding and bar size.
332 =item --graph-format=<character>
334 Glyph to repeat for the graph line.
335 Defaults to a dash C<->.
339 Statistical positions to indicate on bars.
340 Cannot be customized yet,
341 only disabled by providing an empty argument.
343 Any value enables all marker characters:
350 the sum of all values divided by the number of counted lines.
355 the middle value or average between middle values.
359 Standard deviation left of the mean.
360 Only 16% of all values are lower.
364 Standard deviation right of the mean.
365 The part between B<< <--> >> encompass all I<normal> results,
366 or 68% of all entries.
370 =item --spark[=<glyphs>]
372 Replace lines by I<sparklines>,
373 single characters corresponding to input values.
374 A specified sequence of unicode characters will be used for
375 Of a specified sequence of unicode characters,
376 the first one will be used for non-values,
377 the last one for the maximum,
378 the second (if any) for the minimum,
379 and any remaining will be distributed over the range of values.
380 Unspecified, block fill glyphs U+2581-2588 will be used.
384 Total statistics after all data.
386 =item -u, --unmodified
388 Do not reformat values, keeping leading whitespace.
389 Keep original value alignment, which may be significant in some programs.
391 =item --value-length=<size>
393 Reserved space for numbers.
395 =item -w, --width=<columns>
397 Override the maximum number of columns to use.
398 Appended graphics will extend to fill up the entire screen.
402 Overview of available options.
419 seq 30 | awk '{print sin($1/10)}' | barcat
421 Compare file sizes (with human-readable numbers):
423 du -d0 -b * | barcat -H
425 Memory usage of user processes with long names truncated:
427 ps xo %mem,pid,cmd | barcat -l40
429 Monitor network latency from prefixed results:
431 ping google.com | barcat -f'time=\K' -t
433 Commonly used after counting, for example users on the current server:
435 users | sed 's/ /\n/g' | sort | uniq -c | barcat
437 Letter frequencies in text files:
439 cat /usr/share/games/fortunes/*.u8 |
440 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
441 sort | uniq -c | barcat
443 Number of HTTP requests per day:
445 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
447 Any kind of database query with counts, preserving returned alignment:
449 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
452 Earthquakes worldwide magnitude 1+ in the last 24 hours:
454 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
455 column -tns, | graph -f4 -u -l80%
457 External datasets, like movies per year:
459 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
460 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
462 But please get I<jq> to process JSON
463 and replace the manual selection by C<< jq '.[].year' >>.
465 Pokémon height comparison:
467 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
468 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
470 USD/EUR exchange rate from CSV provided by the ECB:
472 curl https://sdw.ecb.europa.eu/export.do \
473 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
474 grep '^[12]' | barcat -f',\K' --value-length=7
476 Total population history from the World Bank dataset (XML):
477 External datasets, like total population in XML from the World Bank:
479 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
480 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
481 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
483 And of course various Git statistics, such commit count by year:
485 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
487 Or the top 3 most frequent authors with statistics over all:
489 git shortlog -sn | barcat -L3 -s
491 Activity of the last days (substitute date C<-v-{}d> on BSD):
493 ( git log --pretty=%ci --since=30day | cut -b-10
494 seq 0 30 | xargs -i date +%F -d-{}day ) |
495 sort | uniq -c | awk '$1--' | graph --spark
499 Mischa POSLAWSKY <perl@shiar.org>