git.shiar.nl / barcat.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
prefer SIGINFO for statistics if available
[barcat.git] / barcat
diff --git a/barcat b/barcat
index fe04246f8f8ae7ad8d58663b1fc1326baf3cf646..de3f6f8459721ae78c734401961607eaef4c4e20 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,29 +43,59 @@ GetOptions(\%opt,
                );
        },
        'markers|m=s',
                );
        },
        'markers|m=s',
+       'graph-format=s' => sub {
+               $opt{'graph-format'} = substr $_[1], 0, 1;
+       },
+       '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;
 $opt{color} //= -t *STDOUT;  # enable on tty
 ) or exit 64;  # EX_USAGE
 
 $opt{width} ||= $ENV{COLUMNS} || 80;
 $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{anchor} //= qr/\A/;
 $opt{'value-length'} = 6 if $opt{units};
 $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{'value-length'} = 1 if $opt{unmodified};
 
 my (@lines, @values, @order);
 
 
 my (@lines, @values, @order);
 
+$SIG{$_} = \&show_stat for exists $SIG{INFO} ? 'INFO' : 'QUIT';
+$SIG{ALRM} = sub {
+       show_lines();
+       alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
+};
+
 if (defined $opt{interval}) {
        $opt{interval} ||= 1;
 if (defined $opt{interval}) {
        $opt{interval} ||= 1;
-       $SIG{ALRM} = sub {
-               show_lines();
-               alarm $opt{interval};
-       };
-       alarm $opt{interval};
+       alarm $opt{interval} if $opt{interval} > 0;
 
        eval {
                require Tie::Array::Sorted;
 
        eval {
                require Tie::Array::Sorted;
@@ -77,7 +103,11 @@ 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
+       exit if !$.;
+       '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,21 +117,25 @@ 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) = '…';
                }
        }
        push @lines, $_;
                }
                elsif (length > $trimpos) {
                        substr($_, $trimpos - 1) = '…';
                }
        }
        push @lines, $_;
+       show_lines() if defined $opt{interval} and $opt{interval} < 0
+               and $. % $opt{interval} == 0;
 }
 
 $SIG{INT} = 'DEFAULT';
 
 sub color {
 }
 
 $SIG{INT} = 'DEFAULT';
 
 sub color {
-       $opt{color} or return '';
-       return "\e[$_[0]m";
+       $opt{color} and defined $_[0] or return '';
+       return "\e[$_[0]m" if defined wantarray;
+       $_ = color(@_) . $_ . color(0) if defined;
 }
 
 sub show_lines {
 }
 
 sub show_lines {
@@ -129,7 +163,7 @@ 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 $_ = color(36).$_.color(0) for @barmark;
+       color(36) for @barmark;
 
        state $lastmax = $maxval;
        if ($maxval > $lastmax) {
 
        state $lastmax = $maxval;
        if ($maxval > $lastmax) {
@@ -160,26 +194,34 @@ sub sival {
 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 = color($color).$val.color(0) if $color;
+               color($color) for $val;
        }
        my $line = $lines[$nr] =~ s/\n/$val/r;
        printf '%-*s', $len + length($val), $line;
        }
        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;
+       print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
        say '';
        say '';
-
+}
+continue {
        $nr++;
 }
        $nr++;
 }
+say '' if $opt{spark};
 
 }
 show_lines();
 
 
 }
 show_lines();
 
-if ($opt{stat}) {
+sub show_stat {
        if ($opt{hidemin} or $opt{hidemax}) {
                $opt{hidemin} ||= 1;
                $opt{hidemax} ||= @lines;
        if ($opt{hidemin} or $opt{hidemax}) {
                $opt{hidemin} ||= 1;
                $opt{hidemax} ||= @lines;
@@ -187,13 +229,17 @@ 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 '';
 }
        }
        say '';
 }
+show_stat() if $opt{stat};
 
 __END__
 =encoding utf8
 
 __END__
 =encoding utf8
@@ -212,6 +258,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
@@ -241,9 +293,10 @@ turning long numbers like I<12356789> into I<12.4M>.
 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
 Short integers are aligned but kept without decimal point.
 
 Also changes an exponent I<1.602176634e-19> to I<160.2z>.
 Short integers are aligned but kept without decimal point.
 
-=item -t, --interval[=<seconds>]
+=item -t, --interval[=(<seconds>|-<lines>)]
 
 
-Interval time to output partial progress.
+Output partial progress every given number of seconds or input lines.
+An update can also be forced by sending a I<SIGALRM> alarm signal.
 
 =item -l, --length=[-]<size>[%]
 
 
 =item -l, --length=[-]<size>[%]
 
@@ -261,6 +314,11 @@ Stop output after a number of lines.
 All input is still counted and analyzed for statistics,
 but disregarded for padding and bar size.
 
 All input is still counted and analyzed for statistics,
 but disregarded for padding and bar size.
 
+=item --graph-format=<character>
+
+Glyph to repeat for the graph line.
+Defaults to a dash C<->.
+
 =item -m, --markers=
 
 Statistical positions to indicate on bars.
 =item -m, --markers=
 
 Statistical positions to indicate on bars.
@@ -300,7 +358,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>
@@ -312,6 +370,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
@@ -351,6 +422,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 |
@@ -385,6 +461,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>
cat with bar graph