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/;
61 $opt{'value-length'} = 6 if $opt{units};
63 if (defined $opt{interval}) {
72 $SIG{INT} = 'IGNORE'; # continue after assumed eof
75 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
78 s/^\h*// unless $opt{unmodified};
79 push @values, s/$valmatch/\n/ && $1;
80 if (defined $opt{trim}) {
81 my $trimpos = abs $opt{trim};
85 elsif (length > $trimpos) {
86 substr($_, $trimpos - 1) = '…';
92 $SIG{INT} = 'DEFAULT';
96 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
97 @lines and @lines > $nr or return;
99 my @order = sort { $b <=> $a } grep { length } @values;
100 my $maxval = $opt{hidemax} ? max @values[0 .. $opt{hidemax} - 1] : $order[0];
101 my $minval = min $order[-1], 0;
102 my $lenval = $opt{'value-length'} // max map { length } @order;
103 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
104 max map { length $values[$_] && length $lines[$_] }
105 0 .. min $#lines, $opt{hidemax} || (); # left padding
106 my $size = ($maxval - $minval) &&
107 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
110 if ($opt{markers} // 1 and $size > 0) {
111 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
112 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
113 $barmark[ orderpos($#order * .31731) ] = '>';
114 $barmark[ orderpos($#order * .68269) ] = '<';
115 $barmark[ orderpos($#order / 2) ] = '+'; # mean
116 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
117 defined and $opt{color} and $_ = "\e[36m$_\e[0m" for @barmark;
119 state $lastmax = $maxval;
120 if ($maxval > $lastmax) {
121 print ' ' x ($lenval + $len);
122 printf "\e[90m" if $opt{color};
124 ($lastmax - $minval) * $size + .5,
125 '-' x (($values[$nr - 1] - $minval) * $size);
126 print "\e[92m" if $opt{color};
127 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
128 print "\e[0m" if $opt{color};
134 my $unit = int(log($_[0]) / log(1000) - ($_[0] < 1));
135 my $float = $_[0] !~ /^ (?: 0*\.)? [0-9]{1,3} $/x;
137 $float ? 5 : 3, $float, # length and tenths
138 $_[0] / 1000 ** $unit, # number
139 $float ? 1 : 3, # unit size
140 $#{$opt{units}} >> 1 < abs $unit ? "e$unit" : $opt{units}->[$unit]
144 while ($nr <= $#lines) {
145 $nr >= $opt{hidemax} and last if $opt{hidemax};
146 my $val = $values[$nr];
148 my $color = !$opt{color} ? 0 :
149 $val == $order[0] ? 32 : # max
150 $val == $order[-1] ? 31 : # min
152 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
153 $val = "\e[${color}m$val\e[0m" if $color;
155 my $line = $lines[$nr] =~ s/\n/$val/r;
156 printf '%-*s', $len + length($val), $line;
157 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
170 barcat - graph to visualize input values
174 B<barcat> [<options>] [<input>]
178 Visualizes relative sizes of values read from input (file(s) or STDIN).
179 Contents are concatenated similar to I<cat>,
180 but numbers are reformatted and a bar graph is appended to each line.
186 =item -c, --[no-]color
188 Force colored output of values and bar markers.
189 Defaults on if output is a tty,
190 disabled otherwise such as when piped or redirected.
192 =item -f, --field=(<number>|<regexp>)
194 Compare values after a given number of whitespace separators,
195 or matching a regular expression.
197 Unspecified or I<-f0> means values are at the start of each line.
198 With I<-f1> the second word is taken instead.
199 A string can indicate the starting position of a value
200 (such as I<-f:> if preceded by colons),
201 or capture the numbers itself,
202 for example I<-f'(\d+)'> for the first digits anywhere.
204 =item -H, --human-readable
206 Format values using SI unit prefixes,
207 turning long numbers like I<12356789> into I<12.4M>.
208 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
209 Short integers are aligned but kept without decimal point.
211 =item -t, --interval[=<seconds>]
213 Interval time to output partial progress.
215 =item -l, --length=[-]<size>[%]
217 Trim line contents (between number and bars)
218 to a maximum number of characters.
219 The exceeding part is replaced by an abbreviation sign,
220 unless C<--length=0>.
222 Prepend a dash (i.e. make negative) to enforce padding
223 regardless of encountered contents.
225 =item -L, --limit=(<count>|<start>-[<end>])
227 Stop output after a number of lines.
228 All input is still counted and analyzed for statistics,
229 but disregarded for padding and bar size.
233 Statistical positions to indicate on bars.
234 Cannot be customized yet,
235 only disabled by providing an empty argument.
237 Any value enables all marker characters:
244 the sum of all values divided by the number of counted lines.
249 the middle value or average between middle values.
253 Standard deviation left of the mean.
254 Only 16% of all values are lower.
258 Standard deviation right of the mean.
259 The part between B<< <--> >> encompass all I<normal> results,
260 or 68% of all entries.
264 =item -u, --unmodified
266 Do not strip leading whitespace.
267 Keep original value alignment, which may be significant in some programs.
269 =item --value-length=<size>
271 Reserved space for numbers.
273 =item -w, --width=<columns>
275 Override the maximum number of columns to use.
276 Appended graphics will extend to fill up the entire screen.
282 Commonly used after counting, such as users on the current server:
284 users | sed 's/ /\n/g' | sort | uniq -c | barcat
286 Letter frequencies in text files:
288 cat /usr/share/games/fortunes/*.u8 |
289 perl -CO -nE 'say for grep length, split /\PL*/, uc' |
290 sort | uniq -c | barcat
292 Memory usage of user processes:
294 ps xo %mem,pid,cmd | barcat -l40
296 Sizes (in megabytes) of all root files and directories:
300 Number of HTTP requests per day:
302 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
304 Any kind of database query with leading counts:
306 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
309 Exchange rate USD/EUR history from CSV download provided by ECB:
311 curl https://sdw.ecb.europa.eu/export.do \
312 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
313 grep '^[12]' | barcat -f',\K' --value-length=7
315 Total population history from the World Bank dataset (XML):
317 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
318 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
319 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
321 Movies per year from prepared JSON data:
323 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
324 jq '.[].year' | uniq -c | barcat
326 Pokémon height comparison:
328 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
329 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
331 Git statistics, such commit count by year:
333 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
335 Or the most frequent authors:
337 git shortlog -sn | barcat -L3
341 ping google.com | barcat -f'time=\K' -t
345 Mischa POSLAWSKY <perl@shiar.org>