rewrite macro parser, improving speed and making parameter parsing more sane

docs/changelog/7.x.x.txt

@@ -1,4 +1,5 @@
 7.6.0
+ - rewrite macro parser, improving speed and making parameter parsing more sane
  - Made the charset metatag the highest thing in the head block.
  - fixed: AssetProxy allows proxying content in the trash or clipboard
  - fixed: Textarea resizer has a gap between textbox and resizer initially

lib/WebGUI/Macro.pm

@@ -14,8 +14,8 @@ package WebGUI::Macro;
 
 =cut
 
-
 use strict;
+use warnings;
 use WebGUI::Pluggable;
 
 =head1 NAME
@@ -42,28 +42,24 @@ These functions are available from this package:
 
 =cut
 
-my $parenthesis;
-$parenthesis = qr /\(                      # Start with '(',
-                     (?:                     # Followed by
-                     (?>[^()]+)              # Non-parenthesis
-                     |(??{ $parenthesis })   # Or a balanced parenthesis block
-                     )*                      # zero or more times
-                     \)/x;                  # Ending with ')'
-
-my $nestedMacro;
-$nestedMacro = qr /(\^                     # Start with carat
-                     ([^\^;()]+)            # And one or more none-macro characters -tagged-
-                     ((?:                   # Followed by
-                     (??{ $parenthesis })   # a balanced parenthesis block
-                     |(?>[^\^;])            # Or not a carat or semicolon
-#                    |(??{ $nestedMacro }) # Or a balanced carat-semicolon block
-                     )*)                    # zero or more times -tagged-
-                     ;)/x;                   # End with  a semicolon.
-
-
-
-
 #-------------------------------------------------------------------
