only ignore interrupt signal after input

[barcat.git] / barcat

diff --git a/barcat b/barcat
index 442559c804a05ac433f2e473c48cc4c19b3e2d37..2f73fa5ab2c59e3e8be6ce6b0b57fd235641587a 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!',


@@ -53,8 +49,28 @@ GetOptions(\%opt,
        '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;


@@ -63,16 +79,18 @@ $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);
 

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


@@ -82,6 +100,7 @@ if (defined $opt{interval}) {
 
 $SIG{INT} = sub {
        $SIG{INT} = 'DEFAULT';  # reset for subsequent attempts
 
 $SIG{INT} = sub {
        $SIG{INT} = 'DEFAULT';  # reset for subsequent attempts

+       exit if !$.;

        'IGNORE' # continue after assumed eof
 };
 
        'IGNORE' # continue after assumed eof
 };
 


@@ -93,14 +112,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';


@@ -202,10 +224,13 @@ 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 '';
 }


@@ -227,6 +252,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 +287,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>[%]
 


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