Viikon pähkinä

[Jarkko Hietaniemi]

Jarkko Hietaniemi writes:
 > 
 > Testailen lisää: subscribe unsubscribe subscribe unsubscribe

No nyt ilmeisesti 'sub' peikko manattu pois.  Majordomon oletus
asetus on tosiaan heittää kaikki (un)?subscribe-viesteiltä haiskahtava
listan administraattorille, onpas "hieno" piirre...

[takaisin aiheeseen "Viikon pähkinä"]

Eli: ei nyt aivan täsmälleen mitä haluttiin, mutta tässä olisi ihan
oikea jäsennin.  Tarkalleen ottaen tämä muuntaa lausekkeen

	foo and bar or zap or not goo

lausekkeeksi

	/foo/ && /bar/ || /zap/ || ! /goo/

siinä sivussa tarkistaen myös lausekkeen oikeellisuuden.

sub literal    ($);
sub emit       ($;$);
sub expression ();
sub error      ($);
sub parse      (); 

my $emit;  # The output accumulator.
my $error; # The error message.

parse;     # Do it.

exit 0;    # Quit.

sub literal ($) {
    my $lit = $_[0];	# The literal string to be consumed.
    return s/^\s*\Q$lit\E\b\s*//;
}

sub emit ($;$) { # Consume input and (or just) emit output.
    unless ( $error ) {
        if ( @_ == 2 ) {
            my ( $in, $out ) = ( literal( $_[0] ), $_[1] );
            $emit .= $out if $in;
            return $in;
        } else {
            $emit .= $_[0]; # Just $out.
        }
    }
}

sub expression () {
    do {
        do {
            if ( literal '(' ) {
                emit '( ';
                expression;
                error 'missing )' unless literal ')';
                emit ' )';
            } elsif ( literal 'not' ) {
                error 'empty negation' if $_ eq '';
                emit '! ';
                expression;
            } else {
                if ( s/^\s*(\S+)\s*// || s/^\s*"(\S+?)"\s*// ) {
                    my $word = $1;
                    if ( $word =~ /^(not|and|or)$/ ) {
                        error "word '$word' cannot be a search word";
                    } else {
                        emit "/$word/i";
                    }
                }
            }
        } while emit 'and', ' && ';
    } while emit 'or', ' || ';
}

sub error ($) {
    my $msg = $_[0];
    $error = "$msg: $_" if $error eq '';
}

sub parse () {
    while ( <STDIN> ) {
        chomp;
        $emit = $error = '';
        expression;
        error 'illegal input' if $_ ne '';
        if ( $error eq '' ) {
            print "$emit\n";
        } else {
            warn "parse error: $error\n";
        }
    }
}

(eräät saavat tämä jo kolmanteen kertaan :-)

-- 
$jhi++; # http://www.iki.fi/jhi/
        # There is this special biologist word we use for 'stable'.
        # It is 'dead'. -- Jack Cohen