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 'graph-format=s' => sub {
48 $opt{'graph-format'} = substr $_[1], 0, 1;
51 $opt{spark} = [split //, $_[1] || '▁▂▃▄▅▆▇█'];
58 say "barcat version $VERSION";
63 my $pod = readline *DATA;
64 $pod =~ s/^=over\K/ 22/m; # indent options list
65 $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
68 my $parser = Pod::Usage->new;
69 $parser->select('SYNOPSIS', 'OPTIONS');
70 $parser->output_string(\my $contents);
71 $parser->parse_string_document($pod);
73 $contents =~ s/\n(?=\n\h)//msg; # strip space between items
79 Pod::Usage::pod2usage(
80 -exitval => 0, -perldocopt => '-oman', -verbose => 2,
83 ) or exit 64; # EX_USAGE
85 $opt{width} ||= $ENV{COLUMNS} || 80;
86 $opt{color} //= -t *STDOUT; # enable on tty
87 $opt{'graph-format'} //= '-';
88 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
89 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
90 $opt{anchor} //= qr/\A/;
91 $opt{'value-length'} = 6 if $opt{units};
92 $opt{'value-length'} = 1 if $opt{unmodified};
93 $opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT';
95 my (@lines, @values, @order);
97 $SIG{$_} = \&show_stat for $opt{'signal-stat'} || ();
100 alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
102 $SIG{INT} = \&show_exit;
104 if (defined $opt{interval}) {
105 $opt{interval} ||= 1;
106 alarm $opt{interval} if $opt{interval} > 0;
109 require Tie::Array::Sorted;
110 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
111 } or warn $@, "Expect slowdown with large datasets!\n";
114 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
117 s/^\h*// unless $opt{unmodified};
118 push @values, s/$valmatch/\n/ && $1;
119 push @order, $1 if length $1;
120 if (defined $opt{trim} and defined $1) {
121 my $trimpos = abs $opt{trim};
122 $trimpos -= length $1 if $opt{unmodified};
124 $_ = substr $_, 0, 2;
126 elsif (length > $trimpos) {
127 substr($_, $trimpos - 1) = '…';
131 show_lines() if defined $opt{interval} and $opt{interval} < 0
132 and $. % $opt{interval} == 0;
135 $SIG{INT} = 'DEFAULT';
138 $opt{color} and defined $_[0] or return '';
139 return "\e[$_[0]m" if defined wantarray;
140 $_ = color(@_) . $_ . color(0) if defined;
145 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
146 @lines and @lines > $nr or return;
148 @lines > $nr or return unless $opt{hidemin};
150 @order = sort { $b <=> $a } @order unless tied @order;
151 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
152 my $minval = min $order[-1] // (), 0;
153 my $lenval = $opt{'value-length'} // max map { length } @order;
154 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
155 max map { length $values[$_] && length $lines[$_] }
156 0 .. min $#lines, $opt{hidemax} || (); # left padding
157 my $size = ($maxval - $minval) &&
158 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
161 if ($opt{markers} // 1 and $size > 0) {
162 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
163 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
164 $barmark[ orderpos($#order * .31731) ] = '>';
165 $barmark[ orderpos($#order * .68269) ] = '<';
166 $barmark[ orderpos($#order / 2) ] = '+'; # mean
167 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
168 color(36) for @barmark;
170 state $lastmax = $maxval;
171 if ($maxval > $lastmax) {
172 print ' ' x ($lenval + $len);
175 ($lastmax - $minval) * $size + .5,
176 '-' x (($values[$nr - 1] - $minval) * $size);
178 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
184 @lines > $nr or return if $opt{hidemin};
187 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
188 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
190 $float && ($unit % 3) == ($unit < 0), # tenths
191 $_[0] / 1000 ** int($unit/3), # number
192 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
197 color(31), sprintf('%*s', $lenval, $minval),
198 color(90), '-', color(36), '+',
199 color(32), sprintf('%*s', $size * ($maxval - $minval) - 3, $maxval),
200 color(90), '-', color(36), '+',
204 while ($nr <= $#lines) {
205 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
206 my $val = $values[$nr];
209 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
214 my $color = !$opt{color} ? undef :
215 $val == $order[0] ? 32 : # max
216 $val == $order[-1] ? 31 : # min
218 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
219 color($color) for $val;
221 my $line = $lines[$nr] =~ s/\n/$val/r;
222 printf '%-*s', $len + length($val), $line;
223 print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
229 say '' if $opt{spark};
234 if ($opt{hidemin} or $opt{hidemax}) {
236 $opt{hidemax} ||= @lines;
237 printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
240 my $total = sum @order;
241 printf '%s total', color(1) . $total . color(0);
242 printf ' in %d values', scalar @values;
243 printf(' (%s min, %s avg, %s max)',
244 color(31) . $order[-1] . color(0),
245 color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0),
246 color(32) . $order[0] . color(0),
254 show_stat() if $opt{stat};
255 exit 130 if @_; # 0x80+signo
266 barcat - graph to visualize input values
270 B<barcat> [<options>] [<input>]
274 Visualizes relative sizes of values read from input (file(s) or STDIN).
275 Contents are concatenated similar to I<cat>,
276 but numbers are reformatted and a bar graph is appended to each line.
278 Don't worry, barcat does not drink and divide.
279 It can has various options for input and output (re)formatting,
280 but remains limited to one-dimensional charts.
281 For more complex graphing needs
282 you'll need a larger animal like I<gnuplot>.
288 =item -c, --[no-]color
290 Force colored output of values and bar markers.
291 Defaults on if output is a tty,
292 disabled otherwise such as when piped or redirected.
294 =item -f, --field=(<number>|<regexp>)
296 Compare values after a given number of whitespace separators,
297 or matching a regular expression.
299 Unspecified or I<-f0> means values are at the start of each line.
300 With I<-f1> the second word is taken instead.
301 A string can indicate the starting position of a value
302 (such as I<-f:> if preceded by colons),
303 or capture the numbers itself,
304 for example I<-f'(\d+)'> for the first digits anywhere.
308 Prepend a chart axis with minimum and maximum values labeled.
310 =item -H, --human-readable
312 Format values using SI unit prefixes,
313 turning long numbers like I<12356789> into I<12.4M>.
314 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
315 Short integers are aligned but kept without decimal point.
317 =item -t, --interval[=(<seconds>|-<lines>)]
319 Output partial progress every given number of seconds or input lines.
320 An update can also be forced by sending a I<SIGALRM> alarm signal.
322 =item -l, --length=[-]<size>[%]
324 Trim line contents (between number and bars)
325 to a maximum number of characters.
326 The exceeding part is replaced by an abbreviation sign,
327 unless C<--length=0>.
329 Prepend a dash (i.e. make negative) to enforce padding
330 regardless of encountered contents.
332 =item -L, --limit=(<count>|<start>-[<end>])
334 Stop output after a number of lines.
335 All input is still counted and analyzed for statistics,
336 but disregarded for padding and bar size.
338 =item --graph-format=<character>
340 Glyph to repeat for the graph line.
341 Defaults to a dash C<->.
345 Statistical positions to indicate on bars.
346 Cannot be customized yet,
347 only disabled by providing an empty argument.
349 Any value enables all marker characters:
356 the sum of all values divided by the number of counted lines.
361 the middle value or average between middle values.
365 Standard deviation left of the mean.
366 Only 16% of all values are lower.
370 Standard deviation right of the mean.
371 The part between B<< <--> >> encompass all I<normal> results,
372 or 68% of all entries.
376 =item --spark[=<glyphs>]
378 Replace lines by I<sparklines>,
379 single characters corresponding to input values.
380 A specified sequence of unicode characters will be used for
381 Of a specified sequence of unicode characters,
382 the first one will be used for non-values,
383 the last one for the maximum,
384 the second (if any) for the minimum,
385 and any remaining will be distributed over the range of values.
386 Unspecified, block fill glyphs U+2581-2588 will be used.
390 Total statistics after all data.
392 =item -u, --unmodified
394 Do not reformat values, keeping leading whitespace.
395 Keep original value alignment, which may be significant in some programs.
397 =item --value-length=<size>
399 Reserved space for numbers.
401 =item -w, --width=<columns>
403 Override the maximum number of columns to use.
404 Appended graphics will extend to fill up the entire screen.
408 Overview of available options.
425 seq 30 | awk '{print sin($1/10)}' | barcat
427 Compare file sizes (with human-readable numbers):
429 du -d0 -b * | barcat -H
431 Memory usage of user processes with long names truncated:
433 ps xo %mem,pid,cmd | barcat -l40
435 Monitor network latency from prefixed results:
437 ping google.com | barcat -f'time=\K' -t
439 Commonly used after counting, for example users on the current server:
441 users | sed 's/ /\n/g' | sort | uniq -c | barcat
443 Letter frequencies in text files:
445 cat /usr/share/games/fortunes/*.u8 |
446 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
447 sort | uniq -c | barcat
449 Number of HTTP requests per day:
451 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
453 Any kind of database query with counts, preserving returned alignment:
455 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
458 Earthquakes worldwide magnitude 1+ in the last 24 hours:
460 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
461 column -tns, | graph -f4 -u -l80%
463 External datasets, like movies per year:
465 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
466 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
468 But please get I<jq> to process JSON
469 and replace the manual selection by C<< jq '.[].year' >>.
471 Pokémon height comparison:
473 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
474 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
476 USD/EUR exchange rate from CSV provided by the ECB:
478 curl https://sdw.ecb.europa.eu/export.do \
479 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
480 grep '^[12]' | barcat -f',\K' --value-length=7
482 Total population history from the World Bank dataset (XML):
483 External datasets, like total population in XML from the World Bank:
485 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
486 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
487 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
489 And of course various Git statistics, such commit count by year:
491 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
493 Or the top 3 most frequent authors with statistics over all:
495 git shortlog -sn | barcat -L3 -s
497 Activity of the last days (substitute date C<-v-{}d> on BSD):
499 ( git log --pretty=%ci --since=30day | cut -b-10
500 seq 0 30 | xargs -i date +%F -d-{}day ) |
501 sort | uniq -c | awk '$1--' | graph --spark
505 Mischa POSLAWSKY <perl@shiar.org>