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"
35 my ($optname, $optval) = @_;
37 ($opt{hidemin}, $opt{hidemax}) =
38 $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die(
39 "Value \"$optval\" invalid for option limit",
46 'usage|h' => sub { podexit() },
47 'help' => sub { podexit(-verbose => 2) },
48 ) or exit 64; # EX_USAGE
50 $opt{width} ||= $ENV{COLUMNS} || 80;
51 $opt{color} //= -t *STDOUT; # enable on tty
52 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
54 if (defined $opt{interval}) {
63 $SIG{INT} = 'IGNORE'; # continue after assumed eof
66 my $anchor = !defined $opt{field} ? qr/\A/ :
67 $opt{field} =~ /^[0-9]+$/ ? qr/(?:\S*\h+){$opt{field}}\K/ :
71 s/^\h*// unless $opt{unmodified};
72 push @values, s/$anchor ( \h* -? [0-9]* \.? [0-9]+ |)/\n/x && $1;
73 if (defined $opt{trim}) {
74 my $trimpos = abs $opt{trim};
78 elsif (length > $trimpos) {
79 substr($_, $trimpos - 1) = '…';
85 $SIG{INT} = 'DEFAULT';
89 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
90 @lines and @lines > $nr or return;
92 my @order = sort { $b <=> $a } grep { length } @values;
93 my $maxval = $opt{hidemax} ? max @values[0 .. $opt{hidemax} - 1] : $order[0];
94 my $minval = min $order[-1], 0;
95 my $lenval = $opt{'value-length'} // max map { length } @order;
96 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
97 max map { length $values[$_] && length $lines[$_] }
98 0 .. min $#lines, $opt{hidemax} || (); # left padding
99 my $size = ($maxval - $minval) &&
100 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
103 if ($opt{markers} // 1 and $size > 0) {
104 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
105 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
106 $barmark[ orderpos($#order * .31731) ] = '>';
107 $barmark[ orderpos($#order * .68269) ] = '<';
108 $barmark[ orderpos($#order / 2) ] = '+'; # mean
109 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
110 defined and $opt{color} and $_ = "\e[36m$_\e[0m" for @barmark;
112 state $lastmax = $maxval;
113 if ($maxval > $lastmax) {
114 print ' ' x ($lenval + $len);
115 printf "\e[90m" if $opt{color};
117 ($lastmax - $minval) * $size + .5,
118 '-' x (($values[$nr - 1] - $minval) * $size);
119 print "\e[92m" if $opt{color};
120 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
121 print "\e[0m" if $opt{color};
126 while ($nr <= $#lines) {
127 $nr >= $opt{hidemax} and last if $opt{hidemax};
128 my $val = $values[$nr];
130 my $color = !$opt{color} ? 0 :
131 $val == $order[0] ? 32 : # max
132 $val == $order[-1] ? 31 : # min
134 $val = sprintf "%*s", $lenval, $val;
135 $val = "\e[${color}m$val\e[0m" if $color;
137 my $line = $lines[$nr] =~ s/\n/$val/r;
138 printf '%-*s', $len + length($val), $line;
139 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
152 barcat - graph to visualize input values
156 B<barcat> [<options>] [<input>]
160 Visualizes relative sizes of values read from input (file(s) or STDIN).
161 Contents are concatenated similar to I<cat>,
162 but numbers are reformatted and a bar graph is appended to each line.
168 =item -c, --[no-]color
170 Force colored output of values and bar markers.
171 Defaults on if output is a tty,
172 disabled otherwise such as when piped or redirected.
174 =item -f, --field=(<number>|<regexp>)
176 Compare values after a given number of whitespace separators,
177 or matching a regular expression.
179 Unspecified or I<-f0> means values are at the start of each line.
180 With I<-f1> the second word is taken instead.
181 A string can indicate the starting position of a value
182 (such as I<-f:> if preceded by colons),
183 or capture the numbers itself,
184 for example I<-f'(\d+)'> for the first digits anywhere.
186 =item -t, --interval[=<seconds>]
188 Interval time to output partial progress.
190 =item -l, --length=[-]<size>[%]
192 Trim line contents (between number and bars)
193 to a maximum number of characters.
194 The exceeding part is replaced by an abbreviation sign,
195 unless C<--length=0>.
197 Prepend a dash (i.e. make negative) to enforce padding
198 regardless of encountered contents.
200 =item -L, --limit=(<count>|<start>-[<end>])
202 Stop output after a number of lines.
203 All input is still counted and analyzed for statistics,
204 but disregarded for padding and bar size.
208 Statistical positions to indicate on bars.
209 Cannot be customized yet,
210 only disabled by providing an empty argument.
212 Any value enables all marker characters:
219 the sum of all values divided by the number of counted lines.
224 the middle value or average between middle values.
228 Standard deviation left of the mean.
229 Only 16% of all values are lower.
233 Standard deviation right of the mean.
234 The part between B<< <--> >> encompass all I<normal> results,
235 or 68% of all entries.
239 =item -u, --unmodified
241 Do not strip leading whitespace.
242 Keep original value alignment, which may be significant in some programs.
244 =item --value-length=<size>
246 Reserved space for numbers.
248 =item -w, --width=<columns>
250 Override the maximum number of columns to use.
251 Appended graphics will extend to fill up the entire screen.
257 Commonly used after counting, such as users on the current server:
259 users | sed 's/ /\n/g' | sort | uniq -c | barcat
261 Letter frequencies in text files:
263 cat /usr/share/games/fortunes/*.u8 |
264 perl -CO -nE 'say for grep length, split /\PL*/, uc' |
265 sort | uniq -c | barcat
267 Memory usage of user processes:
269 ps xo %mem,pid,cmd | barcat -l40
271 Sizes (in megabytes) of all root files and directories:
275 Number of HTTP requests per day:
277 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
279 Any kind of database query with leading counts:
281 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
284 Exchange rate USD/EUR history from CSV download provided by ECB:
286 curl https://sdw.ecb.europa.eu/export.do \
287 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
288 grep '^[12]' | barcat -f',\K' --value-length=7
290 Total population history from the World Bank dataset (XML):
292 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
293 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
294 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1
296 Movies per year from prepared JSON data:
298 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
299 jq '.[].year' | uniq -c | barcat
301 Pokémon height comparison:
303 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
304 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
306 Git statistics, such commit count by year:
308 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
310 Or the most frequent authors:
312 git shortlog -sn | barcat -L3
316 ping google.com | barcat -f'time=\K' -t
320 Mischa POSLAWSKY <perl@shiar.org>