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
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 if (defined $opt{trim}) {
82 my $trimpos = abs $opt{trim};
86 elsif (length > $trimpos) {
87 substr($_, $trimpos - 1) = '…';
93 $SIG{INT} = 'DEFAULT';
99 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
100 @lines and @lines > $nr or return;
102 @lines > $nr or return unless $opt{hidemin};
104 @order = sort { $b <=> $a } grep { length } @values;
105 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
106 my $minval = min $order[-1] // (), 0;
107 my $lenval = $opt{'value-length'} // max map { length } @order;
108 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
109 max map { length $values[$_] && length $lines[$_] }
110 0 .. min $#lines, $opt{hidemax} || (); # left padding
111 my $size = ($maxval - $minval) &&
112 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
115 if ($opt{markers} // 1 and $size > 0) {
116 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
117 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
118 $barmark[ orderpos($#order * .31731) ] = '>';
119 $barmark[ orderpos($#order * .68269) ] = '<';
120 $barmark[ orderpos($#order / 2) ] = '+'; # mean
121 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
122 defined and $opt{color} and $_ = "\e[36m$_\e[0m" for @barmark;
124 state $lastmax = $maxval;
125 if ($maxval > $lastmax) {
126 print ' ' x ($lenval + $len);
127 printf "\e[90m" if $opt{color};
129 ($lastmax - $minval) * $size + .5,
130 '-' x (($values[$nr - 1] - $minval) * $size);
131 print "\e[92m" if $opt{color};
132 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
133 print "\e[0m" if $opt{color};
138 @lines > $nr or return if $opt{hidemin};
141 my $unit = int(log($_[0]) / log(1000) - ($_[0] < 1));
142 my $float = $_[0] !~ /^ (?: 0*\.)? [0-9]{1,3} $/x;
144 $float ? 5 : 3, $float, # length and tenths
145 $_[0] / 1000 ** $unit, # number
146 $float ? 0 : 3, # unit size
147 $#{$opt{units}} >> 1 < abs $unit ? "e$unit" : $opt{units}->[$unit]
151 while ($nr <= $#lines) {
152 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
153 my $val = $values[$nr];
155 my $color = !$opt{color} ? 0 :
156 $val == $order[0] ? 32 : # max
157 $val == $order[-1] ? 31 : # min
159 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
160 $val = "\e[${color}m$val\e[0m" if $color;
162 my $line = $lines[$nr] =~ s/\n/$val/r;
163 printf '%-*s', $len + length($val), $line;
164 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
174 if ($opt{hidemin} or $opt{hidemax}) {
176 $opt{hidemax} ||= @lines;
177 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
179 my $total = sum @order;
180 printf '%s total', $total;
181 printf ' in %d values', scalar @values;
182 printf ' (%s min, %*.*f avg, %s max)',
183 $order[-1], 0, 2, $total / @order, $order[0];
191 barcat - graph to visualize input values
195 B<barcat> [<options>] [<input>]
199 Visualizes relative sizes of values read from input (file(s) or STDIN).
200 Contents are concatenated similar to I<cat>,
201 but numbers are reformatted and a bar graph is appended to each line.
207 =item -c, --[no-]color
209 Force colored output of values and bar markers.
210 Defaults on if output is a tty,
211 disabled otherwise such as when piped or redirected.
213 =item -f, --field=(<number>|<regexp>)
215 Compare values after a given number of whitespace separators,
216 or matching a regular expression.
218 Unspecified or I<-f0> means values are at the start of each line.
219 With I<-f1> the second word is taken instead.
220 A string can indicate the starting position of a value
221 (such as I<-f:> if preceded by colons),
222 or capture the numbers itself,
223 for example I<-f'(\d+)'> for the first digits anywhere.
225 =item -H, --human-readable
227 Format values using SI unit prefixes,
228 turning long numbers like I<12356789> into I<12.4M>.
229 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
230 Short integers are aligned but kept without decimal point.
232 =item -t, --interval[=<seconds>]
234 Interval time to output partial progress.
236 =item -l, --length=[-]<size>[%]
238 Trim line contents (between number and bars)
239 to a maximum number of characters.
240 The exceeding part is replaced by an abbreviation sign,
241 unless C<--length=0>.
243 Prepend a dash (i.e. make negative) to enforce padding
244 regardless of encountered contents.
246 =item -L, --limit=(<count>|<start>-[<end>])
248 Stop output after a number of lines.
249 All input is still counted and analyzed for statistics,
250 but disregarded for padding and bar size.
254 Statistical positions to indicate on bars.
255 Cannot be customized yet,
256 only disabled by providing an empty argument.
258 Any value enables all marker characters:
265 the sum of all values divided by the number of counted lines.
270 the middle value or average between middle values.
274 Standard deviation left of the mean.
275 Only 16% of all values are lower.
279 Standard deviation right of the mean.
280 The part between B<< <--> >> encompass all I<normal> results,
281 or 68% of all entries.
287 Total statistics after all data.
289 =item -u, --unmodified
291 Do not strip leading whitespace.
292 Keep original value alignment, which may be significant in some programs.
294 =item --value-length=<size>
296 Reserved space for numbers.
298 =item -w, --width=<columns>
300 Override the maximum number of columns to use.
301 Appended graphics will extend to fill up the entire screen.
307 Commonly used after counting, such as users on the current server:
309 users | sed 's/ /\n/g' | sort | uniq -c | barcat
311 Letter frequencies in text files:
313 cat /usr/share/games/fortunes/*.u8 |
314 perl -CO -nE 'say for grep length, split /\PL*/, uc' |
315 sort | uniq -c | barcat
317 Memory usage of user processes:
319 ps xo %mem,pid,cmd | barcat -l40
321 Sizes (in megabytes) of all root files and directories:
325 Number of HTTP requests per day:
327 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
329 Any kind of database query with leading counts:
331 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
334 Exchange rate USD/EUR history from CSV download provided by ECB:
336 curl https://sdw.ecb.europa.eu/export.do \
337 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
338 grep '^[12]' | barcat -f',\K' --value-length=7
340 Total population history from the World Bank dataset (XML):
342 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
343 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
344 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
346 Movies per year from prepared JSON data:
348 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
349 jq '.[].year' | uniq -c | barcat
351 Pokémon height comparison:
353 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
354 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
356 Git statistics, such commit count by year:
358 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
360 Or the top 3 most frequent authors with statistics over all:
362 git shortlog -sn | barcat -L3 -s
366 ping google.com | barcat -f'time=\K' -t
370 Mischa POSLAWSKY <perl@shiar.org>