#!/usr/bin/perl

use warnings;
use Getopt::Std;
use open ":locale";
$Getopt::Std::STANDARD_HELP_VERSION++;

($SELF = $0) =~ s,.*/,,;
$VERSION="0.0.1";

sub HELP_MESSAGE {
	print <<EOF;
$SELF - count repeats in input

Given the following input:

foo
foo
bar
bar
baz

$SELF will output:

bar	2	40.0%
baz	1	20.0%
foo	2	40.0%

Usage: $SELF <options> <file> ...

General options:
  --help
  -h        display this help message

Output options:
  -c        show counts only (suppress percentages)
  -p        show percentages only (suppress counts)
  -t        show total count
  -x        print output in hexadecimal
  -s opts   output sort options. opts may include:
            r - reverse sort
            f - fold case
            c - sort by count rather than input string
  -T thresh filter out results below threshold (which may be a
            count or a percentage, e.g. 5%).
  -P        don't pad output with spaces to length of longest element
            -o option enables this as well.

Input options:
  -B        binary mode (default: input is characters in current locale)
  -o string use string as output delimiter (default: \\t). implies -P.
  -b range  consider only a range of chars/bytes in each line (e.g. 1-3)
  -d delim  split on delimiter (default: /\\s+/ aka whitespace)
  -f field  consider only this (delimiter-separated) field
  -i        case insensitive (actually, lowercases all input)
  -w        remove leading and trailing whitespace from input lines
  -W        remove ALL whitespace from input lines
  -e code   execute perl code for each line of input (should modify \$_,
            make sure you quote the argument as needed by your shell)

Input will be read from filenames given on the command line, or from
standard input if none given. The input need not be sorted. The output
will always be sorted.

Each line of input is chomped (has trailing \\n removed) before any
further processing.

-b is like the -b or -c option to cut(1) (depending on whether -B is
set). It supports the same type of range as cut(1):

N      N'th byte/character, counted from 1
N-     from N'th byte/character to end of line
N-M    from N'th to M'th (included) byte/character
-M     from first to M'th (included) byte/character

...except that cut allows many ranges separated by commas, while $SELF
-b only allows a single range.

-d is like the the -d option to cut(1), except that the delimiter can be
multiple characters. Also, the delimiter is treated as a regular expression
if it's at least 4 characters long *and* enclosed in //.

-f like cut's -f, except that it only allows a single field number (not
a list), which is indexed starting from 1 (same as cut)... or a negative
number, meaning the Nth field from the right (-1 = rightmost). Also
unlike cut, -f and -b may be combined (-b is applied first).

The -b -f -i -w -W -e<code> options will be processed in the order
listed here, regardless of the order they're given on the command
line. In particular, this means the code for -e will see \$_ *after*
it's been modified by any of the other options.

There can only be one -e option, but it may be multiple lines of code
separated with semicolons (like perl's own -e option). When the -e code
runs, \$_ contains the input (possibly tranformed by other options),
and can be modified arbitratily. The -e code can filter out unwanted
lines by executing "next", which will cause them to be skipped entirely.
EOF
}

sub VERSION_MESSAGE {
	print "$SELF $VERSION\n";
}

sub hexify {
	my @out = ();
	push @out, sprintf("%x", ord($_)) for split "", $_[0];
	return join(" ", @out);
}

# main()
getopts('hcpiwWte:d:f:b:xo:Bs:T:P', \%opt);

HELP_MESSAGE() if $opt{h};

die "$SELF: options -c and -p are mutually exclusive\n"
	if $opt{c} && $opt{p};

if(defined $opt{o}) {
	$opt{P} = 1;
} else {
	$opt{o} = "\t";
}

if(defined $opt{d}) {
	if($opt{d} =~ m|^/(.{2,})/$|) {
		$opt{d} = qr/$1/;
	} else {
		$opt{d} = quotemeta($opt{d});
		$opt{d} = qr/$opt{d}/;
	}
} else {
	$opt{d} = qr/\s+/;
}

if(defined $opt{b}) {
	for($opt{b}) {
		/^(\d+)$/ && do { $substrarg = "$1 - 1, 1" };
		/^(\d+)-$/ && do { $substrarg = "$1 - 1" };
		/^-(\d+)$/ && do { $substrarg = "0, $1" };
		/^(\d+)-(\d+)$/ && do { $substrarg = "$1 - 1, " . ($2 - $1 + 1) };
	}
	die "$SELF: invalid -b argument\n" unless $substrarg;
}

# -f index starts at 1, perl arrays are indexed from 0, fix (but
# don't break using -1 for rightmost field)
$opt{f}-- if defined $opt{f} && $opt{f} > 0;

