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 my $total = sum @order;
175 printf '%s total', $total;
176 printf ' in %d values', scalar @values;
177 printf ' (%s min, %*.*f avg, %s max)',
178 $order[-1], 0, 2, $total / @order, $order[0];
186 barcat - graph to visualize input values
190 B<barcat> [<options>] [<input>]
194 Visualizes relative sizes of values read from input (file(s) or STDIN).
195 Contents are concatenated similar to I<cat>,
196 but numbers are reformatted and a bar graph is appended to each line.
202 =item -c, --[no-]color
204 Force colored output of values and bar markers.
205 Defaults on if output is a tty,
206 disabled otherwise such as when piped or redirected.
208 =item -f, --field=(<number>|<regexp>)
210 Compare values after a given number of whitespace separators,
211 or matching a regular expression.
213 Unspecified or I<-f0> means values are at the start of each line.
214 With I<-f1> the second word is taken instead.
215 A string can indicate the starting position of a value
216 (such as I<-f:> if preceded by colons),
217 or capture the numbers itself,
218 for example I<-f'(\d+)'> for the first digits anywhere.
220 =item -H, --human-readable
222 Format values using SI unit prefixes,
223 turning long numbers like I<12356789> into I<12.4M>.
224 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
225 Short integers are aligned but kept without decimal point.
227 =item -t, --interval[=<seconds>]
229 Interval time to output partial progress.
231 =item -l, --length=[-]<size>[%]
233 Trim line contents (between number and bars)
234 to a maximum number of characters.
235 The exceeding part is replaced by an abbreviation sign,
236 unless C<--length=0>.
238 Prepend a dash (i.e. make negative) to enforce padding
239 regardless of encountered contents.
241 =item -L, --limit=(<count>|<start>-[<end>])
243 Stop output after a number of lines.
244 All input is still counted and analyzed for statistics,
245 but disregarded for padding and bar size.
249 Statistical positions to indicate on bars.
250 Cannot be customized yet,
251 only disabled by providing an empty argument.
253 Any value enables all marker characters:
260 the sum of all values divided by the number of counted lines.
265 the middle value or average between middle values.
269 Standard deviation left of the mean.
270 Only 16% of all values are lower.
274 Standard deviation right of the mean.
275 The part between B<< <--> >> encompass all I<normal> results,
276 or 68% of all entries.
282 Total statistics after all data.
284 =item -u, --unmodified
286 Do not strip leading whitespace.
287 Keep original value alignment, which may be significant in some programs.
289 =item --value-length=<size>
291 Reserved space for numbers.
293 =item -w, --width=<columns>
295 Override the maximum number of columns to use.
296 Appended graphics will extend to fill up the entire screen.
302 Commonly used after counting, such as users on the current server:
304 users | sed 's/ /\n/g' | sort | uniq -c | barcat
306 Letter frequencies in text files:
308 cat /usr/share/games/fortunes/*.u8 |
309 perl -CO -nE 'say for grep length, split /\PL*/, uc' |
310 sort | uniq -c | barcat
312 Memory usage of user processes:
314 ps xo %mem,pid,cmd | barcat -l40
316 Sizes (in megabytes) of all root files and directories:
320 Number of HTTP requests per day:
322 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
324 Any kind of database query with leading counts:
326 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
329 Exchange rate USD/EUR history from CSV download provided by ECB:
331 curl https://sdw.ecb.europa.eu/export.do \
332 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
333 grep '^[12]' | barcat -f',\K' --value-length=7
335 Total population history from the World Bank dataset (XML):
337 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
338 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
339 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
341 Movies per year from prepared JSON data:
343 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
344 jq '.[].year' | uniq -c | barcat
346 Pokémon height comparison:
348 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
349 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
351 Git statistics, such commit count by year:
353 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
355 Or the top 3 most frequent authors with statistics over all:
357 git shortlog -sn | barcat -L3 -s
361 ping google.com | barcat -f'time=\K' -t
365 Mischa POSLAWSKY <perl@shiar.org>