From 68a22f4de82f872d56513d7a294c1f166fd0474e Mon Sep 17 00:00:00 2001 From: b Date: Sun, 18 Sep 2022 20:20:42 +0000 Subject: [PATCH] Add static template insert, add debug test, update description --- configure.pl | 170 ++++++++++++++++++++++++++++++++++++++++----------- makefile | 4 +- 2 files changed, 135 insertions(+), 39 deletions(-) diff --git a/configure.pl b/configure.pl index 499419f..40ec789 100755 --- 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 = )) { $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 5a49d14..e7ae4d6 100644 --- 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) -- 2.30.2