value-length option to override $lenval
[barcat.git] / graph
diff --git a/graph b/graph
index eaafb764d387a5f65514ed3fcb017e8763e62840..ea17d4538eafe629e45323dae754ca4d3cea40e7 100755 (executable)
--- a/graph
+++ b/graph
@@ -1,9 +1,10 @@
 #!/usr/bin/env perl
 #!/usr/bin/env perl
-use 5.014;
+use 5.018;
 use warnings;
 use utf8;
 use List::Util qw( min max sum );
 use open qw( :std :utf8 );
 use warnings;
 use utf8;
 use List::Util qw( min max sum );
 use open qw( :std :utf8 );
+use experimental qw( lexical_subs );
 
 our $VERSION = '1.02';
 
 
 our $VERSION = '1.02';
 
@@ -12,10 +13,22 @@ sub podexit {
        require Pod::Usage;
        Pod::Usage::pod2usage(-exitval => 0, -perldocopt => '-oman', @_);
 }
        require Pod::Usage;
        Pod::Usage::pod2usage(-exitval => 0, -perldocopt => '-oman', @_);
 }
-GetOptions(\my %opt,
+my %opt;
+GetOptions(\%opt,
        'color|c!',
        'color|c!',
-       'follow|f:i',
-       'trim|length|l=i',
+       'C' => sub { $opt{color} = 0 },
+       'field|f=s',
+       'interval|t:i',
+       'trim|length|l=s' => sub {
+               my ($optname, $optval) = @_;
+               $optval =~ s/%$// and $opt{trimpct}++;
+               $optval =~ m/^-?[0-9]+$/ or die(
+                       "Value \"$optval\" invalid for option $optname",
+                       " (number or percentage expected)\n"
+               );
+               $opt{trim} = $optval;
+       },
+       'value-length=i',
        'markers|m=s',
        'unmodified|u!',
        'width|w=i',
        'markers|m=s',
        'unmodified|u!',
        'width|w=i',
@@ -25,23 +38,27 @@ GetOptions(\my %opt,
 
 $opt{width} ||= $ENV{COLUMNS} || 80;
 $opt{color} //= -t *STDOUT;  # enable on tty
 
 $opt{width} ||= $ENV{COLUMNS} || 80;
 $opt{color} //= -t *STDOUT;  # enable on tty
+$opt{trim}   *= $opt{width} / 100 if $opt{trimpct};
 
 
-if (defined $opt{follow}) {
-       $opt{follow} ||= 1;
+if (defined $opt{interval}) {
+       $opt{interval} ||= 1;
        $SIG{ALRM} = sub {
                show_lines();
        $SIG{ALRM} = sub {
                show_lines();
-               alarm $opt{follow};
+               alarm $opt{interval};
        };
        };
-       alarm $opt{follow};
+       alarm $opt{interval};
 }
 
 $SIG{INT} = 'IGNORE';  # continue after assumed eof
 
 my (@lines, @values);
 }
 
 $SIG{INT} = 'IGNORE';  # continue after assumed eof
 
 my (@lines, @values);
+my $anchor = !defined $opt{field} ? qr/\A/ :
+       $opt{field} =~ /^[0-9]+$/ ? qr/(?:\S*\h+){$opt{field}}\K/ :
+       $opt{field};
 while (readline) {
 while (readline) {
-       chomp;
+       s/\r?\n\z//;
        s/^\h*// unless $opt{unmodified};
        s/^\h*// unless $opt{unmodified};
-       push @values, s/^ ( \h* -? [0-9]* \.? [0-9]+ |)//x && $1;
+       push @values, s/$anchor ( \h* -? [0-9]* \.? [0-9]+ |)/\n/x && $1;
        if (defined $opt{trim}) {
                my $trimpos = abs $opt{trim};
                if ($trimpos <= 1) {
        if (defined $opt{trim}) {
                my $trimpos = abs $opt{trim};
                if ($trimpos <= 1) {
@@ -53,20 +70,20 @@ while (readline) {
        }
        push @lines, $_;
 }
        }
        push @lines, $_;
 }
-@lines or exit;
 
 $SIG{INT} = 'DEFAULT';
 
 sub show_lines {
 
 state $nr = 0;
 
 $SIG{INT} = 'DEFAULT';
 
 sub show_lines {
 
 state $nr = 0;
+@lines and @lines > $nr or return;
 
 my @order  = sort { $b <=> $a } grep { length } @values;
 my $maxval = $order[0];
 my $minval = min $order[-1], 0;
 
 my @order  = sort { $b <=> $a } grep { length } @values;
 my $maxval = $order[0];
 my $minval = min $order[-1], 0;
-my $lenval = max map { length } @order;
+my $lenval = $opt{'value-length'} // max map { length } @order;
 my $len    = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
 my $len    = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
-       1 + max map { length } @lines;  # left padding
+       max map { length $values[$_] && length $lines[$_] } 0 .. $#lines;  # left padding
 my $size   = ($maxval - $minval) &&
        ($opt{width} - $lenval - $len) / ($maxval - $minval);  # bar multiplication
 
 my $size   = ($maxval - $minval) &&
        ($opt{width} - $lenval - $len) / ($maxval - $minval);  # bar multiplication
 
@@ -101,12 +118,12 @@ while ($nr <= $#lines) {
                        $val == $order[0] ? 32 : # max
                        $val == $order[-1] ? 31 : # min
                        90;
                        $val == $order[0] ? 32 : # max
                        $val == $order[-1] ? 31 : # min
                        90;
-               printf "\e[%sm", $color if $color;
-               printf "%*s", $lenval, $val;
-               print "\e[0m" if $color;
+               $val = sprintf "%*s", $lenval, $val;
+               $val = "\e[${color}m$val\e[0m" if $color;
        }
        }
-       printf '%-*s', $len, $lines[$nr];
-       print $barmark[$_] // '-' for 1 .. $size && (($val || 0) - $minval) * $size;
+       my $line = $lines[$nr] =~ s/\n/$val/r;
+       printf '%-*s', $len + length($val), $line;
+       print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size;
        say '';
        $nr++;
 }
        say '';
        $nr++;
 }
@@ -126,7 +143,9 @@ B<graph> [<options>] [<input>]
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 
-Each line starting with a number is given a bar to visualise relative sizes.
+Visualizes relative sizes of values read from input (file(s) or STDIN).
+Contents are concatenated similar to I<cat>,
+but numbers are reformatted and a bar graph is appended to each line.
 
 =head1 OPTIONS
 
 
 =head1 OPTIONS
 
@@ -138,11 +157,23 @@ Force colored output of values and bar markers.
 Defaults on if output is a tty,
 disabled otherwise such as when piped or redirected.
 
 Defaults on if output is a tty,
 disabled otherwise such as when piped or redirected.
 
-=item -f, --follow[=<seconds>]
+=item -f, --field=(<number>|<regexp>)
 
 
-Interval to output partial progress.
+Compare values after a given number of whitespace separators,
+or matching a regular expression.
 
 
-=item -l, --length=[-]<size>
+Unspecified or I<-f0> means values are at the start of each line.
+With I<-f1> the second word is taken instead.
+A string can indicate the starting position of a value
+(such as I<-f:> if preceded by colons),
+or capture the numbers itself,
+for example I<-f'(\d+)'> for the first digits anywhere.
+
+=item -t, --interval[=<seconds>]
+
+Interval time to output partial progress.
+
+=item -l, --length=[-]<size>[%]
 
 Trim line contents (between number and bars)
 to a maximum number of characters.
 
 Trim line contents (between number and bars)
 to a maximum number of characters.
@@ -190,6 +221,10 @@ or 68% of all entries.
 Do not strip leading whitespace.
 Keep original value alignment, which may be significant in some programs.
 
 Do not strip leading whitespace.
 Keep original value alignment, which may be significant in some programs.
 
+=item --value-length=<size>
+
+Reserved space for numbers.
+
 =item -w, --width=<columns>
 
 Override the maximum number of columns to use.
 =item -w, --width=<columns>
 
 Override the maximum number of columns to use.
@@ -226,6 +261,28 @@ Any kind of database query with leading counts:
     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
     psql -t | graph -u
 
     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
     psql -t | graph -u
 
+Exchange rate USD/EUR history from CSV download provided by ECB:
+
+    curl https://sdw.ecb.europa.eu/export.do \
+         -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
+    grep '^[12]' | graph -f',\K' --value-length=7
+
+Total population history from the World Bank dataset (XML):
+
+    curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
+    xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
+    sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | graph -f1
+
+Movies per year from prepared JSON data:
+
+    curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
+    jq '.[].year' | uniq -c | graph
+
+Pokémon height comparison:
+
+       curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
+       jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | graph
+
 Git statistics, such commit count by year:
 
     git log --pretty=%ci | cut -b-4 | uniq -c | graph
 Git statistics, such commit count by year:
 
     git log --pretty=%ci | cut -b-4 | uniq -c | graph
@@ -236,8 +293,7 @@ Or the most frequent authors:
 
 Latency history:
 
 
 Latency history:
 
-    ping google.com |
-    perl -pe '$|=1; print s/ time=(.*)// ? "$1 for " : "> "' | graph -f
+    ping google.com | graph -f'time=\K' -t
 
 =head1 AUTHOR
 
 
 =head1 AUTHOR