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