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 $opt{spark} = [split //, $_[1] || '⎽▁▂▃▄▅▆▇█'];
54 my $pod = readline *DATA;
55 $pod =~ s/^=over\K/ 22/m; # indent options list
56 $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
59 my $parser = Pod::Usage->new;
60 $parser->select('SYNOPSIS', 'OPTIONS');
61 $parser->output_string(\my $contents);
62 $parser->parse_string_document($pod);
64 $contents =~ s/\n(?=\n\h)//msg; # strip space between items
70 Pod::Usage::pod2usage(
71 -exitval => 0, -perldocopt => '-oman', -verbose => 2,
74 ) or exit 64; # EX_USAGE
76 $opt{width} ||= $ENV{COLUMNS} || 80;
77 $opt{color} //= -t *STDOUT; # enable on tty
78 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
79 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
80 $opt{anchor} //= qr/\A/;
81 $opt{'value-length'} = 6 if $opt{units};
82 $opt{'value-length'} = 1 if $opt{unmodified};
84 my (@lines, @values, @order);
86 if (defined $opt{interval}) {
95 require Tie::Array::Sorted;
96 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
97 } or warn $@, "Expect slowdown with large datasets!\n";
101 $SIG{INT} = 'DEFAULT'; # reset for subsequent attempts
102 'IGNORE' # continue after assumed eof
105 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
108 s/^\h*// unless $opt{unmodified};
109 push @values, s/$valmatch/\n/ && $1;
110 push @order, $1 if length $1;
111 if (defined $opt{trim} and defined $1) {
112 my $trimpos = abs $opt{trim};
113 $trimpos -= length $1 if $opt{unmodified};
115 $_ = substr $_, 0, 1;
117 elsif (length > $trimpos) {
118 substr($_, $trimpos - 1) = '…';
124 $SIG{INT} = 'DEFAULT';
127 $opt{color} and defined $_[0] or return '';
128 return "\e[$_[0]m" if defined wantarray;
129 $_ = color(@_) . $_ . color(0) if defined;
134 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
135 @lines and @lines > $nr or return;
137 @lines > $nr or return unless $opt{hidemin};
139 @order = sort { $b <=> $a } @order unless tied @order;
140 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
141 my $minval = min $order[-1] // (), 0;
142 my $lenval = $opt{'value-length'} // max map { length } @order;
143 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
144 max map { length $values[$_] && length $lines[$_] }
145 0 .. min $#lines, $opt{hidemax} || (); # left padding
146 my $size = ($maxval - $minval) &&
147 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
150 if ($opt{markers} // 1 and $size > 0) {
151 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
152 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
153 $barmark[ orderpos($#order * .31731) ] = '>';
154 $barmark[ orderpos($#order * .68269) ] = '<';
155 $barmark[ orderpos($#order / 2) ] = '+'; # mean
156 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
157 color(36) for @barmark;
159 state $lastmax = $maxval;
160 if ($maxval > $lastmax) {
161 print ' ' x ($lenval + $len);
164 ($lastmax - $minval) * $size + .5,
165 '-' x (($values[$nr - 1] - $minval) * $size);
167 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
173 @lines > $nr or return if $opt{hidemin};
176 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
177 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
179 $float && ($unit % 3) == ($unit < 0), # tenths
180 $_[0] / 1000 ** int($unit/3), # number
181 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
185 while ($nr <= $#lines) {
186 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
187 my $val = $values[$nr];
190 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
195 my $color = !$opt{color} ? undef :
196 $val == $order[0] ? 32 : # max
197 $val == $order[-1] ? 31 : # min
199 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
200 color($color) for $val;
202 my $line = $lines[$nr] =~ s/\n/$val/r;
203 printf '%-*s', $len + length($val), $line;
204 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
210 say '' if $opt{spark};
216 if ($opt{hidemin} or $opt{hidemax}) {
218 $opt{hidemax} ||= @lines;
219 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
222 my $total = sum @order;
223 printf '%s total', $total;
224 printf ' in %d values', scalar @values;
225 printf ' (%s min, %*.*f avg, %s max)',
226 $order[-1], 0, 2, $total / @order, $order[0];
236 barcat - graph to visualize input values
240 B<barcat> [<options>] [<input>]
244 Visualizes relative sizes of values read from input (file(s) or STDIN).
245 Contents are concatenated similar to I<cat>,
246 but numbers are reformatted and a bar graph is appended to each line.
248 Don't worry, barcat does not drink and divide.
249 It can has various options for input and output (re)formatting,
250 but remains limited to one-dimensional charts.
251 For more complex graphing needs
252 you'll need a larger animal like I<gnuplot>.
258 =item -c, --[no-]color
260 Force colored output of values and bar markers.
261 Defaults on if output is a tty,
262 disabled otherwise such as when piped or redirected.
264 =item -f, --field=(<number>|<regexp>)
266 Compare values after a given number of whitespace separators,
267 or matching a regular expression.
269 Unspecified or I<-f0> means values are at the start of each line.
270 With I<-f1> the second word is taken instead.
271 A string can indicate the starting position of a value
272 (such as I<-f:> if preceded by colons),
273 or capture the numbers itself,
274 for example I<-f'(\d+)'> for the first digits anywhere.
276 =item -H, --human-readable
278 Format values using SI unit prefixes,
279 turning long numbers like I<12356789> into I<12.4M>.
280 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
281 Short integers are aligned but kept without decimal point.
283 =item -t, --interval[=<seconds>]
285 Interval time to output partial progress.
287 =item -l, --length=[-]<size>[%]
289 Trim line contents (between number and bars)
290 to a maximum number of characters.
291 The exceeding part is replaced by an abbreviation sign,
292 unless C<--length=0>.
294 Prepend a dash (i.e. make negative) to enforce padding
295 regardless of encountered contents.
297 =item -L, --limit=(<count>|<start>-[<end>])
299 Stop output after a number of lines.
300 All input is still counted and analyzed for statistics,
301 but disregarded for padding and bar size.
305 Statistical positions to indicate on bars.
306 Cannot be customized yet,
307 only disabled by providing an empty argument.
309 Any value enables all marker characters:
316 the sum of all values divided by the number of counted lines.
321 the middle value or average between middle values.
325 Standard deviation left of the mean.
326 Only 16% of all values are lower.
330 Standard deviation right of the mean.
331 The part between B<< <--> >> encompass all I<normal> results,
332 or 68% of all entries.
338 Total statistics after all data.
340 =item -u, --unmodified
342 Do not reformat values, keeping leading whitespace.
343 Keep original value alignment, which may be significant in some programs.
345 =item --value-length=<size>
347 Reserved space for numbers.
349 =item -w, --width=<columns>
351 Override the maximum number of columns to use.
352 Appended graphics will extend to fill up the entire screen.
356 Overview of available options.
373 seq 30 | awk '{print sin($1/10)}' | barcat
375 Compare file sizes (with human-readable numbers):
377 du -d0 -b * | barcat -H
379 Memory usage of user processes with long names truncated:
381 ps xo %mem,pid,cmd | barcat -l40
383 Monitor network latency from prefixed results:
385 ping google.com | barcat -f'time=\K' -t
387 Commonly used after counting, for example users on the current server:
389 users | sed 's/ /\n/g' | sort | uniq -c | barcat
391 Letter frequencies in text files:
393 cat /usr/share/games/fortunes/*.u8 |
394 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
395 sort | uniq -c | barcat
397 Number of HTTP requests per day:
399 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
401 Any kind of database query with counts, preserving returned alignment:
403 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
406 Earthquakes worldwide magnitude 1+ in the last 24 hours:
408 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
409 column -tns, | graph -f4 -u -l80%
411 External datasets, like movies per year:
413 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
414 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
416 But please get I<jq> to process JSON
417 and replace the manual selection by C<< jq '.[].year' >>.
419 Pokémon height comparison:
421 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
422 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
424 USD/EUR exchange rate from CSV provided by the ECB:
426 curl https://sdw.ecb.europa.eu/export.do \
427 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
428 grep '^[12]' | barcat -f',\K' --value-length=7
430 Total population history from the World Bank dataset (XML):
431 External datasets, like total population in XML from the World Bank:
433 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
434 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
435 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
437 And of course various Git statistics, such commit count by year:
439 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
441 Or the top 3 most frequent authors with statistics over all:
443 git shortlog -sn | barcat -L3 -s
445 Activity of the last days (substitute date C<-v-{}d> on BSD):
447 ( git log --pretty=%ci --since=30day | cut -b-10
448 seq 0 30 | xargs -i date +%F -d-{}day ) |
449 sort | uniq -c | awk '$1--' | graph --spark
453 Mischa POSLAWSKY <perl@shiar.org>