t: report missing output as TODO

[barcat.git] / barcat

diff --git a/barcat b/barcat
index d3ba821a27802df355ad070a43633d828fba3c16..1818493a8af4603898a2e4b7f1265c6bcfda948d 100755 (executable)
--- a/barcat
+++ b/barcat
@@ -1,4 +1,4 @@
-#!/usr/bin/env perl
+#!/usr/bin/perl -CA

 use 5.018;
 use warnings;
 use utf8;
 use 5.018;
 use warnings;
 use utf8;


@@ -6,13 +6,9 @@ use List::Util qw( min max sum );
 use open qw( :std :utf8 );
 use experimental qw( lexical_subs );
 
 use open qw( :std :utf8 );
 use experimental qw( lexical_subs );
 

-our $VERSION = '1.04';
+our $VERSION = '1.05';

 
 use Getopt::Long '2.33', qw( :config gnu_getopt );
 
 use Getopt::Long '2.33', qw( :config gnu_getopt );

-sub podexit {
-       require Pod::Usage;
-       Pod::Usage::pod2usage(-exitval => 0, -perldocopt => '-oman', @_);
-}

 my %opt;
 GetOptions(\%opt,
        'color|c!',
 my %opt;
 GetOptions(\%opt,
        'color|c!',


@@ -47,11 +43,34 @@ GetOptions(\%opt,
                );
        },
        'markers|m=s',
                );
        },
        'markers|m=s',

+       'spark:s' => sub {
+               $opt{spark} = [split //, $_[1] || '⎽▁▂▃▄▅▆▇█'];
+       },

        'stat|s!',
        'unmodified|u!',
        'width|w=i',
        'stat|s!',
        'unmodified|u!',
        'width|w=i',

-       'usage|h' => sub { podexit() },
-       'help'    => sub { podexit(-verbose => 2) },
+       'usage|h' => sub {
+               local $/;
+               my $pod = readline *DATA;
+               $pod =~ s/^=over\K/ 22/m;  # indent options list
+               $pod =~ s/^=item \N*\n\n\N*\n\K(?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/msg;
+
+               require Pod::Usage;
+               my $parser = Pod::Usage->new;
+               $parser->select('SYNOPSIS', 'OPTIONS');
+               $parser->output_string(\my $contents);
+               $parser->parse_string_document($pod);
+
+               $contents =~ s/\n(?=\n\h)//msg;  # strip space between items
+               print $contents;
+               exit;
+       },
+       'help|?'  => sub {
+               require Pod::Usage;
+               Pod::Usage::pod2usage(
+                       -exitval => 0, -perldocopt => '-oman', -verbose => 2,
+               );
+       },

 ) or exit 64;  # EX_USAGE
 
 $opt{width} ||= $ENV{COLUMNS} || 80;
 ) or exit 64;  # EX_USAGE
 
 $opt{width} ||= $ENV{COLUMNS} || 80;


@@ -60,6 +79,7 @@ $opt{trim}   *= $opt{width} / 100 if $opt{trimpct};
 $opt{units}   = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
 $opt{anchor} //= qr/\A/;
 $opt{'value-length'} = 6 if $opt{units};
 $opt{units}   = [split //, ' kMGTPEZYyzafpnμm'] if $opt{'human-readable'};
 $opt{anchor} //= qr/\A/;
 $opt{'value-length'} = 6 if $opt{units};

+$opt{'value-length'} = 1 if $opt{unmodified};

 
 my (@lines, @values, @order);
 
 
 my (@lines, @values, @order);
 


@@ -77,7 +97,10 @@ if (defined $opt{interval}) {
        } or warn $@, "Expect slowdown with large datasets!\n";
 }
 
        } or warn $@, "Expect slowdown with large datasets!\n";
 }
 

