more special functions,

rework pattern expansion

diff --git a/configure.pl b/configure.pl
index 11d5eea8008c76cc9363cae04b33d86257085a97..ce2ac6dc2ba09d540a5619e4b44232d26605a884 100755 (executable)
--- a/configure.pl
+++ b/configure.pl
@@ -21,9 +21,29 @@
 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 use strict;
-use constant MAX_DEPTH => 256;
+
+use constant MAX_DEPTH               => 256;
+use constant KEYWORD_PATTERN         => '[A-Za-z0-9_\-\.]+';
+use constant DEFAULT_PATH_SEPARATOR  => '/';
+use constant DEFAULT_REPLACE_LINE    => '###$0:';
+use constant DEFAULT_REPLACE_KEYWORD => '###$0;';
+
+use constant REPLACE_LINE    => '_REPLACE_LINE';
+use constant REPLACE_KEYWORD => '_REPLACE_KEYWORD';
+use constant PATH_SEPARATOR  => '_PATH_SEPARATOR';
+
+use constant ESCAPE     => '_ESCAPE';
+use constant URL_ENCODE => '_URL_ENCODE';
+use constant PATH       => '_PATH';
+use constant SPRINTF    => '_SPRINTF';
+
+# TODO more special functions
 
 my %cfg;
+$cfg{REPLACE_LINE()}    = DEFAULT_REPLACE_LINE;
+$cfg{REPLACE_KEYWORD()} = DEFAULT_REPLACE_KEYWORD;
+$cfg{PATH_SEPARATOR()}  = DEFAULT_PATH_SEPARATOR;
+
 foreach my $arg (@ARGV) {
        %cfg = parse_file($arg, 0, %cfg);
 }
