#!/usr/bin/perl -CA
use 5.018;
use warnings;
use utf8;
use List::Util qw( min max sum );
use open qw( :std :utf8 );
use experimental qw( lexical_subs );

our $VERSION = '1.06';

use Getopt::Long '2.33', qw( :config gnu_getopt );
my %opt;
GetOptions(\%opt,
	'color|c!',
	'C' => sub { $opt{color} = 0 },
	'field|f=s' => sub {
		eval {
			local $_ = $_[1];
			$opt{anchor} = /^[0-9]+$/ ? qr/(?:\S*\h+){$_}\K/ : qr/$_/;
		} or die $@ =~ s/(?: at .+)?$/ for option $_[0]/r;
	},
	'human-readable|H!',
	'interval|t:i',
	'trim|length|l=s' => sub {
		my ($optname, $optval) = @_;
		$optval =~ s/%$// and $opt{trimpct}++;
		$optval =~ m/^-?[0-9]+$/ or die(
			"Value \"$optval\" invalid for option $optname",
			" (number or percentage expected)\n"
		);
		$opt{trim} = $optval;
	},
	'value-length=i',
	'hidemin=i',
	'hidemax=i',
	'minval=f',
	'maxval=f',
	'limit|L:s' => sub {
		my ($optname, $optval) = @_;
		$optval ||= 0;
		($opt{hidemin}, $opt{hidemax}) =
		$optval =~ m/\A (?: ([0-9]+)? - )? ([0-9]+)? \z/x or die(
			"Value \"$optval\" invalid for option limit",
			" (range expected)\n"
		);
	},
	'header!',
	'markers|m=s',
	'graph-format=s' => sub {
		$opt{'graph-format'} = substr $_[1], 0, 1;
	},
	'spark:s' => sub {
		$opt{spark} = [split //, $_[1] || ' ▁▂▃▄▅▆▇█'];
	},
	'palette=s' => sub {
		$opt{palette} = {
			fire   => [qw( 90 31 91 33 93 97 96 )],
			fire88 => [map {"38;5;$_"} qw(
				80  32 48 64  68 72 76  77 78 79  47
			)],
			fire256=> [map {"38;5;$_"} qw(
				235  52 88 124 160 196
				202 208 214 220 226  227 228 229 230 231  159
			)],
			ramp88 => [map {"38;5;$_"} qw(
				64 65 66 67 51 35 39 23 22 26 25 28
			)],
			whites => [qw( 1;30 0;37 1;37 )],
			greys  => [map {"38;5;$_"} 52, 235..255, 47],
		}->{$_[1]} // [ split /[^0-9;]/, $_[1] ];
	},
	'stat|s!',
	'signal-stat=s',
	'unmodified|u!',
	'width|w=i',
	'version' => sub {
		say "barcat version $VERSION";
		exit;
	},
	'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} || qx(tput cols) || 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{'value-length'} = 1 if $opt{unmodified};
$opt{'signal-stat'} //= exists $SIG{INFO} ? 'INFO' : 'QUIT';
$opt{markers} //= '=avg >31.73v <68.27v +50v |0';
$opt{palette} //= $opt{color} && [31, 90, 32];

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;
	alarm $opt{interval} if $opt{interval} > 0;

	eval {
		require Tie::Array::Sorted;
		tie @order, 'Tie::Array::Sorted', sub { $_[1] <=> $_[0] };
	} or warn $@, "Expect slowdown with large datasets!\n";
}

my $valmatch = qr/$opt{anchor} ( \h* -? [0-9]* \.? [0-9]+ (?: e[+-]?[0-9]+ )? |)/x;
while (readline) {
	s/\r?\n\z//;
	s/^\h*// unless $opt{unmodified};
	push @values, s/$valmatch/\n/ && $1;
	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) {
			$_ = substr $_, 0, 2;
		}
		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 {
	$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;
@lines and @lines > $nr or return;
@lines or return;
@lines > $nr or return unless $opt{hidemin};

@order = sort { $b <=> $a } @order unless tied @order;
my $maxval = $opt{maxval} // ($opt{hidemax} ? max grep { length } @values[0 .. $opt{hidemax} - 1] : $order[0]) // 0;
my $minval = $opt{minval} // min $order[-1] // (), 0;
my $lenval = $opt{'value-length'} // max map { length } @order;
my $len    = defined $opt{trim} && $opt{trim} <= 0 ? -$opt{trim} + 1 :
	max map { length $values[$_] && length $lines[$_] }
		0 .. min $#lines, $opt{hidemax} || ();  # left padding
my $size   = ($maxval - $minval) &&
	($opt{width} - $lenval - $len) / ($maxval - $minval);  # bar multiplication

my @barmark;
if ($opt{markers} and $size > 0) {
	for my $markspec (split /\h/, $opt{markers}) {
		my ($char, $func) = split //, $markspec, 2;
		my $pos = eval {
			if ($func eq 'avg') {
				return sum(@order) / @order;
			}
			elsif ($func =~ /\A([0-9.]+)v\z/) {
				my $index = $#order * $1 / 100;
				return ($order[$index] + $order[$index + .5]) / 2;
			}
			else {
				return $func;
			}
		} - $minval;
		$pos >= 0 or next;
		color(36) for $barmark[$pos * $size] = $char;
	}

	state $lastmax = $maxval;
	if ($maxval > $lastmax) {
		print ' ' x ($lenval + $len);
		printf color(90);
		printf '%-*s',
			($lastmax - $minval) * $size + .5,
			'-' x (($values[$nr - 1] - $minval) * $size);
		print color(92);
		say '+' x (($maxval - $lastmax - $minval) * $size + .5);
		print color(0);
		$lastmax = $maxval;
	}
}

@lines > $nr or return if $opt{hidemin};

sub sival {
	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]
	);
}

