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 },
22 'trim|length|l=s' => sub {
23 my ($optname, $optval) = @_;
24 $optval =~ s/%$// and $opt{trimpct}++;
25 $optval =~ m/^-?[0-9]+$/ or die(
26 "Value \"$optval\" invalid for option $optname",
27 " (number or percentage expected)\n"
36 'usage|h' => sub { podexit() },
37 'help' => sub { podexit(-verbose => 2) },
38 ) or exit 64; # EX_USAGE
40 $opt{width} ||= $ENV{COLUMNS} || 80;
41 $opt{color} //= -t *STDOUT; # enable on tty
42 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
44 if (defined $opt{interval}) {
53 $SIG{INT} = 'IGNORE'; # continue after assumed eof
56 my $anchor = !defined $opt{field} ? qr/\A/ :
57 $opt{field} =~ /^[0-9]+$/ ? qr/(?:\S*\h+){$opt{field}}\K/ :
61 s/^\h*// unless $opt{unmodified};
62 push @values, s/$anchor ( \h* -? [0-9]* \.? [0-9]+ |)/\n/x && $1;
63 if (defined $opt{trim}) {
64 my $trimpos = abs $opt{trim};
68 elsif (length > $trimpos) {
69 substr($_, $trimpos - 1) = '…';
75 $SIG{INT} = 'DEFAULT';
80 @lines and @lines > $nr or return;
82 my @order = sort { $b <=> $a } grep { length } @values;
83 my $maxval = $opt{hidemax} ? max @values[0 .. $opt{hidemax} - 1] : $order[0];
84 my $minval = min $order[-1], 0;
85 my $lenval = $opt{'value-length'} // max map { length } @order;
86 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
87 max map { length $values[$_] && length $lines[$_] }
88 0 .. min $#lines, $opt{hidemax} || (); # left padding
89 my $size = ($maxval - $minval) &&
90 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
93 if ($opt{markers} // 1 and $size > 0) {
94 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
95 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
96 $barmark[ orderpos($#order * .31731) ] = '>';
97 $barmark[ orderpos($#order * .68269) ] = '<';
98 $barmark[ orderpos($#order / 2) ] = '+'; # mean
99 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
100 defined and $opt{color} and $_ = "\e[36m$_\e[0m" for @barmark;
102 state $lastmax = $maxval;
103 if ($maxval > $lastmax) {
104 print ' ' x ($lenval + $len);
105 printf "\e[90m" if $opt{color};
107 ($lastmax - $minval) * $size + .5,
108 '-' x (($values[$nr - 1] - $minval) * $size);
109 print "\e[92m" if $opt{color};
110 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
111 print "\e[0m" if $opt{color};
116 while ($nr <= $#lines) {
117 $nr >= $opt{hidemax} and last if $opt{hidemax};
118 my $val = $values[$nr];
120 my $color = !$opt{color} ? 0 :
121 $val == $order[0] ? 32 : # max
122 $val == $order[-1] ? 31 : # min
124 $val = sprintf "%*s", $lenval, $val;
125 $val = "\e[${color}m$val\e[0m" if $color;
127 my $line = $lines[$nr] =~ s/\n/$val/r;
128 printf '%-*s', $len + length($val), $line;
129 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
142 barcat - graph to visualize input values
146 B<barcat> [<options>] [<input>]
150 Visualizes relative sizes of values read from input (file(s) or STDIN).
151 Contents are concatenated similar to I<cat>,
152 but numbers are reformatted and a bar graph is appended to each line.
158 =item -c, --[no-]color
160 Force colored output of values and bar markers.
161 Defaults on if output is a tty,
162 disabled otherwise such as when piped or redirected.
164 =item -f, --field=(<number>|<regexp>)
166 Compare values after a given number of whitespace separators,
167 or matching a regular expression.
169 Unspecified or I<-f0> means values are at the start of each line.
170 With I<-f1> the second word is taken instead.
171 A string can indicate the starting position of a value
172 (such as I<-f:> if preceded by colons),
173 or capture the numbers itself,
174 for example I<-f'(\d+)'> for the first digits anywhere.
176 =item -t, --interval[=<seconds>]
178 Interval time to output partial progress.
180 =item -l, --length=[-]<size>[%]
182 Trim line contents (between number and bars)
183 to a maximum number of characters.
184 The exceeding part is replaced by an abbreviation sign,
185 unless C<--length=0>.
187 Prepend a dash (i.e. make negative) to enforce padding
188 regardless of encountered contents.
190 =item -L, --limit=<count>
192 Stop output after a number of lines.
193 All input is still counted and analyzed for statistics,
194 but disregarded for padding and bar size.
198 Statistical positions to indicate on bars.
199 Cannot be customized yet,
200 only disabled by providing an empty argument.
202 Any value enables all marker characters:
209 the sum of all values divided by the number of counted lines.
214 the middle value or average between middle values.
218 Standard deviation left of the mean.
219 Only 16% of all values are lower.
223 Standard deviation right of the mean.
224 The part between B<< <--> >> encompass all I<normal> results,
225 or 68% of all entries.
229 =item -u, --unmodified
231 Do not strip leading whitespace.
232 Keep original value alignment, which may be significant in some programs.
234 =item --value-length=<size>
236 Reserved space for numbers.
238 =item -w, --width=<columns>
240 Override the maximum number of columns to use.
241 Appended graphics will extend to fill up the entire screen.
247 Commonly used after counting, such as users on the current server:
249 users | sed 's/ /\n/g' | sort | uniq -c | barcat
251 Letter frequencies in text files:
253 cat /usr/share/games/fortunes/*.u8 |
254 perl -CO -nE 'say for grep length, split /\PL*/, uc' |
255 sort | uniq -c | barcat
257 Memory usage of user processes:
259 ps xo %mem,pid,cmd | barcat -l40
261 Sizes (in megabytes) of all root files and directories:
265 Number of HTTP requests per day:
267 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
269 Any kind of database query with leading counts:
271 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
274 Exchange rate USD/EUR history from CSV download provided by ECB:
276 curl https://sdw.ecb.europa.eu/export.do \
277 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
278 grep '^[12]' | barcat -f',\K' --value-length=7
280 Total population history from the World Bank dataset (XML):
282 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
283 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
284 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1
286 Movies per year from prepared JSON data:
288 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
289 jq '.[].year' | uniq -c | barcat
291 Pokémon height comparison:
293 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
294 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
296 Git statistics, such commit count by year:
298 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
300 Or the most frequent authors:
302 git shortlog -sn | barcat -L3
306 ping google.com | barcat -f'time=\K' -t
310 Mischa POSLAWSKY <perl@shiar.org>