#!/usr/bin/perl -w
#<n32: numbers lines in base-32

use Getopt::Long;
use File::Basename;
use strict;

use subs qw(base32 manpage myuuid usage version where);

my $myname = basename($0);
$myname =~ s/\.\w*$//;   # strip any extension

my %options;
my @getopt_args = (
    'h|?',    # print usage
    'c=i',    # number of digits
    'd=s',    # delimiter (default is tab)
    'm',      # print manpage
    's=i',    # starting number
    'u',      # print UUID
    'v',      # print version
    'w',      # print source location
    );

Getopt::Long::config("noignorecase", "bundling");
usage unless GetOptions(\%options, @getopt_args);

manpage if $options{'m'};
myuuid  if $options{'u'};
version if $options{'v'};
where   if $options{'w'};
usage   if $options{'h'};

my $dnum  = $options{'c'} || 0;
my $delim = $options{'d'} || "\t";
my $start = $options{'s'} || 0;

while (<>) {
    $start++;
    print base32($start, $dnum), $delim, $_;
}

exit(0);

#---------------------------------------------------------------------
# Base-32 math.  Leave out letters that might look like digits.
#
sub base32 {
    use integer;
    my ($num, $precision) = @_;
    $precision = 0 unless defined($precision);

    my @digits = qw/0 1 2 3 4 5 6 7 8 9 a b c d e f
                    g h i j k m n p q r t u v w x y/;
    my $k;
    my $result = '';
    my $shift  = 5;
    my $mask   = 037;

    while ($num > 0) {
        $k      = $num & $mask;
        $result = $digits[$k] . $result;
        $num  >>= $shift;
        $precision--;
    }

    # leading zeroes?
    while ($precision > 0) {
        $result = '0' . $result;
        $precision--;
    }

    return ($result);
}

#---------------------------------------------------------------------
# Print a usage message from the comments and exit.

sub usage {
    my ($emsg) = @_;
    use Pod::Usage qw(pod2usage);
    warn "$emsg\n" if defined $emsg;
    pod2usage(-verbose => 99, -sections => "NAME|SYNOPSIS|OPTIONS");
}

sub manpage {
    my @args = ("perldoc", "$0");
    exec { $args[0] } @args;          # safe even with one-arg list
    die("should not get here\n");
}

#---------------------------------------------------------------------
# Print the UUID, current version, or source location.

sub myuuid {
    my $UUID = $1
        if q$UUID: 372b6914-ac94-38f3-bfaf-436203fc04bd $ =~ /UUID: (.*) /;
    print "$UUID\n";
    exit(0);
}

sub version {
    my $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
    my $DATE = $1 if q$Date: 2012-07-26 17:11:48-04 $ =~ /Date: (.*) /;
    print "$myname $VERSION $DATE\n";
    exit(0);
}

sub where {
    my $SOURCE = $1
        if q$Source: /home/vogelke/bin/RCS/n32,v $ =~
          /Source: (.*) /;
    my $HOST = $1 if q$Host: sys7.com $ =~ /Host: (.*) /;
    print "file://$HOST", "$SOURCE\n";
    exit(0);
}

#---------------------------------------------------------------------
__END__

=head1 NAME

n32 - numbers lines in base-32

=head1 SYNOPSIS

n32 [-c n] [-d ch] [-s n] [-hmuvw] [file ...]

=head1 OPTIONS

=over 4

=item B<-c> num

Number of digits to use for output (default is as many as needed).

=item B<-d> ch

Character to use for a field delimiter (default is tab).

=item B<-h>

Print a brief help message and exit.

=item B<-m>

Print the manual page and exit.

=item B<-s> num

Starting number (default is 1);

=item B<-u>

Print the script UUID and exit.

=item B<-v>

Print the version and exit.

=item B<-w>

Print the source location and exit.

=back

=head1 DESCRIPTION

B<n32> will read the given input file(s) and number them in base-32.

=head1 AUTHOR

 Karl Vogel <vogelke@pobox.com>
 Array Information Technology

=cut