increase value length for newline substitution

[barcat.git] / barcat

diff --git a/barcat b/barcat
index a5ea9f33c2267c0d2b480a3fad5a874ec3daa478..4cb2cd14ce69467cb6767f063100c6774cef328b 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();


@@ -192,6 +229,7 @@ if ($opt{stat}) {
 }
 
 __END__
 }
 
 __END__

+=encoding utf8

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -207,6 +245,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 +339,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 +351,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


@@ -315,15 +372,15 @@ Draw a sine wave:
 
     seq 30 | awk '{print sin($1/10)}' | barcat
 
 
     seq 30 | awk '{print sin($1/10)}' | barcat
 

-Compare file sizes:
+Compare file sizes (with human-readable numbers):

 
 

-    du -d0 -m * | barcat
+    du -d0 -b * | barcat -H

 
 

-Memory usage of user processes:
+Memory usage of user processes with long names truncated:

 
     ps xo %mem,pid,cmd | barcat -l40
 
 
     ps xo %mem,pid,cmd | barcat -l40
 

-Monitor network latency:
+Monitor network latency from prefixed results:

 
     ping google.com | barcat -f'time=\K' -t
 
 
     ping google.com | barcat -f'time=\K' -t
 


@@ -341,15 +398,23 @@ Number of HTTP requests per day:
 
     cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat
 
 
     cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat
 

-Any kind of database query with leading counts:
+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 |

-    jq '.[].year' | uniq -c | barcat
+    perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat
+
+But please get I<jq> to process JSON
+and replace the manual selection by C<< jq '.[].year' >>.

 
 Pokémon height comparison:
 
 
 Pokémon height comparison:
 


@@ -377,6 +442,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>