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"
33 'hidemax|limit|L=i' => sub {
34 $opt{$_[1] < 0 ? 'hidemin' : 'hidemax'} = abs $_[1];
39 'usage|h' => sub { podexit() },
40 'help' => sub { podexit(-verbose => 2) },
41 ) or exit 64; # EX_USAGE
43 $opt{width} ||= $ENV{COLUMNS} || 80;
44 $opt{color} //= -t *STDOUT; # enable on tty
45 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
47 if (defined $opt{interval}) {
56 $SIG{INT} = 'IGNORE'; # continue after assumed eof
59 my $anchor = !defined $opt{field} ? qr/\A/ :
60 $opt{field} =~ /^[0-9]+$/ ? qr/(?:\S*\h+){$opt{field}}\K/ :
64 s/^\h*// unless $opt{unmodified};
65 push @values, s/$anchor ( \h* -? [0-9]* \.? [0-9]+ |)/\n/x && $1;
66 if (defined $opt{trim}) {
67 my $trimpos = abs $opt{trim};
71 elsif (length > $trimpos) {
72 substr($_, $trimpos - 1) = '…';
78 $SIG{INT} = 'DEFAULT';
82 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
83 @lines and @lines > $nr or return;
85 my @order = sort { $b <=> $a } grep { length } @values;
86 my $maxval = $opt{hidemax} ? max @values[0 .. $opt{hidemax} - 1] : $order[0];
87 my $minval = min $order[-1], 0;
88 my $lenval = $opt{'value-length'} // max map { length } @order;
89 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
90 max map { length $values[$_] && length $lines[$_] }
91 0 .. min $#lines, $opt{hidemax} || (); # left padding
92 my $size = ($maxval - $minval) &&
93 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
96 if ($opt{markers} // 1 and $size > 0) {
97 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
98 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
99 $barmark[ orderpos($#order * .31731) ] = '>';
100 $barmark[ orderpos($#order * .68269) ] = '<';
101 $barmark[ orderpos($#order / 2) ] = '+'; # mean
102 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
103 defined and $opt{color} and $_ = "\e[36m$_\e[0m" for @barmark;
105 state $lastmax = $maxval;
106 if ($maxval > $lastmax) {
107 print ' ' x ($lenval + $len);
108 printf "\e[90m" if $opt{color};
110 ($lastmax - $minval) * $size + .5,
111 '-' x (($values[$nr - 1] - $minval) * $size);
112 print "\e[92m" if $opt{color};
113 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
114 print "\e[0m" if $opt{color};
119 while ($nr <= $#lines) {
120 $nr >= $opt{hidemax} and last if $opt{hidemax};
121 my $val = $values[$nr];
123 my $color = !$opt{color} ? 0 :
124 $val == $order[0] ? 32 : # max
125 $val == $order[-1] ? 31 : # min
127 $val = sprintf "%*s", $lenval, $val;
128 $val = "\e[${color}m$val\e[0m" if $color;
130 my $line = $lines[$nr] =~ s/\n/$val/r;
131 printf '%-*s', $len + length($val), $line;
132 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
145 barcat - graph to visualize input values
149 B<barcat> [<options>] [<input>]
153 Visualizes relative sizes of values read from input (file(s) or STDIN).
154 Contents are concatenated similar to I<cat>,
155 but numbers are reformatted and a bar graph is appended to each line.
161 =item -c, --[no-]color
163 Force colored output of values and bar markers.
164 Defaults on if output is a tty,
165 disabled otherwise such as when piped or redirected.
167 =item -f, --field=(<number>|<regexp>)
169 Compare values after a given number of whitespace separators,
170 or matching a regular expression.
172 Unspecified or I<-f0> means values are at the start of each line.
173 With I<-f1> the second word is taken instead.
174 A string can indicate the starting position of a value
175 (such as I<-f:> if preceded by colons),
176 or capture the numbers itself,
177 for example I<-f'(\d+)'> for the first digits anywhere.
179 =item -t, --interval[=<seconds>]
181 Interval time to output partial progress.
183 =item -l, --length=[-]<size>[%]
185 Trim line contents (between number and bars)
186 to a maximum number of characters.
187 The exceeding part is replaced by an abbreviation sign,
188 unless C<--length=0>.
190 Prepend a dash (i.e. make negative) to enforce padding
191 regardless of encountered contents.
193 =item -L, --limit=[-]<count>
195 Stop output after a number of lines.
196 All input is still counted and analyzed for statistics,
197 but disregarded for padding and bar size.
201 Statistical positions to indicate on bars.
202 Cannot be customized yet,
203 only disabled by providing an empty argument.
205 Any value enables all marker characters:
212 the sum of all values divided by the number of counted lines.
217 the middle value or average between middle values.
221 Standard deviation left of the mean.
222 Only 16% of all values are lower.
226 Standard deviation right of the mean.
227 The part between B<< <--> >> encompass all I<normal> results,
228 or 68% of all entries.
232 =item -u, --unmodified
234 Do not strip leading whitespace.
235 Keep original value alignment, which may be significant in some programs.
237 =item --value-length=<size>
239 Reserved space for numbers.
241 =item -w, --width=<columns>
243 Override the maximum number of columns to use.
244 Appended graphics will extend to fill up the entire screen.
250 Commonly used after counting, such as users on the current server:
252 users | sed 's/ /\n/g' | sort | uniq -c | barcat
254 Letter frequencies in text files:
256 cat /usr/share/games/fortunes/*.u8 |
257 perl -CO -nE 'say for grep length, split /\PL*/, uc' |
258 sort | uniq -c | barcat
260 Memory usage of user processes:
262 ps xo %mem,pid,cmd | barcat -l40
264 Sizes (in megabytes) of all root files and directories:
268 Number of HTTP requests per day:
270 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
272 Any kind of database query with leading counts:
274 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
277 Exchange rate USD/EUR history from CSV download provided by ECB:
279 curl https://sdw.ecb.europa.eu/export.do \
280 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
281 grep '^[12]' | barcat -f',\K' --value-length=7
283 Total population history from the World Bank dataset (XML):
285 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
286 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
287 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1
289 Movies per year from prepared JSON data:
291 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
292 jq '.[].year' | uniq -c | barcat
294 Pokémon height comparison:
296 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
297 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
299 Git statistics, such commit count by year:
301 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
303 Or the most frequent authors:
305 git shortlog -sn | barcat -L3
309 ping google.com | barcat -f'time=\K' -t
313 Mischa POSLAWSKY <perl@shiar.org>