]> bicyclesonthemoon.info Git - botm/config/commitdiff
Parsing settings file is done.
authorb <b@bicyclesonthemoon.info>
Fri, 9 Sep 2022 15:25:33 +0000 (15:25 +0000)
committerb <b@bicyclesonthemoon.info>
Fri, 9 Sep 2022 15:25:33 +0000 (15:25 +0000)
configure.pl [new file with mode: 0755]
settings_template.txt [new file with mode: 0644]

diff --git a/configure.pl b/configure.pl
new file mode 100755 (executable)
index 0000000..11d5eea
--- /dev/null
@@ -0,0 +1,295 @@
+#!/usr/bin/perl
+
+# configure.pl
+#
+# This script is called from the makefile. It reads the settings file and
+# inserts the information in the source files.
+#
+#    Copyright (C) 2015-2017, 2022  Balthasar SzczepaƄski
+#
+#    This program is free software: you can redistribute it and/or modify
+#    it under the terms of the GNU Affero General Public License as
+#    published by the Free Software Foundation, either version 3 of the
+#    License, or (at your option) any later version.
+#
+#    This program is distributed in the hope that it will be useful,
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#    GNU Affero General Public License for more details.
+#
+#    You should have received a copy of the GNU Affero General Public License
+#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use constant MAX_DEPTH => 256;
+
+my %cfg;
+foreach my $arg (@ARGV) {
+       %cfg = parse_file($arg, 0, %cfg);
+}
+
+foreach my $key (keys %cfg) {
+       print $key.': >'.$cfg{$key}."<\n";
+}
+
+# TODO: OK we have settings parsing done.
+#       Now parse the actual files, do the replacements
+
+sub escape {
+       (my $to_escape) = @_;
+       
+       if    ($to_escape eq 'a') { return "\a";}
+       elsif ($to_escape eq 'b') { return "\b";}
+       elsif ($to_escape eq 'e') { return "\e";}
+       elsif ($to_escape eq 'f') { return "\f";}
+       elsif ($to_escape eq 'n') { return "\n";}
+       elsif ($to_escape eq 'r') { return "\r";}
+       elsif ($to_escape eq 't') { return "\t";}
+       else                      { return $to_escape;}
+}
+
+sub get_pattern_parameters {
+       (my $text) = @_;
+       my $parameters;
+       
+       my $level = 0;
+       my $esc = 0;
+       
+       while ($text ne '') {
+               my $ch = substr($text, 0, 1);
+               my $rest = substr($text, 1);
+               
+               if ($esc) {
+                       $parameters .= $ch;
+                       $esc = 0;
+               }
+               elsif ($ch eq '(') {
+                       $parameters .= $ch;
+                       $level += 1;
+               }
+               else {
+                       if ($level == 0) {
+                               last;
+                       }
+                       $parameters .= $ch;
+                       if ($ch eq ')') {
+                               $level -= 1;
+                       }
+                       elsif ($ch eq '\\') {
+                               $esc = 1;
+                       }
+                       else {
+                       }
+               }
+               $text = $rest;
+               if ($level == 0) {
+                       last;
+               }
+       }
+       return ($text, $parameters);
+}
+
+sub parse_pattern_parameters {
+       (my $text, my $depth, my %cfg) = @_;
+       my @parameters;
+       my $current_parameter = '';
+       
+       my $level = 0;
+       my $esc = 0;
+       
+       while ($text ne '') {
+               my $ch = substr($text, 0, 1);
+               my $rest = substr($text, 1);
+               
+               if ($esc) {
+                       $current_parameter .= $ch;
+                       $esc = 0;
+               }
+               elsif ($ch eq '(') {
+                       if ($level != 0) {
+                               $current_parameter .= $ch;
+                       }
+                       $level += 1;
+               }
+               else {
+                       if ($level == 0) {
+                               last;
+                       }
+                       if ($ch eq ')') {
+                               $level -= 1;
+                               if ($level == 0) {
+                                       push @parameters, parse_value($current_parameter, $depth+1, %cfg);
+                                       $current_parameter = '';
+                               }
+                               else {
+                                       $current_parameter .= $ch;
+                               }
+                       }
+                       elsif ($ch eq '\\') {
+                               $current_parameter .= $ch;
+                               $esc = 1;
+                       }
+                       else {
+                               if (($level == 1) and ($ch eq ',')) {
+                                       push @parameters, parse_value($current_parameter, $depth+1, %cfg);
+                                       $current_parameter = '';
+                               }
+                               else {
+                                       $current_parameter .= $ch;
+                               }
+                       }
+               }
+               $text = $rest;
+               if ($level == 0) {
+                       last;
+               }
+       };
+       return @parameters;
+}
+       
+sub parse_pattern {
+       (my $pattern, my $parameters, my $depth, my %cfg) = @_;
+       
+       if ($depth >= MAX_DEPTH) {
+               return '$'.$pattern.$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];
+                       }
+               }
+               elsif ($pattern =~ /^([^\$]+)((\$.*)?)$/) {
+                       $parsed .= $1;
+                       $pattern = $2;
+               }
+               else {
+                       $parsed .= substr($pattern, 0, 1);
+                       $pattern = substr($pattern, 1);
+               }
+       }
+       return $parsed;
+}
+
+sub parse_value {
+       (my $to_parse, my $depth, my %cfg) = @_;
+       
+       if ($depth >= MAX_DEPTH) {
+               return $to_parse;
+       }
+       
+       my $parsed = '';
+       
+       if ($to_parse =~ /^((([^#\\])|(\\.))*)#/) {
+               $to_parse = $1;
+       }
+       if ($to_parse =~ /^[ \t]*([^ \t](.*[^ \t])?)[ \t]*$/) {
+               $to_parse = $1;
+       }
+       
+       while ($to_parse ne '') {
+               # escape
+               if ($to_parse =~ /^\\(.)(.*)$/) {
+                       $parsed .= escape($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;
+                       }
+               }
+               elsif ($to_parse =~ /^([^\$\\]+)(([\$\\].*)?)$/) {
+                       $parsed .= $1;
+                       $to_parse = $2;
+               }
+               else {
+                       $parsed .= substr($to_parse, 0, 1);
+                       $to_parse = substr($to_parse, 1);
+               }
+       }
+       return $parsed;
+}
+
+sub parse_file {
+       (my $path, my $depth, my %cfg) = @_;
+       
+       if ($depth >= MAX_DEPTH) {
+               print STDERR "Too deep.\n";
+               exit 3;
+       }
+       
+       my $file;
+       unless (open $file, "<", $path) {
+               print STDERR "Cannot open configfile $path.\n";
+               exit 2;
+       }
+       
+       my $parse_mode = 0;
+       my $name = '';
+       my $value = '';
+
+       while (defined(my $line = <$file>)) {
+               $line =~ s/[\r\n]//g;
+               # new definition name: value
+               if ($line =~ /^([A-Za-z0-9_\-\.]+):[ \t](.*)$/) {
+                       $parse_mode = 0;
+                       $name = $1;
+                       $value = $2;
+                       $cfg{$name} = '';
+               }
+               # new definition name = value
+               elsif ($line =~ /^([A-Za-z0-9_\-\.]+)[ \t]*=(.*)$/) {
+                       $parse_mode = 1;
+                       $name = $1;
+                       $value = $2;
+                       $cfg{$name} = '';
+               }
+               # continued definition
+               elsif ($line =~ /^[ \t](.*)$/) {
+                       $value = "\n".$1;
+               }
+               # 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};
+                       # }
+                       $name = '';
+                       $value = '';
+               }
+               # other line, not understood
+               else {
+                       $name = '';
+                       $value = '';
+               }
+               
+               if ($name ne '') {
+                       if ($parse_mode != 0) {
+                               $value = parse_value($value, $depth, %cfg);
+                       }
+                       $cfg{$name} .= $value;
+               }
+       }
+       close ($file);
+       
+       return %cfg;
+}
diff --git a/settings_template.txt b/settings_template.txt
new file mode 100644 (file)
index 0000000..45919e2
--- /dev/null
@@ -0,0 +1 @@
+# TODO: add template