source4/build/smb_build/config_mk.pm

   1 ###########################################################
   2 ### SMB Build System                                    ###
   3 ### - config.mk parsing functions                       ###
   4 ###                                                     ###
   5 ###  Copyright (C) Stefan (metze) Metzmacher 2004       ###
   6 ###  Released under the GNU GPL                         ###
   7 ###########################################################
   8
   9 package config_mk;
  10 use smb_build::input;
  11
  12 use strict;
  13
  14 my %attribute_types = (
  15         "NOPROTO" => "bool",
  16         "REQUIRED_SUBSYSTEMS" => "list",
  17         "OUTPUT_TYPE" => "string",
  18         "INIT_OBJ_FILES" => "list",
  19         "ADD_OBJ_FILES" => "list",
  20         "OBJ_FILES" => "list",
  21         "SUBSYSTEM" => "string",
  22         "CFLAGS" => "list",
  23         "CPPFLAGS" => "list",
  24         "LDFLAGS" => "list",
  25         "LIBS" => "list",
  26         "INIT_FUNCTION" => "string",
  27         "MAJOR_VERSION" => "string",
  28         "MINOR_VERSION" => "string",
  29         "RELEASE_VERSION" => "string",
  30         "ENABLE" => "bool",
  31         "CMD" => "string",
  32         "MANPAGE" => "string"
  33 );
  34
  35 ###########################################################
  36 # The parsing function which parses the file
  37 #
  38 # $result = _parse_config_mk($filename)
  39 #
  40 # $filename -   the path of the config.mk file
  41 #               which should be parsed
  42 #
  43 # $result -     the resulting structure
  44 #
  45 # $result->{ERROR_CODE} -       the error_code, '0' means success
  46 # $result->{ERROR_STR} -        the error string
  47 #
  48 # $result->{$key}{KEY} -        the key == the variable which was parsed
  49 # $result->{$key}{VAL} -        the value of the variable
  50 sub _parse_config_mk($)
  51 {
  52         my $filename = shift;
  53         my $result;
  54         my $linenum = -1;
  55         my $waiting = 0;
  56         my $section = "GLOBAL";
  57         my $key;
  58
  59         $result->{ERROR_CODE} = -1;
  60
  61         open(CONFIG_MK, "< $filename") || die ("Can't open $filename\n");
  62
  63         while (<CONFIG_MK>) {
  64                 my $line = $_;
  65                 my $val;
  66
  67                 $linenum++;
  68
  69                 #
  70                 # lines beginnig with '#' are ignored
  71                 #
  72                 if ($line =~ /^\#.*$/) {
  73                         next;
  74                 }
  75
  76                 #
  77                 #
  78                 #
  79                 if (($waiting == 0) && ($line =~ /^\[([a-zA-Z0-9_:]+)\][\t ]*$/)) {
  80                         $section = $1;
  81                         next;
  82                 }
  83
  84                 #
  85                 # 1.)   lines with an alphanumeric character indicate
  86                 #       a new variable,
  87                 # 2.)   followed by zero or more whitespaces or tabs
  88                 # 3.)   then one '=' character
  89                 # 4.)   followed by the value of the variable
  90                 # 5.)   a newline ('\n') can be escaped by a '\' before the newline
  91                 #       and the next line needs to start with a tab ('\t')
  92                 #
  93                 if (($waiting == 0) && ($line =~ /^([a-zA-Z0-9_]+)[\t ]*=(.*)$/)) {
  94                         $key = $1;
  95                         $val = $2;
  96
  97                         #
  98                         # when we have a '\' before the newline
  99                         # then skip it and wait for the next line.
 100                         #
 101                         if ($val =~ /(.*)(\\)$/) {
 102                                 $val = $1;
 103                                 $waiting = 1;
 104                         } else {
 105                                 $waiting = 0;
 106                         }
 107
 108                         $result->{$section}{$key}{KEY} = $key;
 109                         $result->{$section}{$key}{VAL} = $val;
 110                         next;
 111                 }
 112
 113                 #
 114                 # when we are waiting for a value to continue then
 115                 # check if it has a leading tab.
 116                 #
 117                 if (($waiting == 1) && ($line =~ /^\t(.*)$/)) {
 118                         $val = $1;
 119
 120                         #
 121                         # when we have a '\' before the newline
 122                         # then skip it and wait for the next line.
 123                         #
 124                         if ($val =~ /(.*)( \\)$/) {
 125                                 $val = $1;
 126                                 $waiting = 1;
 127                         } else {
 128                                 $waiting = 0;
 129                         }
 130
 131                         $result->{$section}{$key}{VAL} .= " ";
 132                         $result->{$section}{$key}{VAL} .= $val;
 133                         next;
 134                 }
 135
 136                 #
 137                 # catch empty lines they're ignored
 138                 # and we're no longer waiting for the value to continue
 139                 #
 140                 if ($line =~ /^$/) {
 141                         $waiting = 0;
 142                         next;
 143                 }
 144
 145                 close(CONFIG_MK);
 146
 147                 $result->{ERROR_STR} = "Bad line while parsing $filename\n$filename:$linenum: $line";
 148
 149                 return $result;
 150         }
 151
 152         close(CONFIG_MK);
 153
 154         $result->{ERROR_CODE} = 0;
 155
 156         return $result;
 157 }
 158
 159 sub import_file($$)
 160 {
 161         my ($input, $filename) = @_;
 162
 163         my $result = _parse_config_mk($filename);
 164
 165         die ($result->{ERROR_STR}) unless $result->{ERROR_CODE} == 0;
 166
 167         foreach my $section (keys %{$result}) {
 168                 next if ($section eq "ERROR_CODE");
 169                 my ($type, $name) = split(/::/, $section, 2);
 170
 171                 $input->{$name}{NAME} = $name;
 172                 $input->{$name}{TYPE} = $type;
 173
 174                 foreach my $key (values %{$result->{$section}}) {
 175                         $key->{VAL} = smb_build::input::strtrim($key->{VAL});
 176                         my $vartype = $attribute_types{$key->{KEY}};
 177                         if (not defined($vartype)) {
 178                                 die("Unknown attribute $key->{KEY}");
 179                         }
 180                         if ($vartype eq "string") {
 181                                 $input->{$name}{$key->{KEY}} = $key->{VAL};
 182                         } elsif ($vartype eq "list") {
 183                                 $input->{$name}{$key->{KEY}} = [smb_build::input::str2array($key->{VAL})];
 184                         } elsif ($vartype eq "bool") {
 185                                 if (($key->{VAL} ne "YES") and ($key->{VAL} ne "NO")) {
 186                                         die("Invalid value for bool attribute $key->{KEY}: $key->{VAL}");
 187                                 }
 188                                 $input->{$name}{$key->{KEY}} = $key->{VAL};
 189                         }
 190                 }
 191         }
 192 }
 193
 194 sub import_files($$)
 195 {
 196         my ($input, $config_list) = @_;
 197
 198         open(IN, $config_list) or die("Can't open $config_list: $!");
 199         my @mkfiles = grep{!/^#/} <IN>;
 200         close(IN);
 201
 202         $| = 1;
 203
 204         foreach (@mkfiles) {
 205                 s/\n//g;
 206                 import_file($input, $_);
 207         }
 208 }
 209 1;