+my $parenthesis;
+$parenthesis = qr{
+    \(                      # Start with '(',
+    (?:                     # Followed by
+        (?>[^()]+)              # Non-parenthesis
+    |                       # or
+        (??{ $parenthesis })    # a balanced parenthesis block
+    )*                      # zero or more times
+    \)                      # Ending with ')'
+}x;
+
+my $macro_re = qr{
+    (\^                     # Start with carat
+    ([-a-zA-Z0-9_@#/*]{1,64})   # And one or more non-macro characters -tagged-
+    ((??{ $parenthesis })?) # a balanced parenthesis block
+    ;)                      # End with a semicolon.
+}msx;
 
 =head2 filter ( html )
 
@@ -76,10 +72,8 @@ The segment to be filtered as a scalar reference.
 =cut
 
 sub filter {
-	my $content = shift;
+    my $content = shift;
-        while ($$content =~ /($nestedMacro)/gs) {
+    ${ $content } =~ s/$macro_re//g;
-		$$content =~ s/\Q$1//gs;
-	}
 }
 
 
@@ -96,8 +90,8 @@ A scalar reference of HTML to be processed.
 =cut
 
 sub negate {
-	my $html = shift;
+    my $html = shift;
-	$$html =~ s/\^/\&\#94\;/g;
+    ${ $html } =~ s/\^/^/g;
 }
 
 
@@ -117,39 +111,81 @@ A scalar reference of HTML to be processed.
 
 =cut
 
+
 sub process {
     my $session = shift;
-   	my $content = shift;
+    my $content = shift;
-   	while ($$content =~ /$nestedMacro/gs) {
+    our $macrodepth ||= 0;
-        my ($macro, $searchString, $params) = ($1, $2, $3);
+    local $macrodepth = $macrodepth + 1;
-      	next if ($searchString =~ /^\d+$/); # don't process ^0; ^1; ^2; etc.
+    ${ $content } =~ s{$macro_re}{
-      	next if ($searchString =~ /^\-$/); # don't process ^-;
+        if ( $macrodepth > 64 ) {
-		if ($params ne "") {
+            $session->errorHandler->error($2 . " : Too many levels of macro recursion.  Stopping.");
-      		$params =~ s/(^\(|\)$)//g; # remove parenthesis
+            "Too many levels of macro recursion. Stopping.";
-      		&process($session,\$params); # recursive process params
+        }
-		}
+        else {
-		my $macros = $session->config->get("macros");
+            my $replaceText = processMacro($session, $2, $3);
-		if ($macros->{$searchString} ne "") {
+            defined $replaceText ? $replaceText : $1;           # processMacro returns undef on failure, use original text
-		    my @param;
+        }
-        	push(@param, $+) while $params =~ m {
+    }ge;
-               		"([^\"\\]*(?:\\.[^\"\\]*)*)",?
+}
-               		|       ([^,]+),?
+
-               		|       ,
+sub processMacro {
-        		}gx;
+    my $session = shift;
-        	push(@param, undef) if substr($params,-1,1) eq ',';
+    my $macroname = shift;
-            my $result = eval { WebGUI::Pluggable::run("WebGUI::Macro::".$macros->{$searchString}, "process", [ $session, @param ] ) };
+    my $parameters = shift;
-            if ( $@ ) {
+    if ($macroname =~ /^[-0-9]$/) {    # ^0; ^1; ^2; and ^-; have special uses, don't replace
-                $session->errorHandler->error($@);
+        return;
-            }
+    }
-            else {
+    my $macrofile = $session->config->get("macros")->{$macroname};
-				if ($result =~ /\Q$macro/) {
+    if (!$macrofile) {
-                    $result = "Endless macro loop detected. Stopping recursion.";
+        $session->errorHandler->error("No macro with name $macroname defined.");
-					$session->errorHandler->error($macro." : ".$result);
+        return;
-                }
+    }
-				$$content =~ s/\Q$macro/$result/ges;
+    my $macropackage = "WebGUI::Macro::$macrofile";
-			}
+    if (! eval { WebGUI::Pluggable::load($macropackage) } ) {
-		}
+        $session->log->error($@);
-   	}
+        return;
+    }
+    my $process = $macropackage->can('process');
+    if (!$process) {
+        $session->log->error("Macro has no process sub: $macropackage.");
+        return;
+    }
+    $parameters =~ s/^\(//;
+    $parameters =~ s/\)$//;
+
+    # there are two possible matches and only one will ever match at a time, so we filter out the undef ones
+    my @params = grep { defined $_ } ($parameters =~ /
+        (?<!\z)                             # don't try to match if we are at the end of the string
+        (?:                                 # either
+            \s* "                               # white space followed by quotes
+            ( (?:                               # capture inside
+                [^"\\]                              # something other than a quote or backslash
+            |                                   # or
+                \\.                                 # a backslash followed by any character
+            ) * )                               # as many times as needed
+            " \s*                               # end quote and any white space
+        |                                   # or
+            ([^,]*)                         # anything but a comma
+        )
+        (?:                                 # followed by
+            \z                                  # end of the string
+        |                                   # or
+            ,                                   # a comma
+        )
+    /xg);
+    for my $param (@params) {
+        $param =~ s/\\(.)/$1/xmsg;      # deal with backslash escapes
+        process($session, \$param)
+            if ($param);                # process any macros
+    }
+    my $output;
+    unless ( eval { $output = $process->($session, @params); 1 } ) {         # call process sub with parameters
+        $session->log->error("Unable to process macro '$macroname': $@");
+        return;
+    }
+    process($session, \$output);                                            # also need to process macros on output
+    return $output;
 }
 
 1;

t/Macro.t

@@ -17,6 +17,9 @@ use WebGUI::Session;
 
 use WebGUI::Macro;
 use WebGUI::Asset;
+use WebGUI::Macro;
+use WebGUI::HTML;
+use Tie::IxHash;
 
 use Test::More; # increment this value for each test you create
 
@@ -32,17 +35,21 @@ $session->user({user => $registeredUser});
 
 my %originalMacros = %{ $session->config->get('macros') };
 ##Overwrite any local configuration so that we know how to call it.
-foreach my $macro (qw/GroupText LoginToggle PageTitle/) {
+foreach my $macro (qw/GroupText LoginToggle PageTitle MacroStart MacroEnd MacroNest ReverseParams InfiniteMacro VisualMacro/) {
 	$session->config->addToHash('macros', $macro, $macro);
 }
+$session->config->addToHash('macros', "Ex'tras", "Extras");
 
-plan tests => 10;
+plan 'no_plan'; #tests => 10;
 
 my $macroText = "CompanyName: ^c;";
+my $companyName = $session->setting->get('companyName');
+WebGUI::HTML::makeParameterSafe( \$companyName );
+
 WebGUI::Macro::process($session, \$macroText),
 is(
 	$macroText,
-	"CompanyName: ".$session->setting->get('companyName'),
+	"CompanyName: $companyName",
 	"c_companyName Macro in text processed okay"
 );
 
@@ -66,7 +73,7 @@ my $macroText = q|GroupText(Registered Users, example: c/CompanyName Macro) : ^G
 WebGUI::Macro::process($session, \$macroText),
 is(
 	$macroText,
-	"GroupText(Registered Users, example: c/CompanyName Macro) : example: ".$session->setting->get('companyName'),
+	"GroupText(Registered Users, example: c/CompanyName Macro) : example: $companyName",
 	"GroupText Macro with nested c_companyName macro"
 );
 
@@ -136,8 +143,102 @@ my $macroText = <<'EOF'
 EOF
 ;
 
-WebGUI::Macro::process($session, \$macroText);
+my $macroTextOut = $macroText;
-is ($macroText, $macroText, "Impossibly ugly, invalid macro fails to process and fails to kill WebGUI");
+WebGUI::Macro::process($session, \$macroTextOut);
+is ($macroTextOut, $macroText, "Impossibly ugly, invalid macro fails to process and fails to kill WebGUI");
+
+
+
+my $macroText = q|^GroupText("Registered Users","Commas ',' work?");|;
+WebGUI::Macro::process($session, \$macroText),
+is(
+	$macroText,
+	"Commas ',' work?",
+	"GroupText Macro with quoted comma"
+);
+
+my $macroText = qq|^ReverseParams(1,"here's a quote: \\"",2);|;
+WebGUI::Macro::process($session, \$macroText),
+is(
+	$macroText,
+	"2here's a quote: \"1",
+	"Escaped double quotes work properly"
+);
+
+my $macroText = q|^MacroNest();|;
+WebGUI::Macro::process($session, \$macroText),
+is(
+	$macroText,
+	"/extras/",
+	"Nested macro evaluates results to extras",
+);
+
+my $macroText = q|^MacroStart;^MacroEnd;|;
+WebGUI::Macro::process($session, \$macroText),
+is(
+	$macroText,
+	"^MacroNest();",
+	"Combined macro calls don't get evaluated",
+);
+
+my $macroText = q|^InfiniteMacro;|;
+WebGUI::Macro::process($session, \$macroText),
+is(
+	$macroText,
+	"Too many levels of macro recursion. Stopping.",
+	"Infinite recursion gets broken",
+);
+
+my $macroText = qq|^ReverseParams(1,"carriage returns\npass through as needed",2);|;
+WebGUI::Macro::process($session, \$macroText),
+is(
+	$macroText,
+	"2carriage returns\npass through as needed1",
+	"Carriage returns pass through as needed."
+);
+
+tie my %quotingEdges, 'Tie::IxHash';
+%quotingEdges = (
+    '^VisualMacro(text);'                           => '@MacroCall[`text`]:',
+    '^VisualMacro(^VisualMacro("something);");'     => '@MacroCall[`@MacroCall[`"something`]:"`]:',
+    '^VisualMacro("^VisualMacro("something););'     => '@MacroCall[`"@MacroCall[`"something`]:`]:',
+    '^VisualMacro("^VisualMacro(something"););'     => '@MacroCall[`"@MacroCall[`something"`]:`]:',
+    '^VisualMacro^VisualMacro(this);;'              => '^VisualMacro@MacroCall[`this`]:;',
+    '^VisualMacro(^VisualMacro);'                   => '@MacroCall[`^VisualMacro`]:',
+    '^VisualMacro(^VisualMacro(this));'             => '@MacroCall[`^VisualMacro(this)`]:',
+);
+my $index = 0;
+while (my ($inText, $outText) = each %quotingEdges) {
+    my $procText = $inText;
+    WebGUI::Macro::process($session, \$procText),
+    is(
+        $procText,
+        $outText,
+        "Nesting edge case: $inText",
+    );
+}
+
+tie my %invalidCalls, 'Tie::IxHash';
+%invalidCalls = (
+    '^;'                                            => '^;',
+    '^();'                                          => '^();',
+    '^MacroThatDoesntExist;'                        => '^MacroThatDoesntExist;',
+    "^Ex'tras;"                                     => "^Ex'tras;",
+    '^Extras(;'                                     => '^Extras(;',
+    '^Extras);'                                     => '^Extras);',
+    '^Extras(;)'                                    => '^Extras(;)',
+);
+my $index = 0;
+while (my ($inText, $outText) = each %invalidCalls) {
+    my $procText = $inText;
+    WebGUI::Macro::process($session, \$procText),
+    is(
+        $procText,
+        $outText,
+        "Invalid macro call: $inText",
+    );
+}
+
 
 END {
 	$session->config->set('macros', \%originalMacros);

t/lib/WebGUI/Macro/InfiniteMacro.pm

@@ -0,0 +1,28 @@
+package WebGUI::Macro::InfiniteMacro;
+
+use strict;
+use warnings;
+
+sub process {
+    my $session = shift;
+    my $slow = shift;
+    if ($slow) {
+        my $rand = int(rand(10000));
+        return <<END;
+^InfiniteMacro(^dfkgjhdfgk();dssdfsdfawilygth4 wu gbzwilrstg 
+sdfgdsfg
+r7ilsgg hbawl
+dsfgsdfgiegvgv
+dfggvac
+"sdaf${rand}gsdfgdsfg"
+w3avvbfielysv iw4yvg silyrgvb iyzrsv bilw4u bgizs4rv,
+"efgkhgsdfges.rkdjgdskjghsalkgh\\"\\"\\"sag"       );';
+END
+    }
+    else {
+        return '^InfiniteMacro();';
+    }
+}
+
+1;
+

t/lib/WebGUI/Macro/MacroEnd.pm

@@ -0,0 +1,12 @@
+package WebGUI::Macro::MacroEnd;
+
+use strict;
+use warnings;
+
+sub process {
+    my $session = shift;
+    return "Nest();";
+}
+
+1;
+

t/lib/WebGUI/Macro/MacroNest.pm

@@ -0,0 +1,12 @@
+package WebGUI::Macro::MacroNest;
+
+use strict;
+use warnings;
+
+sub process {
+    my $session = shift;
+    return "^Extras;";
+}
+
+1;
+

t/lib/WebGUI/Macro/MacroStart.pm

@@ -0,0 +1,12 @@
+package WebGUI::Macro::MacroStart;
+
+use strict;
+use warnings;
+
+sub process {
+    my $session = shift;
+    return "^Macro";
+}
+
+1;
+

t/lib/WebGUI/Macro/ReverseParams.pm

@@ -0,0 +1,12 @@
+package WebGUI::Macro::ReverseParams;
+
+use strict;
+use warnings;
+
+sub process {
+    my $session = shift;
+    return join '', reverse @_;
+}
+
+1;
+

t/lib/WebGUI/Macro/VisualMacro.pm

@@ -0,0 +1,14 @@
+package WebGUI::Macro::VisualMacro;
+
+use strict;
+use warnings;
+
+sub process {
+    my $session = shift;
+    my @params = @_;
+    $_ = "`$_`" for @params;
+    return "\@MacroCall[" . join('.', @params) . "]:";
+}
+
+1;
+