X-Git-Url: http://git.shiar.nl/barcat.git/blobdiff_plain/61a444b020fe921791fff78c3acc3f39b5495f5a..4855cd33928ac5c3003ad747048a7e5d5477bff8:/barcat diff --git a/barcat b/barcat index 7289039..8e104c9 100755 --- a/barcat +++ b/barcat @@ -4,26 +4,30 @@ use warnings; use utf8; use List::Util qw( min max sum ); use open qw( :std :utf8 ); +use re '/msx'; -our $VERSION = '1.06'; +our $VERSION = '1.07'; -use Getopt::Long '2.33', qw( :config gnu_getopt ); my %opt; +if (@ARGV) { +require Getopt::Long; +Getopt::Long->import('2.33', qw( :config gnu_getopt )); GetOptions(\%opt, + 'ascii|a!', 'color|c!', 'C' => sub { $opt{color} = 0 }, 'field|f=s' => sub { eval { local $_ = $_[1]; - $opt{anchor} = /^[0-9]+$/ ? qr/(?:\S*\h+){$_}\K/ : qr/$_/; - } or die $@ =~ s/(?: at .+)?$/ for option $_[0]/r; + $opt{anchor} = /\A[0-9]+\z/ ? qr/(?:\S*\h+){$_}\K/ : qr/$_/; + } or die $@ =~ s/(?:\ at\ \N+)?\Z/ for option $_[0]/r; }, 'human-readable|H!', 'interval|t:i', 'trim|length|l=s' => sub { my ($optname, $optval) = @_; $optval =~ s/%$// and $opt{trimpct}++; - $optval =~ m/^-?[0-9]+$/ or die( + $optval =~ m/\A-?[0-9]+\z/ or die( "Value \"$optval\" invalid for option $optname", " (number or percentage expected)\n" ); @@ -37,8 +41,9 @@ GetOptions(\%opt, 'limit|L:s' => sub { my ($optname, $optval) = @_; $optval ||= 0; + $optval =~ /\A-[0-9]+\z/ and $optval .= '-'; # tail shorthand ($opt{hidemin}, $opt{hidemax}) = - $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die( + $optval =~ m/\A (?: (-? [0-9]+)? - )? ([0-9]+)? \z/ or die( "Value \"$optval\" invalid for option limit", " (range expected)\n" ); @@ -49,7 +54,9 @@ GetOptions(\%opt, $opt{'graph-format'} = substr $_[1], 0, 1; }, 'spark:s' => sub { - $opt{spark} = [split //, $_[1] || ' ▁▂▃▄▅▆▇█']; + $opt{spark} = [split //, + $_[1] || ($opt{ascii} ? ' ..oOO' : ' ▁▂▃▄▅▆▇█') + ]; }, 'palette=s' => sub { $opt{palette} = { @@ -77,30 +84,7 @@ GetOptions(\%opt, exit; }, 'usage|h' => sub { - local $/; - my $pod = readline *DATA; - $pod =~ s/^=over\K/ 25/m; # indent options list - $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg; - $pod =~ s/[.,](?=\n)//g; # trailing punctuation - $pod =~ s/^=item \K(?=--)/____/gm; # align long options - # abbreviate indicators - $pod =~ s/\Q>.../s>/g; - $pod =~ s/<(?:number|count|seconds)>/N/g; - $pod =~ s//\Uchar$1/g; - $pod =~ s/\Q | /|/g; - $pod =~ s/(?/\U$1/g; # uppercase - - require Pod::Usage; - my $parser = Pod::Usage->new(USAGE_OPTIONS => { - -indent => 2, -width => 78, - }); - $parser->select('SYNOPSIS', 'OPTIONS'); - $parser->output_string(\my $contents); - $parser->parse_string_document($pod); - - $contents =~ s/\n(?=\n\h)//msg; # strip space between items - $contents =~ s/^ \K____/ /gm; # nbsp substitute - print $contents; + /^=/ ? last : print for readline *DATA; # text between __END__ and pod exit; }, 'help|?' => sub { @@ -110,21 +94,46 @@ GetOptions(\%opt, ); }, ) or exit 64; # EX_USAGE +} $opt{width} ||= $ENV{COLUMNS} || qx(tput cols) || 80 unless $opt{spark}; $opt{color} //= -t *STDOUT; # enable on tty $opt{'graph-format'} //= '-'; $opt{trim} *= $opt{width} / 100 if $opt{trimpct}; -$opt{units} = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'}; +$opt{units} = [split //, ' kMGTPEZYyzafpn'.($opt{ascii} ? 'u' : 'μ').'m'] + if $opt{'human-readable'}; $opt{anchor} //= qr/\A/; $opt{'value-length'} = 6 if $opt{units}; $opt{'value-length'} = 1 if $opt{unmodified}; $opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT'; $opt{markers} //= '=avg >31.73v <68.27v +50v |0'; $opt{palette} //= $opt{color} && [31, 90, 32]; -$opt{input} = @ARGV && $ARGV[0] =~ m/\A[-0-9]/ ? \@ARGV : undef +$opt{hidemin} = ($opt{hidemin} || 1) - 1; +$opt{input} = (@ARGV && $ARGV[0] =~ m/\A[-0-9]/) ? \@ARGV : undef and undef $opt{interval}; +$opt{'sum-format'} = sub { sprintf '%.8g', $_[0] }; +$opt{'calc-format'} = sub { sprintf '%*.*f', 0, 2, $_[0] }; +$opt{'value-format'} = $opt{units} && sub { + my $unit = ( + log(abs $_[0] || 1) / log(10) + - 3 * (abs($_[0]) < .9995) # shift to smaller unit if below 1 + + 1e-15 # float imprecision + ); + my $decimal = ($unit % 3) == ($unit < 0); + $unit -= log($decimal ? .995 : .9995) / log(10); # rounded + $decimal = ($unit % 3) == ($unit < 0); + $decimal &&= $_[0] !~ /^-?0*[0-9]{1,3}$/; # integer 0..999 + sprintf('%*.*f%1s', + 3 + ($_[0] < 0), # digits plus optional negative sign + $decimal, # tenths + $_[0] / 1000 ** int($unit/3), # number + $#{$opt{units}} * 1.5 < abs $unit ? sprintf('e%d', $unit) : + $opt{units}->[$unit/3] # suffix + ); +}; + + my (@lines, @values, @order); $SIG{$_} = \&show_stat for $opt{'signal-stat'} || (); @@ -145,21 +154,23 @@ if (defined $opt{interval}) { } my $valmatch = qr< - $opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |) + $opt{anchor} ( \h* -? [0-9]* [.]? [0-9]+ (?: e[+-]?[0-9]+ )? |) >x; while (defined ($_ = $opt{input} ? shift @{ $opt{input} } : readline)) { s/\r?\n\z//; - s/^\h*// unless $opt{unmodified}; - push @values, s/$valmatch/\n/ && $1; - push @order, $1 if length $1; - if (defined $opt{trim} and defined $1) { + s/\A\h*// unless $opt{unmodified}; + my $valnum = s/$valmatch/\n/ && $1; + push @values, $valnum; + push @order, $valnum if length $valnum; + if (defined $opt{trim} and defined $valnum) { my $trimpos = abs $opt{trim}; - $trimpos -= length $1 if $opt{unmodified}; + $trimpos -= length $valnum if $opt{unmodified}; if ($trimpos <= 1) { $_ = substr $_, 0, 2; } elsif (length > $trimpos) { - substr($_, $trimpos - 1) = '…'; + # cut and replace (intentional lvalue for speed, contrary to PBP) + substr($_, $trimpos - 1) = $opt{ascii} ? '>' : '…'; } } push @lines, $_; @@ -181,14 +192,24 @@ sub color { sub show_lines { -state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0; -@lines and @lines > $nr or return; -@lines or return; -@lines > $nr or return unless $opt{hidemin}; +state $nr = + $opt{hidemin} < 0 ? @lines + $opt{hidemin} + 1 : + $opt{hidemin}; +@lines > $nr or return; + +my $limit = $#lines; +if (defined $opt{hidemax}) { + if ($opt{hidemin} and $opt{hidemin} < 0) { + $limit -= $opt{hidemax} - 1; + } + else { + $limit = $opt{hidemax} - 1; + } +} @order = sort { $b <=> $a } @order unless tied @order; my $maxval = $opt{maxval} // ( - $opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : + $opt{hidemax} ? max grep { length } @values[$nr .. $limit] : $order[0] ) // 0; my $minval = $opt{minval} // min $order[-1] // (), 0; @@ -197,7 +218,7 @@ my $lenval = $opt{'value-length'} // max map { length } @order; my $len = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 : max map { length $values[$_] && length $lines[$_] } 0 .. min $#lines, $opt{hidemax} || (); # left padding -my $size = $range && +my $size = defined $opt{width} && $range && ($opt{width} - $lenval - $len) / $range; # bar multiplication my @barmark; @@ -209,13 +230,22 @@ if ($opt{markers} and $size > 0) { return sum(@order) / @order; } elsif ($func =~ /\A([0-9.]+)v\z/) { + die "Invalid marker $char: percentile $1 out of bounds\n" if $1 > 100; my $index = $#order * $1 / 100; return ($order[$index] + $order[$index + .5]) / 2; } - else { + elsif ($func =~ /\A-?[0-9.]+\z/) { return $func; } - } - $minval; + else { + die "Unknown marker $char: $func\n"; + } + }; + defined $pos or do { + warn $@ if $@; + next; + }; + $pos -= $minval; $pos >= 0 or next; color(36) for $barmark[$pos * $size] = $char; } @@ -234,18 +264,6 @@ if ($opt{markers} and $size > 0) { } } -@lines > $nr or return if $opt{hidemin}; - -sub sival { - my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15); - my $float = $_[0] !~ /^0*[-0-9]{1,3}$/; - sprintf('%3.*f%1s', - $float && ($unit % 3) == ($unit < 0), # tenths - $_[0] / 1000 ** int($unit/3), # number - $#{$opt{units}} * 1.5 < abs $unit ? "e$unit" : $opt{units}->[$unit/3] - ); -} - say( color(31), sprintf('%*s', $lenval, $minval), color(90), '-', color(36), '+', @@ -254,8 +272,7 @@ say( color(0), ) if $opt{header}; -while ($nr <= $#lines) { - $nr >= $opt{hidemax} and last if defined $opt{hidemax}; +while ($nr <= $limit) { my $val = $values[$nr]; my $rel = length $val && $range && ($val - $minval) / $range; my $color = !length $val || !$opt{palette} ? undef : @@ -266,7 +283,7 @@ while ($nr <= $#lines) { if ($opt{spark}) { say '' if $opt{width} and $nr and $nr % $opt{width} == 0; print color($color), $opt{spark}->[ - !$val ? 0 : # blank + !$val || !$#{$opt{spark}} ? 0 : # blank $val == $order[0] ? -1 : # max $val == $order[-1] ? 1 : # min $#{$opt{spark}} < 3 ? 1 : @@ -276,10 +293,15 @@ while ($nr <= $#lines) { } if (length $val) { - $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val; + $val = $opt{'value-format'} ? $opt{'value-format'}->($val) : + sprintf "%*s", $lenval, $val; color($color) for $val; } my $line = $lines[$nr] =~ s/\n/$val/r; + if (not length $val) { + say $line; + next; + } printf '%-*s', $len + length($val), $line; print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5; @@ -290,26 +312,34 @@ continue { } say $opt{palette} ? color(0) : '' if $opt{spark}; + return $nr; } sub show_stat { if ($opt{hidemin} or $opt{hidemax}) { - $opt{hidemin} ||= 1; - $opt{hidemax} ||= @lines; - printf '%s of ', sum(grep {length} @values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0; + my $linemin = $opt{hidemin}; + my $linemax = ($opt{hidemax} || @lines) - 1; + if ($linemin < 0) { + $linemin += @lines; + $linemax = @lines - $linemax; + } + printf '%.8g of ', $opt{'sum-format'}->( + sum(grep {length} @values[$linemin .. $linemax]) // 0 + ); } if (@order) { my $total = sum @order; - printf '%s total', color(1) . sprintf('%.8g', $total) . color(0); + printf '%s total', color(1) . $opt{'sum-format'}->($total) . color(0); printf ' in %d values', scalar @order; printf ' over %d lines', scalar @lines if @order != @lines; printf(' (%s min, %s avg, %s max)', - color(31) . $order[-1] . color(0), - color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0), - color(32) . $order[0] . color(0), + color(31) . ($opt{'value-format'} || sub {$_[0]})->($order[-1]) . color(0), + color(36) . ($opt{'value-format'} || $opt{'calc-format'})->($total / @order) . color(0), + color(32) . ($opt{'value-format'} || sub {$_[0]})->($order[0]) . color(0), ); } say ''; + return 1; } sub show_exit { @@ -322,6 +352,37 @@ sub show_exit { show_exit(); __END__ +Usage: + barcat [OPTIONS] [FILES|NUMBERS] + +Options: + -a, --[no-]ascii Restrict user interface to ASCII characters + -c, --[no-]color Force colored output of values and bar markers + -f, --field=(N|REGEXP) Compare values after a given number of whitespace + separators + --header Prepend a chart axis with minimum and maximum + values labeled + -H, --human-readable Format values using SI unit prefixes + -t, --interval[=(N|-LINES)] + Output partial progress every given number of + seconds or input lines + -l, --length=[-]SIZE[%] Trim line contents (between number and bars) + -L, --limit[=(N|-LAST|START-[END])] + Stop output after a number of lines + --graph-format=CHAR Glyph to repeat for the graph line + -m, --markers=FORMAT Statistical positions to indicate on bars + --min=N, --max=N Bars extend from 0 or the minimum value if lower + --palette=(PRESET|COLORS) + Override colors of parsed numbers + --spark[=CHARS] Replace lines by sparklines + -s, --stat Total statistics after all data + -u, --unmodified Do not reformat values, keeping leading whitespace + --value-length=SIZE Reserved space for numbers + -w, --width=COLUMNS Override the maximum number of columns to use + -h, --usage Overview of available options + --help Full documentation + --version Version information + =encoding utf8 =head1 NAME @@ -349,6 +410,12 @@ you'll need a larger animal like I. =over +=item -a, --[no-]ascii + +Restrict user interface to ASCII characters, +replacing default UTF-8 by their closest approximation. +Input is always interpreted as UTF-8 and shown as is. + =item -c, --[no-]color Force colored output of values and bar markers. @@ -393,9 +460,13 @@ unless C<--length=0>. Prepend a dash (i.e. make negative) to enforce padding regardless of encountered contents. -=item -L, --limit[=( | -[])] +=item -L, --limit[=( | - | -[])] Stop output after a number of lines. +A single value indicates the last line number (like C), +or first line counting from the bottom if negative (like C). +A specific range can be given by two values. + All input is still counted and analyzed for statistics, but disregarded for padding and bar size. @@ -450,6 +521,11 @@ or alternatively I<1;30> for bright black. In case of additional colors, the last is used for values equal to the maximum, the first for minima. If unspecified, these are green and red respectively (I<31 90 32>). +Multiple intermediate colors will be distributed +relative to the size of values. + +Predefined color schemes are named I and I, +or I and I for 256-color variants. =item --spark[=] @@ -533,14 +609,18 @@ Any kind of database query with counts, preserving returned alignment: echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' | psql -t | barcat -u +In PostgreSQL from within the client: + + postgres=> SELECT sin(generate_series(0, 3, .1)) \g |barcat + Earthquakes worldwide magnitude 1+ in the last 24 hours: - https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv | - column -tns, | graph -f4 -u -l80% + curl https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv | + column -tns, | barcat -f4 -u -l80% External datasets, like movies per year: - curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json | + curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json -L | perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat But please get I to process JSON @@ -548,7 +628,7 @@ and replace the manual selection by C<< jq '.[].year' >>. Pokémon height comparison: - curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json | + curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json -L | jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat USD/EUR exchange rate from CSV provided by the ECB: @@ -559,7 +639,7 @@ USD/EUR exchange rate from CSV provided by the ECB: Total population history in XML from the World Bank: - curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL | + curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL -L | xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - | sed -r 's,,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H @@ -579,7 +659,7 @@ Activity graph of the last days (substitute date C<-v-{}d> on BSD): ( git log --pretty=%ci --since=30day | cut -b-10 seq 0 30 | xargs -i date +%F -d-{}day ) | - sort | uniq -c | awk '$1--' | graph --spark + sort | uniq -c | awk '$1--' | barcat --spark =head1 AUTHOR