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 say "barcat version $VERSION";
62 my $pod = readline *DATA;
63 $pod =~ s/^=over\K/ 22/m; # indent options list
64 $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
67 my $parser = Pod::Usage->new;
68 $parser->select('SYNOPSIS', 'OPTIONS');
69 $parser->output_string(\my $contents);
70 $parser->parse_string_document($pod);
72 $contents =~ s/\n(?=\n\h)//msg; # strip space between items
78 Pod::Usage::pod2usage(
79 -exitval => 0, -perldocopt => '-oman', -verbose => 2,
82 ) or exit 64; # EX_USAGE
84 $opt{width} ||= $ENV{COLUMNS} || 80;
85 $opt{color} //= -t *STDOUT; # enable on tty
86 $opt{'graph-format'} //= '-';
87 $opt{trim} *= $opt{width} / 100 if $opt{trimpct};
88 $opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
89 $opt{anchor} //= qr/\A/;
90 $opt{'value-length'} = 6 if $opt{units};
91 $opt{'value-length'} = 1 if $opt{unmodified};
92 $opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT';
94 my (@lines, @values, @order);
96 $SIG{$_} = \&show_stat for $opt{'signal-stat'} || ();
99 alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
101 $SIG{INT} = \&show_exit;
103 if (defined $opt{interval}) {
104 $opt{interval} ||= 1;
105 alarm $opt{interval} if $opt{interval} > 0;
108 require Tie::Array::Sorted;
109 tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
110 } or warn $@, "Expect slowdown with large datasets!\n";
113 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
116 s/^\h*// unless $opt{unmodified};
117 push @values, s/$valmatch/\n/ && $1;
118 push @order, $1 if length $1;
119 if (defined $opt{trim} and defined $1) {
120 my $trimpos = abs $opt{trim};
121 $trimpos -= length $1 if $opt{unmodified};
123 $_ = substr $_, 0, 2;
125 elsif (length > $trimpos) {
126 substr($_, $trimpos - 1) = '…';
130 show_lines() if defined $opt{interval} and $opt{interval} < 0
131 and $. % $opt{interval} == 0;
134 $SIG{INT} = 'DEFAULT';
137 $opt{color} and defined $_[0] or return '';
138 return "\e[$_[0]m" if defined wantarray;
139 $_ = color(@_) . $_ . color(0) if defined;
144 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
145 @lines and @lines > $nr or return;
147 @lines > $nr or return unless $opt{hidemin};
149 @order = sort { $b <=> $a } @order unless tied @order;
150 my $maxval = ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
151 my $minval = min $order[-1] // (), 0;
152 my $lenval = $opt{'value-length'} // max map { length } @order;
153 my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
154 max map { length $values[$_] && length $lines[$_] }
155 0 .. min $#lines, $opt{hidemax} || (); # left padding
156 my $size = ($maxval - $minval) &&
157 ($opt{width} - $lenval - $len) / ($maxval - $minval); # bar multiplication
160 if ($opt{markers} // 1 and $size > 0) {
161 my sub orderpos { (($order[$_[0]] + $order[$_[0] + .5]) / 2 - $minval) * $size }
162 $barmark[ (sum(@order) / @order - $minval) * $size ] = '='; # average
163 $barmark[ orderpos($#order * .31731) ] = '>';
164 $barmark[ orderpos($#order * .68269) ] = '<';
165 $barmark[ orderpos($#order / 2) ] = '+'; # mean
166 $barmark[ -$minval * $size ] = '|' if $minval < 0; # zero
167 color(36) for @barmark;
169 state $lastmax = $maxval;
170 if ($maxval > $lastmax) {
171 print ' ' x ($lenval + $len);
174 ($lastmax - $minval) * $size + .5,
175 '-' x (($values[$nr - 1] - $minval) * $size);
177 say '+' x (($maxval - $lastmax - $minval) * $size + .5);
183 @lines > $nr or return if $opt{hidemin};
186 my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
187 my $float = $_[0] !~ /^0*[-0-9]{1,3}$/;
189 $float && ($unit % 3) == ($unit < 0), # tenths
190 $_[0] / 1000 ** int($unit/3), # number
191 $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3]
195 while ($nr <= $#lines) {
196 $nr >= $opt{hidemax} and last if defined $opt{hidemax};
197 my $val = $values[$nr];
200 print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
205 my $color = !$opt{color} ? undef :
206 $val == $order[0] ? 32 : # max
207 $val == $order[-1] ? 31 : # min
209 $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
210 color($color) for $val;
212 my $line = $lines[$nr] =~ s/\n/$val/r;
213 printf '%-*s', $len + length($val), $line;
214 print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
220 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),
245 show_stat() if $opt{stat};
246 exit 130 if @_; # 0x80+signo
257 barcat - graph to visualize input values
261 B<barcat> [<options>] [<input>]
265 Visualizes relative sizes of values read from input (file(s) or STDIN).
266 Contents are concatenated similar to I<cat>,
267 but numbers are reformatted and a bar graph is appended to each line.
269 Don't worry, barcat does not drink and divide.
270 It can has various options for input and output (re)formatting,
271 but remains limited to one-dimensional charts.
272 For more complex graphing needs
273 you'll need a larger animal like I<gnuplot>.
279 =item -c, --[no-]color
281 Force colored output of values and bar markers.
282 Defaults on if output is a tty,
283 disabled otherwise such as when piped or redirected.
285 =item -f, --field=(<number>|<regexp>)
287 Compare values after a given number of whitespace separators,
288 or matching a regular expression.
290 Unspecified or I<-f0> means values are at the start of each line.
291 With I<-f1> the second word is taken instead.
292 A string can indicate the starting position of a value
293 (such as I<-f:> if preceded by colons),
294 or capture the numbers itself,
295 for example I<-f'(\d+)'> for the first digits anywhere.
297 =item -H, --human-readable
299 Format values using SI unit prefixes,
300 turning long numbers like I<12356789> into I<12.4M>.
301 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
302 Short integers are aligned but kept without decimal point.
304 =item -t, --interval[=(<seconds>|-<lines>)]
306 Output partial progress every given number of seconds or input lines.
307 An update can also be forced by sending a I<SIGALRM> alarm signal.
309 =item -l, --length=[-]<size>[%]
311 Trim line contents (between number and bars)
312 to a maximum number of characters.
313 The exceeding part is replaced by an abbreviation sign,
314 unless C<--length=0>.
316 Prepend a dash (i.e. make negative) to enforce padding
317 regardless of encountered contents.
319 =item -L, --limit=(<count>|<start>-[<end>])
321 Stop output after a number of lines.
322 All input is still counted and analyzed for statistics,
323 but disregarded for padding and bar size.
325 =item --graph-format=<character>
327 Glyph to repeat for the graph line.
328 Defaults to a dash C<->.
332 Statistical positions to indicate on bars.
333 Cannot be customized yet,
334 only disabled by providing an empty argument.
336 Any value enables all marker characters:
343 the sum of all values divided by the number of counted lines.
348 the middle value or average between middle values.
352 Standard deviation left of the mean.
353 Only 16% of all values are lower.
357 Standard deviation right of the mean.
358 The part between B<< <--> >> encompass all I<normal> results,
359 or 68% of all entries.
365 Total statistics after all data.
367 =item -u, --unmodified
369 Do not reformat values, keeping leading whitespace.
370 Keep original value alignment, which may be significant in some programs.
372 =item --value-length=<size>
374 Reserved space for numbers.
376 =item -w, --width=<columns>
378 Override the maximum number of columns to use.
379 Appended graphics will extend to fill up the entire screen.
383 Overview of available options.
400 seq 30 | awk '{print sin($1/10)}' | barcat
402 Compare file sizes (with human-readable numbers):
404 du -d0 -b * | barcat -H
406 Memory usage of user processes with long names truncated:
408 ps xo %mem,pid,cmd | barcat -l40
410 Monitor network latency from prefixed results:
412 ping google.com | barcat -f'time=\K' -t
414 Commonly used after counting, for example users on the current server:
416 users | sed 's/ /\n/g' | sort | uniq -c | barcat
418 Letter frequencies in text files:
420 cat /usr/share/games/fortunes/*.u8 |
421 perl -CS -nE 'say for grep length, split /\PL*/, uc' |
422 sort | uniq -c | barcat
424 Number of HTTP requests per day:
426 cat log/access.log | cut -d\ -f4 | cut -d: -f1 | uniq -c | barcat
428 Any kind of database query with counts, preserving returned alignment:
430 echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
433 Earthquakes worldwide magnitude 1+ in the last 24 hours:
435 https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv |
436 column -tns, | graph -f4 -u -l80%
438 External datasets, like movies per year:
440 curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
441 perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
443 But please get I<jq> to process JSON
444 and replace the manual selection by C<< jq '.[].year' >>.
446 Pokémon height comparison:
448 curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
449 jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat
451 USD/EUR exchange rate from CSV provided by the ECB:
453 curl https://sdw.ecb.europa.eu/export.do \
454 -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
455 grep '^[12]' | barcat -f',\K' --value-length=7
457 Total population history from the World Bank dataset (XML):
458 External datasets, like total population in XML from the World Bank:
460 curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
461 xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
462 sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H
464 And of course various Git statistics, such commit count by year:
466 git log --pretty=%ci | cut -b-4 | uniq -c | barcat
468 Or the top 3 most frequent authors with statistics over all:
470 git shortlog -sn | barcat -L3 -s
472 Activity of the last days (substitute date C<-v-{}d> on BSD):
474 ( git log --pretty=%ci --since=30day | cut -b-10
475 seq 0 30 | xargs -i date +%F -d-{}day ) |
476 sort | uniq -c | awk '$1--' | graph --spark
480 Mischa POSLAWSKY <perl@shiar.org>