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 my (@lines, @values, @order);
66 if (defined $opt{interval}) {
75 require Tie::Array::Sorted;
76 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
77 } or warn $@, "Expect slowdown with large datasets!\n";
80 $SIG{INT} = 'IGNORE'; # continue after assumed eof
82 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
85 s/^\h*// unless $opt{unmodified};
86 push @values, s/$valmatch/\n/ && $1;
87 push @order, $1 if length $1;
88 if (defined $opt{trim}) {
89 my $trimpos = abs $opt{trim};
93 elsif (length > $trimpos) {
94 substr($_, $trimpos - 1) = '…';
100 $SIG{INT} = 'DEFAULT';
104 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
105 @lines and @lines > $nr or return;
107 @lines > $nr or return unless $opt{hidemin};
109 @order = sort { $b <=> $a } @order unless tied @order;
110 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
111 my $minval = min $order[-1] // (), 0;
112 my $lenval = $opt{'value-length'} // max map { length } @order;
113 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
114 max map { length $values[$_] && length $lines[$_] }
115 0 .. min $#lines, $opt{hidemax} || (); # left padding
116 my $size = ($maxval - $minval) &&
117 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
120 if ($opt{markers} // 1 and $size > 0) {
121 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
122 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
123 $barmark[ orderpos($#order * .31731) ] = '>';
124 $barmark[ orderpos($#order * .68269) ] = '<';
125 $barmark[ orderpos($#order / 2) ] = '+'; # mean
126 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
127 defined and $opt{color} and $_ = "\e[36m$_\e[0m" for @barmark;
129 state $lastmax = $maxval;
130 if ($maxval > $lastmax) {
131 print ' ' x ($lenval + $len);
132 printf "\e[90m" if $opt{color};
134 ($lastmax - $minval) * $size + .5,
135 '-' x (($values[$nr - 1] - $minval) * $size);
136 print "\e[92m" if $opt{color};
137 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
138 print "\e[0m" if $opt{color};
143 @lines > $nr or return if $opt{hidemin};
146 my $unit = int(log($_[0]) / log(1000) - ($_[0] < 1));
147 my $float = $_[0] !~ /^ (?: 0*\.)? [0-9]{1,3} $/x;
149 $float ? 5 : 3, $float, # length and tenths
150 $_[0] / 1000 ** $unit, # number
151 $float ? 0 : 3, # unit size
152 $#{$opt{units}} >> 1 < abs $unit ? "e$unit" : $opt{units}->[$unit]
156 while ($nr <= $#lines) {
157 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
158 my $val = $values[$nr];
160 my $color = !$opt{color} ? 0 :
161 $val == $order[0] ? 32 : # max
162 $val == $order[-1] ? 31 : # min
164 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
165 $val = "\e[${color}m$val\e[0m" if $color;
167 my $line = $lines[$nr] =~ s/\n/$val/r;
168 printf '%-*s', $len + length($val), $line;
169 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
179 if ($opt{hidemin} or $opt{hidemax}) {
181 $opt{hidemax} ||= @lines;
182 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
184 my $total = sum @order;
185 printf '%s total', $total;
186 printf ' in %d values', scalar @values;
187 printf ' (%s min, %*.*f avg, %s max)',
188 $order[-1], 0, 2, $total / @order, $order[0];
196 barcat - graph to visualize input values
200 B<barcat> [<options>] [<input>]
204 Visualizes relative sizes of values read from input (file(s) or STDIN).
205 Contents are concatenated similar to I<cat>,
206 but numbers are reformatted and a bar graph is appended to each line.
212 =item -c, --[no-]color
214 Force colored output of values and bar markers.
215 Defaults on if output is a tty,
216 disabled otherwise such as when piped or redirected.
218 =item -f, --field=(<number>|<regexp>)
220 Compare values after a given number of whitespace separators,
221 or matching a regular expression.
223 Unspecified or I<-f0> means values are at the start of each line.
224 With I<-f1> the second word is taken instead.
225 A string can indicate the starting position of a value
226 (such as I<-f:> if preceded by colons),
227 or capture the numbers itself,
228 for example I<-f'(\d+)'> for the first digits anywhere.
230 =item -H, --human-readable
232 Format values using SI unit prefixes,
233 turning long numbers like I<12356789> into I<12.4M>.
234 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
235 Short integers are aligned but kept without decimal point.
237 =item -t, --interval[=<seconds>]
239 Interval time to output partial progress.
241 =item -l, --length=[-]<size>[%]
243 Trim line contents (between number and bars)
244 to a maximum number of characters.
245 The exceeding part is replaced by an abbreviation sign,
246 unless C<--length=0>.
248 Prepend a dash (i.e. make negative) to enforce padding
249 regardless of encountered contents.
251 =item -L, --limit=(<count>|<start>-[<end>])
253 Stop output after a number of lines.
254 All input is still counted and analyzed for statistics,
255 but disregarded for padding and bar size.
259 Statistical positions to indicate on bars.
260 Cannot be customized yet,
261 only disabled by providing an empty argument.
263 Any value enables all marker characters:
270 the sum of all values divided by the number of counted lines.
275 the middle value or average between middle values.
279 Standard deviation left of the mean.
280 Only 16% of all values are lower.
284 Standard deviation right of the mean.
285 The part between B<< <--> >> encompass all I<normal> results,
286 or 68% of all entries.
292 Total statistics after all data.
294 =item -u, --unmodified
296 Do not strip leading whitespace.
297 Keep original value alignment, which may be significant in some programs.
299 =item --value-length=<size>
301 Reserved space for numbers.
303 =item -w, --width=<columns>
305 Override the maximum number of columns to use.
306 Appended graphics will extend to fill up the entire screen.
312 Commonly used after counting, such as users on the current server:
314 users | sed 's/ /\n/g' | sort | uniq -c | barcat
316 Letter frequencies in text files:
318 cat /usr/share/games/fortunes/*.u8 |
319 perl -CO -nE 'say for grep length, split /\PL*/, uc' |
320 sort | uniq -c | barcat
322 Memory usage of user processes:
324 ps xo %mem,pid,cmd | barcat -l40
326 Sizes (in megabytes) of all root files and directories:
330 Number of HTTP requests per day:
332 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
334 Any kind of database query with leading counts:
336 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
339 Exchange rate USD/EUR history from CSV download provided by ECB:
341 curl https://sdw.ecb.europa.eu/export.do \
342 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
343 grep '^[12]' | barcat -f',\K' --value-length=7
345 Total population history from the World Bank dataset (XML):
347 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
348 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
349 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
351 Movies per year from prepared JSON data:
353 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
354 jq '.[].year' | uniq -c | barcat
356 Pokémon height comparison:
358 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
359 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
361 Git statistics, such commit count by year:
363 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
365 Or the top 3 most frequent authors with statistics over all:
367 git shortlog -sn | barcat -L3 -s
371 ping google.com | barcat -f'time=\K' -t
375 Mischa POSLAWSKY <perl@shiar.org>