GSP
Quick Navigator

Search Site

Unix VPS
A - Starter
B - Basic
C - Preferred
D - Commercial
MPS - Dedicated
Previous VPSs
* Sign Up! *

Support
Contact Us
Online Help
Handbooks
Domain Status
Man Pages

FAQ
Virtual Servers
Pricing
Billing
Technical

Network
Facilities
Connectivity
Topology Map

Miscellaneous
Server Agreement
Year 2038
Credits
 

USA Flag

 

 

Man Pages


Manual Reference Pages  -  WML_P6_ASUBST (1)

.ds Aq ’ # # process command line # sub usage {
print STDERR Usage: asubst [options] [file]\n;
print STDERR \n;
print STDERR Options:\n;
print STDERR -o, --outputfile=<file> set output file instead of stdout\n;
print STDERR -v, --verbose verbose mode\n;
exit(1); } $opt_v = 0; $opt_o = ’-’; $Getopt::Long::bundling = 1; $Getopt::Long::getopt_compat = 0; if (not Getopt::Long::GetOptions(
v|verbose,
o|outputfile=s)) {
&usage; } sub verbose {
my ($str) = @_;
if ($opt_v) {
print STDERR ** ASubst:Verbose: $str\n;
} } sub error {
my ($str) = @_;
print STDERR ** ASubst:Error: $str\n;
exit(1); }

# # open input file and read into buffer # if (($#ARGV == 0 and $ARGV[0] eq ’-’) or $#ARGV == -1) {
$in = new IO::Handle;
$in->fdopen(fileno(STDIN), ’r’) || error(cannot load STDIN: $!);
local ($/) = undef;
$buffer = <$in>;
$in->close() || error(cannot close STDIN: $!); } elsif ($#ARGV == 0) {
$in = new IO::File;
$in->open($ARGV[0]) || error(cannot load $ARGV[0]: $!);
local ($/) = undef;
$buffer = <$in>;
$in->close() || error(cannot close $ARGV[0]: $!); } else {
&usage; }

# # processing loop #

# ExpandBlock — expand a delimited and perhaps nested block structure # # ($rc, $buffer) = ExpandBlock($buffer, \&cnvpre, $startdel, \&cnvin, $enddel, \&cnvpost, $level); # sub ExpandBlock {
return &ExpandBlockMore(@_); }

# This subvariant is used to split the input into # segments which only contain one block, but this # itself can be still nested. # input: ... < < > > ... < > < < > < > > ... # inputs for ExpandBlockOne: ... < < > > ..., < >, < < > < > > ..., # ... # sub ExpandBlockMore {
local ($buffer, $cnvpre, $opendel, $cnvin, $closedel, $cnvpost, $level) = @_;
local ($rc, $opened, $offset, @segment, $del, $openidx, $closeidx);
local ($bufferN, $s, $e, $i, $data);



    #
    #   first, check for corresponding delimiters
    #   and determine (nested) block segment positions
    #
    $opened = 0;
    $offset = 0;
    @segment = (0);
    while (1) {
        $openidx  = index($buffer, $opendel,  $offset);
        $closeidx = index($buffer, $closedel, $offset);
        &Dbg(1, "buffer=<>, off=$offset, o=$openidx, c=$closeidx\n");
        if ($openidx == -1 && $closeidx == -1) {
            #   both not found, stop now
            push(@segment, length($buffer));
            last;
        }
        if ($openidx != -1 && $closeidx != -1) {
            #   both found, take closer one
            ($offset, $del, $opened) = ($openidx < $closeidx ?
                ($openidx, $opendel, $opened+1) :
                ($closeidx, $closedel, $opened-1) );
        }
        else {
            #   one not found, take other one
            ($offset, $del, $opened) = ($openidx != -1 ?
                ($openidx, $opendel, $opened+1) :
                ($closeidx, $closedel, $opened-1) );
        }
        $offset = $offset+length($del);
        #   still reached a complete segment
        if ($opened == 0) {
            push(@segment, $offset);
        }
    }
    if ($opened != 0) {
        return (1, "invalid number of opening and closing delimiters");
    }

    #
    #   now process each segment
    #
    $bufferN = ;
    for ($i = 0; $i < $#segment; ) {
        $s = $segment[$i];
        $e = $segment[$i+1];
        $i++;
        $data = substr($buffer, $s, ($e-$s));
        ($rc, $data) = &ExpandBlockOne($data, $cnvpre, $opendel, $cnvin, $closedel, $cnvpost, $level);
        if ($rc != 0) {
            return ($rc, $data);
        }
        $bufferN .= $data;
    }

    return (0, $bufferN);
}



