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