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 );
15 'C' => sub { $opt{color} = 0 },
19 $opt{anchor} = /^[0-9]+$/ ? qr/(?:\S*\h+){$_}\K/ : qr/$_/;
20 } or die $@ =~ s/(?: at .+)?$/ for option $_[0]/r;
24 'trim|length|l=s' => sub {
25 my ($optname, $optval) = @_;
26 $optval =~ s/%$// and $opt{trimpct}++;
27 $optval =~ m/^-?[0-9]+$/ or die(
28 "Value \"$optval\" invalid for option $optname",
29 " (number or percentage expected)\n"
37 my ($optname, $optval) = @_;
39 ($opt{hidemin}, $opt{hidemax}) =
40 $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die(
41 "Value \"$optval\" invalid for option limit",
47 $opt{spark} = [split //, $_[1] || '⎽▁▂▃▄▅▆▇█'];
54 my $pod = readline *DATA;
55 $pod =~ s/^=over\K/ 22/m; # indent options list
56 $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
59 my $parser = Pod::Usage->new;
60 $parser->select('SYNOPSIS', 'OPTIONS');
61 $parser->output_string(\my $contents);
62 $parser->parse_string_document($pod);
64 $contents =~ s/\n(?=\n\h)//msg; # strip space between items
70 Pod::Usage::pod2usage(
71 -exitval => 0, -perldocopt => '-oman', -verbose => 2,
74 ) or exit 64; # EX_USAGE
76 $opt{width} ||= $ENV{COLUMNS} || 80;
77 $opt{color} //= -t *STDOUT; # enable on tty
78 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
79 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
80 $opt{anchor} //= qr/\A/;
81 $opt{'value-length'} = 6 if $opt{units};
82 $opt{'value-length'} = 1 if $opt{unmodified};
84 my (@lines, @values, @order);
86 if (defined $opt{interval}) {
95 require Tie::Array::Sorted;
96 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
97 } or warn $@, "Expect slowdown with large datasets!\n";
101 $SIG{INT} = 'DEFAULT'; # reset for subsequent attempts
102 'IGNORE' # continue after assumed eof
105 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
108 s/^\h*// unless $opt{unmodified};
109 push @values, s/$valmatch/\n/ && $1;
110 push @order, $1 if length $1;
111 if (defined $opt{trim} and defined $1) {
112 my $trimpos = abs $opt{trim};
113 $trimpos -= length $1 if $opt{unmodified};
115 $_ = substr $_, 0, 1;
117 elsif (length > $trimpos) {
118 substr($_, $trimpos - 1) = '…';
124 $SIG{INT} = 'DEFAULT';
127 $opt{color} and defined $_[0] or return '';
128 return "\e[$_[0]m" if defined wantarray;
129 $_ = color(@_) . $_ . color(0) if defined;
134 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
135 @lines and @lines > $nr or return;
137 @lines > $nr or return unless $opt{hidemin};
139 @order = sort { $b <=> $a } @order unless tied @order;
140 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
141 my $minval = min $order[-1] // (), 0;
142 my $lenval = $opt{'value-length'} // max map { length } @order;
143 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
144 max map { length $values[$_] && length $lines[$_] }
145 0 .. min $#lines, $opt{hidemax} || (); # left padding
146 my $size = ($maxval - $minval) &&
147 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
150 if ($opt{markers} // 1 and $size > 0) {
151 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
152 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
153 $barmark[ orderpos($#order * .31731) ] = '>';
154 $barmark[ orderpos($#order * .68269) ] = '<';
155 $barmark[ orderpos($#order / 2) ] = '+'; # mean
156 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
157 color(36) for @barmark;
159 state $lastmax = $maxval;
160 if ($maxval > $lastmax) {
161 print ' ' x ($lenval + $len);
164 ($lastmax - $minval) * $size + .5,
165 '-' x (($values[$nr - 1] - $minval) * $size);
167 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
173 @lines > $nr or return if $opt{hidemin};
176 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
177 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
179 $float && ($unit % 3) == ($unit < 0), # tenths
180 $_[0] / 1000 ** int($unit/3), # number
181 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
185 while ($nr <= $#lines) {
186 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
187 my $val = $values[$nr];
190 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
195 my $color = !$opt{color} ? undef :
196 $val == $order[0] ? 32 : # max
197 $val == $order[-1] ? 31 : # min
199 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
200 color($color) for $val;
202 my $line = $lines[$nr] =~ s/\n/$val/r;
203 printf '%-*s', $len + length($val), $line;
204 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
210 say '' if $opt{spark};
216 if ($opt{hidemin} or $opt{hidemax}) {
218 $opt{hidemax} ||= @lines;
219 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
222 my $total = sum @order;
223 printf '%s total', $total;
224 printf ' in %d values', scalar @values;
225 printf ' (%s min, %*.*f avg, %s max)',
226 $order[-1], 0, 2, $total / @order, $order[0];
236 barcat - graph to visualize input values
240 B<barcat> [<options>] [<input>]
244 Visualizes relative sizes of values read from input (file(s) or STDIN).
245 Contents are concatenated similar to I<cat>,
246 but numbers are reformatted and a bar graph is appended to each line.
252 =item -c, --[no-]color
254 Force colored output of values and bar markers.
255 Defaults on if output is a tty,
256 disabled otherwise such as when piped or redirected.
258 =item -f, --field=(<number>|<regexp>)
260 Compare values after a given number of whitespace separators,
261 or matching a regular expression.
263 Unspecified or I<-f0> means values are at the start of each line.
264 With I<-f1> the second word is taken instead.
265 A string can indicate the starting position of a value
266 (such as I<-f:> if preceded by colons),
267 or capture the numbers itself,
268 for example I<-f'(\d+)'> for the first digits anywhere.
270 =item -H, --human-readable
272 Format values using SI unit prefixes,
273 turning long numbers like I<12356789> into I<12.4M>.
274 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
275 Short integers are aligned but kept without decimal point.
277 =item -t, --interval[=<seconds>]
279 Interval time to output partial progress.
281 =item -l, --length=[-]<size>[%]
283 Trim line contents (between number and bars)
284 to a maximum number of characters.
285 The exceeding part is replaced by an abbreviation sign,
286 unless C<--length=0>.
288 Prepend a dash (i.e. make negative) to enforce padding
289 regardless of encountered contents.
291 =item -L, --limit=(<count>|<start>-[<end>])
293 Stop output after a number of lines.
294 All input is still counted and analyzed for statistics,
295 but disregarded for padding and bar size.
299 Statistical positions to indicate on bars.
300 Cannot be customized yet,
301 only disabled by providing an empty argument.
303 Any value enables all marker characters:
310 the sum of all values divided by the number of counted lines.
315 the middle value or average between middle values.
319 Standard deviation left of the mean.
320 Only 16% of all values are lower.
324 Standard deviation right of the mean.
325 The part between B<< <--> >> encompass all I<normal> results,
326 or 68% of all entries.
332 Total statistics after all data.
334 =item -u, --unmodified
336 Do not reformat values, keeping leading whitespace.
337 Keep original value alignment, which may be significant in some programs.
339 =item --value-length=<size>
341 Reserved space for numbers.
343 =item -w, --width=<columns>
345 Override the maximum number of columns to use.
346 Appended graphics will extend to fill up the entire screen.
354 seq 30 | awk '{print sin($1/10)}' | barcat
356 Compare file sizes (with human-readable numbers):
358 du -d0 -b * | barcat -H
360 Memory usage of user processes with long names truncated:
362 ps xo %mem,pid,cmd | barcat -l40
364 Monitor network latency from prefixed results:
366 ping google.com | barcat -f'time=\K' -t
368 Commonly used after counting, for example users on the current server:
370 users | sed 's/ /\n/g' | sort | uniq -c | barcat
372 Letter frequencies in text files:
374 cat /usr/share/games/fortunes/*.u8 |
375 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
376 sort | uniq -c | barcat
378 Number of HTTP requests per day:
380 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
382 Any kind of database query with counts, preserving returned alignment:
384 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
387 Earthquakes worldwide magnitude 1+ in the last 24 hours:
389 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
390 column -tns, | graph -f4 -u -l80%
392 External datasets, like movies per year:
394 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
395 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
397 But please get I<jq> to process JSON
398 and replace the manual selection by C<< jq '.[].year' >>.
400 Pokémon height comparison:
402 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
403 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
405 USD/EUR exchange rate from CSV provided by the ECB:
407 curl https://sdw.ecb.europa.eu/export.do \
408 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
409 grep '^[12]' | barcat -f',\K' --value-length=7
411 Total population history from the World Bank dataset (XML):
412 External datasets, like total population in XML from the World Bank:
414 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
415 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
416 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
418 And of course various Git statistics, such commit count by year:
420 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
422 Or the top 3 most frequent authors with statistics over all:
424 git shortlog -sn | barcat -L3 -s
426 Activity of the last days (substitute date C<-v-{}d> on BSD):
428 ( git log --pretty=%ci --since=30day | cut -b-10
429 seq 0 30 | xargs -i date +%F -d-{}day ) |
430 sort | uniq -c | awk '$1--' | graph --spark
434 Mischa POSLAWSKY <perl@shiar.org>