#!/usr/bin/perl

=begin metadata

Name: tr
Description: translate or delete characters
Author: Tom Christiansen, tchrist@perl.com
License: perl

=end metadata

=cut

use strict;

use File::Basename qw(basename);
use Getopt::Std qw(getopts);

use constant EX_SUCCESS => 0;
use constant EX_FAILURE => 1;

my $Program = basename($0);

my(
    %opt,           # option hash
    $string1,	    # from set
    $string2,       # to set
);

sub usage {
    warn "usage: $Program [-Ccds] string1 string2\n";
    exit EX_FAILURE;
}

getopts('Ccds', \%opt) or usage();
my $narg = ($opt{'d'} && !$opt{'s'}) ? 1 : 2;
if (scalar(@ARGV) < $narg) {
    warn "missing operand\n";
    usage();
}
if (scalar(@ARGV) > $narg) {
    warn "extra operand\n";
    usage();
}

# remove spurious [...]
for (($string1, $string2) = splice(@ARGV, 0, 2)) {
    s/^\[(.*?)\]$/$1/;
}

# this is in an eval because tr/// needs to
# see its parts at compile time
my $cflag = ($opt{'C'} || $opt{'c'}) ? 'c' : '';
my $dflag = $opt{'d'} ? 'd' : '';
my $sflag = $opt{'s'} ? 's' : '';
eval qq{
    while (<STDIN>) {
	tr[$string1][$string2]$cflag$dflag$sflag;
	print;
    }
    1;
} or do {
    warn "$Program: $@\n";
    exit EX_FAILURE;
};
exit EX_SUCCESS;

__END__

=head1 NAME

tr - translate or delete characters

=head1 SYNOPSIS

tr [ -Ccds ] [ I<SEARCHLIST> [ I<REPLACEMENTLIST> ] ]

=head1 DESCRIPTION

The I<tr> program copies the standard input to the standard output
with substitution or deletion of selected characters.  Input characters
found in I<SEARCHLIST> are mapped into the corresponding characters of
I<REPLACEMENTLIST>. When I<REPLACEMENTLIST> is short it is padded to
the length of I<SEARCHLIST> by duplicating its last character.

Here are the options:

=over

=item -C

Complement the SEARCHLIST.

=item -c

The same as -C.

=item -d

Delete found but unreplaced characters.

=item -s

Squash duplicate replaced characters.

=back

In either string, the notation C<a-b> means a range of characters from
C<a> to C<b> in increasing ASCII order. Customary Perl escapes are
honored, such as C<\n> for newline, C<\012> for octal, and C<\x0A>
for hexadecimal codes.

If the B<-c> flag is specified, the SEARCHLIST character set is
complemented.  If the B<-d> flag is specified, any characters specified
by SEARCHLIST not found in REPLACEMENTLIST are deleted.  (Note that
this is slightly more flexible than the behavior of some tr programs,
which delete anything they find in the SEARCHLIST, period.)  If the B<-s>
flag is specified, sequences of characters that were transliterated to the
same character are squashed down to a single instance of the character.

If the B<-d> flag is used, the REPLACEMENTLIST is always interpreted
exactly as specified.  Otherwise, if the REPLACEMENTLIST is shorter
than the SEARCHLIST, the final character is replicated till it is long
enough.  If the REPLACEMENTLIST is empty, the SEARCHLIST is replicated.
This latter is useful for counting characters in a class or for squashing
character sequences in a class.

=head1 EXAMPLES

The following command creates a list of all the words in F<file1>
one per line in F<file2>, where a word is taken to be a maximal string
of alphabetics.

    tr -cs A-Za-z "\n" <file1 >file2

The following command strips the 8th bit from an input file:

    tr "\200-\377" "\000-\177"

=head1 NOTE

This command is implemented using Perl's C<tr> operator.
See the documentation in L<perlop> for details on its
operation.

=head1 BUGS

I<tr> has no known bugs.

=head1 AUTHOR

Tom Christiansen, I<tchrist@perl.com>.

=head1 COPYRIGHT and LICENSE

This program is copyright (c) Tom Christiansen 1999.

This program is free and open software. You may use, modify, distribute,
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.