say(
	color(31), sprintf('%*s', $lenval, $minval),
	color(90), '-', color(36), '+',
	color(32), sprintf('%*s', $size * ($maxval - $minval) - 3, $maxval),
	color(90), '-', color(36), '+',
	color(0),
) if $opt{header};

while ($nr <= $#lines) {
	$nr >= $opt{hidemax} and last if defined $opt{hidemax};
	my $val = $values[$nr];
	my $rel = length $val && ($val - $minval) / ($maxval - $minval);
	my $color = !length $val || !$opt{palette} ? undef :
		$val == $order[0] ? $opt{palette}->[-1] : # max
		$val == $order[-1] ? $opt{palette}->[0] : # min
		$opt{palette}->[ $rel * ($#{$opt{palette}} - 1) + 1 ];

	if ($opt{spark}) {
		print color($color), $opt{spark}->[
			!$val ? 0 : # blank
			$val == $order[0] ? -1 : # max
			$val == $order[-1] ? 1 : # min
			$#{$opt{spark}} < 3 ? 1 :
			$rel * ($#{$opt{spark}} - 3) + 2.5
		];
		next;
	}

	if (length $val) {
		$val = $opt{units} ? sival($val) : sprintf "%*s", $lenval, $val;
		color($color) for $val;
	}
	my $line = $lines[$nr] =~ s/\n/$val/r;
	printf '%-*s', $len + length($val), $line;
	print $barmark[$_] // $opt{'graph-format'} for 1 .. $size && (($values[$nr] || 0) - $minval) * $size + .5;
	say '';
}
continue {
	$nr++;
}
say $opt{palette} ? color(0) : '' if $opt{spark};

}

sub show_stat {
	if ($opt{hidemin} or $opt{hidemax}) {
		$opt{hidemin} ||= 1;
		$opt{hidemax} ||= @lines;
		printf '%s of ', sum(@values[$opt{hidemin} - 1 .. $opt{hidemax} - 1]) // 0;
	}
	if (@order) {
		my $total = sum @order;
		printf '%s total', color(1) . $total . color(0);
		printf ' in %d values', scalar @values;
		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 '';
}

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

show_exit();

__END__
=encoding utf8

=head1 NAME

barcat - graph to visualize input values

=head1 SYNOPSIS

B<barcat> [<options>] [<input>]

=head1 DESCRIPTION

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.

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

=item -c, --[no-]color

Force colored output of values and bar markers.
Defaults on if output is a tty,
disabled otherwise such as when piped or redirected.

=item -f, --field=(<number>|<regexp>)

Compare values after a given number of whitespace separators,
or matching a regular expression.

Unspecified or I<-f0> means values are at the start of each line.
With I<-f1> the second word is taken instead.
A string can indicate the starting position of a value
(such as I<-f:> if preceded by colons),
or capture the numbers itself,
for example I<-f'(\d+)'> for the first digits anywhere.

=item --header

Prepend a chart axis with minimum and maximum values labeled.

=item -H, --human-readable

Format values using SI unit prefixes,
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.

=item -t, --interval[=(<seconds>|-<lines>)]

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>[%]

Trim line contents (between number and bars)
to a maximum number of characters.
The exceeding part is replaced by an abbreviation sign,
unless C<--length=0>.

Prepend a dash (i.e. make negative) to enforce padding
regardless of encountered contents.

=item -L, --limit[=(<count> | <start>-[<end>])]

Stop output after a number of lines.
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=<format>

Statistical positions to indicate on bars.
A single indicator glyph precedes each position:

=over 2

=item <number>

Exact value to match on the axis.
A vertical bar at the zero crossing is displayed by I<|0>
for negative values.
For example I<:3.14> would show a colon at pi.

=item <percentage>I<v>

Ranked value at the given percentile.
The default shows I<+> at I<50v> for the mean or median;
the middle value or average between middle values.
One standard deviation right of the mean is at about I<68.3v>.
The default includes I<< >31.73v <68.27v >>
to encompass all I<normal> results, or 68% of all entries, by B<< <--> >>.

=item I<avg>

Matches the average;
the sum of all values divided by the number of counted lines.
Indicated by default as I<=>.

=back

=item --min=<number>, --max=<number>

Bars extend from 0 or the minimum value if lower,
to the largest value encountered.
These options can be set to customize this range.

=item --palette=(<preset> | <color>...)

Override colors of parsed numbers.
Can be any CSI escape, such as I<90> for default dark grey,
or alternatively I<1;30> for bold black.

In case of additional colors,
the last is used for values equal to the maximum, the first for minima.
If unspecified, these are green and red respectively (I<31 90 32>).

=item --spark[=<glyphs>]

Replace lines by I<sparklines>,
single characters corresponding to input values.
A specified sequence of unicode characters will be used for
Of a specified sequence of unicode characters,
the first one will be used for non-values,
the last one for the maximum,
the second (if any) for the minimum,
and any remaining will be distributed over the range of values.
Unspecified, block fill glyphs U+2581-2588 will be used.

=item -s, --stat

Total statistics after all data.

=item -u, --unmodified

Do not reformat values, keeping leading whitespace.
Keep original value alignment, which may be significant in some programs.

=item --value-length=<size>

Reserved space for numbers.

=item -w, --width=<columns>

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

Draw a sine wave:

    seq 30 | awk '{print sin($1/10)}' | barcat

Compare file sizes (with human-readable numbers):

    du -d0 -b * | barcat -H

Memory usage of user processes with long names truncated:

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

Monitor network latency from prefixed results:

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

Commonly used after counting, for example users on the current server:

    users | sed 's/ /\n/g' | sort | uniq -c | barcat

Letter frequencies in text files:

    cat /usr/share/games/fortunes/*.u8 |
    perl -CS -nE 'say for grep length, split /\PL*/, uc' |
    sort | uniq -c | barcat

Number of HTTP requests per day:

    cat log/access.log | cut -d\  -f4 | cut -d: -f1 | uniq -c | barcat

Any kind of database query with counts, preserving returned alignment:

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

    curl https://github.com/Biuni/PokemonGO-Pokedex/raw/master/pokedex.json |
    jq -r '.pokemon[] | [.height,.num,.name] | join(" ")' | barcat

USD/EUR exchange rate from CSV provided by the ECB:

    curl https://sdw.ecb.europa.eu/export.do \
         -Gd 'node=SEARCHRESULTS&q=EXR.D.USD.EUR.SP00.A&exportType=csv' |
    grep '^[12]' | barcat -f',\K' --value-length=7

Total population history from the World Bank dataset (XML):
External datasets, like total population in XML from the World Bank:

    curl http://api.worldbank.org/v2/country/1W/indicator/SP.POP.TOTL |
    xmllint --xpath '//*[local-name()="date" or local-name()="value"]' - |
    sed -r 's,</wb:value>,\n,g; s,(<[^>]+>)+, ,g' | barcat -f1 -H

And of course various Git statistics, such commit count by year:

    git log --pretty=%ci | cut -b-4 | uniq -c | barcat

Or the top 3 most frequent authors with statistics over all:

    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 LICENSE

GPL3+.