AtomicSoft.com Add power to your website!
Home Products Services Support Free

Products
EasyData/SQL
easy-to-use web interface for SQL databases with countless features
AtomicDesk
help desk, FAQ, knowledge base, live support chat - all in one product

Services
Custom programming
Installation

Support
Documentation
HelpDesk

Free
Libraries

Mailing list
Join our newsletter for information on software updates and new releases. You may unsubscribe at any time.



Click here to download plain text source code.

# subroutine name: process_text
# Input: template text, reference to hash {tag_name=>tag_value}
# Processes string using an input template text and <!--$ANYTHING--> tag values hash.
# Supports also <!--%% "perl commands" %%--> tags.
# Usage example: process_text('I <!--$WORDTWO--> free scripts, do <!--$WORDONE-->?', {WORDONE => "you", WORDTWO => "like"});
#        Result: "I like free scripts, do you?"
sub process_text {
    local ($templatetext,$namespace) = @_;
    $templatetext =~ s/<\!--\%\%(.+?)\%\%-->/&evaluate($1)/egs;
    my @blocks = split(/(<!--if .*?-->|<!--else-->|<!--endif-->)/, $templatetext);
    my @stack=(); # format: ["true|false", "expression", "true string", "false (else) string"]
    my $result="";
    foreach my $block (@blocks) {
        if ($block =~ m/^<!--if (.*)-->$/s) {
            push (@stack, ["true", $1, "", ""]);
        } elsif ($block eq "<!--else-->") {
            if (scalar @stack > 0) {
                $stack[-1]->[0] = "false";
            } else {
                die "Nesting error: too many <!--else--> tags.";
            }
        } elsif ($block eq "<!--endif-->") {
            if (scalar @stack > 0) {
                my $expr = $stack[-1]->[1];
                my $r="";
                if ( &exec_expression($expr, $namespace) ) {
                    $r = $stack[-1]->[2];
                } else {
                    $r = $stack[-1]->[3];
                };
                pop(@stack);
                if (scalar @stack > 0) {
                    if ($stack[-1]->[0] eq "true") {
                        # Append result to "true" part of parent expression
                        $stack[-1]->[2] .= $r;
                    } else {
                        # Append result to "false" part of parent expression
                        $stack[-1]->[3] .= $r;
                    }
                } else {
                    $result .= $r;
                }
            } else {
                die "Nesting error: too many <!--endif--> tags.";
            }
        } else {
            # Text
            my $r = $block;
            if (scalar @stack > 0) {
                if ($stack[-1]->[0] eq "true") {
                    # Append result to "true" part of upper-level expression
                    $stack[-1]->[2] .= $r;
                } else {
                    # Append result to "false" part of upper-level expression
                    $stack[-1]->[3] .= $r;
                }
            } else {
                $result .= $r;
            }
        }
    }
    if (scalar @stack > 0) {
        die "Nesting error: too many <!--if ...--> tags.";
    } else {
        $templatetext = $result;
    }
    undef $result;
    
    # $templatetext =~ s/<!--if (.*?)-->(.*?)<!--endif-->/my ($expr,$yes)=($1,$2); my $no=""; if ($yes =~ m\/^(.*?)<!--else-->(.*)$\/s) {($yes,$no)=($1,$2)}; &exec_expression($expr, $namespace) ? $yes : $no /sge;
    $templatetext =~ s/<!--\$([A-Za-z\-_\.\d]+)-->/$namespace->{$1}/sg;
    $templatetext;
}

sub exec_expression {
    my ($expr, $namespace) = @_;
    my $original = $expr;
    my $perl_expr;
    while ($expr ne "") {
        $expr = " $expr";
        if ($expr =~ s/^\s*\$([A-Za-z\-_\.\d]+)//s) {
            $perl_expr.= "\$namespace->{'$1'}";
        } elsif ($expr =~ s/^\s*(==|!=|>=|>|<=|<>|<|=|\+|\-|\/|\*)//s) {
            if ($1 eq "<>") {
                $perl_expr.= "!=";
            } elsif ($1 eq "=") {
                $perl_expr.= "==";
            } else {
                $perl_expr.= $1;
            };
        } elsif ($expr =~ s/^\s+(eq|ne|le|lt|ge|gt)\s//si) {
            $perl_expr.= lc(" $1 ");
        } elsif ($expr =~ s/^\s+(and|\&\&)\s//si) {
            $perl_expr.= " && ";
        } elsif ($expr =~ s/^\s+(or|\|\|)\s//si) {
            $perl_expr.= " || ";
        } elsif ($expr =~ s/^\s+(not|!)\s//si) {
            $perl_expr.= " ! ";
        } elsif ($expr =~ s/^\s*"((?:\\"|\\\\|[^"])*)"//s) {
            my $str=$1;
            # unquote \ and "
            $str=~s/\\("|\\)/$1/gs;
            # quote ",\,@,$
            $str=~s/([\"\\\@\$])/\\$1/gs;
            $perl_expr.= " \"$str\" ";
        } elsif ($expr =~ s/^\s*(\d*\.?\d+)//s) {
            $perl_expr.= " $1 ";
        } elsif ($expr =~ s/^\s+$//s) {
            # end of expression
        } else {
            die "Can't parse expression: $original. Parser stopped at position: $expr";
        };
    };
    return evaluate($perl_expr, "ignore");
}
 
Copyright © 1999-2007 Atomicsoft Ltd. All Rights Reserved.