Add static template insert,

add debug test,
update description

diff --git a/configure.pl b/configure.pl
index 499419f455c51c3d5864accf0c2a77a9a9b794ff..40ec789c4559c61bd3370b9dceb77dcc9bb3b51b 100755 (executable)
--- a/configure.pl
+++ b/configure.pl
@@ -129,7 +129,7 @@
 #
 # It is possible to use a value as a function pattern:
 #   s1: $0 = "$1"
-#   s2 = $s1(a,b)
+#   s2 = @s1(a,b)
 # In this example the value of s2 is: 'a = "b"'.
 # Here names made entirely from digits are used as the parameters of the 
 # function pattern and should not be used for other purposes. Possible but
@@ -139,7 +139,7 @@
 # If not provided, the parameters will be treated as empty string.
 # So here:
 #   s1: $0 = "$1"
-#   s2 = $s1(a)
+#   s2 = @s1(a)
 # the value of s2 is: 'a = ""'.
 #
 # Even though $0 and $1 were not processed when s1 was defined, they
@@ -147,26 +147,26 @@
 #
 # In this example:
 #   s1 = $0 = "$1"
-#   s2 = $s1(a,b)
+#   s2 = @s1(a,b)
 # s1 will be immediately evaluated to ' = ""', and s2 will also become
 # ' = ""'.
 #
-# Escaping will protece $0 and $2 to be processed too early:
+# Escaping will protect $0 and $2 to be processed too early:
 #   s1 = \$0 = "\$1"
-#   s2 = $s1(a,b)
+#   s2 = @s1(a,b)
 # Here the value of s1 is '$0 = "$1"' again.
 #
 # The pattern function calls can be nested:
 #   s1: >$0<
 #   s2: <$0>
-#   s3 = $s2($s1(1))
+#   s3 = @s2(@s1(1))
 # In this example this is how it will be processed:
-#   processing s3, '$s2($s1(1))'
-#   found call to s2 with parameters '($s1(1))'
-#     processing s2, '<$0>', '($s1(1))'
-#       processing parameters '($s1(1))'
-#       found parameter '$s1(1)'
-#         processing '$s1(1)'
+#   processing s3, '@s2(@s1(1))'
+#   found call to s2 with parameters '(@s1(1))'
+#     processing s2, '<$0>', '(@s1(1))'
+#       processing parameters '(@s1(1))'
+#       found parameter '@s1(1)'
+#         processing '@s1(1)'
 #         found call to s1 with parameters '(1)'
 #           processing s1, '>$0<', '(1)'
 #             processing parameters '(1)'
@@ -199,6 +199,8 @@
 # base value) and the $0, etc. are replaced by the (already processed)
 # parameters.
 #
+# The parameter list is used for '@name' and '$name' even if '$' doesn't
+# take any parameters.
 # Empty parameter list can be useful for separating from text afterwards:
 #   s1: 456
 #   s2 = 123$s1()789
@@ -218,6 +220,13 @@
 # Here the value of s2 is: '(123)456' because '789' was given to s1
 # as $0 and ignored.
 #
+# Function patterns can also be given as parameters.
+# Example:
+#   s1: @0($1,$2)
+#   s2: ($0)_($1)
+#   s3 = s1($s2, a, b)
+# Here the value of s3 is '(a)_(b)'.
+#
 # There are special functions and values:
 #   $_ESCAPE is a function which will escape some characters with '\'.
 #     $0 - the text to be escaped
@@ -330,8 +339,9 @@ use constant ESCAPE     => '_ESCAPE';
 use constant URL_ENCODE => '_URL_ENCODE';
 use constant PATH       => '_PATH';
 use constant SPRINTF    => '_SPRINTF';
-use constant DEBUG      => '_DEBUG';
-use constant DEBUG_ALL  => '_DEBUG_ALL';
+use constant DEBUG      => '_LIST';
+use constant DEBUG_ALL  => '_LIST_ALL';
+use constant DEBUG_TEXT => '_DEBUG';
 
 # TODO more special functions
 
@@ -339,10 +349,13 @@ my %cfg;
 $cfg{REPLACE_LINE()}    = DEFAULT_REPLACE_LINE;
 $cfg{REPLACE_KEYWORD()} = DEFAULT_REPLACE_KEYWORD;
 $cfg{PATH_SEPARATOR()}  = DEFAULT_PATH_SEPARATOR;
