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 );
14 Pod::Usage::pod2usage(-exitval => 0, -perldocopt => '-oman', @_);
19 'C' => sub { $opt{color} = 0 },
23 $opt{anchor} = /^[0-9]+$/ ? qr/(?:\S*\h+){$_}\K/ : qr/$_/;
24 } or die $@ =~ s/(?: at .+)?$/ for option $_[0]/r;
28 'trim|length|l=s' => sub {
29 my ($optname, $optval) = @_;
30 $optval =~ s/%$// and $opt{trimpct}++;
31 $optval =~ m/^-?[0-9]+$/ or die(
32 "Value \"$optval\" invalid for option $optname",
33 " (number or percentage expected)\n"
41 my ($optname, $optval) = @_;
43 ($opt{hidemin}, $opt{hidemax}) =
44 $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die(
45 "Value \"$optval\" invalid for option limit",
51 $opt{spark} = [split //, $_[1] || '⎽▁▂▃▄▅▆▇█'];
58 my $pod = readline *DATA;
59 $pod =~ s/^=over\K/ 22/m; # indent options list
60 $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
63 my $parser = Pod::Usage->new;
64 $parser->select('SYNOPSIS', 'OPTIONS');
65 $parser->output_string(\my $contents);
66 $parser->parse_string_document($pod);
68 $contents =~ s/\n(?=\n\h)//msg; # strip space between items
72 'help' => sub { podexit(-verbose => 2) },
73 ) or exit 64; # EX_USAGE
75 $opt{width} ||= $ENV{COLUMNS} || 80;
76 $opt{color} //= -t *STDOUT; # enable on tty
77 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
78 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
79 $opt{anchor} //= qr/\A/;
80 $opt{'value-length'} = 6 if $opt{units};
81 $opt{'value-length'} = 1 if $opt{unmodified};
83 my (@lines, @values, @order);
85 if (defined $opt{interval}) {
94 require Tie::Array::Sorted;
95 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
96 } or warn $@, "Expect slowdown with large datasets!\n";
100 $SIG{INT} = 'DEFAULT'; # reset for subsequent attempts
101 'IGNORE' # continue after assumed eof
104 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
107 s/^\h*// unless $opt{unmodified};
108 push @values, s/$valmatch/\n/ && $1;
109 push @order, $1 if length $1;
110 if (defined $opt{trim} and defined $1) {
111 my $trimpos = abs $opt{trim};
112 $trimpos -= length $1 if $opt{unmodified};
114 $_ = substr $_, 0, 1;
116 elsif (length > $trimpos) {
117 substr($_, $trimpos - 1) = '…';
123 $SIG{INT} = 'DEFAULT';
126 $opt{color} and defined $_[0] or return '';
127 return "\e[$_[0]m" if defined wantarray;
128 $_ = color(@_) . $_ . color(0) if defined;
133 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
134 @lines and @lines > $nr or return;
136 @lines > $nr or return unless $opt{hidemin};
138 @order = sort { $b <=> $a } @order unless tied @order;
139 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
140 my $minval = min $order[-1] // (), 0;
141 my $lenval = $opt{'value-length'} // max map { length } @order;
142 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
143 max map { length $values[$_] && length $lines[$_] }
144 0 .. min $#lines, $opt{hidemax} || (); # left padding
145 my $size = ($maxval - $minval) &&
146 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
149 if ($opt{markers} // 1 and $size > 0) {
150 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
151 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
152 $barmark[ orderpos($#order * .31731) ] = '>';
153 $barmark[ orderpos($#order * .68269) ] = '<';
154 $barmark[ orderpos($#order / 2) ] = '+'; # mean
155 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
156 color(36) for @barmark;
158 state $lastmax = $maxval;
159 if ($maxval > $lastmax) {
160 print ' ' x ($lenval + $len);
163 ($lastmax - $minval) * $size + .5,
164 '-' x (($values[$nr - 1] - $minval) * $size);
166 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
172 @lines > $nr or return if $opt{hidemin};
175 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
176 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
178 $float && ($unit % 3) == ($unit < 0), # tenths
179 $_[0] / 1000 ** int($unit/3), # number
180 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
184 while ($nr <= $#lines) {
185 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
186 my $val = $values[$nr];
189 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
194 my $color = !$opt{color} ? undef :
195 $val == $order[0] ? 32 : # max
196 $val == $order[-1] ? 31 : # min
198 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
199 color($color) for $val;
201 my $line = $lines[$nr] =~ s/\n/$val/r;
202 printf '%-*s', $len + length($val), $line;
203 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
209 say '' if $opt{spark};
215 if ($opt{hidemin} or $opt{hidemax}) {
217 $opt{hidemax} ||= @lines;
218 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
221 my $total = sum @order;
222 printf '%s total', $total;
223 printf ' in %d values', scalar @values;
224 printf ' (%s min, %*.*f avg, %s max)',
225 $order[-1], 0, 2, $total / @order, $order[0];
235 barcat - graph to visualize input values
239 B<barcat> [<options>] [<input>]
243 Visualizes relative sizes of values read from input (file(s) or STDIN).
244 Contents are concatenated similar to I<cat>,
245 but numbers are reformatted and a bar graph is appended to each line.
251 =item -c, --[no-]color
253 Force colored output of values and bar markers.
254 Defaults on if output is a tty,
255 disabled otherwise such as when piped or redirected.
257 =item -f, --field=(<number>|<regexp>)
259 Compare values after a given number of whitespace separators,
260 or matching a regular expression.
262 Unspecified or I<-f0> means values are at the start of each line.
263 With I<-f1> the second word is taken instead.
264 A string can indicate the starting position of a value
265 (such as I<-f:> if preceded by colons),
266 or capture the numbers itself,
267 for example I<-f'(\d+)'> for the first digits anywhere.
269 =item -H, --human-readable
271 Format values using SI unit prefixes,
272 turning long numbers like I<12356789> into I<12.4M>.
273 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
274 Short integers are aligned but kept without decimal point.
276 =item -t, --interval[=<seconds>]
278 Interval time to output partial progress.
280 =item -l, --length=[-]<size>[%]
282 Trim line contents (between number and bars)
283 to a maximum number of characters.
284 The exceeding part is replaced by an abbreviation sign,
285 unless C<--length=0>.
287 Prepend a dash (i.e. make negative) to enforce padding
288 regardless of encountered contents.
290 =item -L, --limit=(<count>|<start>-[<end>])
292 Stop output after a number of lines.
293 All input is still counted and analyzed for statistics,
294 but disregarded for padding and bar size.
298 Statistical positions to indicate on bars.
299 Cannot be customized yet,
300 only disabled by providing an empty argument.
302 Any value enables all marker characters:
309 the sum of all values divided by the number of counted lines.
314 the middle value or average between middle values.
318 Standard deviation left of the mean.
319 Only 16% of all values are lower.
323 Standard deviation right of the mean.
324 The part between B<< <--> >> encompass all I<normal> results,
325 or 68% of all entries.
331 Total statistics after all data.
333 =item -u, --unmodified
335 Do not reformat values, keeping leading whitespace.
336 Keep original value alignment, which may be significant in some programs.
338 =item --value-length=<size>
340 Reserved space for numbers.
342 =item -w, --width=<columns>
344 Override the maximum number of columns to use.
345 Appended graphics will extend to fill up the entire screen.
353 seq 30 | awk '{print sin($1/10)}' | barcat
355 Compare file sizes (with human-readable numbers):
357 du -d0 -b * | barcat -H
359 Memory usage of user processes with long names truncated:
361 ps xo %mem,pid,cmd | barcat -l40
363 Monitor network latency from prefixed results:
365 ping google.com | barcat -f'time=\K' -t
367 Commonly used after counting, for example users on the current server:
369 users | sed 's/ /\n/g' | sort | uniq -c | barcat
371 Letter frequencies in text files:
373 cat /usr/share/games/fortunes/*.u8 |
374 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
375 sort | uniq -c | barcat
377 Number of HTTP requests per day:
379 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
381 Any kind of database query with counts, preserving returned alignment:
383 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
386 Earthquakes worldwide magnitude 1+ in the last 24 hours:
388 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
389 column -tns, | graph -f4 -u -l80%
391 External datasets, like movies per year:
393 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
394 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
396 But please get I<jq> to process JSON
397 and replace the manual selection by C<< jq '.[].year' >>.
399 Pokémon height comparison:
401 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
402 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
404 USD/EUR exchange rate from CSV provided by the ECB:
406 curl https://sdw.ecb.europa.eu/export.do \
407 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
408 grep '^[12]' | barcat -f',\K' --value-length=7
410 Total population history from the World Bank dataset (XML):
411 External datasets, like total population in XML from the World Bank:
413 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
414 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
415 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
417 And of course various Git statistics, such commit count by year:
419 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
421 Or the top 3 most frequent authors with statistics over all:
423 git shortlog -sn | barcat -L3 -s
425 Activity of the last days (substitute date C<-v-{}d> on BSD):
427 ( git log --pretty=%ci --since=30day | cut -b-10
428 seq 0 30 | xargs -i date +%F -d-{}day ) |
429 sort | uniq -c | awk '$1--' | graph --spark
433 Mischa POSLAWSKY <perl@shiar.org>