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",
52 'usage|h' => sub { podexit() },
53 'help' => sub { podexit(-verbose => 2) },
54 ) or exit 64; # EX_USAGE
56 $opt{width} ||= $ENV{COLUMNS} || 80;
57 $opt{color} //= -t *STDOUT; # enable on tty
58 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
59 $opt{units} = $opt{'human-readable'} && ['', qw( k M G T P E Z Y y z a f p n μ m )];
60 $opt{anchor} //= qr/\A/;
62 if (defined $opt{interval}) {
71 $SIG{INT} = 'IGNORE'; # continue after assumed eof
74 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
77 s/^\h*// unless $opt{unmodified};
78 push @values, s/$valmatch/\n/ && $1;
79 if (defined $opt{trim}) {
80 my $trimpos = abs $opt{trim};
84 elsif (length > $trimpos) {
85 substr($_, $trimpos - 1) = '…';
91 $SIG{INT} = 'DEFAULT';
95 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
96 @lines and @lines > $nr or return;
98 my @order = sort { $b <=> $a } grep { length } @values;
99 my $maxval = $opt{hidemax} ? max @values[0 .. $opt{hidemax} - 1] : $order[0];
100 my $minval = min $order[-1], 0;
101 my $lenval = $opt{'value-length'} // max map { length } @order;
102 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
103 max map { length $values[$_] && length $lines[$_] }
104 0 .. min $#lines, $opt{hidemax} || (); # left padding
105 my $size = ($maxval - $minval) &&
106 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
109 if ($opt{markers} // 1 and $size > 0) {
110 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
111 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
112 $barmark[ orderpos($#order * .31731) ] = '>';
113 $barmark[ orderpos($#order * .68269) ] = '<';
114 $barmark[ orderpos($#order / 2) ] = '+'; # mean
115 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
116 defined and $opt{color} and $_ = "\e[36m$_\e[0m" for @barmark;
118 state $lastmax = $maxval;
119 if ($maxval > $lastmax) {
120 print ' ' x ($lenval + $len);
121 printf "\e[90m" if $opt{color};
123 ($lastmax - $minval) * $size + .5,
124 '-' x (($values[$nr - 1] - $minval) * $size);
125 print "\e[92m" if $opt{color};
126 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
127 print "\e[0m" if $opt{color};
133 my $unit = int(log($_[0]) / log(1000) - ($_[0] < 1));
134 sprintf "%3.1f%1s", $_[0] / 1000 ** $unit,
135 $#{$opt{units}} >> 1 < abs $unit ? "e$unit" : $opt{units}->[$unit];
138 while ($nr <= $#lines) {
139 $nr >= $opt{hidemax} and last if $opt{hidemax};
140 my $val = $values[$nr];
142 my $color = !$opt{color} ? 0 :
143 $val == $order[0] ? 32 : # max
144 $val == $order[-1] ? 31 : # min
146 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
147 $val = "\e[${color}m$val\e[0m" if $color;
149 my $line = $lines[$nr] =~ s/\n/$val/r;
150 printf '%-*s', $len + length($val), $line;
151 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
164 barcat - graph to visualize input values
168 B<barcat> [<options>] [<input>]
172 Visualizes relative sizes of values read from input (file(s) or STDIN).
173 Contents are concatenated similar to I<cat>,
174 but numbers are reformatted and a bar graph is appended to each line.
180 =item -c, --[no-]color
182 Force colored output of values and bar markers.
183 Defaults on if output is a tty,
184 disabled otherwise such as when piped or redirected.
186 =item -f, --field=(<number>|<regexp>)
188 Compare values after a given number of whitespace separators,
189 or matching a regular expression.
191 Unspecified or I<-f0> means values are at the start of each line.
192 With I<-f1> the second word is taken instead.
193 A string can indicate the starting position of a value
194 (such as I<-f:> if preceded by colons),
195 or capture the numbers itself,
196 for example I<-f'(\d+)'> for the first digits anywhere.
198 =item -H, --human-readable
200 Format values using SI unit prefixes,
201 turning long numbers like I<12356789> into I<12.4M>.
202 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
204 =item -t, --interval[=<seconds>]
206 Interval time to output partial progress.
208 =item -l, --length=[-]<size>[%]
210 Trim line contents (between number and bars)
211 to a maximum number of characters.
212 The exceeding part is replaced by an abbreviation sign,
213 unless C<--length=0>.
215 Prepend a dash (i.e. make negative) to enforce padding
216 regardless of encountered contents.
218 =item -L, --limit=(<count>|<start>-[<end>])
220 Stop output after a number of lines.
221 All input is still counted and analyzed for statistics,
222 but disregarded for padding and bar size.
226 Statistical positions to indicate on bars.
227 Cannot be customized yet,
228 only disabled by providing an empty argument.
230 Any value enables all marker characters:
237 the sum of all values divided by the number of counted lines.
242 the middle value or average between middle values.
246 Standard deviation left of the mean.
247 Only 16% of all values are lower.
251 Standard deviation right of the mean.
252 The part between B<< <--> >> encompass all I<normal> results,
253 or 68% of all entries.
257 =item -u, --unmodified
259 Do not strip leading whitespace.
260 Keep original value alignment, which may be significant in some programs.
262 =item --value-length=<size>
264 Reserved space for numbers.
266 =item -w, --width=<columns>
268 Override the maximum number of columns to use.
269 Appended graphics will extend to fill up the entire screen.
275 Commonly used after counting, such as users on the current server:
277 users | sed 's/ /\n/g' | sort | uniq -c | barcat
279 Letter frequencies in text files:
281 cat /usr/share/games/fortunes/*.u8 |
282 perl -CO -nE 'say for grep length, split /\PL*/, uc' |
283 sort | uniq -c | barcat
285 Memory usage of user processes:
287 ps xo %mem,pid,cmd | barcat -l40
289 Sizes (in megabytes) of all root files and directories:
293 Number of HTTP requests per day:
295 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
297 Any kind of database query with leading counts:
299 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
302 Exchange rate USD/EUR history from CSV download provided by ECB:
304 curl https://sdw.ecb.europa.eu/export.do \
305 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
306 grep '^[12]' | barcat -f',\K' --value-length=7
308 Total population history from the World Bank dataset (XML):
310 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
311 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
312 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
314 Movies per year from prepared JSON data:
316 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
317 jq '.[].year' | uniq -c | barcat
319 Pokémon height comparison:
321 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
322 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
324 Git statistics, such commit count by year:
326 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
328 Or the most frequent authors:
330 git shortlog -sn | barcat -L3
334 ping google.com | barcat -f'time=\K' -t
338 Mischa POSLAWSKY <perl@shiar.org>