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] || '⎽▁▂▃▄▅▆▇█'];
57 my $pod = readline *DATA;
58 $pod =~ s/^=over\K/ 22/m; # indent options list
59 $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
62 my $parser = Pod::Usage->new;
63 $parser->select('SYNOPSIS', 'OPTIONS');
64 $parser->output_string(\my $contents);
65 $parser->parse_string_document($pod);
67 $contents =~ s/\n(?=\n\h)//msg; # strip space between items
73 Pod::Usage::pod2usage(
74 -exitval => 0, -perldocopt => '-oman', -verbose => 2,
77 ) or exit 64; # EX_USAGE
79 $opt{width} ||= $ENV{COLUMNS} || 80;
80 $opt{color} //= -t *STDOUT; # enable on tty
81 $opt{'graph-format'} //= '-';
82 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
83 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
84 $opt{anchor} //= qr/\A/;
85 $opt{'value-length'} = 6 if $opt{units};
86 $opt{'value-length'} = 1 if $opt{unmodified};
88 my (@lines, @values, @order);
90 $SIG{$_} = \&show_stat for exists $SIG{INFO} ? 'INFO' : 'QUIT';
93 alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
96 if (defined $opt{interval}) {
98 alarm $opt{interval} if $opt{interval} > 0;
101 require Tie::Array::Sorted;
102 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
103 } or warn $@, "Expect slowdown with large datasets!\n";
107 $SIG{INT} = 'DEFAULT'; # reset for subsequent attempts
109 'IGNORE' # continue after assumed eof
112 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
115 s/^\h*// unless $opt{unmodified};
116 push @values, s/$valmatch/\n/ && $1;
117 push @order, $1 if length $1;
118 if (defined $opt{trim} and defined $1) {
119 my $trimpos = abs $opt{trim};
120 $trimpos -= length $1 if $opt{unmodified};
122 $_ = substr $_, 0, 2;
124 elsif (length > $trimpos) {
125 substr($_, $trimpos - 1) = '…';
129 show_lines() if defined $opt{interval} and $opt{interval} < 0
130 and $. % $opt{interval} == 0;
133 $SIG{INT} = 'DEFAULT';
136 $opt{color} and defined $_[0] or return '';
137 return "\e[$_[0]m" if defined wantarray;
138 $_ = color(@_) . $_ . color(0) if defined;
143 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
144 @lines and @lines > $nr or return;
146 @lines > $nr or return unless $opt{hidemin};
148 @order = sort { $b <=> $a } @order unless tied @order;
149 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
150 my $minval = min $order[-1] // (), 0;
151 my $lenval = $opt{'value-length'} // max map { length } @order;
152 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
153 max map { length $values[$_] && length $lines[$_] }
154 0 .. min $#lines, $opt{hidemax} || (); # left padding
155 my $size = ($maxval - $minval) &&
156 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
159 if ($opt{markers} // 1 and $size > 0) {
160 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
161 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
162 $barmark[ orderpos($#order * .31731) ] = '>';
163 $barmark[ orderpos($#order * .68269) ] = '<';
164 $barmark[ orderpos($#order / 2) ] = '+'; # mean
165 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
166 color(36) for @barmark;
168 state $lastmax = $maxval;
169 if ($maxval > $lastmax) {
170 print ' ' x ($lenval + $len);
173 ($lastmax - $minval) * $size + .5,
174 '-' x (($values[$nr - 1] - $minval) * $size);
176 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
182 @lines > $nr or return if $opt{hidemin};
185 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
186 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
188 $float && ($unit % 3) == ($unit < 0), # tenths
189 $_[0] / 1000 ** int($unit/3), # number
190 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
194 while ($nr <= $#lines) {
195 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
196 my $val = $values[$nr];
199 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
204 my $color = !$opt{color} ? undef :
205 $val == $order[0] ? 32 : # max
206 $val == $order[-1] ? 31 : # min
208 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
209 color($color) for $val;
211 my $line = $lines[$nr] =~ s/\n/$val/r;
212 printf '%-*s', $len + length($val), $line;
213 print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
219 say '' if $opt{spark};
225 if ($opt{hidemin} or $opt{hidemax}) {
227 $opt{hidemax} ||= @lines;
228 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
231 my $total = sum @order;
232 printf '%s total', color(1) . $total . color(0);
233 printf ' in %d values', scalar @values;
234 printf(' (%s min, %s avg, %s max)',
235 color(31) . $order[-1] . color(0),
236 color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
237 color(32) . $order[0] . color(0),
242 show_stat() if $opt{stat};
249 barcat - graph to visualize input values
253 B<barcat> [<options>] [<input>]
257 Visualizes relative sizes of values read from input (file(s) or STDIN).
258 Contents are concatenated similar to I<cat>,
259 but numbers are reformatted and a bar graph is appended to each line.
261 Don't worry, barcat does not drink and divide.
262 It can has various options for input and output (re)formatting,
263 but remains limited to one-dimensional charts.
264 For more complex graphing needs
265 you'll need a larger animal like I<gnuplot>.
271 =item -c, --[no-]color
273 Force colored output of values and bar markers.
274 Defaults on if output is a tty,
275 disabled otherwise such as when piped or redirected.
277 =item -f, --field=(<number>|<regexp>)
279 Compare values after a given number of whitespace separators,
280 or matching a regular expression.
282 Unspecified or I<-f0> means values are at the start of each line.
283 With I<-f1> the second word is taken instead.
284 A string can indicate the starting position of a value
285 (such as I<-f:> if preceded by colons),
286 or capture the numbers itself,
287 for example I<-f'(\d+)'> for the first digits anywhere.
289 =item -H, --human-readable
291 Format values using SI unit prefixes,
292 turning long numbers like I<12356789> into I<12.4M>.
293 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
294 Short integers are aligned but kept without decimal point.
296 =item -t, --interval[=(<seconds>|-<lines>)]
298 Output partial progress every given number of seconds or input lines.
299 An update can also be forced by sending a I<SIGALRM> alarm signal.
301 =item -l, --length=[-]<size>[%]
303 Trim line contents (between number and bars)
304 to a maximum number of characters.
305 The exceeding part is replaced by an abbreviation sign,
306 unless C<--length=0>.
308 Prepend a dash (i.e. make negative) to enforce padding
309 regardless of encountered contents.
311 =item -L, --limit=(<count>|<start>-[<end>])
313 Stop output after a number of lines.
314 All input is still counted and analyzed for statistics,
315 but disregarded for padding and bar size.
317 =item --graph-format=<character>
319 Glyph to repeat for the graph line.
320 Defaults to a dash C<->.
324 Statistical positions to indicate on bars.
325 Cannot be customized yet,
326 only disabled by providing an empty argument.
328 Any value enables all marker characters:
335 the sum of all values divided by the number of counted lines.
340 the middle value or average between middle values.
344 Standard deviation left of the mean.
345 Only 16% of all values are lower.
349 Standard deviation right of the mean.
350 The part between B<< <--> >> encompass all I<normal> results,
351 or 68% of all entries.
357 Total statistics after all data.
359 =item -u, --unmodified
361 Do not reformat values, keeping leading whitespace.
362 Keep original value alignment, which may be significant in some programs.
364 =item --value-length=<size>
366 Reserved space for numbers.
368 =item -w, --width=<columns>
370 Override the maximum number of columns to use.
371 Appended graphics will extend to fill up the entire screen.
375 Overview of available options.
392 seq 30 | awk '{print sin($1/10)}' | barcat
394 Compare file sizes (with human-readable numbers):
396 du -d0 -b * | barcat -H
398 Memory usage of user processes with long names truncated:
400 ps xo %mem,pid,cmd | barcat -l40
402 Monitor network latency from prefixed results:
404 ping google.com | barcat -f'time=\K' -t
406 Commonly used after counting, for example users on the current server:
408 users | sed 's/ /\n/g' | sort | uniq -c | barcat
410 Letter frequencies in text files:
412 cat /usr/share/games/fortunes/*.u8 |
413 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
414 sort | uniq -c | barcat
416 Number of HTTP requests per day:
418 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
420 Any kind of database query with counts, preserving returned alignment:
422 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
425 Earthquakes worldwide magnitude 1+ in the last 24 hours:
427 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
428 column -tns, | graph -f4 -u -l80%
430 External datasets, like movies per year:
432 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
433 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
435 But please get I<jq> to process JSON
436 and replace the manual selection by C<< jq '.[].year' >>.
438 Pokémon height comparison:
440 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
441 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
443 USD/EUR exchange rate from CSV provided by the ECB:
445 curl https://sdw.ecb.europa.eu/export.do \
446 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
447 grep '^[12]' | barcat -f',\K' --value-length=7
449 Total population history from the World Bank dataset (XML):
450 External datasets, like total population in XML from the World Bank:
452 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
453 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
454 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
456 And of course various Git statistics, such commit count by year:
458 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
460 Or the top 3 most frequent authors with statistics over all:
462 git shortlog -sn | barcat -L3 -s
464 Activity of the last days (substitute date C<-v-{}d> on BSD):
466 ( git log --pretty=%ci --since=30day | cut -b-10
467 seq 0 30 | xargs -i date +%F -d-{}day ) |
468 sort | uniq -c | awk '$1--' | graph --spark
472 Mischa POSLAWSKY <perl@shiar.org>