@@ -35,7 +55,7 @@ foreach my $key (keys %cfg) {
 # TODO: OK we have settings parsing done.
 #       Now parse the actual files, do the replacements
 
-sub escape {
+sub unescape {
        (my $to_escape) = @_;
        
        if    ($to_escape eq 'a') { return "\a";}
@@ -48,6 +68,47 @@ sub escape {
        else                      { return $to_escape;}
 }
 
+sub urlencode {
+       (my $text, my $match) = @_;
+       unless (defined $match) {
+               $match = '[^0-9A-Za-z.~\-_]'
+       }
+       
+       my $outcome = '';
+       foreach my $ch (split('', $text)) {
+               if ($ch =~ $match) {
+                       $outcome .= sprintf('%%%02hX',ord($ch));
+               }
+               else {
+                       $outcome .= $ch;
+               }
+       }
+       return $outcome;
+}
+
+sub join_path {
+       (my $joiner, my @segments) = @_;
+       
+       my $path = '';
+       foreach my $segment (@segments) {
+               if ($path eq '') {
+                       $path = $segment;
+               }
+               else {
+                       unless (substr ($path, -1) eq $joiner) {
+                               $path .= $joiner;
+                       }
+                       if (substr ($segment, 0, 1) eq $joiner) {
+                               $path = $segment;
+                       }
+                       else {
+                               $path .= $segment;
+                       }
+               }
+       }
+       return $path;
+}
+
 sub get_pattern_parameters {
        (my $text) = @_;
        my $parameters;
@@ -148,34 +209,72 @@ sub parse_pattern_parameters {
 }
        
 sub parse_pattern {
-       (my $pattern, my $parameters, my $depth, my %cfg) = @_;
+       (my $name, my $parameters, my $depth, my %cfg) = @_;
        
        if ($depth >= MAX_DEPTH) {
-               return '$'.$pattern.$parameters;
+               return '$'.$name.$parameters;
        }
        
        my @parameter_list = parse_pattern_parameters($parameters, $depth, %cfg);
        
-       my $parsed = '';
-       
-       while ($pattern ne '') {
-               if ($pattern =~ /^\$([0-9]+)(.*)$/) {
-                       my $id = $1;
-                       $pattern = $2;
-                       if (defined $parameter_list[$id]){
-                               $parsed .= $parameter_list[$id];
-                       }
+       my %subcfg;
+       foreach my $id (keys %cfg) {
+               unless (($id eq '') or ($id =~ /^[0-9]+$/)) {
+                       $subcfg{$id} = $cfg{$id};
                }
-               elsif ($pattern =~ /^([^\$]+)((\$.*)?)$/) {
-                       $parsed .= $1;
-                       $pattern = $2;
+       }
+       $subcfg{'_'} = '';
+       for (my $i = 0; defined $parameter_list[$i]; $i += 1) {
+               if ($i) {
+                       $subcfg{'_'} .= ',';
                }
-               else {
-                       $parsed .= substr($pattern, 0, 1);
-                       $pattern = substr($pattern, 1);
+               $subcfg{'_'} .= $parameter_list[$i];
+               $subcfg{$i} = $parameter_list[$i];
+       }
+       
+       if (defined $cfg{$name}) {
+               my $to_parse = $cfg{$name};
+               my $parsed = '';
+       
+               while ($to_parse ne '') {
+                       if ($to_parse =~ /^\\(.)(.*)$/) {
+                               $parsed .= unescape($1);
+                               $to_parse = $2;
+                       }
+                       elsif ($to_parse =~ /^\$([A-Za-z0-9_\-\.]+)(.*)$/) {
+                               my $id = $1;
+                               $to_parse = $2;
+                               
+                               ($to_parse, my $parameters)= get_pattern_parameters($to_parse);
+                               $parsed .= parse_pattern($id, $parameters, $depth+1, %subcfg);
+                       }
+                       elsif ($to_parse =~ /^([^\$\\]+)(([\$\\].*)?)$/) {
+                               $parsed .= $1;
+                               $to_parse = $2;
+                       }
+                       else {
+                               $parsed .= substr($to_parse, 0, 1);
+                               $to_parse = substr($to_parse, 1);
+                       }
                }
+               return $parsed;
+       }
+       elsif ($name eq ESCAPE) {
+               return '+'; #TODO
+       }
+       elsif ($name eq URL_ENCODE) {
+               return urlencode(@parameter_list);
+       }
+       elsif ($name eq PATH) {
+               return join_path($cfg{PATH_SEPARATOR()},@parameter_list);
+       }
+       elsif ($name eq SPRINTF) {
+               my $format = shift @parameter_list;
+               return sprintf($format,@parameter_list);
+       }
+       else {
+               return '$'.$name.$parameters;
        }
-       return $parsed;
 }
 
 sub parse_value {
@@ -197,24 +296,15 @@ sub parse_value {
        while ($to_parse ne '') {
                # escape
                if ($to_parse =~ /^\\(.)(.*)$/) {
-                       $parsed .= escape($1);
+                       $parsed .= unescape($1);
                        $to_parse = $2;
                }
                elsif ($to_parse =~ /^\$([A-Za-z0-9_\-\.]+)(.*)$/) {
                        my $name = $1;
                        $to_parse = $2;
                        
-                       # arg number, leave unconverted
-                       if ($name =~ /^[0-9]+$/) {
-                               $parsed .= '$'.$name;
-                       }
-                       elsif (defined $cfg{$name}) {
-                               ($to_parse, my $parameters)= get_pattern_parameters($to_parse);
-                               $parsed .= parse_pattern($cfg{$name}, $parameters, $depth+1, %cfg);
-                       }
-                       else {
-                               $parsed .= '$'.$name;
-                       }
+                       ($to_parse, my $parameters)= get_pattern_parameters($to_parse);
+                       $parsed .= parse_pattern($name, $parameters, $depth+1, %cfg);
                }
                elsif ($to_parse =~ /^([^\$\\]+)(([\$\\].*)?)$/) {
                        $parsed .= $1;
@@ -269,10 +359,8 @@ sub parse_file {
                # include file
                elsif ($line =~ /^include[ \t]+([^ \t](.*[^ \t])?)[ \t]*$/)
                {
-                       %cfg = parse_file($1, $depth+1, %cfg);
-                       # foreach my $ind (keys %included) {
-                               # $cfg{$ind} = $included{$ind};
-                       # }
+                       my $path = parse_value($1, $depth, %cfg);
+                       %cfg = parse_file($path, $depth+1, %cfg);
                        $name = '';
                        $value = '';
                }

diff --git a/settings_template.txt b/settings_template.txt
index 45919e23dea83d1d6ea4fa60be9b9e5c0fd8411a..7ea3146826ce234883c43d934976b2ec1ea3594e 100644 (file)
--- a/settings_template.txt
+++ b/settings_template.txt
@@ -1 +1 @@
-# TODO: add template
+p0 = $_SPRINTF(%02x %02x,44,22)