if($opt{s}) {
	for(split "", $opt{s}) {
		/r/ && do { $revsort++;   };
		/f/ && do { $foldsort++;  };
		/c/ && do { $countsort++; };
		/([^rfc])/ && do {
			warn "$SELF: ignoring unknown sort option '$1'\n"; };
	}
}

if($countsort && $foldsort) {
	die "$SELF: sort options 'c' and 'f' are mutually exclusive\n";
}

if($countsort) {
	$sortcode = "{ " .
		'$counts{' . ($revsort ? '$b' : '$a') . '}' .
		" <=> " .
		'$counts{' . ($revsort ? '$a' : '$b') . '}' .
		"}";
} else {
	$sortcode = "{ " .
		($foldsort ? 'lc ' : "" ) .
		($revsort ? '$b' : '$a') .
		" cmp " .
		($foldsort ? 'lc ' : "" ) .
		($revsort ? '$a' : '$b') .
		"}";
}

# finally done with option processing, let the main event commence.

%counts = ();
$total = 0;
$longest = 0;
$readfiles = 0;
$badfiles = 0;

# Sadly, we can't use the magical while(<>) here to automatically iterate
# and open all the files in @ARGV, because of the locale stuff. We need to
# call binmode() on each filehandle after it's opened, but before anything
# gets read from it. 'use open ":bytes"' would set the default binmode,
# but I couldn't get it to work conditionally (not even with eval).

$ARGV[0] = '-' unless @ARGV;
for(@ARGV) {
	my $fh;

	if($_ eq '-') {
		$fh = \*STDIN;
	} else {
		open $fh, '<', $_ or do {
			warn "$SELF: $_: $!\n";
			$badfiles++;
			next;
		};
	}

	binmode $fh, ":bytes" if $opt{B};
	$readfiles++;

	while(<$fh>) {
		chomp;

		# behave like cut for -b/-f: no warnings if -f3 but only 2 fields exist,
		# or -b10 but only 9 characters exist.

		if($substrarg) { # set via $opt{b}
			no warnings qw/substr/;
			eval "\$_ = substr(\$_, $substrarg)";
			$_ = "" unless defined $_;
		}

		if($opt{f}) {
			$_ = (split($opt{d}))[$opt{f}];
			$_ = "" unless defined $_;
		}

		$_ = lc if $opt{i};
		s/^\s+|\s+$//g if $opt{w};
		s/\s//g if $opt{W};

		if($opt{e}) {
			no warnings qw/exiting/; # so -e code can "next" to skip a line
			eval $opt{e};
			die "$SELF: $@" if $@;
		}

		$counts{$_}++;
		$total++;
	}
}

die "$SELF: couldn't read any input files\n" unless $readfiles;

if($opt{T}) {
	(my ($thresh, $pct)) = ($opt{T} =~ /^(\d+)(%?)/);
	if($thresh) {
		for(keys %counts) {
			delete $counts{$_} if
				($pct && (($counts{$_} * 100 / $total) < $thresh)) ||
				(!$pct && ($counts{$_} < $thresh));
		}
	} else {
		warn "$SELF: invalid argument for -T\n";
	}
}

if(!$opt{P}) {
	for(keys %counts) {
		my $l = length($opt{x} ? hexify($_) : $_);
		$longest = $l if $longest < $l;
	}
}

# done reading & counting all input, show the results.
for(sort { eval $sortcode } keys %counts) {
	print ($opt{x} ? hexify($_) : $_);
	print " " x ($longest - length) unless $opt{P};
	print $opt{o};
	print $counts{$_} . $opt{o} unless $opt{p};
	printf "%.1f%%", ($counts{$_} * 100 / $total) unless $opt{c};
	print "\n";
}

if($opt{t}) {
	print "\n-- Total count: $total\n";
}

# be like cat, exit with error status if any input file couldn't be
# read (even if we did successfully read others)
exit($badfiles != 0);

__END__

Examples:

# show the percentage of binaries that start with each letter/number/etc,
# 4 different ways
cd /usr/bin
ls | bkt -b1
ls | cut -b1 | bkt
ls | bkt -e '$_=substr($_,0,1)'
ls | bkt -e 's,^(.).*,$1,'

# show percentages of stuff said by each user in an irssi IRC log. relies
# on the log format having a timestamp, space, <nick> for normal lines.
# misses /me actions entirely though.
# add -src to show the most talkative first.
bkt -f2 -e 'next unless /^\</' channelname.log

# show us how many users use each shell (including stuff like /bin/false).
bkt -d: -f-1 /etc/passwd

# how many images of each type have we got? ignore case, so JPG and jpg
# are counted together.
ls ~/images/*.* | bkt -d. -f-1