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, 2;
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', color(1) . $total . color(0);
224 printf ' in %d values', scalar @values;
225 printf(' (%s min, %s avg, %s max)',
226 color(31) . $order[-1] . color(0),
227 color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
228 color(32) . $order[0] . color(0),
239 barcat - graph to visualize input values
243 B<barcat> [<options>] [<input>]
247 Visualizes relative sizes of values read from input (file(s) or STDIN).
248 Contents are concatenated similar to I<cat>,
249 but numbers are reformatted and a bar graph is appended to each line.
251 Don't worry, barcat does not drink and divide.
252 It can has various options for input and output (re)formatting,
253 but remains limited to one-dimensional charts.
254 For more complex graphing needs
255 you'll need a larger animal like I<gnuplot>.
261 =item -c, --[no-]color
263 Force colored output of values and bar markers.
264 Defaults on if output is a tty,
265 disabled otherwise such as when piped or redirected.
267 =item -f, --field=(<number>|<regexp>)
269 Compare values after a given number of whitespace separators,
270 or matching a regular expression.
272 Unspecified or I<-f0> means values are at the start of each line.
273 With I<-f1> the second word is taken instead.
274 A string can indicate the starting position of a value
275 (such as I<-f:> if preceded by colons),
276 or capture the numbers itself,
277 for example I<-f'(\d+)'> for the first digits anywhere.
279 =item -H, --human-readable
281 Format values using SI unit prefixes,
282 turning long numbers like I<12356789> into I<12.4M>.
283 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
284 Short integers are aligned but kept without decimal point.
286 =item -t, --interval[=<seconds>]
288 Interval time to output partial progress.
290 =item -l, --length=[-]<size>[%]
292 Trim line contents (between number and bars)
293 to a maximum number of characters.
294 The exceeding part is replaced by an abbreviation sign,
295 unless C<--length=0>.
297 Prepend a dash (i.e. make negative) to enforce padding
298 regardless of encountered contents.
300 =item -L, --limit=(<count>|<start>-[<end>])
302 Stop output after a number of lines.
303 All input is still counted and analyzed for statistics,
304 but disregarded for padding and bar size.
308 Statistical positions to indicate on bars.
309 Cannot be customized yet,
310 only disabled by providing an empty argument.
312 Any value enables all marker characters:
319 the sum of all values divided by the number of counted lines.
324 the middle value or average between middle values.
328 Standard deviation left of the mean.
329 Only 16% of all values are lower.
333 Standard deviation right of the mean.
334 The part between B<< <--> >> encompass all I<normal> results,
335 or 68% of all entries.
341 Total statistics after all data.
343 =item -u, --unmodified
345 Do not reformat values, keeping leading whitespace.
346 Keep original value alignment, which may be significant in some programs.
348 =item --value-length=<size>
350 Reserved space for numbers.
352 =item -w, --width=<columns>
354 Override the maximum number of columns to use.
355 Appended graphics will extend to fill up the entire screen.
359 Overview of available options.
376 seq 30 | awk '{print sin($1/10)}' | barcat
378 Compare file sizes (with human-readable numbers):
380 du -d0 -b * | barcat -H
382 Memory usage of user processes with long names truncated:
384 ps xo %mem,pid,cmd | barcat -l40
386 Monitor network latency from prefixed results:
388 ping google.com | barcat -f'time=\K' -t
390 Commonly used after counting, for example users on the current server:
392 users | sed 's/ /\n/g' | sort | uniq -c | barcat
394 Letter frequencies in text files:
396 cat /usr/share/games/fortunes/*.u8 |
397 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
398 sort | uniq -c | barcat
400 Number of HTTP requests per day:
402 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
404 Any kind of database query with counts, preserving returned alignment:
406 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
409 Earthquakes worldwide magnitude 1+ in the last 24 hours:
411 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
412 column -tns, | graph -f4 -u -l80%
414 External datasets, like movies per year:
416 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
417 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
419 But please get I<jq> to process JSON
420 and replace the manual selection by C<< jq '.[].year' >>.
422 Pokémon height comparison:
424 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
425 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
427 USD/EUR exchange rate from CSV provided by the ECB:
429 curl https://sdw.ecb.europa.eu/export.do \
430 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
431 grep '^[12]' | barcat -f',\K' --value-length=7
433 Total population history from the World Bank dataset (XML):
434 External datasets, like total population in XML from the World Bank:
436 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
437 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
438 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
440 And of course various Git statistics, such commit count by year:
442 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
444 Or the top 3 most frequent authors with statistics over all:
446 git shortlog -sn | barcat -L3 -s
448 Activity of the last days (substitute date C<-v-{}d> on BSD):
450 ( git log --pretty=%ci --since=30day | cut -b-10
451 seq 0 30 | xargs -i date +%F -d-{}day ) |
452 sort | uniq -c | awk '$1--' | graph --spark
456 Mischa POSLAWSKY <perl@shiar.org>