#!/usr/bin/perl =pod =head1 NAME B - count repeats in input =head1 SYNOPSIS B -h | --help B -[cpiwWtxaBPnkFL] [...] [-e code] [-d delim ] [-f field] [-b list] [-o delim] [-s sortopts] [-T thresh[%]] [-/ separator] [-r recordsize] =head1 DESCRIPTION B reads input from files or standard input, splits it into records, optionally transforms them according to various options, and counts like records. After all input is read, a count and percentage is given for the occurrence of each record. Given the following input: foo foo bar bar baz B will output: bar 2 40.0% baz 1 20.0% foo 2 40.0% The name 'B' comes from the concept of collecting like items in buckets. The original plan was to name this script 'bucketize', but who wants to type all that? Also, purely to support lazy typists, B implements subsets of the functionality of B(1), B(1), B(1), and B(1). B also allows executing arbitrary perl code for each record, and supports various output options, including an ASCII art histogram. The utility of B will be obvious, if you've written lots of variants of: | perl -lne 's/\s.*//; $a{$_}++; END { print "$_ $a{$_}" for sort keys %a }' The above could be written as: | bkt -f1 =head1 OPTIONS Options that don't take arguments may be bundled: B<-BipW> is the same as B<-B> B<-i> B<-p> B<-W>. =head2 General Options =over =item B<--help>, B<-h> Display this help message =item B<--version> Display version of bkt =item B<--> End of options. Everything after this is treated as a filename. =back =head2 Input Options These options are applied to each input file when it's first opened for reading. =over =item B<-B> Byte mode. By default, input is treated as characters in the encoding specified by the current locale. B<-B> treats the input as a stream of 8-bit bytes (octets, if you like). =item B<-r> I Read input as fixed-size records. This can't be combined with B<-/>, as it sets the value of B<$/> to a reference to its argument. See I. =item B<-/> I Set value of B<$/>, perl's input record separator. Default is I<\n>. One of B<-w> B<-W> B<-n> is highly recommended with this option. This can't be combined with B<-r>. =back =head2 Transform Options These options are applied to each record of input, in the order listed here, before it's counted. If you haven't used B<-r> or B<-/>, a record is a line. The B<-f> and <-b> options can be used together, which is unlike B(1). =over =item B<-l> I Operate only on records numbered within the range, e.g. I<1-3> for the first 3 records of each file, I<10-> for 10th through the end, I<15> for only the 15th record. The starting record is optional and defaults to 1, so I<-3> could be used for the first example. If multiple files are given, the numbering resets to 1 at the start of each file. =item B<-d> I Delimiter for B<-f>. Default: /\\s+/ aka whitespace. This can be a literal string or a regular expression (if enclosed in //, with optional /i modifier). As a special case, I alone is treated as a literal string. This option does nothing without B<-f>. B<-d>'s argument is used with perl's B, so you might read I to understand this. =item B<-f> I Consider only this (B<-d> delimiter separated) field. Unlike B, only one field may be selected (B's lists of fields are not supported). Also unlike B, negative field numbers can be used to index from the rightmost field (which is numbered B<-1>). =item B<-b> I Like B: Consider only a range of characters (or bytes, if B<-B>) in each record. Example: I<1-3> for the first 3 bytes/chars of each input record. B<-b> supports the same types of range as cut(1): N N'th byte/character, counted from 1 N- from N'th byte/character to end of record N-M from N'th to M'th (included) byte/character -M from first to M'th (included) byte/character ...plus 2 extra types: -M- from Mth-to-last byte/character (included) to end of record (-1 = last) -M-N from Mth-to-last byte/character to Nth-to-last (included) ...including multiple ranges separated by commas. =item B<-i> Case insensitive mode. Actually, lowercases all input. Use B<-sf> instead to sort output case-insensitively. =item B<-w> Remove leading and trailing whitespace from input records. =item B<-W> Remove ALL whitespace from input records. =item B<-n> Remove all non-word (I<\W>) characters from input records. =item B<-g> I Grep for regex. Equivalent to: B<-e 'next unless /regex/'>. Remember this is a perl-style regex, not a B(1) one. =item B<-v> I Grep for records not containing regex. Equivalent to: B<-e 'next if /regex/'>. =item B<-e> I Execute perl code for each input record. The code should modify B<$_>. Make sure you quote the argument as needed by your shell. See OPERATION below for more information. =item B<-k> Skip blank records. Basically the same as B<-e 'next if $_ eq ""'>. =item B<-F> Word frequency count. Alias for B<-ink/' '>. =item B<-L> Letter frequency count. Alias for B<-inkr1>. =back =head2 Output Options These options are applied after all I/O and counting is done, and only affect how the output is printed. =over =item B<-c> Show counts only (suppress percentages). =item B<-p> Show percentages only (suppress counts). B<-c> and B<-p> may be combined, if you can find a use for it. =item B<-t> Show total count after all item counts. =item B<-C> Print the records themselves, instead of the counts. Allows B to be used as a general-purpose text manipulation tool. Mainly this option was implemented for debugging purposes, but it might be useful for other stuff. When B<-C> is used, B<-a> and B<-x> still work, but none of the other output options have any effect. =item B<-H> Print a crude ASCII art histogram. The histogram's width is half the width of the terminal, as reported by the COLUMNS environment variable (or by B, if COLUMNS not set), so the width can be controlled by setting COLUMNS manually. =item B<-x> Print output records as hexadecimal. =item B<-a> ASCII output: render non-ASCII characters as hex escapes. =item B<-s> I Output sort options. Options may include: r - reverse sort (default is ascending) a - sort alphabetically by record (default is by count, then alpha) n - sort numerically by record f - fold case =item B<-T> I Filter out results below threshold, which may be a count or a percentage, e.g. 5%. =item B<-o> I Use string as output delimiter (default: \\t). Implies B<-P>. =item B<-P> Don't pad output with spaces to length of longest element. The B<-o> option enables this as well. =back =head1 OPERATION Input will be read from filenames given on the command line, or from standard input if none given, or if the filename B<-> (hyphen) is given. Use B<./-> to read file a real file named B<->. The input need not be sorted. The output will always be sorted. Each input record is chomped before any further processing. The transform options (B<-l> B<-f> B<-b> B<-i> B<-w> B<-W> B<-n> B<-g> B<-v> B<-e>I B<-k>) will be applied to each record in the order listed here, regardless of the order they're given on the command line. In particular, this means the code for B<-e> will see B<$_> *after* it's been modified by any of the other options (except B<-k>). In the case of B<-l>, B<-g>, B<-v>, the B<-e> code will not be run for records not matched by the options. The code for B<-e> will run with strict disabled and warnings enabled. To disable warnings, prefix the code with 'no warnings;'. There can only be one B<-e> option, but it may be multiple lines of code separated with semicolons. When the B<-e> code runs, B<$_> contains the input (possibly tranformed by other options), and can be modified arbitratily. The B<-e> code can filter out unwanted records by executing "next", which will cause them to be skipped entirely. Also, if the B<-k> option is used, the code can B or assign B<$_=""> to skip the current record. The astute reader will have noticed that all the other transform options could be written as code for B<-e>. This is correct: the other options exist to support lazy typists such as the author. After each record of input is read and any transform options applied to it, I<$counts{$_}++> is executed. After all input is read, output is generated via I. =head1 EXIT STATUS B exits with zero (success) status if all operations were successful, otherwise non-zero. Currently, there are no specific non-zero exit codes (e.g. different ones for different error types), though this may change in the future. If some files couldn't be read, but at least one could, the file(s) that were readable are processed normally and the exit status will be non-zero. This mimics the behaviour of GNU cat(1), head(1), tail(1), etc. =head1 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 lines said by each user in an irssi IRC log. Relies on the log format having a timestamp, space, for normal lines. Misses /me actions entirely though. Add -sr to show the most talkative first. bkt -f2 -g'<' channelname.log -- We have a directory full of scripts, a mix of perl, python, shell, etc. How many scripts are written in each language? Skip any files that don't start with a #! (shebang) line. Using B only: bkt -l1 -g'#!' scripts/* Which is equivalent to: head -qn1 scripts/* | grep '#!' | bkt If you wanted to make the same assumption the OS does, that a script missing its shebang line is a #!/bin/sh script: bkt -l1 -e'$_="#!/bin/sh" unless /#!/' scripts/* If some of them might be ELF executables, add "-B -v ELF" to the above. -- 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 -i -d. -f-1 The above could have been written as: ls ~/images/*.* | tr A-Z a-z | cut -d. -f2 | bkt ...except it wouldn't handle filenames with multiple dots in them, like image.01.jpg. Replacing the cut with "sed 's,.*\.,,'" would fix that, but it's still a lot more keystrokes. -- Plot a histogram of word lengths in a file of words: bkt -H -sn -e '$_=length' /usr/share/dict/words ...which should show a nice bell-curve distrubution. -- What percentage of words in a text file are capitalized? bkt -n/' ' -e's/^[A-Z]+$/CAPS/ || s/^[A-Z].*$/Caps/ || s/^[a-z].*$/lower/ || next' file.txt -- Given a CSV file with fields lastname, firstname, phonenumber: Blow,Joe,444-555-0123 Showers,April,876-333-9874 ...etc... ...to get a breakdown by area code: bkt -d, -f3 -b1-3 phonelist.csv -- Suppose you have a team of people working on a large C++ or Java codebase. By convention, TODO comments are written as: // TODO bob: Support non-Unicode locales ...where "bob" is the coder assigned to that TODO item. You can get summary of these with: find . -name '*.c++' | xargs bkt -e 'm,//\s+TODO\s+(\w+),||next; $_=$1;' ...which might show something like: john 3 3.7% bill 18 22.2% jane 23 28.4% bob 37 45.7% If you're more comfortable with sed than perl, you could write the above as: find . -name '*.c++' | xargs sed -n 's,.*// *TODO *\([^:]*\):.*,\1,p' | bkt =head1 AUTHOR B. Watson =head1 LICENSE WTFPL. See http://www.wtfpl.net/txt/copying/ for full text of license. =head1 SEE ALSO B(1), B(1), B(1) =cut # by popular demand: use warnings; use strict; # I wish there were a way to do this conditionally. # no, this didn't work: require 'open.pm'; ::open->import(':locale', ':std'); use open ":locale", ":std"; use Getopt::Std; # this makes getopts exit after --help: $Getopt::Std::STANDARD_HELP_VERSION++; (our $SELF = $0) =~ s,.*/,,; our $VERSION="0.0.1"; sub HELP_MESSAGE { exec "perldoc $0"; } sub VERSION_MESSAGE { print "$SELF $VERSION\n"; } sub hexify { my @out = (); push @out, sprintf("%x", ord($_)) for split "", $_[0]; return join(" ", @out); } sub print_histogram { my $value = shift; my $maxval = shift; my $columns = shift; my $hist = " " x $columns; substr($hist, int($value / $maxval * ($columns - 1)), 1) = "*"; print $hist; } # this bit of 300 baud linenoise replaces all non-ascii characters # with {\x00} style hex escapes. best viewed with a colorful syntax # highlighting editor (I like vim). sub asciify { my $in = shift; $in =~ s| ( # capture to $1... [^\x20-\x7e] # anything outside the range 0x20 - 0x7e ) | # replace with {\xXX}: "{\\x" . sprintf("%02x", ord($1)) . "}" |gex; return $in; } # sub render, sub render, but don't give yourself awaaaayyy sub render { our %opt; my $in = shift; return hexify($in) if $opt{x}; return asciify($in) if $opt{a}; return $in; } # main() getopts('hcpiwWte:d:f:b:xao:Bs:T:P/:nkFr:Ll:g:v:CH', \our %opt); # -h == --help HELP_MESSAGE(), exit(0) if $opt{h}; # -F = -ink/' ' if($opt{F}) { $opt{'/'} = ' '; $opt{n} = $opt{k} = $opt{i} = 1; } # -L = -inkr1 if($opt{L}) { $opt{r} = 1; $opt{n} = $opt{k} = $opt{i} = 1; } # use an eval for -/ so we can handle escapes like \t \n \r if(defined($opt{'/'})) { if(defined($opt{r})) { warn "$SELF: -r and -/ given; -/ ignored\n"; } else { $opt{'/'} =~ s/'/\\'/g; # to allow -/"'" eval "\$/ = '" . $opt{'/'} . "'"; } } # -r also uses $/ if(defined($opt{r})) { die "$SELF: -r argument must be positive integer\n" unless $opt{r} =~ /^\d+$/; $/ = \$opt{r}; } # -o implies -P if(defined $opt{o}) { $opt{P} = 1; } else { $opt{o} = "\t"; } # -cp implies -P too $opt{P}++ if $opt{c} && $opt{p}; # handle -d arg. we only support the /i modifier when -d/regex/. if(defined $opt{d}) { if($opt{d} =~ m(^/(.+)/(i?)$)) { # qr/$1/$2 is a syntax error, so: $opt{d} = $2 ? qr/$1/i : qr/$1/; } else { $opt{d} = quotemeta($opt{d}); $opt{d} = qr/$opt{d}/; } if(not defined($opt{f})) { warn "$SELF: -d given without -f, which is pointless\n"; } } else { $opt{d} = qr/\s+/; } # handle -b arg our @substrargs; if(defined $opt{b}) { my $s; for(split /,/, $opt{b}) { /^(\d+)$/ && do { $s = "$1 - 1, 1" }; /^(\d+)-$/ && do { $s = "$1 - 1" }; /^-(\d+)$/ && do { $s = "0, $1" }; /^(\d+)-(\d+)$/ && do { $s = "$1 - 1, " . ($2 - $1 + 1) }; /^-(\d+)-$/ && do { $s = "$1"; }; /^-(\d+)-(\d+)$/ && do { $s = "$1, " . ($2 - $1); }; die "$SELF: invalid -b argument\n" unless $s; push @substrargs, $s; } } # handle -l arg. similar to but simpler than -b arg. our ($startrec, $endrec); if(defined $opt{l}) { for($opt{l}) { /^(\d+)$/ && do { $startrec = $endrec = $1 }; /^(\d+)-$/ && do { $startrec = $1 }; /^-(\d+)$/ && do { $startrec = 1; $endrec = $1 }; /^(\d+)-(\d+)$/ && do { $startrec = $1 ; $endrec = $2 }; die "$SELF: invalid -l argument\n" unless $startrec; } } # -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; # handle the various -s sub-options our ($revsort, $foldsort, $alphasort, $numsort); if($opt{s}) { for(split "", $opt{s}) { /r/ && do { $revsort++; }; /f/ && do { $foldsort++; }; /a/ && do { $alphasort++; }; /n/ && do { $numsort++; }; /([^rfan])/ && do { warn "$SELF: ignoring unknown sort option '$1'\n"; }; } } warn "$SELF: sort opts a and n conflict, ignoring a\n" if $alphasort && $numsort; warn "$SELF: sort opts f and n conflict, ignoring f\n" if $foldsort && $numsort; # construct a string of perl code to implement the sort, according # to the options given. sorry, this is kinda ugly. our ($a, $b, $A, $B); $a = $revsort ? '$b' : '$a'; $b = $revsort ? '$a' : '$b'; ($A, $B) = $foldsort ? ("lc $a", "lc $b") : ($a, $b); our $sortcode = $A . " cmp " . $B; if($numsort) { $sortcode = "{ $A <=> $B }" } elsif($alphasort) { $sortcode = "{ $sortcode }"; } else { $sortcode = "{ (\$counts{$a} <=> \$counts{$b}) || ($sortcode) }"; } # the "C" locale causes lots of warnings with 'use open ":locale"' # enabled, when reading files with non-ascii characters. Turning # on the -B option avoids that, and causes the output to be printed # as-is. locale(7) says LC_ALL is checked before LANG, so: $opt{B}++ if(($ENV{LC_ALL} || $ENV{LANG}) eq 'C'); # undo the 'use open ":locale"' on STDOUT, for binary mode. This means we # can print binary gibberish to a terminal, but that's the user's fault. binmode \*STDOUT, ":raw" if $opt{B}; # finally done with option processing, let the main event commence. our %counts = (); our $total = 0; our $longest = 0; our $readfiles = 0; our $badfiles = 0; # Sadly, we can't use the magical while(<>) here to automatically iterate # and open all the files in @ARGV, because of the -B option. 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, ":raw" if $opt{B}; $readfiles++; while(<$fh>) { next if defined $startrec && $. < $startrec; next if defined $endrec && $. > $endrec; chomp; # behave like cut for -b/-f: no warnings if -f3 but only 2 fields exist, # or -b10 but only 9 characters exist. if(defined $opt{f}) { $_ = (split(/$opt{d}/))[$opt{f}]; $_ = "" unless defined $_; } if(@substrargs) { # set via $opt{b} my $out = ""; my $in = $_; no warnings qw/substr/; eval "\$out .= substr(\$in, $_)" for(@substrargs); $_ = $out; $_ = "" unless defined $_; } $_ = lc if $opt{i}; s/^\s+|\s+$//g if $opt{w}; s/\s//g if $opt{W}; s/\W//g if $opt{n}; next if defined $opt{g} && !/$opt{g}/o; next if defined $opt{v} && /$opt{v}/o; if($opt{e}) { no strict; no warnings qw/exiting/; # so -e code can "next" to skip a record eval $opt{e}; die "$SELF: $@" if $@; } next if $opt{k} && (!defined || length == 0); $_ = "" unless defined $_; print render($_) . "\n" if $opt{C}; $counts{$_}++; $total++; } } die "$SELF: couldn't read any input files\n" unless $readfiles; # done reading & counting all input, show the results. if(!$opt{C}) { 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 { die "$SELF: invalid argument for -T\n"; } } my $maxval = 0; if($opt{H} || !$opt{P}) { for(keys %counts) { my $l = length(render($_)); $longest = $l if $longest < $l; $maxval = $counts{$_} if $counts{$_} > $maxval; } } my $histwidth; # TODO: parameterize if($opt{H}) { chomp($histwidth = int(($ENV{COLUMNS} || `tput cols 2>/dev/null` || 80) / 2)); } # do this instead of using sort { eval $sortcode } in the loop, # since eval is slow. my $sortsub = eval "sub " . $sortcode; for(sort { $sortsub->() } keys %counts) { (print_histogram($counts{$_}, $maxval, $histwidth), print $opt{o}) if $opt{H}; print (my $printable = render($_)); print " " x ($longest - length($printable)) unless $opt{P}; print $opt{o} . $counts{$_} unless $opt{p}; printf "$opt{o}%.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);