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",
53 'usage|h' => sub { podexit() },
54 'help' => sub { podexit(-verbose => 2) },
55 ) or exit 64; # EX_USAGE
57 $opt{width} ||= $ENV{COLUMNS} || 80;
58 $opt{color} //= -t *STDOUT; # enable on tty
59 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
60 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
61 $opt{anchor} //= qr/\A/;
62 $opt{'value-length'} = 6 if $opt{units};
64 if (defined $opt{interval}) {
73 $SIG{INT} = 'IGNORE'; # continue after assumed eof
75 my (@lines, @values, @order);
76 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
79 s/^\h*// unless $opt{unmodified};
80 push @values, s/$valmatch/\n/ && $1;
81 push @order, $1 if length $1;
82 if (defined $opt{trim}) {
83 my $trimpos = abs $opt{trim};
87 elsif (length > $trimpos) {
88 substr($_, $trimpos - 1) = '…';
94 $SIG{INT} = 'DEFAULT';
98 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
99 @lines and @lines > $nr or return;
101 @lines > $nr or return unless $opt{hidemin};
103 @order = sort { $b <=> $a } @order;
104 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
105 my $minval = min $order[-1] // (), 0;
106 my $lenval = $opt{'value-length'} // max map { length } @order;
107 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
108 max map { length $values[$_] && length $lines[$_] }
109 0 .. min $#lines, $opt{hidemax} || (); # left padding
110 my $size = ($maxval - $minval) &&
111 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
114 if ($opt{markers} // 1 and $size > 0) {
115 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
116 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
117 $barmark[ orderpos($#order * .31731) ] = '>';
118 $barmark[ orderpos($#order * .68269) ] = '<';
119 $barmark[ orderpos($#order / 2) ] = '+'; # mean
120 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
121 defined and $opt{color} and $_ = "\e[36m$_\e[0m" for @barmark;
123 state $lastmax = $maxval;
124 if ($maxval > $lastmax) {
125 print ' ' x ($lenval + $len);
126 printf "\e[90m" if $opt{color};
128 ($lastmax - $minval) * $size + .5,
129 '-' x (($values[$nr - 1] - $minval) * $size);
130 print "\e[92m" if $opt{color};
131 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
132 print "\e[0m" if $opt{color};
137 @lines > $nr or return if $opt{hidemin};
140 my $unit = int(log($_[0]) / log(1000) - ($_[0] < 1));
141 my $float = $_[0] !~ /^ (?: 0*\.)? [0-9]{1,3} $/x;
143 $float ? 5 : 3, $float, # length and tenths
144 $_[0] / 1000 ** $unit, # number
145 $float ? 0 : 3, # unit size
146 $#{$opt{units}} >> 1 < abs $unit ? "e$unit" : $opt{units}->[$unit]
150 while ($nr <= $#lines) {
151 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
152 my $val = $values[$nr];
154 my $color = !$opt{color} ? 0 :
155 $val == $order[0] ? 32 : # max
156 $val == $order[-1] ? 31 : # min
158 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
159 $val = "\e[${color}m$val\e[0m" if $color;
161 my $line = $lines[$nr] =~ s/\n/$val/r;
162 printf '%-*s', $len + length($val), $line;
163 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
173 if ($opt{hidemin} or $opt{hidemax}) {
175 $opt{hidemax} ||= @lines;
176 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
178 my $total = sum @order;
179 printf '%s total', $total;
180 printf ' in %d values', scalar @values;
181 printf ' (%s min, %*.*f avg, %s max)',
182 $order[-1], 0, 2, $total / @order, $order[0];
190 barcat - graph to visualize input values
194 B<barcat> [<options>] [<input>]
198 Visualizes relative sizes of values read from input (file(s) or STDIN).
199 Contents are concatenated similar to I<cat>,
200 but numbers are reformatted and a bar graph is appended to each line.
206 =item -c, --[no-]color
208 Force colored output of values and bar markers.
209 Defaults on if output is a tty,
210 disabled otherwise such as when piped or redirected.
212 =item -f, --field=(<number>|<regexp>)
214 Compare values after a given number of whitespace separators,
215 or matching a regular expression.
217 Unspecified or I<-f0> means values are at the start of each line.
218 With I<-f1> the second word is taken instead.
219 A string can indicate the starting position of a value
220 (such as I<-f:> if preceded by colons),
221 or capture the numbers itself,
222 for example I<-f'(\d+)'> for the first digits anywhere.
224 =item -H, --human-readable
226 Format values using SI unit prefixes,
227 turning long numbers like I<12356789> into I<12.4M>.
228 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
229 Short integers are aligned but kept without decimal point.
231 =item -t, --interval[=<seconds>]
233 Interval time to output partial progress.
235 =item -l, --length=[-]<size>[%]
237 Trim line contents (between number and bars)
238 to a maximum number of characters.
239 The exceeding part is replaced by an abbreviation sign,
240 unless C<--length=0>.
242 Prepend a dash (i.e. make negative) to enforce padding
243 regardless of encountered contents.
245 =item -L, --limit=(<count>|<start>-[<end>])
247 Stop output after a number of lines.
248 All input is still counted and analyzed for statistics,
249 but disregarded for padding and bar size.
253 Statistical positions to indicate on bars.
254 Cannot be customized yet,
255 only disabled by providing an empty argument.
257 Any value enables all marker characters:
264 the sum of all values divided by the number of counted lines.
269 the middle value or average between middle values.
273 Standard deviation left of the mean.
274 Only 16% of all values are lower.
278 Standard deviation right of the mean.
279 The part between B<< <--> >> encompass all I<normal> results,
280 or 68% of all entries.
286 Total statistics after all data.
288 =item -u, --unmodified
290 Do not strip leading whitespace.
291 Keep original value alignment, which may be significant in some programs.
293 =item --value-length=<size>
295 Reserved space for numbers.
297 =item -w, --width=<columns>
299 Override the maximum number of columns to use.
300 Appended graphics will extend to fill up the entire screen.
306 Commonly used after counting, such as users on the current server:
308 users | sed 's/ /\n/g' | sort | uniq -c | barcat
310 Letter frequencies in text files:
312 cat /usr/share/games/fortunes/*.u8 |
313 perl -CO -nE 'say for grep length, split /\PL*/, uc' |
314 sort | uniq -c | barcat
316 Memory usage of user processes:
318 ps xo %mem,pid,cmd | barcat -l40
320 Sizes (in megabytes) of all root files and directories:
324 Number of HTTP requests per day:
326 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
328 Any kind of database query with leading counts:
330 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
333 Exchange rate USD/EUR history from CSV download provided by ECB:
335 curl https://sdw.ecb.europa.eu/export.do \
336 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
337 grep '^[12]' | barcat -f',\K' --value-length=7
339 Total population history from the World Bank dataset (XML):
341 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
342 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
343 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
345 Movies per year from prepared JSON data:
347 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
348 jq '.[].year' | uniq -c | barcat
350 Pokémon height comparison:
352 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
353 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
355 Git statistics, such commit count by year:
357 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
359 Or the top 3 most frequent authors with statistics over all:
361 git shortlog -sn | barcat -L3 -s
365 ping google.com | barcat -f'time=\K' -t
369 Mischa POSLAWSKY <perl@shiar.org>