--- /dev/null
+#!/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;
+}