#!/usr/bin/env perl
# Transform text from stdin to stdout by resolving alternatives.
#
# Alternatives directive is of the form:
#
#   <alt-indicator>~/foo/bar/.../~
#
# where <alt-indicator> is by default @: or is given by command line,
# and instead of ~ and / any single characters can be used consistently.
#
# The alternative to take is given by index in the command line (indexing
# is 0 based). If index is out of range, the error is signaled and input
# processing stops, without writing anything out.
#
# Input text must be UTF-8 encoded, and output is too.
#
# Chusslove Illich <caslav.ilic@gmx.net>
# Last change: $Date$
# (first use May 28th, 2007.)

use strict;
use warnings;

binmode(STDIN, ":utf8");
binmode(STDOUT, ":utf8");

$0 =~ s/.*\///;
sub error { die "$0: @_\n"; }

sub show_usage {
    die "Usage: $0 <alt-index> [<alt-indicator>]\n";
}

@ARGV >= 1 and @ARGV <= 2 or show_usage();
my $altind = shift @ARGV;
my $altdir = @ARGV ? shift @ARGV : '@:';
$altdir = escaperx($altdir);

my $inalt = 0; # indicates if we are inside or outside of directive
my $altend; # alternatives end delimiter in a directive
my $altsep; # alternatives separator in a directive
my @alts; # list of alternatives
my $out; # collective output string

# Process input and collect output string.
for (<STDIN>) {
    while ($_) {
        if (not $inalt) { # we're outside directive
            if (s/(.*?)$altdir//) { # found directive
                $out .= $1; # output preceeding part of the line
                $inalt = 1; # indicate we're now inside directive
                $altsep = ""; # clear separator
                $altend = ""; # clear end delimiter
            }
            else { # no directive
                $out .= $_; # just pass rest to output
                $_ = "";
            }
        }

        if ($inalt) { # we're inside the directive
            if ($altsep eq "") { # alternatives separator/end not yet determined
                length($_) >= 2 or error "Malformed directive in line $.";
                # Take first and second character as end and separator.
                s/(.)(.)//;
                ($altend, $altsep) = (escaperx($1), escaperx($2));
                @alts = (""); # initialize list of alternatives
            }

            # Take as many alternatives as present in current line.
            # First is continued from previous line (or just starts).
            my @calts;
            my $ended = 0;
            while (s/(.*?)($altsep$altend?)//) {
                push @calts, $1;
                $ended = $2 =~ /$altend$/; # check if directive ended
                last if $ended; # stop loop if directive ended
            }

            if (@calts) { # at least one separator found
                $alts[-1] .= shift @calts; # add first to current alternative
                push @alts, @calts; # add rest as new alternatives

                if ($ended) { # we reached directive end
                    $inalt = 0; # indicate we're now outside directive
                    # Assure the indexed alternative exists.
                    $altind >= -@alts and $altind < @alts
                        or error "Alternative index out of range in line $.";
                    $out .= $alts[$altind]; # output chosen alternative
                }
            }
            else { # no separators, whole line is part of current alternative
                $alts[-1] .= $_;
                $_ = "";
            }
        }
    }
}
# Print output.
print $out;

# Returns string escaped for interpolation into regex (more or less...)
sub escaperx {
    my ($str) = @_;
    $str =~ s/([\/\$\@\?\(\)\[\]\{\}])/\\$1/g;
    return $str;
}
