From 1de60201303fff6e0d612658790b4c44eff0c055 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 13 Mar 2021 04:54:50 +0100 Subject: [PATCH 01/16] script to run examples from documentation --- t/examples.t | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) create mode 100755 t/examples.t diff --git a/t/examples.t b/t/examples.t new file mode 100755 index 0000000..19c1377 --- /dev/null +++ b/t/examples.t @@ -0,0 +1,20 @@ +#!/usr/bin/env perl +use 5.014; +use warnings; +use Test::More; + +my $filename = 'barcat'; +open my $input, '<', $filename + or die "Cannot read documentation from $filename script\n"; + +local $/ = "\n\n"; +while (readline $input) { + /^=head1 EXAMPLES/ ... /^=head1/ or next; + /^\h/ or next; + chomp; + + my ($name) = /[\h(]*([^|]+)/; + ok(qx($_), $name); +} + +done_testing(); -- 2.30.2 From 38eb915e53017bb02788efc30a8650a8b322a753 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 13 Mar 2021 04:59:43 +0100 Subject: [PATCH 02/16] adjust example commands for testing --- t/examples.t | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/t/examples.t b/t/examples.t index 19c1377..cd7f1b3 100755 --- a/t/examples.t +++ b/t/examples.t @@ -3,6 +3,12 @@ use 5.014; use warnings; use Test::More; +my %CMDARGS = ( + ping => '-c 1', + curl => '-sS', + 'cat \Klog/' => '/var/log/apache2/', +); + my $filename = 'barcat'; open my $input, '<', $filename or die "Cannot read documentation from $filename script\n"; @@ -14,7 +20,13 @@ while (readline $input) { chomp; my ($name) = /[\h(]*([^|]+)/; - ok(qx($_), $name); + + my $cmd = $_; + while (my ($subcmd, $args) = each %CMDARGS) { + $subcmd .= " \\K", $args .= ' ' unless $subcmd =~ m/\\K/; + $cmd =~ s/\b$subcmd/$args/; + } + ok(qx($cmd), $name); } done_testing(); -- 2.30.2 From 45371e38949c63a14570a6d69ee0302d70cd48e1 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 13 Mar 2021 05:05:34 +0100 Subject: [PATCH 03/16] test return status of example commands and pipes Explicitly run with bash so intermediate failure can be detected using the pipefail option. --- t/examples.t | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/t/examples.t b/t/examples.t index cd7f1b3..02019b9 100755 --- a/t/examples.t +++ b/t/examples.t @@ -15,18 +15,26 @@ open my $input, '<', $filename local $/ = "\n\n"; while (readline $input) { + # find code snippets in the appropriate section /^=head1 EXAMPLES/ ... /^=head1/ or next; /^\h/ or next; chomp; my ($name) = /[\h(]*([^|]+)/; + # prepare shell command to execute my $cmd = $_; while (my ($subcmd, $args) = each %CMDARGS) { $subcmd .= " \\K", $args .= ' ' unless $subcmd =~ m/\\K/; $cmd =~ s/\b$subcmd/$args/; } - ok(qx($cmd), $name); + $cmd =~ s/'/'\\''/g, $cmd = "bash -c 'set -o pipefail\n$cmd'"; + + # run and report unexpected results + ok(eval { + qx($cmd) or return; + return $? == 0; + }, $name); } done_testing(); -- 2.30.2 From fd1358b672c565160eb163da00b404325864114d Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 13 Mar 2021 05:15:36 +0100 Subject: [PATCH 04/16] simplify test names of example code Keep only the first command or more significant parameter to minimally identify the concerning script. Add diagnostics output of the full command on failure. --- t/examples.t | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/t/examples.t b/t/examples.t index 02019b9..0b5e778 100755 --- a/t/examples.t +++ b/t/examples.t @@ -1,6 +1,7 @@ #!/usr/bin/env perl use 5.014; use warnings; +use re '/ms'; use Test::More; my %CMDARGS = ( @@ -20,7 +21,20 @@ while (readline $input) { /^\h/ or next; chomp; - my ($name) = /[\h(]*([^|]+)/; + # compose an identifier from significant parts + do { + s/^\h+//; # indentation + s/\\\n\s*//g; # line continuations + s/^[(\h]+//; # subshell + s/^echo\ .*?\|\s*//; # preceding input + s/\|.*//; # subsequent pipes + s/^cat\ //; # local file + s/^curl\ // and do { # remote url + s/\ -.+//g; # download options + s{//[^/\s]+/\K\S*(?=/)}{}; # subdirectories + s{^https?://}{}; # http protocol + }; + } for my $name = $_; # prepare shell command to execute my $cmd = $_; @@ -28,13 +42,13 @@ while (readline $input) { $subcmd .= " \\K", $args .= ' ' unless $subcmd =~ m/\\K/; $cmd =~ s/\b$subcmd/$args/; } - $cmd =~ s/'/'\\''/g, $cmd = "bash -c 'set -o pipefail\n$cmd'"; + $cmd =~ s/'/'\\''/g, $cmd = " bash -c 'set -o pipefail\n$cmd'"; # run and report unexpected results ok(eval { qx($cmd) or return; return $? == 0; - }, $name); + }, $name) or diag($cmd); } done_testing(); -- 2.30.2 From 06af22b0c153f0c965b27fa674033f5bbaf5b015 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 13 Mar 2021 06:42:54 +0100 Subject: [PATCH 05/16] custom diagnostics in example test failure Replace constant "Failed test at line" by a more interesting report of source location and result discrepancy. --- t/examples.t | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/t/examples.t b/t/examples.t index 0b5e778..ae3e7c9 100755 --- a/t/examples.t +++ b/t/examples.t @@ -2,7 +2,12 @@ use 5.014; use warnings; use re '/ms'; + use Test::More; +{ # silence fail diagnostics because of single caller + no warnings 'redefine'; + sub Test::Builder::_ok_debug {} +} my %CMDARGS = ( ping => '-c 1', @@ -46,9 +51,11 @@ while (readline $input) { # run and report unexpected results ok(eval { - qx($cmd) or return; - return $? == 0; - }, $name) or diag($cmd); + my $output = qx($cmd); + $? == 0 or die "error status ", $? >> 8, "\n"; + length $output or die "empty output\n"; + return 1; + }, $name) or diag("Failed command\n$cmd\nfrom $filename line $.: $@"); } done_testing(); -- 2.30.2 From 9a0f5056e03159f5a58f23385e2995a54b83cbd8 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 13 Mar 2021 06:51:27 +0100 Subject: [PATCH 06/16] follow download redirects in example scripts Found by examples.t tester because curl commands were literally incomplete. --- barcat | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/barcat b/barcat index 63eb3a5..d4a8274 100755 --- a/barcat +++ b/barcat @@ -556,12 +556,12 @@ In PostgreSQL from within the client: Earthquakes worldwide magnitude 1+ in the last 24 hours: - https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv | + curl https://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/1.0_day.csv | column -tns, | barcat -f4 -u -l80% External datasets, like movies per year: - curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json | + curl https://github.com/prust/wikipedia-movie-data/raw/master/movies.json -L | perl -054 -nlE 'say if s/^"year"://' | uniq -c | barcat But please get I to process JSON @@ -569,7 +569,7 @@ and replace the manual selection by C<< jq '.[].year' >>. Pokémon height comparison: - curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json | + curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json -L | jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat USD/EUR exchange rate from CSV provided by the ECB: @@ -580,7 +580,7 @@ USD/EUR exchange rate from CSV provided by the ECB: Total population history in XML from the World Bank: - curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL | + curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL -L | xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - | sed -r 's,,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H -- 2.30.2 From beb81e63d94ed634661c385bf676ceb3544f9079 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 13 Mar 2021 07:03:13 +0100 Subject: [PATCH 07/16] strip pipe arguments from test options Allow combination of -value and |command (or ?status) suffixes, without the latter part being duplicated. --- t/regress.t | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/t/regress.t b/t/regress.t index cd8bb5e..508d361 100755 --- a/t/regress.t +++ b/t/regress.t @@ -35,7 +35,12 @@ do set -- barcat [ -r "$input" ] && set -- "$@" "$input" - case "$name" in *\ -*) set -- "$@" -"${name#* -}";; esac + case "$name" in + *\ -*) + args="${name#* -}" + set -- "$@" -"${args% [?|]*}" + ;; + esac case "$name" in *' ?' ) set -- sh -c "\$0 \$@ 2>/dev/null" "$@";; *' ?'*) set -- sh -c "\$0 \$@ | test \$\? = ${name#* \?}" "$@";; -- 2.30.2 From 1b44cc9300bce9f117fd135102482ff50638c650 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 13 Mar 2021 07:08:09 +0100 Subject: [PATCH 08/16] comment long regexp in usage preparation Insert whitespace and comments for readability. --- barcat | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/barcat b/barcat index d4a8274..319bc32 100755 --- a/barcat +++ b/barcat @@ -81,7 +81,10 @@ GetOptions(\%opt, local $/ = undef; # slurp my $pod = readline *DATA; $pod =~ s/^=over\K/ 25/; # indent options list - $pod =~ s/^=item\ \N*\n\n\N*\n\K (?:(?:^=over.*?^=back\n)?(?!=)\N*\n)*/\n/g; + $pod =~ s{ + ^=item \h \N*\n\n \N*\n \K # first line + (?: (?: ^=over .*? ^=back\n )? (?!=) \N*\n )* + }{\n}g; # abbreviate options $pod =~ s/[.,](?=\n)//g; # trailing punctuation $pod =~ s/^=item\ \K(?=--)/____/g; # align long options # abbreviate indicators -- 2.30.2 From d38e0ec883629db7a1b92f379840e7c409bf904e Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 13 Mar 2021 07:16:29 +0100 Subject: [PATCH 09/16] round partial sum to avoid floating point errors Optional value available since commit v1.03-19-g0938debbad (2019-09-08) [indicate limited results in stats] was overlooked while fixing formatting in v1.06-24-g28f38df922 (2019-10-08) [round total value in statistics]. --- barcat | 2 +- t/t2180-spark_combined_--spark=012345_-cs_--maxval=1_-L17.out | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/barcat b/barcat index 319bc32..0ab19d9 100755 --- a/barcat +++ b/barcat @@ -308,7 +308,7 @@ say $opt{palette} ? color(0) : '' if $opt{spark}; sub show_stat { if ($opt{hidemin} or $opt{hidemax}) { - printf '%s of ', sum(grep { length } + printf '%.8g of ', sum(grep { length } @values[$opt{hidemin} .. ($opt{hidemax} || @lines) - 1] ) // 0; } diff --git a/t/t2180-spark_combined_--spark=012345_-cs_--maxval=1_-L17.out b/t/t2180-spark_combined_--spark=012345_-cs_--maxval=1_-L17.out index df1134e..85a1446 100644 --- a/t/t2180-spark_combined_--spark=012345_-cs_--maxval=1_-L17.out +++ b/t/t2180-spark_combined_--spark=012345_-cs_--maxval=1_-L17.out @@ -1,2 +1,2 @@ 12330443443445043 --7.4589999998 of -7.459 total in 16 values over 18 lines (-3 min, -0.47 avg, 2 max) +-7.459 of -7.459 total in 16 values over 18 lines (-3 min, -0.47 avg, 2 max) -- 2.30.2 From 31f7d504f40ddbc428f726e5b1599f6e9c163c85 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Thu, 18 Mar 2021 19:41:37 +0100 Subject: [PATCH 10/16] declare value formatting functions in options --- barcat | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/barcat b/barcat index 0ab19d9..838c89f 100755 --- a/barcat +++ b/barcat @@ -130,6 +130,19 @@ $opt{hidemin} = ($opt{hidemin} || 1) - 1; $opt{input} = (@ARGV && $ARGV[0] =~ m/\A[-0-9]/) ? \@ARGV : undef and undef $opt{interval}; +$opt{'sum-format'} = sub { sprintf '%.8g', $_[0] }; +$opt{'calc-format'} = sub { sprintf '%*.*f', 0, 2, $_[0] }; +$opt{'value-format'} = $opt{units} && sub { + 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] + ); +}; + + my (@lines, @values, @order); $SIG{$_} = \&show_stat for $opt{'signal-stat'} || (); @@ -186,16 +199,6 @@ sub color { $_ = color(@_) . $_ . color(0) if defined; } -sub sival { - my $unit = int(log(abs $_[0] || 1) / log(10) - 3*($_[0] < 1) + 1e-15); - my $float = $_[0] !~ /\A0*[-0-9]{1,3}\z/; - return 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] - ); -} - sub show_lines { state $nr = $opt{hidemin}; @@ -289,7 +292,8 @@ while ($nr <= $#lines) { } if (length $val) { - $val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val; + $val = $opt{'value-format'} ? $opt{'value-format'}->($val) : + sprintf "%*s", $lenval, $val; color($color) for $val; } my $line = $lines[$nr] =~ s/\n/$val/r; @@ -308,18 +312,18 @@ say $opt{palette} ? color(0) : '' if $opt{spark}; sub show_stat { if ($opt{hidemin} or $opt{hidemax}) { - printf '%.8g of ', sum(grep { length } + printf '%.8g of ', $opt{'sum-format'}->(sum(grep { length } @values[$opt{hidemin} .. ($opt{hidemax} || @lines) - 1] - ) // 0; + ) // 0); } if (@order) { my $total = sum @order; - printf '%s total', color(1) . sprintf('%.8g', $total) . color(0); + printf '%s total', color(1) . $opt{'sum-format'}->($total) . color(0); printf ' in %d values', scalar @order; printf ' over %d lines', scalar @lines if @order != @lines; printf(' (%s min, %s avg, %s max)', color(31) . $order[-1] . color(0), - color(36) . (sprintf '%*.*f', 0, 2, $total / @order) . color(0), + color(36) . $opt{'calc-format'}->($total / @order) . color(0), color(32) . $order[0] . color(0), ); } -- 2.30.2 From 0bfa64faefa577d082b8e62aa0b53b11f307aec5 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Fri, 19 Mar 2021 03:36:43 +0100 Subject: [PATCH 11/16] IPC::Run to run example commands --- t/examples.t | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/t/examples.t b/t/examples.t index ae3e7c9..52e7a5a 100755 --- a/t/examples.t +++ b/t/examples.t @@ -2,6 +2,7 @@ use 5.014; use warnings; use re '/ms'; +use IPC::Run 'run'; use Test::More; { # silence fail diagnostics because of single caller @@ -47,15 +48,15 @@ while (readline $input) { $subcmd .= " \\K", $args .= ' ' unless $subcmd =~ m/\\K/; $cmd =~ s/\b$subcmd/$args/; } - $cmd =~ s/'/'\\''/g, $cmd = " bash -c 'set -o pipefail\n$cmd'"; + my @cmd = (bash => -c => "set -o pipefail\n$cmd"); # run and report unexpected results ok(eval { - my $output = qx($cmd); + run(\@cmd, \undef, \my $output); $? == 0 or die "error status ", $? >> 8, "\n"; length $output or die "empty output\n"; return 1; - }, $name) or diag("Failed command\n$cmd\nfrom $filename line $.: $@"); + }, $name) or diag("Failed command\n@cmd\nfrom $filename line $.: $@"); } done_testing(); -- 2.30.2 From e39bb2aede28e97bc9d8a0477066223388ea324f Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Fri, 19 Mar 2021 03:40:22 +0100 Subject: [PATCH 12/16] capture error messages from examples --- t/examples.t | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/t/examples.t b/t/examples.t index 52e7a5a..1af87e5 100755 --- a/t/examples.t +++ b/t/examples.t @@ -52,8 +52,9 @@ while (readline $input) { # run and report unexpected results ok(eval { - run(\@cmd, \undef, \my $output); - $? == 0 or die "error status ", $? >> 8, "\n"; + run(\@cmd, \undef, \my $output, \my $error); + die("error message:\n $error\n") if $error; + $? == 0 or die "exit status ", $? >> 8, "\n"; length $output or die "empty output\n"; return 1; }, $name) or diag("Failed command\n@cmd\nfrom $filename line $.: $@"); -- 2.30.2 From 678a3ead2e3143f8fbc9881bf51305636c66523c Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Fri, 19 Mar 2021 03:59:09 +0100 Subject: [PATCH 13/16] ascii option to avoid unicode --- barcat | 16 +++++++++++++--- t/t0002-usage_-h_|wc_-l.out | 2 +- t/t0003-invalid_options_-Az_?64.out | 2 ++ t/t0003-invalid_options_-aZ_?64.out | 2 -- t/t2105-spark_ascii.in | 1 + t/t2105-spark_ascii_-a_--spark.out | 1 + t/t2201-ascii.in | 5 +++++ t/t2201-ascii_-aHl7.out | 5 +++++ 8 files changed, 28 insertions(+), 6 deletions(-) create mode 100644 t/t0003-invalid_options_-Az_?64.out delete mode 100644 t/t0003-invalid_options_-aZ_?64.out create mode 120000 t/t2105-spark_ascii.in create mode 100644 t/t2105-spark_ascii_-a_--spark.out create mode 100644 t/t2201-ascii.in create mode 100644 t/t2201-ascii_-aHl7.out diff --git a/barcat b/barcat index 838c89f..cc3f607 100755 --- a/barcat +++ b/barcat @@ -11,6 +11,7 @@ our $VERSION = '1.07'; use Getopt::Long '2.33', qw( :config gnu_getopt ); my %opt; GetOptions(\%opt, + 'ascii|a!', 'color|c!', 'C' => sub { $opt{color} = 0 }, 'field|f=s' => sub { @@ -50,7 +51,9 @@ GetOptions(\%opt, $opt{'graph-format'} = substr $_[1], 0, 1; }, 'spark:s' => sub { - $opt{spark} = [split //, $_[1] || ' ▁▂▃▄▅▆▇█']; + $opt{spark} = [split //, + $_[1] || ($opt{ascii} ? ' ..oOO' : ' ▁▂▃▄▅▆▇█') + ]; }, 'palette=s' => sub { $opt{palette} = { @@ -119,7 +122,8 @@ $opt{width} ||= $ENV{COLUMNS} || qx(tput cols) || 80 unless $opt{spark}; $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{units} = [split //, ' kMGTPEZYyzafpn'.($opt{ascii} ? 'u' : 'μ').'m'] + if $opt{'human-readable'}; $opt{anchor} //= qr/\A/; $opt{'value-length'} = 6 if $opt{units}; $opt{'value-length'} = 1 if $opt{unmodified}; @@ -179,7 +183,7 @@ while (defined ($_ = $opt{input} ? shift @{ $opt{input} } : readline)) { } elsif (length > $trimpos) { # cut and replace (intentional lvalue for speed, contrary to PBP) - substr($_, $trimpos - 1) = '…'; + substr($_, $trimpos - 1) = $opt{ascii} ? '>' : '…'; } } push @lines, $_; @@ -368,6 +372,12 @@ you'll need a larger animal like I. =over +=item -a, --[no-]ascii + +Restrict user interface to ASCII characters, +replacing default UTF-8 by their closest approximation. +Input is always interpreted as UTF-8 and shown as is. + =item -c, --[no-]color Force colored output of values and bar markers. diff --git a/t/t0002-usage_-h_|wc_-l.out b/t/t0002-usage_-h_|wc_-l.out index 64bb6b7..e85087a 100644 --- a/t/t0002-usage_-h_|wc_-l.out +++ b/t/t0002-usage_-h_|wc_-l.out @@ -1 +1 @@ -30 +31 diff --git a/t/t0003-invalid_options_-Az_?64.out b/t/t0003-invalid_options_-Az_?64.out new file mode 100644 index 0000000..e8e36f1 --- /dev/null +++ b/t/t0003-invalid_options_-Az_?64.out @@ -0,0 +1,2 @@ +Unknown option: A +Unknown option: z diff --git a/t/t0003-invalid_options_-aZ_?64.out b/t/t0003-invalid_options_-aZ_?64.out deleted file mode 100644 index 082a421..0000000 --- a/t/t0003-invalid_options_-aZ_?64.out +++ /dev/null @@ -1,2 +0,0 @@ -Unknown option: a -Unknown option: Z diff --git a/t/t2105-spark_ascii.in b/t/t2105-spark_ascii.in new file mode 120000 index 0000000..4646f48 --- /dev/null +++ b/t/t2105-spark_ascii.in @@ -0,0 +1 @@ +t2100-sparkwave.in \ No newline at end of file diff --git a/t/t2105-spark_ascii_-a_--spark.out b/t/t2105-spark_ascii_-a_--spark.out new file mode 100644 index 0000000..eddad81 --- /dev/null +++ b/t/t2105-spark_ascii_-a_--spark.out @@ -0,0 +1 @@ +OOOOOOOOOOOOoooooooo.................ooooooooOOOOOOOOOOOOOOOOOooooooooo................oooooooooOOOO diff --git a/t/t2201-ascii.in b/t/t2201-ascii.in new file mode 100644 index 0000000..447b1fd --- /dev/null +++ b/t/t2201-ascii.in @@ -0,0 +1,5 @@ +123e-6 micro +.1 long line +-1 +-2 +-3 diff --git a/t/t2201-ascii_-aHl7.out b/t/t2201-ascii_-aHl7.out new file mode 100644 index 0000000..fbae8fc --- /dev/null +++ b/t/t2201-ascii_-aHl7.out @@ -0,0 +1,5 @@ +123u micro ------------<-=-+--------| +100m long> ------------<-=-+--------|- + -1 ------------<-=-+ + -2 --------- + -3 -- 2.30.2 From 46f1edad6cf059eaef351f950e2f067c05871563 Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 27 Mar 2021 22:58:25 +0100 Subject: [PATCH 14/16] apply value formatting to statistics --- barcat | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/barcat b/barcat index cc3f607..82f0fff 100755 --- a/barcat +++ b/barcat @@ -326,9 +326,9 @@ sub show_stat { printf ' in %d values', scalar @order; printf ' over %d lines', scalar @lines if @order != @lines; printf(' (%s min, %s avg, %s max)', - color(31) . $order[-1] . color(0), - color(36) . $opt{'calc-format'}->($total / @order) . color(0), - color(32) . $order[0] . color(0), + color(31) . ($opt{'value-format'} || sub {$_[0]})->($order[-1]) . color(0), + color(36) . ($opt{'value-format'} || $opt{'calc-format'})->($total / @order) . color(0), + color(32) . ($opt{'value-format'} || sub {$_[0]})->($order[0]) . color(0), ); } say ''; -- 2.30.2 From 4c703b580c40651e0f2c6aa6e83e5cf614c3bbde Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 27 Mar 2021 22:59:58 +0100 Subject: [PATCH 15/16] t: planned feature for negative limits Do not count names ending in #TODO as failing. --- t/regress.t | 11 +++++++++-- t/t1504-bottom_limit.in | 1 + t/t1504-bottom_limit_-L-3_#TODO.out | 3 +++ 3 files changed, 13 insertions(+), 2 deletions(-) create mode 120000 t/t1504-bottom_limit.in create mode 100644 t/t1504-bottom_limit_-L-3_#TODO.out diff --git a/t/regress.t b/t/regress.t index 508d361..e149b36 100755 --- a/t/regress.t +++ b/t/regress.t @@ -68,8 +68,15 @@ do if test 0 != $? then - fail_count=$((fail_count+1)) - color 1\;31 + case "$name" in + *' #TODO') + color 33 + ;; + *) + fail_count=$((fail_count+1)) + color 1\;31 + esac + printf 'not ' fi echo "ok $test_count - $name" diff --git a/t/t1504-bottom_limit.in b/t/t1504-bottom_limit.in new file mode 120000 index 0000000..0dbe582 --- /dev/null +++ b/t/t1504-bottom_limit.in @@ -0,0 +1 @@ +t1002-sinewave.in \ No newline at end of file diff --git a/t/t1504-bottom_limit_-L-3_#TODO.out b/t/t1504-bottom_limit_-L-3_#TODO.out new file mode 100644 index 0000000..6bf764d --- /dev/null +++ b/t/t1504-bottom_limit_-L-3_#TODO.out @@ -0,0 +1,3 @@ +3350 ------------ +2392 -------- +1411 ----- -- 2.30.2 From d8b46e635b34f40972271b6bdf1ea2383e3bff2a Mon Sep 17 00:00:00 2001 From: Mischa POSLAWSKY Date: Sat, 27 Mar 2021 23:57:35 +0100 Subject: [PATCH 16/16] negative limit counts from last line --- barcat | 22 ++++++++++++++----- ..._#TODO.out => t1504-bottom_limit_-L-3.out} | 0 2 files changed, 16 insertions(+), 6 deletions(-) rename t/{t1504-bottom_limit_-L-3_#TODO.out => t1504-bottom_limit_-L-3.out} (100%) diff --git a/barcat b/barcat index 82f0fff..5d0f85c 100755 --- a/barcat +++ b/barcat @@ -39,8 +39,9 @@ GetOptions(\%opt, 'limit|L:s' => sub { my ($optname, $optval) = @_; $optval ||= 0; + $optval =~ /\A-[0-9]+\z/ and $optval .= '-'; # tail shorthand ($opt{hidemin}, $opt{hidemax}) = - $optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/ or die( + $optval =~ m/\A (?: (-? [0-9]+)? - )? ([0-9]+)? \z/ or die( "Value \"$optval\" invalid for option limit", " (range expected)\n" ); @@ -205,7 +206,9 @@ sub color { sub show_lines { -state $nr = $opt{hidemin}; +state $nr = + $opt{hidemin} < 0 ? @lines + $opt{hidemin} + 1 : + $opt{hidemin}; @lines or return; @lines > $nr or return; @@ -316,9 +319,12 @@ say $opt{palette} ? color(0) : '' if $opt{spark}; sub show_stat { if ($opt{hidemin} or $opt{hidemax}) { - printf '%.8g of ', $opt{'sum-format'}->(sum(grep { length } - @values[$opt{hidemin} .. ($opt{hidemax} || @lines) - 1] - ) // 0); + my $linemin = $opt{hidemin}; + $linemin += @lines if $linemin < 0; + my $linemax = ($opt{hidemax} || @lines) - 1; + printf '%.8g of ', $opt{'sum-format'}->( + sum(grep {length} @values[$linemin .. $linemax]) // 0 + ); } if (@order) { my $total = sum @order; @@ -422,9 +428,13 @@ unless C<--length=0>. Prepend a dash (i.e. make negative) to enforce padding regardless of encountered contents. -=item -L, --limit[=( | -[])] +=item -L, --limit[=( | - | -[])] Stop output after a number of lines. +A single value indicates the last line number (like C), +or first line counting from the bottom if negative (like C). +A specific range can be given by two values. + All input is still counted and analyzed for statistics, but disregarded for padding and bar size. diff --git a/t/t1504-bottom_limit_-L-3_#TODO.out b/t/t1504-bottom_limit_-L-3.out similarity index 100% rename from t/t1504-bottom_limit_-L-3_#TODO.out rename to t/t1504-bottom_limit_-L-3.out -- 2.30.2