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",
46 'graph-format=s' => sub {
47 $opt{'graph-format'} = substr $_[1], 0, 1;
50 $opt{spark} = [split //, $_[1] || '⎽▁▂▃▄▅▆▇█'];
58 my $pod = readline *DATA;
59 $pod =~ s/^=over\K/ 22/m; # indent options list
60 $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
63 my $parser = Pod::Usage->new;
64 $parser->select('SYNOPSIS', 'OPTIONS');
65 $parser->output_string(\my $contents);
66 $parser->parse_string_document($pod);
68 $contents =~ s/\n(?=\n\h)//msg; # strip space between items
74 Pod::Usage::pod2usage(
75 -exitval => 0, -perldocopt => '-oman', -verbose => 2,
78 ) or exit 64; # EX_USAGE
80 $opt{width} ||= $ENV{COLUMNS} || 80;
81 $opt{color} //= -t *STDOUT; # enable on tty
82 $opt{'graph-format'} //= '-';
83 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
84 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
85 $opt{anchor} //= qr/\A/;
86 $opt{'value-length'} = 6 if $opt{units};
87 $opt{'value-length'} = 1 if $opt{unmodified};
88 $opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT';
90 my (@lines, @values, @order);
92 $SIG{$_} = \&show_stat for $opt{'signal-stat'} || ();
95 alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
97 $SIG{INT} = \&show_exit;
99 if (defined $opt{interval}) {
100 $opt{interval} ||= 1;
101 alarm $opt{interval} if $opt{interval} > 0;
104 require Tie::Array::Sorted;
105 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
106 } or warn $@, "Expect slowdown with large datasets!\n";
109 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
112 s/^\h*// unless $opt{unmodified};
113 push @values, s/$valmatch/\n/ && $1;
114 push @order, $1 if length $1;
115 if (defined $opt{trim} and defined $1) {
116 my $trimpos = abs $opt{trim};
117 $trimpos -= length $1 if $opt{unmodified};
119 $_ = substr $_, 0, 2;
121 elsif (length > $trimpos) {
122 substr($_, $trimpos - 1) = '…';
126 show_lines() if defined $opt{interval} and $opt{interval} < 0
127 and $. % $opt{interval} == 0;
130 $SIG{INT} = 'DEFAULT';
133 $opt{color} and defined $_[0] or return '';
134 return "\e[$_[0]m" if defined wantarray;
135 $_ = color(@_) . $_ . color(0) if defined;
140 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
141 @lines and @lines > $nr or return;
143 @lines > $nr or return unless $opt{hidemin};
145 @order = sort { $b <=> $a } @order unless tied @order;
146 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
147 my $minval = min $order[-1] // (), 0;
148 my $lenval = $opt{'value-length'} // max map { length } @order;
149 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
150 max map { length $values[$_] && length $lines[$_] }
151 0 .. min $#lines, $opt{hidemax} || (); # left padding
152 my $size = ($maxval - $minval) &&
153 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
156 if ($opt{markers} // 1 and $size > 0) {
157 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
158 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
159 $barmark[ orderpos($#order * .31731) ] = '>';
160 $barmark[ orderpos($#order * .68269) ] = '<';
161 $barmark[ orderpos($#order / 2) ] = '+'; # mean
162 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
163 color(36) for @barmark;
165 state $lastmax = $maxval;
166 if ($maxval > $lastmax) {
167 print ' ' x ($lenval + $len);
170 ($lastmax - $minval) * $size + .5,
171 '-' x (($values[$nr - 1] - $minval) * $size);
173 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
179 @lines > $nr or return if $opt{hidemin};
182 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
183 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
185 $float && ($unit % 3) == ($unit < 0), # tenths
186 $_[0] / 1000 ** int($unit/3), # number
187 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
191 while ($nr <= $#lines) {
192 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
193 my $val = $values[$nr];
196 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
201 my $color = !$opt{color} ? undef :
202 $val == $order[0] ? 32 : # max
203 $val == $order[-1] ? 31 : # min
205 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
206 color($color) for $val;
208 my $line = $lines[$nr] =~ s/\n/$val/r;
209 printf '%-*s', $len + length($val), $line;
210 print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
216 say '' if $opt{spark};
221 if ($opt{hidemin} or $opt{hidemax}) {
223 $opt{hidemax} ||= @lines;
224 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
227 my $total = sum @order;
228 printf '%s total', color(1) . $total . color(0);
229 printf ' in %d values', scalar @values;
230 printf(' (%s min, %s avg, %s max)',
231 color(31) . $order[-1] . color(0),
232 color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
233 color(32) . $order[0] . color(0),
241 show_stat() if $opt{stat};
242 exit 130 if @_; # 0x80+signo
253 barcat - graph to visualize input values
257 B<barcat> [<options>] [<input>]
261 Visualizes relative sizes of values read from input (file(s) or STDIN).
262 Contents are concatenated similar to I<cat>,
263 but numbers are reformatted and a bar graph is appended to each line.
265 Don't worry, barcat does not drink and divide.
266 It can has various options for input and output (re)formatting,
267 but remains limited to one-dimensional charts.
268 For more complex graphing needs
269 you'll need a larger animal like I<gnuplot>.
275 =item -c, --[no-]color
277 Force colored output of values and bar markers.
278 Defaults on if output is a tty,
279 disabled otherwise such as when piped or redirected.
281 =item -f, --field=(<number>|<regexp>)
283 Compare values after a given number of whitespace separators,
284 or matching a regular expression.
286 Unspecified or I<-f0> means values are at the start of each line.
287 With I<-f1> the second word is taken instead.
288 A string can indicate the starting position of a value
289 (such as I<-f:> if preceded by colons),
290 or capture the numbers itself,
291 for example I<-f'(\d+)'> for the first digits anywhere.
293 =item -H, --human-readable
295 Format values using SI unit prefixes,
296 turning long numbers like I<12356789> into I<12.4M>.
297 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
298 Short integers are aligned but kept without decimal point.
300 =item -t, --interval[=(<seconds>|-<lines>)]
302 Output partial progress every given number of seconds or input lines.
303 An update can also be forced by sending a I<SIGALRM> alarm signal.
305 =item -l, --length=[-]<size>[%]
307 Trim line contents (between number and bars)
308 to a maximum number of characters.
309 The exceeding part is replaced by an abbreviation sign,
310 unless C<--length=0>.
312 Prepend a dash (i.e. make negative) to enforce padding
313 regardless of encountered contents.
315 =item -L, --limit=(<count>|<start>-[<end>])
317 Stop output after a number of lines.
318 All input is still counted and analyzed for statistics,
319 but disregarded for padding and bar size.
321 =item --graph-format=<character>
323 Glyph to repeat for the graph line.
324 Defaults to a dash C<->.
328 Statistical positions to indicate on bars.
329 Cannot be customized yet,
330 only disabled by providing an empty argument.
332 Any value enables all marker characters:
339 the sum of all values divided by the number of counted lines.
344 the middle value or average between middle values.
348 Standard deviation left of the mean.
349 Only 16% of all values are lower.
353 Standard deviation right of the mean.
354 The part between B<< <--> >> encompass all I<normal> results,
355 or 68% of all entries.
361 Total statistics after all data.
363 =item -u, --unmodified
365 Do not reformat values, keeping leading whitespace.
366 Keep original value alignment, which may be significant in some programs.
368 =item --value-length=<size>
370 Reserved space for numbers.
372 =item -w, --width=<columns>
374 Override the maximum number of columns to use.
375 Appended graphics will extend to fill up the entire screen.
379 Overview of available options.
396 seq 30 | awk '{print sin($1/10)}' | barcat
398 Compare file sizes (with human-readable numbers):
400 du -d0 -b * | barcat -H
402 Memory usage of user processes with long names truncated:
404 ps xo %mem,pid,cmd | barcat -l40
406 Monitor network latency from prefixed results:
408 ping google.com | barcat -f'time=\K' -t
410 Commonly used after counting, for example users on the current server:
412 users | sed 's/ /\n/g' | sort | uniq -c | barcat
414 Letter frequencies in text files:
416 cat /usr/share/games/fortunes/*.u8 |
417 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
418 sort | uniq -c | barcat
420 Number of HTTP requests per day:
422 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
424 Any kind of database query with counts, preserving returned alignment:
426 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
429 Earthquakes worldwide magnitude 1+ in the last 24 hours:
431 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
432 column -tns, | graph -f4 -u -l80%
434 External datasets, like movies per year:
436 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
437 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
439 But please get I<jq> to process JSON
440 and replace the manual selection by C<< jq '.[].year' >>.
442 Pokémon height comparison:
444 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
445 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
447 USD/EUR exchange rate from CSV provided by the ECB:
449 curl https://sdw.ecb.europa.eu/export.do \
450 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
451 grep '^[12]' | barcat -f',\K' --value-length=7
453 Total population history from the World Bank dataset (XML):
454 External datasets, like total population in XML from the World Bank:
456 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
457 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
458 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
460 And of course various Git statistics, such commit count by year:
462 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
464 Or the top 3 most frequent authors with statistics over all:
466 git shortlog -sn | barcat -L3 -s
468 Activity of the last days (substitute date C<-v-{}d> on BSD):
470 ( git log --pretty=%ci --since=30day | cut -b-10
471 seq 0 30 | xargs -i date +%F -d-{}day ) |
472 sort | uniq -c | awk '$1--' | graph --spark
476 Mischa POSLAWSKY <perl@shiar.org>