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};
129 my $unit = int(log($_[0]) / log(1000) - ($_[0] < 1));
130 sprintf "%3.1f%1s", $_[0] / 1000 ** $unit, $opt{units}->[$unit];
133 while ($nr <= $#lines) {
134 $nr >= $opt{hidemax} and last if $opt{hidemax};
135 my $val = $values[$nr];
137 my $color = !$opt{color} ? 0 :
138 $val == $order[0] ? 32 : # max
139 $val == $order[-1] ? 31 : # min
141 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
142 $val = "\e[${color}m$val\e[0m" if $color;
144 my $line = $lines[$nr] =~ s/\n/$val/r;
145 printf '%-*s', $len + length($val), $line;
146 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
159 barcat - graph to visualize input values
163 B<barcat> [<options>] [<input>]
167 Visualizes relative sizes of values read from input (file(s) or STDIN).
168 Contents are concatenated similar to I<cat>,
169 but numbers are reformatted and a bar graph is appended to each line.
175 =item -c, --[no-]color
177 Force colored output of values and bar markers.
178 Defaults on if output is a tty,
179 disabled otherwise such as when piped or redirected.
181 =item -f, --field=(<number>|<regexp>)
183 Compare values after a given number of whitespace separators,
184 or matching a regular expression.
186 Unspecified or I<-f0> means values are at the start of each line.
187 With I<-f1> the second word is taken instead.
188 A string can indicate the starting position of a value
189 (such as I<-f:> if preceded by colons),
190 or capture the numbers itself,
191 for example I<-f'(\d+)'> for the first digits anywhere.
193 =item -H, --human-readable
195 Format values using SI unit prefixes,
196 turning long numbers like I<12356789> into I<12.4M>.
198 =item -t, --interval[=<seconds>]
200 Interval time to output partial progress.
202 =item -l, --length=[-]<size>[%]
204 Trim line contents (between number and bars)
205 to a maximum number of characters.
206 The exceeding part is replaced by an abbreviation sign,
207 unless C<--length=0>.
209 Prepend a dash (i.e. make negative) to enforce padding
210 regardless of encountered contents.
212 =item -L, --limit=(<count>|<start>-[<end>])
214 Stop output after a number of lines.
215 All input is still counted and analyzed for statistics,
216 but disregarded for padding and bar size.
220 Statistical positions to indicate on bars.
221 Cannot be customized yet,
222 only disabled by providing an empty argument.
224 Any value enables all marker characters:
231 the sum of all values divided by the number of counted lines.
236 the middle value or average between middle values.
240 Standard deviation left of the mean.
241 Only 16% of all values are lower.
245 Standard deviation right of the mean.
246 The part between B<< <--> >> encompass all I<normal> results,
247 or 68% of all entries.
251 =item -u, --unmodified
253 Do not strip leading whitespace.
254 Keep original value alignment, which may be significant in some programs.
256 =item --value-length=<size>
258 Reserved space for numbers.
260 =item -w, --width=<columns>
262 Override the maximum number of columns to use.
263 Appended graphics will extend to fill up the entire screen.
269 Commonly used after counting, such as users on the current server:
271 users | sed 's/ /\n/g' | sort | uniq -c | barcat
273 Letter frequencies in text files:
275 cat /usr/share/games/fortunes/*.u8 |
276 perl -CO -nE 'say for grep length, split /\PL*/, uc' |
277 sort | uniq -c | barcat
279 Memory usage of user processes:
281 ps xo %mem,pid,cmd | barcat -l40
283 Sizes (in megabytes) of all root files and directories:
287 Number of HTTP requests per day:
289 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
291 Any kind of database query with leading counts:
293 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
296 Exchange rate USD/EUR history from CSV download provided by ECB:
298 curl https://sdw.ecb.europa.eu/export.do \
299 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
300 grep '^[12]' | barcat -f',\K' --value-length=7
302 Total population history from the World Bank dataset (XML):
304 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
305 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
306 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
308 Movies per year from prepared JSON data:
310 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
311 jq '.[].year' | uniq -c | barcat
313 Pokémon height comparison:
315 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
316 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
318 Git statistics, such commit count by year:
320 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
322 Or the most frequent authors:
324 git shortlog -sn | barcat -L3
328 ping google.com | barcat -f'time=\K' -t
332 Mischa POSLAWSKY <perl@shiar.org>