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);
88 alarm $opt{interval} if defined $opt{interval};
91 if (defined $opt{interval}) {
96 require Tie::Array::Sorted;
97 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
98 } or warn $@, "Expect slowdown with large datasets!\n";
102 $SIG{INT} = 'DEFAULT'; # reset for subsequent attempts
103 'IGNORE' # continue after assumed eof
106 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
109 s/^\h*// unless $opt{unmodified};
110 push @values, s/$valmatch/\n/ && $1;
111 push @order, $1 if length $1;
112 if (defined $opt{trim} and defined $1) {
113 my $trimpos = abs $opt{trim};
114 $trimpos -= length $1 if $opt{unmodified};
116 $_ = substr $_, 0, 2;
118 elsif (length > $trimpos) {
119 substr($_, $trimpos - 1) = '…';
125 $SIG{INT} = 'DEFAULT';
128 $opt{color} and defined $_[0] or return '';
129 return "\e[$_[0]m" if defined wantarray;
130 $_ = color(@_) . $_ . color(0) if defined;
135 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
136 @lines and @lines > $nr or return;
138 @lines > $nr or return unless $opt{hidemin};
140 @order = sort { $b <=> $a } @order unless tied @order;
141 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
142 my $minval = min $order[-1] // (), 0;
143 my $lenval = $opt{'value-length'} // max map { length } @order;
144 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
145 max map { length $values[$_] && length $lines[$_] }
146 0 .. min $#lines, $opt{hidemax} || (); # left padding
147 my $size = ($maxval - $minval) &&
148 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
151 if ($opt{markers} // 1 and $size > 0) {
152 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
153 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
154 $barmark[ orderpos($#order * .31731) ] = '>';
155 $barmark[ orderpos($#order * .68269) ] = '<';
156 $barmark[ orderpos($#order / 2) ] = '+'; # mean
157 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
158 color(36) for @barmark;
160 state $lastmax = $maxval;
161 if ($maxval > $lastmax) {
162 print ' ' x ($lenval + $len);
165 ($lastmax - $minval) * $size + .5,
166 '-' x (($values[$nr - 1] - $minval) * $size);
168 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
174 @lines > $nr or return if $opt{hidemin};
177 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
178 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
180 $float && ($unit % 3) == ($unit < 0), # tenths
181 $_[0] / 1000 ** int($unit/3), # number
182 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
186 while ($nr <= $#lines) {
187 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
188 my $val = $values[$nr];
191 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
196 my $color = !$opt{color} ? undef :
197 $val == $order[0] ? 32 : # max
198 $val == $order[-1] ? 31 : # min
200 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
201 color($color) for $val;
203 my $line = $lines[$nr] =~ s/\n/$val/r;
204 printf '%-*s', $len + length($val), $line;
205 print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
211 say '' if $opt{spark};
217 if ($opt{hidemin} or $opt{hidemax}) {
219 $opt{hidemax} ||= @lines;
220 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
223 my $total = sum @order;
224 printf '%s total', color(1) . $total . color(0);
225 printf ' in %d values', scalar @values;
226 printf(' (%s min, %s avg, %s max)',
227 color(31) . $order[-1] . color(0),
228 color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
229 color(32) . $order[0] . color(0),
240 barcat - graph to visualize input values
244 B<barcat> [<options>] [<input>]
248 Visualizes relative sizes of values read from input (file(s) or STDIN).
249 Contents are concatenated similar to I<cat>,
250 but numbers are reformatted and a bar graph is appended to each line.
252 Don't worry, barcat does not drink and divide.
253 It can has various options for input and output (re)formatting,
254 but remains limited to one-dimensional charts.
255 For more complex graphing needs
256 you'll need a larger animal like I<gnuplot>.
262 =item -c, --[no-]color
264 Force colored output of values and bar markers.
265 Defaults on if output is a tty,
266 disabled otherwise such as when piped or redirected.
268 =item -f, --field=(<number>|<regexp>)
270 Compare values after a given number of whitespace separators,
271 or matching a regular expression.
273 Unspecified or I<-f0> means values are at the start of each line.
274 With I<-f1> the second word is taken instead.
275 A string can indicate the starting position of a value
276 (such as I<-f:> if preceded by colons),
277 or capture the numbers itself,
278 for example I<-f'(\d+)'> for the first digits anywhere.
280 =item -H, --human-readable
282 Format values using SI unit prefixes,
283 turning long numbers like I<12356789> into I<12.4M>.
284 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
285 Short integers are aligned but kept without decimal point.
287 =item -t, --interval[=<seconds>]
289 Interval time to output partial progress.
290 An update can also be forced by sending a I<SIGALRM> alarm signal.
292 =item -l, --length=[-]<size>[%]
294 Trim line contents (between number and bars)
295 to a maximum number of characters.
296 The exceeding part is replaced by an abbreviation sign,
297 unless C<--length=0>.
299 Prepend a dash (i.e. make negative) to enforce padding
300 regardless of encountered contents.
302 =item -L, --limit=(<count>|<start>-[<end>])
304 Stop output after a number of lines.
305 All input is still counted and analyzed for statistics,
306 but disregarded for padding and bar size.
310 Statistical positions to indicate on bars.
311 Cannot be customized yet,
312 only disabled by providing an empty argument.
314 Any value enables all marker characters:
321 the sum of all values divided by the number of counted lines.
326 the middle value or average between middle values.
330 Standard deviation left of the mean.
331 Only 16% of all values are lower.
335 Standard deviation right of the mean.
336 The part between B<< <--> >> encompass all I<normal> results,
337 or 68% of all entries.
343 Total statistics after all data.
345 =item -u, --unmodified
347 Do not reformat values, keeping leading whitespace.
348 Keep original value alignment, which may be significant in some programs.
350 =item --value-length=<size>
352 Reserved space for numbers.
354 =item -w, --width=<columns>
356 Override the maximum number of columns to use.
357 Appended graphics will extend to fill up the entire screen.
361 Overview of available options.
378 seq 30 | awk '{print sin($1/10)}' | barcat
380 Compare file sizes (with human-readable numbers):
382 du -d0 -b * | barcat -H
384 Memory usage of user processes with long names truncated:
386 ps xo %mem,pid,cmd | barcat -l40
388 Monitor network latency from prefixed results:
390 ping google.com | barcat -f'time=\K' -t
392 Commonly used after counting, for example users on the current server:
394 users | sed 's/ /\n/g' | sort | uniq -c | barcat
396 Letter frequencies in text files:
398 cat /usr/share/games/fortunes/*.u8 |
399 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
400 sort | uniq -c | barcat
402 Number of HTTP requests per day:
404 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
406 Any kind of database query with counts, preserving returned alignment:
408 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
411 Earthquakes worldwide magnitude 1+ in the last 24 hours:
413 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
414 column -tns, | graph -f4 -u -l80%
416 External datasets, like movies per year:
418 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
419 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
421 But please get I<jq> to process JSON
422 and replace the manual selection by C<< jq '.[].year' >>.
424 Pokémon height comparison:
426 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
427 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
429 USD/EUR exchange rate from CSV provided by the ECB:
431 curl https://sdw.ecb.europa.eu/export.do \
432 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
433 grep '^[12]' | barcat -f',\K' --value-length=7
435 Total population history from the World Bank dataset (XML):
436 External datasets, like total population in XML from the World Bank:
438 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
439 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
440 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
442 And of course various Git statistics, such commit count by year:
444 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
446 Or the top 3 most frequent authors with statistics over all:
448 git shortlog -sn | barcat -L3 -s
450 Activity of the last days (substitute date C<-v-{}d> on BSD):
452 ( git log --pretty=%ci --since=30day | cut -b-10
453 seq 0 30 | xargs -i date +%F -d-{}day ) |
454 sort | uniq -c | awk '$1--' | graph --spark
458 Mischa POSLAWSKY <perl@shiar.org>