-$SIG{INT} = 'IGNORE';  # continue after assumed eof
+$SIG{INT} = sub {
+       $SIG{INT} = 'DEFAULT';  # reset for subsequent attempts
+       'IGNORE' # continue after assumed eof
+};

 
 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
 while (readline) {
 
 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
 while (readline) {


@@ -87,8 +110,9 @@ while (readline) {
        push @order, $1 if length $1;
        if (defined $opt{trim} and defined $1) {
                my $trimpos = abs $opt{trim};
        push @order, $1 if length $1;
        if (defined $opt{trim} and defined $1) {
                my $trimpos = abs $opt{trim};

+               $trimpos -= length $1 if $opt{unmodified};

                if ($trimpos <= 1) {
                if ($trimpos <= 1) {

-                       $_ = substr $_, 0, 1;
+                       $_ = substr $_, 0, 2;

                }
                elsif (length > $trimpos) {
                        substr($_, $trimpos - 1) = '…';
                }
                elsif (length > $trimpos) {
                        substr($_, $trimpos - 1) = '…';


@@ -99,6 +123,12 @@ while (readline) {
 
 $SIG{INT} = 'DEFAULT';
 
 
 $SIG{INT} = 'DEFAULT';
 

+sub color {
+       $opt{color} and defined $_[0] or return '';
+       return "\e[$_[0]m" if defined wantarray;
+       $_ = color(@_) . $_ . color(0) if defined;
+}
+

 sub show_lines {
 
 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;
 sub show_lines {
 
 state $nr = $opt{hidemin} ? $opt{hidemin} - 1 : 0;


@@ -124,18 +154,18 @@ if ($opt{markers} // 1 and $size > 0) {
        $barmark[ orderpos($#order * .68269) ] = '<';
        $barmark[ orderpos($#order / 2) ] = '+';  # mean
        $barmark[ -$minval * $size ] = '|' if $minval < 0;  # zero
        $barmark[ orderpos($#order * .68269) ] = '<';
        $barmark[ orderpos($#order / 2) ] = '+';  # mean
        $barmark[ -$minval * $size ] = '|' if $minval < 0;  # zero

-       defined and $opt{color} and $_ = "\e[36m$_\e[0m" for @barmark;
+       color(36) for @barmark;

 
        state $lastmax = $maxval;
        if ($maxval > $lastmax) {
                print ' ' x ($lenval + $len);
 
        state $lastmax = $maxval;
        if ($maxval > $lastmax) {
                print ' ' x ($lenval + $len);

-               printf "\e[90m" if $opt{color};
+               printf color(90);

                printf '%-*s',
                        ($lastmax - $minval) * $size + .5,
                        '-' x (($values[$nr - 1] - $minval) * $size);
                printf '%-*s',
                        ($lastmax - $minval) * $size + .5,
                        '-' x (($values[$nr - 1] - $minval) * $size);

-               print "\e[92m" if $opt{color};
+               print color(92);

                say '+' x (($maxval - $lastmax - $minval) * $size + .5);
                say '+' x (($maxval - $lastmax - $minval) * $size + .5);

-               print "\e[0m" if $opt{color};
+               print color(0);

                $lastmax = $maxval;
        }
 }
                $lastmax = $maxval;
        }
 }


@@ -143,34 +173,41 @@ if ($opt{markers} // 1 and $size > 0) {
 @lines > $nr or return if $opt{hidemin};
 
 sub sival {
 @lines > $nr or return if $opt{hidemin};
 
 sub sival {

-       my $unit = int(log($_[0]) / log(1000) - ($_[0] < 1));
-       my $float = $_[0] !~ /^ (?: 0*\.)? [0-9]{1,3} $/x;
-       sprintf('%*.*f%*s',
-               $float ? 5 : 3, $float,  # length and tenths
-               $_[0] / 1000 ** $unit,   # number
-               $float ? 0 : 3,          # unit size
-               $#{$opt{units}} >> 1 < abs $unit ? "e$unit" : $opt{units}->[$unit]
+       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]

        );
 }
 
 while ($nr <= $#lines) {
        $nr >= $opt{hidemax} and last if defined $opt{hidemax};
        my $val = $values[$nr];
        );
 }
 
 while ($nr <= $#lines) {
        $nr >= $opt{hidemax} and last if defined $opt{hidemax};
        my $val = $values[$nr];

+
+       if ($opt{spark}) {
+               print $opt{spark}->[ ($val - $minval) / $maxval * $#{$opt{spark}} ];
+               next;
+       }
+

        if (length $val) {
        if (length $val) {

-               my $color = !$opt{color} ? 0 :
+               my $color = !$opt{color} ? undef :

                        $val == $order[0] ? 32 : # max
                        $val == $order[-1] ? 31 : # min
                        90;
                $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
                        $val == $order[0] ? 32 : # max
                        $val == $order[-1] ? 31 : # min
                        90;
                $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;

-               $val = "\e[${color}m$val\e[0m" if $color;
+               color($color) for $val;

        }
        my $line = $lines[$nr] =~ s/\n/$val/r;
        printf '%-*s', $len + length($val), $line;
        print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
        say '';
        }
        my $line = $lines[$nr] =~ s/\n/$val/r;
        printf '%-*s', $len + length($val), $line;
        print $barmark[$_] // '-' for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
        say '';

-
+}
+continue {

        $nr++;
 }
        $nr++;
 }

+say '' if $opt{spark};

 
 }
 show_lines();
 
 }
 show_lines();


@@ -183,15 +220,19 @@ if ($opt{stat}) {
        }
        if (@order) {
                my $total = sum @order;
        }
        if (@order) {
                my $total = sum @order;

-               printf '%s total', $total;
+               printf '%s total', color(1) . $total . color(0);

                printf ' in %d values', scalar @values;
                printf ' in %d values', scalar @values;

-               printf ' (%s min, %*.*f avg, %s max)',
-                       $order[-1], 0, 2, $total / @order, $order[0];
+               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),
+               );

        }
        say '';
 }
 
 __END__
        }
        say '';
 }
 
 __END__

+=encoding utf8

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -207,6 +248,12 @@ 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.
 
 Contents are concatenated similar to I<cat>,
 but numbers are reformatted and a bar graph is appended to each line.
 

+Don't worry, barcat does not drink and divide.
+It can has various options for input and output (re)formatting,
+but remains limited to one-dimensional charts.
+For more complex graphing needs
+you'll need a larger animal like I<gnuplot>.
+

 =head1 OPTIONS
 
 =over
 =head1 OPTIONS
 
 =over


@@ -295,7 +342,7 @@ Total statistics after all data.
 
 =item -u, --unmodified
 
 
 =item -u, --unmodified
 

-Do not strip leading whitespace.
+Do not reformat values, keeping leading whitespace.

 Keep original value alignment, which may be significant in some programs.
 
 =item --value-length=<size>
 Keep original value alignment, which may be significant in some programs.
 
 =item --value-length=<size>


@@ -307,6 +354,19 @@ Reserved space for numbers.
 Override the maximum number of columns to use.
 Appended graphics will extend to fill up the entire screen.
 
 Override the maximum number of columns to use.
 Appended graphics will extend to fill up the entire screen.
 

+=item -h, --usage
+
+Overview of available options.
+
+=item --help
+
+Full documentation
+rendered by perldoc.
+
+=item --version
+
+Version information.
+

 =back
 
 =head1 EXAMPLES
 =back
 
 =head1 EXAMPLES


@@ -346,6 +406,11 @@ Any kind of database query with counts, preserving returned alignment:
     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
     psql -t | barcat -u
 
     echo 'SELECT count(*),schemaname FROM pg_tables GROUP BY 2' |
     psql -t | barcat -u
 

+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%
+

 External datasets, like movies per year:
 
     curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |
 External datasets, like movies per year:
 
     curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json |


@@ -380,6 +445,12 @@ Or the top 3 most frequent authors with statistics over all:
 
     git shortlog -sn | barcat -L3 -s
 
 
     git shortlog -sn | barcat -L3 -s
 

+Activity 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
+

 =head1 AUTHOR
 
 Mischa POSLAWSKY <perl@shiar.org>
 =head1 AUTHOR
 
 Mischa POSLAWSKY <perl@shiar.org>