simplify test names of example code
[barcat.git] / barcat
diff --git a/barcat b/barcat
index 728903914eb7597c283de1649a0650d8441b858c..63eb3a5fd2820f45ac14488962d66b408e44dc6f 100755 (executable)
--- a/barcat
+++ b/barcat
@@ -4,8 +4,9 @@ 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;
@@ -15,15 +16,15 @@ GetOptions(\%opt,
        '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"
                );
@@ -38,7 +39,7 @@ GetOptions(\%opt,
                my ($optname, $optval) = @_;
                $optval ||= 0;
                ($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"
                );
@@ -77,12 +78,12 @@ GetOptions(\%opt,
                exit;
        },
        'usage|h' => sub {
-               local $/;
+               local $/ = undef;  # slurp
                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/^=over\K/ 25/;  # indent options list
+               $pod =~ s/^=item\ \N*\n\n\N*\n\K (?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/g;
                $pod =~ s/[.,](?=\n)//g;  # trailing punctuation
-               $pod =~ s/^=item \K(?=--)/____/gm;  # align long options
+               $pod =~ s/^=item\ \K(?=--)/____/g;  # align long options
                # abbreviate <variable> indicators
                $pod =~ s/\Q>.../s>/g;
                $pod =~ s/<(?:number|count|seconds)>/N/g;
@@ -99,7 +100,7 @@ GetOptions(\%opt,
                $parser->parse_string_document($pod);
 
                $contents =~ s/\n(?=\n\h)//msg;  # strip space between items
-               $contents =~ s/^  \K____/    /gm;  # nbsp substitute
+               $contents =~ s/^\ \ \K____/    /g;  # nbsp substitute
                print $contents;
                exit;
        },
@@ -122,7 +123,8 @@ $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};
 
 my (@lines, @values, @order);
@@ -145,20 +147,22 @@ 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) {
+                       # cut and replace (intentional lvalue for speed, contrary to PBP)
                        substr($_, $trimpos - 1) = '…';
                }
        }
@@ -179,12 +183,21 @@ sub color {
        $_ = color(@_) . $_ . color(0) if defined;
 }
 
+sub sival {
+       my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15);
+       my $float = $_[0] !~ /\A0*[-0-9]{1,3}\z/;
+       return 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]
+       );
+}
+
 sub show_lines {
 
-state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
-@lines and @lines > $nr or return;
+state $nr = $opt{hidemin};
 @lines or return;
-@lines > $nr or return unless $opt{hidemin};
+@lines > $nr or return;
 
 @order = sort { $b <=> $a } @order unless tied @order;
 my $maxval = $opt{maxval} // (
@@ -197,7 +210,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 +222,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 +256,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), '+',
@@ -266,7 +276,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 :
@@ -290,13 +300,14 @@ 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;
+               printf '%s of ', sum(grep { length }
+                       @values[$opt{hidemin} .. ($opt{hidemax} || @lines) - 1]
+               ) // 0;
        }
        if (@order) {
                my $total = sum @order;
@@ -310,6 +321,7 @@ sub show_stat {
                );
        }
        say '';
+       return 1;
 }
 
 sub show_exit {
@@ -450,6 +462,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<whites> and I<fire>,
+or I<greys> and I<fire256> for 256-color variants.
 
 =item --spark[=<characters>]
 
@@ -533,10 +550,14 @@ 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%
+    column -tns, | barcat -f4 -u -l80%
 
 External datasets, like movies per year:
 
@@ -579,7 +600,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