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 'trim|length|l=s' => sub {
24 my ($optname, $optval) = @_;
25 $optval =~ s/%$// and $opt{trimpct}++;
26 $optval =~ m/^-?[0-9]+$/ or die(
27 "Value \"$optval\" invalid for option $optname",
28 " (number or percentage expected)\n"
36 my ($optname, $optval) = @_;
38 ($opt{hidemin}, $opt{hidemax}) =
39 $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die(
40 "Value \"$optval\" invalid for option limit",
47 'usage|h' => sub { podexit() },
48 'help' => sub { podexit(-verbose => 2) },
49 ) or exit 64; # EX_USAGE
51 $opt{width} ||= $ENV{COLUMNS} || 80;
52 $opt{color} //= -t *STDOUT; # enable on tty
53 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
54 $opt{units} = $opt{'human-readable'} && ['', qw( k M G T <> n μ m )];
56 if (defined $opt{interval}) {
65 $SIG{INT} = 'IGNORE'; # continue after assumed eof
68 my $anchor = !defined $opt{field} ? qr/\A/ :
69 $opt{field} =~ /^[0-9]+$/ ? qr/(?:\S*\h+){$opt{field}}\K/ :
73 s/^\h*// unless $opt{unmodified};
74 push @values, s/$anchor ( \h* -? [0-9]* \.? [0-9]+ |)/\n/x && $1;
75 if (defined $opt{trim}) {
76 my $trimpos = abs $opt{trim};
80 elsif (length > $trimpos) {
81 substr($_, $trimpos - 1) = '…';
87 $SIG{INT} = 'DEFAULT';
91 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
92 @lines and @lines > $nr or return;
94 my @order = sort { $b <=> $a } grep { length } @values;
95 my $maxval = $opt{hidemax} ? max @values[0 .. $opt{hidemax} - 1] : $order[0];
96 my $minval = min $order[-1], 0;
97 my $lenval = $opt{'value-length'} // max map { length } @order;
98 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
99 max map { length $values[$_] && length $lines[$_] }
100 0 .. min $#lines, $opt{hidemax} || (); # left padding
101 my $size = ($maxval - $minval) &&
102 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
105 if ($opt{markers} // 1 and $size > 0) {
106 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
107 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
108 $barmark[ orderpos($#order * .31731) ] = '>';
109 $barmark[ orderpos($#order * .68269) ] = '<';
110 $barmark[ orderpos($#order / 2) ] = '+'; # mean
111 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
112 defined and $opt{color} and $_ = "\e[36m$_\e[0m" for @barmark;
114 state $lastmax = $maxval;
115 if ($maxval > $lastmax) {
116 print ' ' x ($lenval + $len);
117 printf "\e[90m" if $opt{color};
119 ($lastmax - $minval) * $size + .5,
120 '-' x (($values[$nr - 1] - $minval) * $size);
121 print "\e[92m" if $opt{color};
122 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
123 print "\e[0m" if $opt{color};
128 while ($nr <= $#lines) {
129 $nr >= $opt{hidemax} and last if $opt{hidemax};
130 my $val = $values[$nr];
132 my $color = !$opt{color} ? 0 :
133 $val == $order[0] ? 32 : # max
134 $val == $order[-1] ? 31 : # min
136 $val = sprintf "%3.1f%1s", $val / 1000**$_, $opt{units}->[$_]
137 for $opt{units} ? int(log($val) / log(1000) - ($val < 1)) : ();
138 $val = sprintf "%*s", $lenval, $val;
139 $val = "\e[${color}m$val\e[0m" if $color;
141 my $line = $lines[$nr] =~ s/\n/$val/r;
142 printf '%-*s', $len + length($val), $line;
143 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
156 barcat - graph to visualize input values
160 B<barcat> [<options>] [<input>]
164 Visualizes relative sizes of values read from input (file(s) or STDIN).
165 Contents are concatenated similar to I<cat>,
166 but numbers are reformatted and a bar graph is appended to each line.
172 =item -c, --[no-]color
174 Force colored output of values and bar markers.
175 Defaults on if output is a tty,
176 disabled otherwise such as when piped or redirected.
178 =item -f, --field=(<number>|<regexp>)
180 Compare values after a given number of whitespace separators,
181 or matching a regular expression.
183 Unspecified or I<-f0> means values are at the start of each line.
184 With I<-f1> the second word is taken instead.
185 A string can indicate the starting position of a value
186 (such as I<-f:> if preceded by colons),
187 or capture the numbers itself,
188 for example I<-f'(\d+)'> for the first digits anywhere.
190 =item -H, --human-readable
192 Format values using SI unit prefixes,
193 turning long numbers like I<12356789> into I<12.4M>.
195 =item -t, --interval[=<seconds>]
197 Interval time to output partial progress.
199 =item -l, --length=[-]<size>[%]
201 Trim line contents (between number and bars)
202 to a maximum number of characters.
203 The exceeding part is replaced by an abbreviation sign,
204 unless C<--length=0>.
206 Prepend a dash (i.e. make negative) to enforce padding
207 regardless of encountered contents.
209 =item -L, --limit=(<count>|<start>-[<end>])
211 Stop output after a number of lines.
212 All input is still counted and analyzed for statistics,
213 but disregarded for padding and bar size.
217 Statistical positions to indicate on bars.
218 Cannot be customized yet,
219 only disabled by providing an empty argument.
221 Any value enables all marker characters:
228 the sum of all values divided by the number of counted lines.
233 the middle value or average between middle values.
237 Standard deviation left of the mean.
238 Only 16% of all values are lower.
242 Standard deviation right of the mean.
243 The part between B<< <--> >> encompass all I<normal> results,
244 or 68% of all entries.
248 =item -u, --unmodified
250 Do not strip leading whitespace.
251 Keep original value alignment, which may be significant in some programs.
253 =item --value-length=<size>
255 Reserved space for numbers.
257 =item -w, --width=<columns>
259 Override the maximum number of columns to use.
260 Appended graphics will extend to fill up the entire screen.
266 Commonly used after counting, such as users on the current server:
268 users | sed 's/ /\n/g' | sort | uniq -c | barcat
270 Letter frequencies in text files:
272 cat /usr/share/games/fortunes/*.u8 |
273 perl -CO -nE 'say for grep length, split /\PL*/, uc' |
274 sort | uniq -c | barcat
276 Memory usage of user processes:
278 ps xo %mem,pid,cmd | barcat -l40
280 Sizes (in megabytes) of all root files and directories:
284 Number of HTTP requests per day:
286 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
288 Any kind of database query with leading counts:
290 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
293 Exchange rate USD/EUR history from CSV download provided by ECB:
295 curl https://sdw.ecb.europa.eu/export.do \
296 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
297 grep '^[12]' | barcat -f',\K' --value-length=7
299 Total population history from the World Bank dataset (XML):
301 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
302 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
303 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
305 Movies per year from prepared JSON data:
307 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
308 jq '.[].year' | uniq -c | barcat
310 Pokémon height comparison:
312 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
313 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
315 Git statistics, such commit count by year:
317 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
319 Or the most frequent authors:
321 git shortlog -sn | barcat -L3
325 ping google.com | barcat -f'time=\K' -t
329 Mischa POSLAWSKY <perl@shiar.org>