+my $debug_text = "DEBUG:\n";
+my $debug_enabled = 1;
 
 foreach my $arg (@ARGV) {
        %cfg = parse_file($arg, 0, %cfg);
 }
+$debug_enabled = 0;
 
 my %replace_line;
 my %replace_keyword;
@@ -375,6 +388,10 @@ $match_line = parse_pattern(REPLACE_LINE(), '('.DEBUG_ALL().')', 0, %cfg);
 $match_keyword = parse_pattern(REPLACE_KEYWORD(), '('.DEBUG_ALL().')', 0, %cfg);
 $replace_line{$match_line} = $debug_all;
 $replace_keyword{$match_keyword} = $debug_all;
+$match_line = parse_pattern(REPLACE_LINE(), '('.DEBUG_TEXT().')', 0, %cfg);
+$match_keyword = parse_pattern(REPLACE_KEYWORD(), '('.DEBUG_TEXT().')', 0, %cfg);
+$replace_line{$match_line} = $debug_text;
+$replace_keyword{$match_keyword} = $debug_text;
 my $status;
 LINE: while (defined(my $line = <STDIN>)) {
        $line =~ s/[\r\n]//g;
@@ -408,6 +425,12 @@ sub replace {
        return (1, $before.$replacement.$after);
 }
 
+sub print_debug {
+       (my $depth, my $text) = @_;
+       if ($debug_enabled) {
+               $debug_text .= ('  'x$depth).$text."\n";
+       }
+}
 
 sub unescape1ch {
        (my $to_escape) = @_;
@@ -531,9 +554,11 @@ sub get_pattern_parameters {
 
 sub parse_pattern_parameters {
        (my $text, my $depth, my %cfg) = @_;
+       
+       print_debug($depth, "PARSE PARAMETERS $text");
+       
        my @parameters;
        my $current_parameter = '';
-       
        my $level = 0;
        my $esc = 0;
        
@@ -558,7 +583,10 @@ sub parse_pattern_parameters {
                        if ($ch eq ')') {
                                $level -= 1;
                                if ($level == 0) {
-                                       push @parameters, parse_value($current_parameter, $depth+1, %cfg);
+                                       print_debug($depth, "FOUND PARAMETER $current_parameter");
+                                       $current_parameter = parse_value($current_parameter, $depth+1, %cfg);
+                                       print_debug($depth, "ADD PARAMETER ".scalar(@parameters)." $current_parameter");
+                                       push @parameters, $current_parameter;
                                        $current_parameter = '';
                                }
                                else {
@@ -571,7 +599,10 @@ sub parse_pattern_parameters {
                        }
                        else {
                                if (($level == 1) and ($ch eq ',')) {
-                                       push @parameters, parse_value($current_parameter, $depth+1, %cfg);
+                                       print_debug($depth, "FOUND PARAMETER $current_parameter");
+                                       $current_parameter = parse_value($current_parameter, $depth+1, %cfg);
+                                       print_debug($depth, "ADD PARAMETER ".scalar(@parameters)." $current_parameter");
+                                       push @parameters, $current_parameter;
                                        $current_parameter = '';
                                }
                                else {
@@ -591,11 +622,16 @@ sub parse_pattern {
        (my $name, my $parameters, my $depth, my %cfg) = @_;
        
        if ($depth >= MAX_DEPTH) {
-               return '$'.$name.$parameters;
+               print STDERR "Too deep.\n";
+               exit 3;
+               # return '@'.$name.$parameters;
                # return '';
        }
        
-       my @parameter_list = parse_pattern_parameters($parameters, $depth, %cfg);
+       print_debug($depth, "PARSE PATTERN $name: $parameters");
+       my $return;
+       
+       my @parameter_list = parse_pattern_parameters($parameters, $depth+1, %cfg);
        
        my %subcfg;
        foreach my $id (keys %cfg) {
@@ -617,57 +653,90 @@ sub parse_pattern {
                my $parsed = '';
        
                while ($to_parse ne '') {
+                       print_debug($depth, ":$to_parse");
                        if ($to_parse =~ /^\\(.)(.*)$/) {
+                               print_debug($depth, "UNESCAPE \\$1");
                                $parsed .= unescape1ch($1);
                                $to_parse = $2;
                        }
-                       elsif ($to_parse =~ /^\$([A-Za-z0-9_\-\.]+)(.*)$/) {
+                       elsif ($to_parse =~ /^@([A-Za-z0-9_\-\.]+)(.*)$/) {
                                my $id = $1;
                                $to_parse = $2;
                                
                                ($to_parse, my $parameters)= get_pattern_parameters($to_parse);
+                               print_debug($depth, "FUNCTION PATTERN $id: $parameters");
                                $parsed .= parse_pattern($id, $parameters, $depth+1, %subcfg);
                        }
-                       elsif ($to_parse =~ /^([^\$\\]+)(([\$\\].*)?)$/) {
+                       elsif ($to_parse =~ /^\$([A-Za-z0-9_\-\.]+)(.*)$/) {
+                               my $id = $1;
+                               $to_parse = $2;
+                               
+                               ($to_parse, my $parameters)= get_pattern_parameters($to_parse); # ignored anyway
+                               print_debug($depth, "STATIC PATTERN $id: $parameters");
+                               $parsed .= get_pattern($id, $depth+1, %subcfg);
+                       }
+                       elsif ($to_parse =~ /^([^\$\\@]+)(([\$\\@].*)?)$/) {
+                               print_debug($depth, "TEXT $1");
                                $parsed .= $1;
                                $to_parse = $2;
                        }
                        else {
-                               $parsed .= substr($to_parse, 0, 1);
+                               my $ch = substr($to_parse, 0, 1);
+                               print_debug($depth, "TEXT $ch");
+                               $parsed .= $ch;
                                $to_parse = substr($to_parse, 1);
                        }
                }
-               return $parsed;
+               $return = $parsed;
        }
        # elsif ($name =~ /^[0-9+]$/) {
-               # return '';
+               # $return = '';
        # }
        elsif ($name eq ESCAPE) {
-               return escape(@parameter_list);
+               $return = escape(@parameter_list);
        }
        elsif ($name eq URL_ENCODE) {
-               return urlencode(@parameter_list);
+               $return = urlencode(@parameter_list);
        }
        elsif ($name eq PATH) {
-               return join_path($cfg{PATH_SEPARATOR()},@parameter_list);
+               $return = join_path($cfg{PATH_SEPARATOR()},@parameter_list);
        }
        elsif ($name eq SPRINTF) {
                my $format = shift @parameter_list;
-               return sprintf($format,@parameter_list);
+               $return = sprintf($format,@parameter_list);
+       }
+       else {
+               # return '@'.$name.$parameters;
+               $return = '';
+       }
+       print_debug($depth, "PARSED! PATTERN $return");
+       return $return; 
+}
+
+sub get_pattern {
+       (my $name, my $depth, my %cfg) = @_;
+       my $value;
+       
+       if (defined $cfg{$name}) {
+               $value = $cfg{$name}
        }
        else {
-               # return '$'.$name.$parameters;
-               return '';
+               # $value = '$'.$name;
+               $value = '';
        }
+       print_debug($depth, "GET PATTERN $name: $value");
+       return $value;
 }
 
 sub parse_value {
        (my $to_parse, my $depth, my %cfg) = @_;
        
        if ($depth >= MAX_DEPTH) {
-               return $to_parse;
+               print STDERR "Too deep.\n";
+               exit 3;
+               # return $to_parse;
+               # return ''
        }
-       
        my $parsed = '';
        
        if ($to_parse =~ /^((([^#\\])|(\\.))*)#/) {
@@ -677,28 +746,45 @@ sub parse_value {
                $to_parse = $1;
        }
        
+       print_debug($depth, "PARSE VALUE $to_parse");
+       
        while ($to_parse ne '') {
+               print_debug($depth, ":$to_parse");
                # escape
                if ($to_parse =~ /^\\(.)(.*)$/) {
+                       print_debug($depth, "UNESCAPE \\$1");
                        $parsed .= unescape1ch($1);
                        $to_parse = $2;
                }
-               elsif ($to_parse =~ /^\$([A-Za-z0-9_\-\.]+)(.*)$/) {
+               elsif ($to_parse =~ /^@([A-Za-z0-9_\-\.]+)(.*)$/) {
                        my $name = $1;
                        $to_parse = $2;
                        
                        ($to_parse, my $parameters)= get_pattern_parameters($to_parse);
+                       print_debug($depth, "FUNCTION PATTERN $name: $parameters");
                        $parsed .= parse_pattern($name, $parameters, $depth+1, %cfg);
                }
-               elsif ($to_parse =~ /^([^\$\\]+)(([\$\\].*)?)$/) {
+               elsif ($to_parse =~ /^\$([A-Za-z0-9_\-\.]+)(.*)$/) {
+                       my $name = $1;
+                       $to_parse = $2;
+                       
+                       ($to_parse, my $parameters)= get_pattern_parameters($to_parse); # ignored anyway
+                       print_debug($depth, "STATIC PATTERN $name: $parameters");
+                       $parsed .= get_pattern($name, $depth+1, %cfg)
+               }
+               elsif ($to_parse =~ /^([^\$\\@]+)(([\$\\@].*)?)$/) {
+                       print_debug($depth, "TEXT $1");
                        $parsed .= $1;
                        $to_parse = $2;
                }
                else {
-                       $parsed .= substr($to_parse, 0, 1);
+                       my $ch = substr($to_parse, 0, 1);
+                       print_debug($depth, "TEXT $ch");
+                       $parsed .= $ch;
                        $to_parse = substr($to_parse, 1);
                }
        }
+       print_debug($depth, "PARSED! VALUE $parsed");
        return $parsed;
 }
 
@@ -710,6 +796,8 @@ sub parse_file {
                exit 3;
        }
        
+       print_debug($depth, "PARSE FILE $path");
+       
        my $file;
        unless (open $file, "<", $path) {
                print STDERR "Cannot open configfile $path.\n";
@@ -722,12 +810,16 @@ sub parse_file {
 
        while (defined(my $line = <$file>)) {
                $line =~ s/[\r\n]//g;
+               
+               print_debug($depth, "LINE $line");
+               
                # new definition name: value
                if ($line =~ /^([A-Za-z0-9_\-\.]+):[ \t](.*)$/) {
                        $parse_mode = 0;
                        $name = $1;
                        $value = $2;
                        $cfg{$name} = '';
+                       print_debug($depth, "STATIC DEFINE $name=$value")
                }
                # new definition name = value
                elsif ($line =~ /^([A-Za-z0-9_\-\.]+)[ \t]*=(.*)$/) {
@@ -735,15 +827,18 @@ sub parse_file {
                        $name = $1;
                        $value = $2;
                        $cfg{$name} = '';
+                       print_debug($depth, "DYNAMIC DEFINE $name=$value")
                }
                # continued definition
                elsif ($line =~ /^[ \t](.*)$/) {
                        $value = "\n".$1;
+                       print_debug($depth, "CONTINUE $name $value")
                }
                # include file
                elsif ($line =~ /^include[ \t]+([^ \t](.*[^ \t])?)[ \t]*$/)
                {
-                       my $path = parse_value($1, $depth, %cfg);
+                       my $path = parse_value($1, $depth+1, %cfg);
+                       print_debug($depth, "INCLUDE $path");
                        %cfg = parse_file($path, $depth+1, %cfg);
                        $name = '';
                        $value = '';
@@ -756,9 +851,10 @@ sub parse_file {
                
                if ($name ne '') {
                        if ($parse_mode != 0) {
-                               $value = parse_value($value, $depth, %cfg);
+                               $value = parse_value($value, $depth+1, %cfg);
                        }
                        $cfg{$name} .= $value;
+                       print_debug($depth, "ADD $name=$value")
                }
        }
        close ($file);

diff --git a/makefile b/makefile
index 5a49d1499291aa76b0f7f79c38bf0a4b6846c5d0..e7ae4d619eb06e900562942a0314270d6c051aed 100644 (file)
--- a/makefile
+++ b/makefile
@@ -1,5 +1,5 @@
 ifndef TARGET
-TARGET = release
+TARGET = debug
 # available targets:
 #   debug
 #   release
@@ -15,7 +15,7 @@ CP    = /usr/bin/cp
 RM    = /usr/bin/rm
 MKDIR = /usr/bin/mkdir
 
-BIN_DIR = /botm/bin/config
+BIN_DIR = /botm/bin/test-config
 
 
 CONFIGURE = $(PERL) ./configure.pl $(CONFIGFILE)