remove lower scan line from spark default

[barcat.git] / barcat

diff --git a/barcat b/barcat
index 442559c804a05ac433f2e473c48cc4c19b3e2d37..1b7cd219353c6f20e29da615c55bd3afd74888c6 100755 (executable)
--- a/barcat
+++ b/barcat
@@ -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,32 +43,62 @@ GetOptions(\%opt,
                );
        },
        'markers|m=s',
                );
        },
        'markers|m=s',

+       'graph-format=s' => sub {
+               $opt{'graph-format'} = substr $_[1], 0, 1;
+       },

        'spark:s' => sub {
        'spark:s' => sub {

-               $opt{spark} = [split //, $_[1] || '������▂▃▄▅▆▇█'];
+               $opt{spark} = [split //, $_[1] || '▁▂▃▄▅▆▇█'];

        },
        'stat|s!',
        },
        'stat|s!',

+       'signal-stat=s',

        'unmodified|u!',
        'width|w=i',
        '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};
+$opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT';

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

+$SIG{$_} = \&show_stat for $opt{'signal-stat'} || ();
+$SIG{ALRM} = sub {
+       show_lines();
+       alarm $opt{interval} if defined $opt{interval} and $opt{interval} > 0;
+};
+$SIG{INT} = \&show_exit;
+

 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;


@@ -80,11 +106,6 @@ if (defined $opt{interval}) {
        } or warn $@, "Expect slowdown with large datasets!\n";
 }
 
        } or warn $@, "Expect slowdown with large datasets!\n";
 }
 

-$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) {
        s/\r?\n\z//;
 my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
 while (readline) {
        s/\r?\n\z//;


@@ -93,14 +114,17 @@ 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';
 }
 
 $SIG{INT} = 'DEFAULT';


@@ -183,7 +207,7 @@ while ($nr <= $#lines) {
        }
        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 '';
 }
 continue {
        say '';
 }
 continue {


@@ -192,9 +216,8 @@ continue {
 say '' if $opt{spark};
 
 }
 say '' if $opt{spark};
 
 }

-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;


@@ -202,14 +225,26 @@ 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 '';
 }
 

+sub show_exit {
+       show_lines();
+       show_stat() if $opt{stat};
+       exit 130 if @_;  # 0x80+signo
+       exit;
+}
+
+show_exit();
+

 __END__
 =encoding utf8
 
 __END__
 =encoding utf8
 


@@ -227,6 +262,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


@@ -256,9 +297,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>[%]
 


@@ -276,6 +318,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.


@@ -315,7 +362,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>


@@ -327,6 +374,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