# This subvariant operates only on a buffer which # contains one block (which can be still nested). # input: ... < < > > ... # sub ExpandBlockOne {
local ($buffer, $cnvpre, $startdel, $cnvin, $enddel, $cnvpost, $level) = @_;
local ($openidx, $closeidx, $prefix, $postfix, $inner, $rc, $data);



    $openidx  =  index($buffer,  $opendel);
    $closeidx = rindex($buffer, $closedel);
    #   either both exist or both not exist
    if ($openidx == -1 && $closeidx == -1) {
        if ($level == 0) {
            $data = &$cnvpre($buffer, $level); # could also be cnvpost..
        }
        else {
            $data = $buffer;
        }
        return (0, $data);
    }
    else {
        #   convert prefix
        $prefix  = &$cnvpre(substr($buffer, 0, $openidx), $level);
        Dbg($level, "ExpandBlockOne::prefix", $prefix);

        #   recursive into the body
        $inner = substr($buffer, $openidx+length($opendel), $closeidx-($openidx+length($opendel)));
        Dbg($level, "ExpandBlockOne::inner", $inner);
        ($rc, $inner) = &ExpandBlockMore($inner, $cnvpre, $opendel, $cnvin, $closedel, $cnvpost, $level+1);
        Dbg($level, "ExpandBlockOne::inner", $inner);
        $inner = &$cnvin($inner, $level+1);
        Dbg($level, "ExpandBlockOne::inner", $inner);

        #   convert postfix
        $postfix = &$cnvpost(substr($buffer, $closeidx+length($closedel), length($buffer)-($closeidx+length($closedel))), $level);
        Dbg($level, "ExpandBlockOne::postfix", $postfix);

        return ($rc, $prefix . $inner . $postfix);
    }
}



$debug = 0;

# A debugging function sub Dbg {
my ($level, $name, $str) = @_;
my (@o, $l);



    return if ($debug == 0);
    push(@o, "    " x $level . "### $name =\n");
    if ($str eq ) {
        push(@o, "    " x $level . "    ||\n");
    }
    else {
        foreach $l (split(\n, $str)) {
            push(@o, "    " x $level . "    |$l|\n");
        }
    }
    print STDERR @o;
}



sub cnvpre {
my ($str, $level) = @_;



    return  if $str eq ;
    return $str;
}
sub cnvin {
    my ($str, $level) = @_;

    return  if $str eq ;

    @SCMD = ();
    $str =~ s|\[\[(s(.)[^\2]+?\2[^\2]*?\2[igosme]*?)\]\]|push(@SCMD, $1), |sge;
    $str =~ s|\[\[(tr(.)[^\2]+?\2[^\2]+?\2[igosme]*?)\]\]|push(@SCMD, $1), |sge;
    foreach $scmd (@SCMD) {
        eval "\$str =~ $scmd;";
    }
    return $str;
}
sub cnvpost {
    my ($str, $level) = @_;

    return  if $str eq ;
    return $str;
}



if (index($buffer, ’{:’) != -1) {
($rc, $buffer) = ExpandBlock($buffer, \&cnvpre, ’{:’, \&cnvin, ’:}’, \&cnvpost, 0); }

if ($rc) {
print STDERR aSubst:Error: $buffer\n;
exit(1); }

# # write to output file # if ($opt_o eq ’-’) {
$out = new IO::Handle;
$out->fdopen(fileno(STDOUT), ’w’) || error(cannot write into STDOUT: $!); } else {
$out = new IO::File;
$out->open(>$opt_o) || error(cannot write into $opt_o: $!); } $out->print($buffer) || error(cannot write into $opt_o: $!); $out->close() || error(cannot close $opt_o: $!);

exit(0);

##EOF## __END__

NAME

asubst - Area Substitution

CONTENTS

SYNOPSIS

asubst [-o outputfile] [-v] [inputfile]

DESCRIPTION

The asubst program reads inputfile or from stdin and performs the following action: Characters and substrings are substituted according to Perl-like substitution commands enclosed by surrounding area delimiters. The substitution commands recognized are



   [[s/pattern/string/options]]
   [[tr/input/output/options]]



and the areas are defined by blocks delimited via



  {: ... :}



EXAMPLE



  {: [[s/ae/ä/]] [[s/ue/ü/]]
  Foo Bar Baz Quux with Umlauts ae and ue
  :}



OPTIONS

-o outputfile This redirects the output to outputfile. Usually the output will be send to stdout if no such option is specified or outputfile is "-".
-v This sets verbose mode where some processing information will be given on the console.

AUTHOR



 Ralf S. Engelschall
 rse@engelschall.com
 www.engelschall.com



Search for    or go to Top of page |  Section 1 |  Main Index


EN Tools ASUBST (1) 2016-04-03

Powered by GSP Visit the GSP FreeBSD Man Page Interface.
Output converted with manServer 1.07.