Subversion Repositories gelsvn

Rev

Rev 198 | Only display areas with differences | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 198 Rev 217
1
package TemplateParser;
1
package TemplateParser;
2
 
2
 
3
# ************************************************************
3
# ************************************************************
4
# Description   : Parses the template and fills in missing values
4
# Description   : Parses the template and fills in missing values
5
# Author        : Chad Elliott
5
# Author        : Chad Elliott
6
# Create Date   : 5/17/2002
6
# Create Date   : 5/17/2002
7
# ************************************************************
7
# ************************************************************
8
 
8
 
9
# ************************************************************
9
# ************************************************************
10
# Pragmas
10
# Pragmas
11
# ************************************************************
11
# ************************************************************
12
 
12
 
13
use strict;
13
use strict;
14
 
14
 
15
use Parser;
15
use Parser;
16
use WinVersionTranslator;
16
use WinVersionTranslator;
17
 
17
 
18
use vars qw(@ISA);
18
use vars qw(@ISA);
19
@ISA = qw(Parser);
19
@ISA = qw(Parser);
20
 
20
 
21
# ************************************************************
21
# ************************************************************
22
# Data Section
22
# Data Section
23
# ************************************************************
23
# ************************************************************
24
 
24
 
25
# Valid keywords for use in template files.  Each has a handle_
25
# Valid keywords for use in template files.  Each has a handle_
26
# method available, but some have other methods too.
26
# method available, but some have other methods too.
27
# Bit  Meaning
27
# Bit  Meaning
28
# 0 means there is a get_ method available (used by if)
28
# 0 means there is a get_ method available (used by if)
29
# 1 means there is a perform_ method available (used by foreach)
29
# 1 means there is a perform_ method available (used by foreach)
30
# 2 means there is a doif_ method available (used by if)
30
# 2 means there is a doif_ method available (used by if)
31
my(%keywords) = ('if'              => 0,
31
my(%keywords) = ('if'              => 0,
32
                 'else'            => 0,
32
                 'else'            => 0,
33
                 'endif'           => 0,
33
                 'endif'           => 0,
34
                 'noextension'     => 2,
34
                 'noextension'     => 2,
35
                 'dirname'         => 5,
35
                 'dirname'         => 5,
36
                 'basename'        => 0,
36
                 'basename'        => 0,
37
                 'basenoextension' => 0,
37
                 'basenoextension' => 0,
38
                 'foreach'         => 0,
38
                 'foreach'         => 0,
39
                 'forfirst'        => 0,
39
                 'forfirst'        => 0,
40
                 'fornotfirst'     => 0,
40
                 'fornotfirst'     => 0,
41
                 'fornotlast'      => 0,
41
                 'fornotlast'      => 0,
42
                 'forlast'         => 0,
42
                 'forlast'         => 0,
43
                 'endfor'          => 0,
43
                 'endfor'          => 0,
44
                 'eval'            => 0,
44
                 'eval'            => 0,
45
                 'comment'         => 0,
45
                 'comment'         => 0,
46
                 'marker'          => 0,
46
                 'marker'          => 0,
47
                 'uc'              => 0,
47
                 'uc'              => 0,
48
                 'lc'              => 0,
48
                 'lc'              => 0,
49
                 'ucw'             => 0,
49
                 'ucw'             => 0,
50
                 'normalize'       => 2,
50
                 'normalize'       => 2,
51
                 'flag_overrides'  => 1,
51
                 'flag_overrides'  => 1,
52
                 'reverse'         => 2,
52
                 'reverse'         => 2,
53
                 'sort'            => 2,
53
                 'sort'            => 2,
54
                 'uniq'            => 3,
54
                 'uniq'            => 3,
55
                 'multiple'        => 5,
55
                 'multiple'        => 5,
56
                 'starts_with'     => 5,
56
                 'starts_with'     => 5,
57
                 'ends_with'       => 5,
57
                 'ends_with'       => 5,
58
                 'contains'        => 5,
58
                 'contains'        => 5,
59
                 'compares'        => 5,
59
                 'compares'        => 5,
60
                 'duplicate_index' => 5,
60
                 'duplicate_index' => 5,
-
 
61
                 'transdir'        => 5,
61
                );
62
                );
62
 
63
 
63
my(%target_type_vars) = ('type_is_static'   => 1,
64
my(%target_type_vars) = ('type_is_static'   => 1,
64
                         'need_staticflags' => 1,
65
                         'need_staticflags' => 1,
65
                         'type_is_dynamic'  => 1,
66
                         'type_is_dynamic'  => 1,
66
                         'type_is_binary'   => 1,
67
                         'type_is_binary'   => 1,
67
                        );
68
                        );
68
 
69
 
-
 
70
my(%arrow_op_ref) = ('custom_type'     => 'custom types',
-
 
71
                     'grouped_.*_file' => 'grouped files',
-
 
72
                     'feature'         => 'features',
-
 
73
                    );
-
 
74
 
69
# ************************************************************
75
# ************************************************************
70
# Subroutine Section
76
# Subroutine Section
71
# ************************************************************
77
# ************************************************************
72
 
78
 
73
sub new {
79
sub new {
74
  my($class) = shift;
80
  my($class) = shift;
75
  my($prjc)  = shift;
81
  my($prjc)  = shift;
76
  my($self)  = $class->SUPER::new();
82
  my($self)  = $class->SUPER::new();
77
 
83
 
78
  $self->{'prjc'}                 = $prjc;
84
  $self->{'prjc'}                 = $prjc;
79
  $self->{'ti'}                   = $prjc->get_template_input();
85
  $self->{'ti'}                   = $prjc->get_template_input();
80
  $self->{'cslashes'}             = $prjc->convert_slashes();
86
  $self->{'cslashes'}             = $prjc->convert_slashes();
81
  $self->{'crlf'}                 = $prjc->crlf();
87
  $self->{'crlf'}                 = $prjc->crlf();
82
  $self->{'cmds'}                 = $prjc->get_command_subs();
88
  $self->{'cmds'}                 = $prjc->get_command_subs();
83
  $self->{'vnames'}               = $prjc->get_valid_names();
89
  $self->{'vnames'}               = $prjc->get_valid_names();
84
  $self->{'values'}               = {};
90
  $self->{'values'}               = {};
85
  $self->{'defaults'}             = {};
91
  $self->{'defaults'}             = {};
86
  $self->{'lines'}                = [];
92
  $self->{'lines'}                = [];
87
  $self->{'built'}                = '';
93
  $self->{'built'}                = '';
88
  $self->{'sstack'}               = [];
94
  $self->{'sstack'}               = [];
89
  $self->{'lstack'}               = [];
95
  $self->{'lstack'}               = [];
90
  $self->{'if_skip'}              = 0;
96
  $self->{'if_skip'}              = 0;
91
  $self->{'eval'}                 = 0;
97
  $self->{'eval'}                 = 0;
92
  $self->{'eval_str'}             = '';
98
  $self->{'eval_str'}             = '';
93
  $self->{'dupfiles'}             = {};
99
  $self->{'dupfiles'}             = {};
94
  $self->{'override_target_type'} = undef;
100
  $self->{'override_target_type'} = undef;
95
 
101
 
96
  $self->{'foreach'}  = {};
102
  $self->{'foreach'}  = {};
97
  $self->{'foreach'}->{'count'}      = -1;
103
  $self->{'foreach'}->{'count'}      = -1;
98
  $self->{'foreach'}->{'nested'}     = 0;
104
  $self->{'foreach'}->{'nested'}     = 0;
99
  $self->{'foreach'}->{'name'}       = [];
105
  $self->{'foreach'}->{'name'}       = [];
100
  $self->{'foreach'}->{'vars'}       = [];
106
  $self->{'foreach'}->{'vars'}       = [];
101
  $self->{'foreach'}->{'text'}       = [];
107
  $self->{'foreach'}->{'text'}       = [];
102
  $self->{'foreach'}->{'scope'}      = [];
108
  $self->{'foreach'}->{'scope'}      = [];
103
  $self->{'foreach'}->{'scope_name'} = [];
109
  $self->{'foreach'}->{'scope_name'} = [];
104
  $self->{'foreach'}->{'temp_scope'} = [];
110
  $self->{'foreach'}->{'temp_scope'} = [];
105
  $self->{'foreach'}->{'processing'} = 0;
111
  $self->{'foreach'}->{'processing'} = 0;
106
 
112
 
107
  return $self;
113
  return $self;
108
}
114
}
109
 
115
 
110
 
116
 
111
sub basename {
117
sub tp_basename {
112
  my($self) = shift;
118
  my($self) = shift;
113
  my($file) = shift;
119
  my($file) = shift;
114
 
120
 
115
  if ($self->{'cslashes'}) {
121
  if ($self->{'cslashes'}) {
116
    $file =~ s/.*[\/\\]//;
122
    $file =~ s/.*[\/\\]//;
117
  }
123
  }
118
  else {
124
  else {
119
    $file =~ s/.*\///;
125
    $file =~ s/.*\///;
120
  }
126
  }
121
  return $file;
127
  return $file;
122
}
128
}
123
 
129
 
124
 
130
 
125
sub tp_dirname {
131
sub validated_dirname {
126
  my($self)  = shift;
132
  my($self)  = shift;
127
  my($file)  = shift;
133
  my($file)  = shift;
128
  my($index) = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
134
  my($index) = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
129
 
135
 
130
  if ($index >= 0) {
136
  if ($index >= 0) {
131
    return $self->{'prjc'}->validated_directory(substr($file, 0, $index));
137
    return $self->{'prjc'}->validated_directory(substr($file, 0, $index));
132
  }
138
  }
133
  else {
139
  else {
134
    return '.';
140
    return '.';
135
  }
141
  }
136
}
142
}
137
 
143
 
138
 
144
 
-
 
145
sub tp_dirname {
-
 
146
  my($self)  = shift;
-
 
147
  my($file)  = shift;
-
 
148
  my($index) = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
-
 
149
 
-
 
150
  if ($index >= 0) {
-
 
151
    return substr($file, 0, $index);
-
 
152
  }
-
 
153
  else {
-
 
154
    return '.';
-
 
155
  }
-
 
156
}
-
 
157
 
-
 
158
 
139
sub strip_line {
159
sub strip_line {
140
  #my($self) = shift;
160
  #my($self) = shift;
141
  #my($line) = shift;
161
  #my($line) = shift;
142
 
162
 
143
  ## Override strip_line() from Parser.
163
  ## Override strip_line() from Parser.
144
  ## We need to preserve leading space and
164
  ## We need to preserve leading space and
145
  ## there is no comment string in templates.
165
  ## there is no comment string in templates.
146
  ++$_[0]->{'line_number'};
166
  ++$_[0]->{'line_number'};
147
  $_[1] =~ s/\s+$//;
167
  $_[1] =~ s/\s+$//;
148
 
168
 
149
  return $_[1];
169
  return $_[1];
150
}
170
}
151
 
171
 
152
 
172
 
153
## Append the current value to the line that is being
173
## Append the current value to the line that is being
154
## built.  This line may be a foreach line or a general
174
## built.  This line may be a foreach line or a general
155
## line without a foreach.
175
## line without a foreach.
156
sub append_current {
176
sub append_current {
157
#  my($self)  = shift;
177
#  my($self)  = shift;
158
#  my($value) = shift;
178
#  my($value) = shift;
159
 
179
 
160
  if ($_[0]->{'foreach'}->{'count'} >= 0) {
180
  if ($_[0]->{'foreach'}->{'count'} >= 0) {
161
    $_[0]->{'foreach'}->{'text'}->[$_[0]->{'foreach'}->{'count'}] .= $_[1];
181
    $_[0]->{'foreach'}->{'text'}->[$_[0]->{'foreach'}->{'count'}] .= $_[1];
162
  }
182
  }
163
  elsif ($_[0]->{'eval'}) {
183
  elsif ($_[0]->{'eval'}) {
164
    $_[0]->{'eval_str'} .= $_[1];
184
    $_[0]->{'eval_str'} .= $_[1];
165
  }
185
  }
166
  else {
186
  else {
167
    $_[0]->{'built'} .= $_[1];
187
    $_[0]->{'built'} .= $_[1];
168
  }
188
  }
169
}
189
}
170
 
190
 
171
 
191
 
172
sub split_parameters {
192
sub split_parameters {
173
  my($self)   = shift;
193
  my($self)   = shift;
174
  my($str)    = shift;
194
  my($str)    = shift;
175
  my(@params) = ();
195
  my(@params) = ();
176
 
196
 
177
  while($str =~ /(\w+\([^\)]+\))\s*,\s*(.*)/) {
197
  while($str =~ /(\w+\([^\)]+\))\s*,\s*(.*)/) {
178
    push(@params, $1);
198
    push(@params, $1);
179
    $str = $2;
199
    $str = $2;
180
  }
200
  }
181
  while($str =~ /([^,]+)\s*,\s*(.*)/) {
201
  while($str =~ /([^,]+)\s*,\s*(.*)/) {
182
    push(@params, $1);
202
    push(@params, $1);
183
    $str = $2;
203
    $str = $2;
184
  }
204
  }
185
 
205
 
186
  ## Return the parameters (which includes whatever is left in the
206
  ## Return the parameters (which includes whatever is left in the
187
  ## string).  Just return it instead of pushing it onto @params.
207
  ## string).  Just return it instead of pushing it onto @params.
188
  return @params, $str;
208
  return @params, $str;
189
}
209
}
190
 
210
 
191
 
211
 
192
sub set_current_values {
212
sub set_current_values {
193
  my($self) = shift;
213
  my($self) = shift;
194
  my($name) = shift;
214
  my($name) = shift;
195
  my($set)  = 0;
215
  my($set)  = 0;
196
 
216
 
197
  ## If any value within a foreach matches the name
217
  ## If any value within a foreach matches the name
198
  ## of a hash table within the template input we will
218
  ## of a hash table within the template input we will
199
  ## set the values of that hash table in the current scope
219
  ## set the values of that hash table in the current scope
200
  if (defined $self->{'ti'}) {
220
  if (defined $self->{'ti'}) {
201
    my($counter) = $self->{'foreach'}->{'count'};
221
    my($counter) = $self->{'foreach'}->{'count'};
202
    if ($counter >= 0) {
222
    if ($counter >= 0) {
203
      ## Variable names are case-insensitive in MPC, however this can
223
      ## Variable names are case-insensitive in MPC, however this can
204
      ## cause problems when dealing with template variable values that
224
      ## cause problems when dealing with template variable values that
205
      ## happen to match HASH names only by case-insensitivity.  So, we
225
      ## happen to match HASH names only by case-insensitivity.  So, we
206
      ## now make HASH names match with case-sensitivity.
226
      ## now make HASH names match with case-sensitivity.
207
      my($value) = $self->{'ti'}->get_value($name);
227
      my($value) = $self->{'ti'}->get_value($name);
208
      if (defined $value && UNIVERSAL::isa($value, 'HASH') &&
228
      if (defined $value && UNIVERSAL::isa($value, 'HASH') &&
209
          $self->{'ti'}->get_realname($name) eq $name) {
229
          $self->{'ti'}->get_realname($name) eq $name) {
210
        $self->{'foreach'}->{'scope_name'}->[$counter] = $name;
230
        $self->{'foreach'}->{'scope_name'}->[$counter] = $name;
211
        my(%copy) = ();
231
        my(%copy) = ();
212
        foreach my $key (keys %$value) {
232
        foreach my $key (keys %$value) {
213
          $copy{$key} = $self->{'prjc'}->adjust_value(
233
          $copy{$key} = $self->{'prjc'}->adjust_value(
214
                    [$name . '::' . $key, $name], $$value{$key});
234
                    [$name . '::' . $key, $name], $$value{$key});
215
        }
235
        }
216
        $self->{'foreach'}->{'temp_scope'}->[$counter] = \%copy;
236
        $self->{'foreach'}->{'temp_scope'}->[$counter] = \%copy;
217
        $set = 1;
237
        $set = 1;
218
      }
238
      }
219
    }
239
    }
220
  }
240
  }
221
  return $set;
241
  return $set;
222
}
242
}
223
 
243
 
224
 
244
 
225
sub get_value {
245
sub get_value {
226
  my($self)    = shift;
246
  my($self)    = shift;
227
  my($name)    = shift;
247
  my($name)    = shift;
228
  my($value)   = undef;
248
  my($value)   = undef;
229
  my($counter) = $self->{'foreach'}->{'count'};
249
  my($counter) = $self->{'foreach'}->{'count'};
230
  my($fromprj) = 0;
250
  my($fromprj) = 0;
231
  my($scope)   = undef;
251
  my($scope)   = undef;
232
  my($sname)   = undef;
252
  my($sname)   = undef;
233
  my($adjust)  = 1;
253
  my($adjust)  = 1;
234
 
254
 
235
  ## $name should always be all lower-case
255
  ## $name should always be all lower-case
236
  $name = lc($name);
256
  $name = lc($name);
237
 
257
 
238
  ## First, check the temporary scope (set inside a foreach)
258
  ## First, check the temporary scope (set inside a foreach)
239
  if ($counter >= 0) {
259
  if ($counter >= 0) {
240
    ## Find the outer most scope for our variable name
260
    ## Find the outer most scope for our variable name
241
    for(my $index = $counter; $index >= 0; --$index) {
261
    for(my $index = $counter; $index >= 0; --$index) {
242
      if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {
262
      if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {
243
        $scope = $self->{'foreach'}->{'scope_name'}->[$index];
263
        $scope = $self->{'foreach'}->{'scope_name'}->[$index];
244
        $sname = $scope . '::' . $name;
264
        $sname = $scope . '::' . $name;
245
        last;
265
        last;
246
      }
266
      }
247
    }
267
    }
248
    while(!defined $value && $counter >= 0) {
268
    while(!defined $value && $counter >= 0) {
249
      $value = $self->{'foreach'}->{'temp_scope'}->[$counter]->{$name};
269
      $value = $self->{'foreach'}->{'temp_scope'}->[$counter]->{$name};
250
      --$counter;
270
      --$counter;
251
    }
271
    }
252
    $counter = $self->{'foreach'}->{'count'};
272
    $counter = $self->{'foreach'}->{'count'};
253
 
273
 
254
    if ($self->{'override_target_type'} &&
274
    if ($self->{'override_target_type'} &&
255
        defined $value && defined $target_type_vars{$name}) {
275
        defined $value && defined $target_type_vars{$name}) {
256
      $value = $self->{'values'}->{$name};
276
      $value = $self->{'values'}->{$name};
257
    }
277
    }
258
  }
278
  }
259
 
279
 
260
  if (!defined $value) {
280
  if (!defined $value) {
261
    if ($name =~ /^flag_overrides\((.*)\)$/) {
281
    if ($name =~ /^flag_overrides\((.*)\)$/) {
262
      $value = $self->get_flag_overrides($1);
282
      $value = $self->get_flag_overrides($1);
263
    }
283
    }
264
 
284
 
265
    if (!defined $value) {
285
    if (!defined $value) {
266
      ## Next, check for a template value
286
      ## Next, check for a template value
267
      if (defined $self->{'ti'}) {
287
      if (defined $self->{'ti'}) {
268
        $value = $self->{'ti'}->get_value($name);
288
        $value = $self->{'ti'}->get_value($name);
269
      }
289
      }
270
 
290
 
271
      if (!defined $value) {
291
      if (!defined $value) {
272
        ## Calling adjust_value here allows us to pick up template
292
        ## Calling adjust_value here allows us to pick up template
273
        ## overrides before getting values elsewhere.
293
        ## overrides before getting values elsewhere.
274
        my($uvalue) = $self->{'prjc'}->adjust_value([$sname, $name], []);
294
        my($uvalue) = $self->{'prjc'}->adjust_value([$sname, $name], []);
275
        if (defined $$uvalue[0]) {
295
        if (defined $$uvalue[0]) {
276
          $value = $uvalue;
296
          $value = $uvalue;
277
          $adjust = 0;
297
          $adjust = 0;
278
        }
298
        }
279
 
299
 
280
        if (!defined $value) {
300
        if (!defined $value) {
281
          ## Next, check the inner to outer foreach
301
          ## Next, check the inner to outer foreach
282
          ## scopes for overriding values
302
          ## scopes for overriding values
283
          while(!defined $value && $counter >= 0) {
303
          while(!defined $value && $counter >= 0) {
284
            $value = $self->{'foreach'}->{'scope'}->[$counter]->{$name};
304
            $value = $self->{'foreach'}->{'scope'}->[$counter]->{$name};
285
            --$counter;
305
            --$counter;
286
          }
306
          }
287
 
307
 
288
          ## Then get the value from the project creator
308
          ## Then get the value from the project creator
289
          if (!defined $value) {
309
          if (!defined $value) {
290
            $fromprj = 1;
310
            $fromprj = 1;
291
            $value = $self->{'prjc'}->get_assignment($name);
311
            $value = $self->{'prjc'}->get_assignment($name);
292
 
312
 
293
            ## Then get it from our known values
313
            ## Then get it from our known values
294
            if (!defined $value) {
314
            if (!defined $value) {
295
              $value = $self->{'values'}->{$name};
315
              $value = $self->{'values'}->{$name};
296
              if (!defined $value) {
316
              if (!defined $value) {
297
                ## Call back onto the project creator to allow
317
                ## Call back onto the project creator to allow
298
                ## it to fill in the value before defaulting to undef.
318
                ## it to fill in the value before defaulting to undef.
299
                $value = $self->{'prjc'}->fill_value($name);
319
                $value = $self->{'prjc'}->fill_value($name);
300
                if (!defined $value && $name =~ /^(.*)\->(\w+)/) {
320
                if (!defined $value && $name =~ /^(.*)\->(\w+)/) {
301
                  my($pre)  = $1;
321
                  my($pre)  = $1;
302
                  my($post) = $2;
322
                  my($post) = $2;
303
                  my($base) = $self->get_value($pre);
323
                  my($base) = $self->get_value($pre);
304
 
324
 
305
                  if (defined $base) {
325
                  if (defined $base) {
306
                    $value = $self->{'prjc'}->get_special_value(
326
                    $value = $self->{'prjc'}->get_special_value(
307
                               $pre, $post, $base,
327
                               $pre, $post, $base,
308
                               ($self->{'prjc'}->requires_parameters($post) ?
328
                               ($self->{'prjc'}->requires_parameters($post) ?
309
                                   $self->prepare_parameters($pre) : undef));
329
                                   $self->prepare_parameters($pre) : undef));
310
                  }
330
                  }
311
                }
331
                }
312
              }
332
              }
313
            }
333
            }
314
          }
334
          }
315
        }
335
        }
316
      }
336
      }
317
    }
337
    }
318
  }
338
  }
319
 
339
 
320
  ## Adjust the value even if we haven't obtained one from an outside
340
  ## Adjust the value even if we haven't obtained one from an outside
321
  ## source.
341
  ## source.
322
  if ($adjust && defined $value) {
342
  if ($adjust && defined $value) {
323
    $value = $self->{'prjc'}->adjust_value([$sname, $name], $value);
343
    $value = $self->{'prjc'}->adjust_value([$sname, $name], $value);
324
  }
344
  }
325
 
345
 
326
  ## If the value did not come from the project creator, we
346
  ## If the value did not come from the project creator, we
327
  ## check the variable name.  If it is a project keyword we then
347
  ## check the variable name.  If it is a project keyword we then
328
  ## check to see if we need to add the project value to the template
348
  ## check to see if we need to add the project value to the template
329
  ## variable value.  If so, we make a copy of the value array and
349
  ## variable value.  If so, we make a copy of the value array and
330
  ## push the project value onto that (to avoid modifying the original).
350
  ## push the project value onto that (to avoid modifying the original).
331
  if (!$fromprj && defined $self->{'vnames'}->{$name} &&
351
  if (!$fromprj && defined $self->{'vnames'}->{$name} &&
332
      $self->{'prjc'}->add_to_template_input_value($name)) {
352
      $self->{'prjc'}->add_to_template_input_value($name)) {
333
    my($pjval) = $self->{'prjc'}->get_assignment($name);
353
    my($pjval) = $self->{'prjc'}->get_assignment($name);
334
    if (defined $pjval) {
354
    if (defined $pjval) {
335
      my(@copy) = @$value;
355
      my(@copy) = @$value;
336
      if (!UNIVERSAL::isa($pjval, 'ARRAY')) {
356
      if (!UNIVERSAL::isa($pjval, 'ARRAY')) {
337
        $pjval = $self->create_array($pjval);
357
        $pjval = $self->create_array($pjval);
338
      }
358
      }
339
      push(@copy, @$pjval);
359
      push(@copy, @$pjval);
340
      $value = \@copy;
360
      $value = \@copy;
341
    }
361
    }
342
  }
362
  }
343
 
363
 
344
  return $self->{'prjc'}->relative($value, undef, $scope);
364
  return $self->{'prjc'}->relative($value, undef, $scope);
345
}
365
}
346
 
366
 
347
 
367
 
348
sub get_value_with_default {
368
sub get_value_with_default {
349
  my($self)  = shift;
369
  my($self)  = shift;
350
  my($name)  = shift;
370
  my($name)  = shift;
351
  my($value) = $self->get_value($name);
371
  my($value) = $self->get_value($name);
352
 
372
 
353
  if (!defined $value) {
373
  if (!defined $value) {
354
    $value = $self->{'defaults'}->{$name};
374
    $value = $self->{'defaults'}->{$name};
355
    if (defined $value) {
375
    if (defined $value) {
356
      my($counter) = $self->{'foreach'}->{'count'};
376
      my($counter) = $self->{'foreach'}->{'count'};
357
      my($sname)   = undef;
377
      my($sname)   = undef;
358
 
378
 
359
      if ($counter >= 0) {
379
      if ($counter >= 0) {
360
        ## Find the outer most scope for our variable name
380
        ## Find the outer most scope for our variable name
361
        for(my $index = $counter; $index >= 0; --$index) {
381
        for(my $index = $counter; $index >= 0; --$index) {
362
          if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {
382
          if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {
363
            $sname = $self->{'foreach'}->{'scope_name'}->[$index] .
383
            $sname = $self->{'foreach'}->{'scope_name'}->[$index] .
364
                     '::' . $name;
384
                     '::' . $name;
365
            last;
385
            last;
366
          }
386
          }
367
        }
387
        }
368
      }
388
      }
369
      $value = $self->{'prjc'}->relative(
389
      $value = $self->{'prjc'}->relative(
370
                    $self->{'prjc'}->adjust_value([$sname, $name], $value));
390
                    $self->{'prjc'}->adjust_value([$sname, $name], $value));
371
 
391
 
372
      ## If the user set the variable to empty, we will go ahead and use
392
      ## If the user set the variable to empty, we will go ahead and use
373
      ## the default value (since we know we have one at this point).
393
      ## the default value (since we know we have one at this point).
374
      if (!defined $value) {
394
      if (!defined $value) {
375
        $value = $self->{'defaults'}->{$name};
395
        $value = $self->{'defaults'}->{$name};
376
      }
396
      }
377
    }
397
    }
378
    else {
398
    else {
379
      #$self->warning("$name defaulting to empty string.");
399
      #$self->warning("$name defaulting to empty string.");
380
      $value = '';
400
      $value = '';
381
    }
401
    }
382
  }
402
  }
383
 
403
 
384
  if (UNIVERSAL::isa($value, 'ARRAY')) {
404
  if (UNIVERSAL::isa($value, 'ARRAY')) {
385
    $value = "@$value";
405
    $value = "@$value";
386
  }
406
  }
387
 
407
 
388
  return $value;
408
  return $value;
389
}
409
}
390
 
410
 
391
 
411
 
392
sub process_foreach {
412
sub process_foreach {
393
  my($self)   = shift;
413
  my($self)   = shift;
394
  my($index)  = $self->{'foreach'}->{'count'};
414
  my($index)  = $self->{'foreach'}->{'count'};
-
 
415
  my($base)   = $self->{'foreach'}->{'base'}->[$index];
395
  my($text)   = $self->{'foreach'}->{'text'}->[$index];
416
  my($text)   = $self->{'foreach'}->{'text'}->[$index];
396
  my($status) = 1;
417
  my($status) = 1;
397
  my($error)  = undef;
418
  my($error)  = undef;
398
  my(@values) = ();
419
  my(@values) = ();
399
  my($name)   = $self->{'foreach'}->{'name'}->[$index];
420
  my($name)   = $self->{'foreach'}->{'name'}->[$index];
400
  my(@cmds)   = ();
421
  my(@cmds)   = ();
401
  my($val)    = $self->{'foreach'}->{'vars'}->[$index];
422
  my($val)    = $self->{'foreach'}->{'vars'}->[$index];
-
 
423
  my($check_for_mixed) = undef;
402
 
424
 
403
  if ($val =~ /^((\w+),\s*)?flag_overrides\((.*)\)$/) {
425
  if ($val =~ /^((\w+),\s*)?flag_overrides\((.*)\)$/) {
404
    my($over) = $self->get_flag_overrides($3);
426
    my($over) = $self->get_flag_overrides($3);
405
    $name = $2;
427
    $name = $2;
406
    if (defined $over) {
428
    if (defined $over) {
407
      $val = $self->create_array($over);
429
      $val = $self->create_array($over);
408
      @values = @$val;
430
      @values = @$val;
409
    }
431
    }
410
    if (!defined $name) {
432
    if (!defined $name) {
411
      $name = '__unnamed__';
433
      $name = '__unnamed__';
412
    }
434
    }
413
  }
435
  }
414
  else {
436
  else {
415
    ## Pull out modifying commands first
437
    ## Pull out modifying commands first
416
    while ($val =~ /(\w+)\((.+)\)/) {
438
    while ($val =~ /(\w+)\((.+)\)/) {
417
      my($cmd) = $1;
439
      my($cmd) = $1;
418
      $val     = $2;
440
      $val     = $2;
419
      if (($keywords{$cmd} & 0x02) != 0) {
441
      if (($keywords{$cmd} & 0x02) != 0) {
420
        push(@cmds, 'perform_' . $cmd);
442
        push(@cmds, 'perform_' . $cmd);
421
      }
443
      }
422
      else {
444
      else {
423
        $self->warning("Unable to use $cmd in foreach (no perform_ method).");
445
        $self->warning("Unable to use $cmd in foreach (no perform_ method).");
424
      }
446
      }
425
    }
447
    }
426
 
448
 
427
    ## Get the values for all of the variable names
449
    ## Get the values for all of the variable names
428
    ## contained within the foreach
450
    ## contained within the foreach
429
    my($names) = $self->create_array($val);
451
    my($names) = $self->create_array($val);
430
    foreach my $n (@$names) {
452
    foreach my $n (@$names) {
431
      my($vals) = $self->get_value($n);
453
      my($vals) = $self->get_value($n);
432
      if (defined $vals && $vals ne '') {
454
      if (defined $vals && $vals ne '') {
433
        if (!UNIVERSAL::isa($vals, 'ARRAY')) {
455
        if (!UNIVERSAL::isa($vals, 'ARRAY')) {
434
          $vals = $self->create_array($vals);
456
          $vals = $self->create_array($vals);
435
        }
457
        }
436
        push(@values, @$vals);
458
        push(@values, @$vals);
437
      }
459
      }
438
      if (!defined $name) {
460
      if (!defined $name) {
439
        $name = $n;
461
        $name = $n;
440
        $name =~ s/s$//;
462
        $name =~ s/s$//;
441
      }
463
      }
-
 
464
      if (!$check_for_mixed && !$self->{'prjc'}->is_keyword($n)) {
-
 
465
        $check_for_mixed = 1;
-
 
466
      }
442
    }
467
    }
443
  }
468
  }
444
 
469
 
445
  ## Perform the commands on the built up @values
470
  ## Perform the commands on the built up @values
446
  foreach my $cmd (reverse @cmds) {
471
  foreach my $cmd (reverse @cmds) {
447
    @values = $self->$cmd(\@values);
472
    @values = $self->$cmd(\@values);
448
  }
473
  }
449
 
474
 
450
  ## Reset the text (it will be regenerated by calling parse_line
475
  ## Reset the text (it will be regenerated by calling parse_line
451
  $self->{'foreach'}->{'text'}->[$index] = '';
476
  $self->{'foreach'}->{'text'}->[$index] = '';
452
 
477
 
453
  if (defined $values[0]) {
478
  if (defined $values[0]) {
454
    my($scope) = $self->{'foreach'}->{'scope'}->[$index];
479
    my($scope) = $self->{'foreach'}->{'scope'}->[$index];
455
 
480
 
456
    $$scope{'forlast'}     = '';
481
    $$scope{'forlast'}     = '';
457
    $$scope{'fornotlast'}  = 1;
482
    $$scope{'fornotlast'}  = 1;
458
    $$scope{'forfirst'}    = 1;
483
    $$scope{'forfirst'}    = 1;
459
    $$scope{'fornotfirst'} = '';
484
    $$scope{'fornotfirst'} = '';
460
 
485
 
461
    ## If the foreach values are mixed (HASH and SCALAR), then
486
    ## If the foreach values are mixed (HASH and SCALAR), then
462
    ## remove the SCALAR values.
487
    ## remove the SCALAR values.
-
 
488
    if ($check_for_mixed) {
463
    my(%mixed) = ();
489
      my(%mixed) = ();
464
    my($mixed) = 0;
490
      my($mixed) = 0;
465
    for(my $i = 0; $i <= $#values; ++$i) {
491
      for(my $i = 0; $i <= $#values; ++$i) {
466
      $mixed{$values[$i]} = $self->set_current_values($values[$i]);
492
        $mixed{$values[$i]} = $self->set_current_values($values[$i]);
467
      $mixed |= $mixed{$values[$i]};
493
        $mixed |= $mixed{$values[$i]};
468
    }
494
      }
469
    if ($mixed) {
495
      if ($mixed) {
470
      my(@nvalues) = ();
496
        my(@nvalues) = ();
471
      foreach my $key (sort keys %mixed) {
497
        foreach my $key (sort keys %mixed) {
472
        if ($mixed{$key}) {
498
          if ($mixed{$key}) {
473
          push(@nvalues, $key);
499
            push(@nvalues, $key);
-
 
500
          }
474
        }
501
        }
475
      }
-
 
476
 
502
 
477
      ## Set the new values only if they are different
503
        ## Set the new values only if they are different
478
      ## from the original (except for order).
504
        ## from the original (except for order).
479
      my(@sorted) = sort(@values);
505
        my(@sorted) = sort(@values);
480
      if (@sorted != @nvalues) {
506
        if (@sorted != @nvalues) {
481
        @values = @nvalues;
507
          @values = @nvalues;
-
 
508
        }
482
      }
509
      }
483
    }
510
    }
484
 
511
 
485
    for(my $i = 0; $i <= $#values; ++$i) {
512
    for(my $i = 0; $i <= $#values; ++$i) {
486
      my($value) = $values[$i];
513
      my($value) = $values[$i];
487
 
514
 
488
      ## Set the corresponding values in the temporary scope
515
      ## Set the corresponding values in the temporary scope
489
      $self->set_current_values($value);
516
      $self->set_current_values($value);
490
 
517
 
491
      ## Set the special values that only exist
518
      ## Set the special values that only exist
492
      ## within a foreach
519
      ## within a foreach
493
      if ($i != 0) {
520
      if ($i != 0) {
494
        $$scope{'forfirst'}    = '';
521
        $$scope{'forfirst'}    = '';
495
        $$scope{'fornotfirst'} = 1;
522
        $$scope{'fornotfirst'} = 1;
496
      }
523
      }
497
      if ($i == $#values) {
524
      if ($i == $#values) {
498
        $$scope{'forlast'}    = 1;
525
        $$scope{'forlast'}    = 1;
499
        $$scope{'fornotlast'} = '';
526
        $$scope{'fornotlast'} = '';
500
      }
527
      }
501
      $$scope{'forcount'} = $i + 1;
528
      $$scope{'forcount'} = $i + $base;
502
 
529
 
503
      ## We don't use adjust_value here because these names
530
      ## We don't use adjust_value here because these names
504
      ## are generated from a foreach and should not be adjusted.
531
      ## are generated from a foreach and should not be adjusted.
505
      $$scope{$name} = $value;
532
      $$scope{$name} = $value;
506
 
533
 
507
      ## A tiny hack for VC7
534
      ## A tiny hack for VC7
508
      if ($name eq 'configuration') {
535
      if ($name eq 'configuration') {
509
        $self->{'prjc'}->update_project_info($self, 1,
536
        $self->{'prjc'}->update_project_info($self, 1,
510
                                             ['configuration', 'platform'],
537
                                             ['configuration', 'platform'],
511
                                             '|');
538
                                             '|');
512
      }
539
      }
513
 
540
 
514
      ## Now parse the line of text, each time
541
      ## Now parse the line of text, each time
515
      ## with different values
542
      ## with different values
516
      ++$self->{'foreach'}->{'processing'};
543
      ++$self->{'foreach'}->{'processing'};
517
      ($status, $error) = $self->parse_line(undef, $text);
544
      ($status, $error) = $self->parse_line(undef, $text);
518
      --$self->{'foreach'}->{'processing'};
545
      --$self->{'foreach'}->{'processing'};
519
      if (!$status) {
546
      if (!$status) {
520
        last;
547
        last;
521
      }
548
      }
522
    }
549
    }
523
  }
550
  }
524
 
551
 
525
  return $status, $error;
552
  return $status, $error;
526
}
553
}
527
 
554
 
528
 
555
 
529
sub handle_endif {
556
sub handle_endif {
530
  my($self) = shift;
557
  my($self) = shift;
531
  my($name) = shift;
558
  my($name) = shift;
532
  my($end)  = pop(@{$self->{'sstack'}});
559
  my($end)  = pop(@{$self->{'sstack'}});
533
  pop(@{$self->{'lstack'}});
560
  pop(@{$self->{'lstack'}});
534
 
561
 
535
  if (!defined $end) {
562
  if (!defined $end) {
536
    return 0, "Unmatched $name";
563
    return 0, "Unmatched $name";
537
  }
564
  }
538
  else {
565
  else {
539
    my($in) = index($end, $name);
566
    my($in) = index($end, $name);
540
    if ($in == 0) {
567
    if ($in == 0) {
541
      $self->{'if_skip'} = 0;
568
      $self->{'if_skip'} = 0;
542
    }
569
    }
543
    elsif ($in == -1) {
570
    elsif ($in == -1) {
544
      return 0, "Unmatched $name";
571
      return 0, "Unmatched $name";
545
    }
572
    }
546
  }
573
  }
547
 
574
 
548
  return 1, undef;
575
  return 1, undef;
549
}
576
}
550
 
577
 
551
 
578
 
552
sub handle_endfor {
579
sub handle_endfor {
553
  my($self) = shift;
580
  my($self) = shift;
554
  my($name) = shift;
581
  my($name) = shift;
555
  my($end)  = pop(@{$self->{'sstack'}});
582
  my($end)  = pop(@{$self->{'sstack'}});
556
  pop(@{$self->{'lstack'}});
583
  pop(@{$self->{'lstack'}});
557
 
584
 
558
  if (!defined $end) {
585
  if (!defined $end) {
559
    return 0, "Unmatched $name";
586
    return 0, "Unmatched $name";
560
  }
587
  }
561
  else {
588
  else {
562
    my($in) = index($end, $name);
589
    my($in) = index($end, $name);
563
    if ($in == 0) {
590
    if ($in == 0) {
564
      my($index) = $self->{'foreach'}->{'count'};
591
      my($index) = $self->{'foreach'}->{'count'};
565
      my($status, $error) = $self->process_foreach();
592
      my($status, $error) = $self->process_foreach();
566
      if ($status) {
593
      if ($status) {
567
        --$self->{'foreach'}->{'count'};
594
        --$self->{'foreach'}->{'count'};
568
        $self->append_current($self->{'foreach'}->{'text'}->[$index]);
595
        $self->append_current($self->{'foreach'}->{'text'}->[$index]);
569
      }
596
      }
570
      return $status, $error;
597
      return $status, $error;
571
    }
598
    }
572
    elsif ($in == -1) {
599
    elsif ($in == -1) {
573
      return 0, "Unmatched $name";
600
      return 0, "Unmatched $name";
574
    }
601
    }
575
  }
602
  }
576
 
603
 
577
  return 1, undef;
604
  return 1, undef;
578
}
605
}
579
 
606
 
580
 
607
 
581
sub get_flag_overrides {
608
sub get_flag_overrides {
582
  my($self)  = shift;
609
  my($self)  = shift;
583
  my($name)  = shift;
610
  my($name)  = shift;
584
  my($type)  = '';
611
  my($type)  = '';
585
 
612
 
586
  ## Split the name and type parameters
613
  ## Split the name and type parameters
587
  ($name, $type) = split(/,\s*/, $name);
614
  ($name, $type) = split(/,\s*/, $name);
588
 
615
 
589
  my($file) = $self->get_value($name);
616
  my($file) = $self->get_value($name);
590
  if (defined $file) {
617
  if (defined $file) {
591
    my($value) = undef;
618
    my($value) = undef;
592
    my($prjc)  = $self->{'prjc'};
619
    my($prjc)  = $self->{'prjc'};
593
    my($fo)    = $prjc->{'flag_overrides'};
620
    my($fo)    = $prjc->{'flag_overrides'};
594
 
621
 
595
    ## Save the name prefix (if there is one) for
622
    ## Save the name prefix (if there is one) for
596
    ## command parameter conversion at the end
623
    ## command parameter conversion at the end
597
    my($pre) = undef;
624
    my($pre) = undef;
598
    if ($name =~ /(\w+)->/) {
625
    if ($name =~ /(\w+)->/) {
599
      $pre = $1;
626
      $pre = $1;
600
    }
627
    }
601
 
628
 
602
    ## Replace the custom_type key with the actual custom type
629
    ## Replace the custom_type key with the actual custom type
603
    if ($name =~ /^custom_type\->/) {
630
    if (index($name, 'custom_type->') == 0) {
604
      my($ct) = $self->get_value('custom_type');
631
      my($ct) = $self->get_value('custom_type');
605
      if (defined $ct) {
632
      if (defined $ct) {
606
        $name = $ct;
633
        $name = $ct;
607
      }
634
      }
608
    }
635
    }
-
 
636
    elsif ($name =~ /^grouped_(.*_file)\->/) {
-
 
637
      $name = $1;
-
 
638
    }
609
 
639
 
610
    my($key) = (defined $$fo{$name} ? $name :
640
    my($key) = (defined $$fo{$name} ? $name :
611
                   (defined $$fo{$name . 's'} ? $name . 's' : undef));
641
                   (defined $$fo{$name . 's'} ? $name . 's' : undef));
612
    if (defined $key) {
642
    if (defined $key) {
613
      if (defined $prjc->{'matching_assignments'}->{$key}) {
643
      if (defined $prjc->{'matching_assignments'}->{$key}) {
614
        ## Convert the file name into a unix style file name
644
        ## Convert the file name into a unix style file name
615
        my($ustyle) = $file;
645
        my($ustyle) = $file;
616
        $ustyle =~ s/\\/\//g;
646
        $ustyle =~ s/\\/\//g;
617
 
647
 
618
        ## Save the directory portion for checking in the foreach
648
        ## Save the directory portion for checking in the foreach
619
        my($dir) = $self->mpc_dirname($ustyle);
649
        my($dir) = $self->mpc_dirname($ustyle);
620
 
650
 
621
        my($of) = (defined $$fo{$key}->{$ustyle} ? $ustyle :
651
        my($of) = (defined $$fo{$key}->{$ustyle} ? $ustyle :
622
                      (defined $$fo{$key}->{$dir} ? $dir : undef));
652
                      (defined $$fo{$key}->{$dir} ? $dir : undef));
623
        if (defined $of) {
653
        if (defined $of) {
624
          foreach my $aname (@{$prjc->{'matching_assignments'}->{$key}}) {
654
          foreach my $aname (@{$prjc->{'matching_assignments'}->{$key}}) {
625
            if ($aname eq $type && defined $$fo{$key}->{$of}->{$aname}) {
655
            if ($aname eq $type && defined $$fo{$key}->{$of}->{$aname}) {
626
              $value = $$fo{$key}->{$of}->{$aname};
656
              $value = $$fo{$key}->{$of}->{$aname};
627
              last;
657
              last;
628
            }
658
            }
629
          }
659
          }
630
        }
660
        }
631
      }
661
      }
632
    }
662
    }
633
 
663
 
634
    ## If the name that we're overriding has a value and
664
    ## If the name that we're overriding has a value and
635
    ## requires parameters, then we will convert all of the
665
    ## requires parameters, then we will convert all of the
636
    ## pseudo variables and provide parameters.
666
    ## pseudo variables and provide parameters.
637
    if (defined $pre &&
667
    if (defined $pre &&
638
        defined $value && $prjc->requires_parameters($type)) {
668
        defined $value && $prjc->requires_parameters($type)) {
639
      $value = $prjc->convert_command_parameters(
669
      $value = $prjc->convert_command_parameters(
640
                              $value,
670
                              $value,
641
                              $self->prepare_parameters($pre));
671
                              $self->prepare_parameters($pre));
642
    }
672
    }
643
 
673
 
644
    return $prjc->relative($value);
674
    return $prjc->relative($value);
645
  }
675
  }
646
 
676
 
647
  return undef;
677
  return undef;
648
}
678
}
649
 
679
 
650
 
680
 
651
sub get_multiple {
681
sub get_multiple {
652
  my($self)  = shift;
682
  my($self)  = shift;
653
  my($name)  = shift;
683
  my($name)  = shift;
654
  my($value) = $self->get_value_with_default($name);
-
 
655
  return (defined $value ?
684
  return $self->doif_multiple(
656
              $self->doif_multiple($self->create_array($value)) :
685
                  $self->create_array(
657
              undef);
686
                           $self->get_value_with_default($name)));
658
}
687
}
659
 
688
 
660
 
689
 
661
sub doif_multiple {
690
sub doif_multiple {
662
  my($self)  = shift;
691
  my($self)  = shift;
663
  my($value) = shift;
692
  my($value) = shift;
664
 
693
 
665
  if (defined $value) {
694
  if (defined $value) {
666
    return (scalar(@$value) > 1);
695
    return (scalar(@$value) > 1);
667
  }
696
  }
668
  return undef;
697
  return undef;
669
}
698
}
670
 
699
 
671
 
700
 
672
sub handle_multiple {
701
sub handle_multiple {
673
  my($self) = shift;
702
  my($self) = shift;
674
  my($name) = shift;
703
  my($name) = shift;
675
  my($val)  = $self->get_value_with_default($name);
704
  my($val)  = $self->get_value_with_default($name);
676
 
705
 
677
  if (defined $val) {
706
  if (defined $val) {
678
    my($array) = $self->create_array($val);
707
    my($array) = $self->create_array($val);
679
    $self->append_current(scalar(@$array));
708
    $self->append_current(scalar(@$array));
680
  }
709
  }
681
  else {
710
  else {
682
    $self->append_current(0);
711
    $self->append_current(0);
683
  }
712
  }
684
}
713
}
685
 
714
 
686
 
715
 
687
sub get_starts_with {
716
sub get_starts_with {
688
  my($self) = shift;
717
  my($self) = shift;
689
  my($str)  = shift;
718
  my($str)  = shift;
690
  return $self->doif_starts_with([$str]);
719
  return $self->doif_starts_with([$str]);
691
}
720
}
692
 
721
 
693
 
722
 
694
sub doif_starts_with {
723
sub doif_starts_with {
695
  my($self) = shift;
724
  my($self) = shift;
696
  my($val)  = shift;
725
  my($val)  = shift;
697
 
726
 
698
  if (defined $val) {
727
  if (defined $val) {
699
    my($name, $pattern) = $self->split_parameters("@$val");
728
    my($name, $pattern) = $self->split_parameters("@$val");
700
    if (defined $name && defined $pattern) {
729
    if (defined $name && defined $pattern) {
701
      return ($self->get_value_with_default($name) =~ /^$pattern/);
730
      return ($self->get_value_with_default($name) =~ /^$pattern/);
702
    }
731
    }
703
  }
732
  }
704
  return undef;
733
  return undef;
705
}
734
}
706
 
735
 
707
 
736
 
708
sub handle_starts_with {
737
sub handle_starts_with {
709
  my($self) = shift;
738
  my($self) = shift;
710
  my($str)  = shift;
739
  my($str)  = shift;
711
 
740
 
712
  if (defined $str) {
741
  if (defined $str) {
713
    my($val) = $self->doif_starts_with([$str]);
742
    my($val) = $self->doif_starts_with([$str]);
714
 
743
 
715
    if (defined $val) {
744
    if (defined $val) {
716
      $self->append_current($val);
745
      $self->append_current($val);
717
    }
746
    }
718
    else {
747
    else {
719
      $self->append_current(0);
748
      $self->append_current(0);
720
    }
749
    }
721
  }
750
  }
722
}
751
}
723
 
752
 
724
 
753
 
725
sub get_ends_with {
754
sub get_ends_with {
726
  my($self) = shift;
755
  my($self) = shift;
727
  my($str)  = shift;
756
  my($str)  = shift;
728
  return $self->doif_ends_with([$str]);
757
  return $self->doif_ends_with([$str]);
729
}
758
}
730
 
759
 
731
 
760
 
732
sub doif_ends_with {
761
sub doif_ends_with {
733
  my($self) = shift;
762
  my($self) = shift;
734
  my($val)  = shift;
763
  my($val)  = shift;
735
 
764
 
736
  if (defined $val) {
765
  if (defined $val) {
737
    my($name, $pattern) = $self->split_parameters("@$val");
766
    my($name, $pattern) = $self->split_parameters("@$val");
738
    if (defined $name && defined $pattern) {
767
    if (defined $name && defined $pattern) {
739
      return ($self->get_value_with_default($name) =~ /$pattern$/);
768
      return ($self->get_value_with_default($name) =~ /$pattern$/);
740
    }
769
    }
741
  }
770
  }
742
  return undef;
771
  return undef;
743
}
772
}
744
 
773
 
745
 
774
 
746
sub handle_ends_with {
775
sub handle_ends_with {
747
  my($self) = shift;
776
  my($self) = shift;
748
  my($str)  = shift;
777
  my($str)  = shift;
749
 
778
 
750
  if (defined $str) {
779
  if (defined $str) {
751
    my($val) = $self->doif_ends_with([$str]);
780
    my($val) = $self->doif_ends_with([$str]);
752
 
781
 
753
    if (defined $val) {
782
    if (defined $val) {
754
      $self->append_current($val);
783
      $self->append_current($val);
755
    }
784
    }
756
    else {
785
    else {
757
      $self->append_current(0);
786
      $self->append_current(0);
758
    }
787
    }
759
  }
788
  }
760
}
789
}
761
 
790
 
762
 
791
 
763
sub get_contains {
792
sub get_contains {
764
  my($self) = shift;
793
  my($self) = shift;
765
  my($str)  = shift;
794
  my($str)  = shift;
766
  return $self->doif_contains([$str]);
795
  return $self->doif_contains([$str]);
767
}
796
}
768
 
797
 
769
 
798
 
770
sub doif_contains {
799
sub doif_contains {
771
  my($self) = shift;
800
  my($self) = shift;
772
  my($val)  = shift;
801
  my($val)  = shift;
773
 
802
 
774
  if (defined $val) {
803
  if (defined $val) {
775
    my($name, $pattern) = $self->split_parameters("@$val");
804
    my($name, $pattern) = $self->split_parameters("@$val");
776
    if (defined $name && defined $pattern) {
805
    if (defined $name && defined $pattern) {
777
      return ($self->get_value_with_default($name) =~ /$pattern/);
806
      return ($self->get_value_with_default($name) =~ /$pattern/);
778
    }
807
    }
779
  }
808
  }
780
  return undef;
809
  return undef;
781
}
810
}
782
 
811
 
783
 
812
 
784
sub handle_contains {
813
sub handle_contains {
785
  my($self) = shift;
814
  my($self) = shift;
786
  my($str)  = shift;
815
  my($str)  = shift;
787
 
816
 
788
  if (defined $str) {
817
  if (defined $str) {
789
    my($val) = $self->doif_contains([$str]);
818
    my($val) = $self->doif_contains([$str]);
790
 
819
 
791
    if (defined $val) {
820
    if (defined $val) {
792
      $self->append_current($val);
821
      $self->append_current($val);
793
    }
822
    }
794
    else {
823
    else {
795
      $self->append_current(0);
824
      $self->append_current(0);
796
    }
825
    }
797
  }
826
  }
798
}
827
}
799
 
828
 
800
 
829
 
801
sub get_compares {
830
sub get_compares {
802
  my($self) = shift;
831
  my($self) = shift;
803
  my($str)  = shift;
832
  my($str)  = shift;
804
  return $self->doif_compares([$str]);
833
  return $self->doif_compares([$str]);
805
}
834
}
806
 
835
 
807
 
836
 
808
sub doif_compares {
837
sub doif_compares {
809
  my($self) = shift;
838
  my($self) = shift;
810
  my($val)  = shift;
839
  my($val)  = shift;
811
 
840
 
812
  if (defined $val) {
841
  if (defined $val) {
813
    my($name, $pattern) = $self->split_parameters("@$val");
842
    my($name, $pattern) = $self->split_parameters("@$val");
814
    if (defined $name && defined $pattern) {
843
    if (defined $name && defined $pattern) {
815
      return ($self->get_value_with_default($name) eq $pattern);
844
      return ($self->get_value_with_default($name) eq $pattern);
816
    }
845
    }
817
  }
846
  }
818
  return undef;
847
  return undef;
819
}
848
}
820
 
849
 
821
 
850
 
822
sub handle_compares {
851
sub handle_compares {
823
  my($self) = shift;
852
  my($self) = shift;
824
  my($str)  = shift;
853
  my($str)  = shift;
825
 
854
 
826
  if (defined $str) {
855
  if (defined $str) {
827
    my($val) = $self->doif_compares([$str]);
856
    my($val) = $self->doif_compares([$str]);
828
 
857
 
829
    if (defined $val) {
858
    if (defined $val) {
830
      $self->append_current($val);
859
      $self->append_current($val);
831
    }
860
    }
832
    else {
861
    else {
833
      $self->append_current(0);
862
      $self->append_current(0);
834
    }
863
    }
835
  }
864
  }
836
}
865
}
837
 
866
 
838
 
867
 
839
sub perform_reverse {
868
sub perform_reverse {
840
  my($self)  = shift;
869
  my($self)  = shift;
841
  my($value) = shift;
870
  my($value) = shift;
842
  return reverse(@$value);
871
  return reverse(@$value);
843
}
872
}
844
 
873
 
845
 
874
 
846
sub handle_reverse {
875
sub handle_reverse {
847
  my($self) = shift;
876
  my($self) = shift;
848
  my($name) = shift;
877
  my($name) = shift;
849
  my($val)  = $self->get_value_with_default($name);
878
  my($val)  = $self->get_value_with_default($name);
850
 
879
 
851
  if (defined $val) {
880
  if (defined $val) {
852
    my(@array) = $self->perform_reverse($self->create_array($val));
881
    my(@array) = $self->perform_reverse($self->create_array($val));
853
    $self->append_current("@array");
882
    $self->append_current("@array");
854
  }
883
  }
855
}
884
}
856
 
885
 
857
 
886
 
858
sub perform_sort {
887
sub perform_sort {
859
  my($self)  = shift;
888
  my($self)  = shift;
860
  my($value) = shift;
889
  my($value) = shift;
861
  return sort(@$value);
890
  return sort(@$value);
862
}
891
}
863
 
892
 
864
 
893
 
865
sub handle_sort {
894
sub handle_sort {
866
  my($self) = shift;
895
  my($self) = shift;
867
  my($name) = shift;
896
  my($name) = shift;
868
  my($val)  = $self->get_value_with_default($name);
897
  my($val)  = $self->get_value_with_default($name);
869
 
898
 
870
  if (defined $val) {
899
  if (defined $val) {
871
    my(@array) = $self->perform_sort($self->create_array($val));
900
    my(@array) = $self->perform_sort($self->create_array($val));
872
    $self->append_current("@array");
901
    $self->append_current("@array");
873
  }
902
  }
874
}
903
}
875
 
904
 
876
 
905
 
877
sub get_uniq {
906
sub get_uniq {
878
  my($self)  = shift;
907
  my($self)  = shift;
879
  my($name)  = shift;
908
  my($name)  = shift;
880
  my($value) = $self->get_value_with_default($name);
909
  my($value) = $self->get_value_with_default($name);
881
 
910
 
882
  if (defined $value) {
911
  if (defined $value) {
883
    my(@array) = $self->perform_uniq($self->create_array($value));
912
    my(@array) = $self->perform_uniq($self->create_array($value));
884
    return \@array;
913
    return \@array;
885
  }
914
  }
886
 
915
 
887
  return undef;
916
  return undef;
888
}
917
}
889
 
918
 
890
 
919
 
891
sub perform_uniq {
920
sub perform_uniq {
892
  my($self)  = shift;
921
  my($self)  = shift;
893
  my($value) = shift;
922
  my($value) = shift;
894
  my(%value) = ();
923
  my(%value) = ();
895
  @value{@$value} = ();
924
  @value{@$value} = ();
896
  return sort(keys %value);
925
  return sort(keys %value);
897
}
926
}
898
 
927
 
899
 
928
 
900
sub handle_uniq {
929
sub handle_uniq {
901
  my($self) = shift;
930
  my($self) = shift;
902
  my($name) = shift;
931
  my($name) = shift;
903
  my($val)  = $self->get_value_with_default($name);
932
  my($val)  = $self->get_value_with_default($name);
904
 
933
 
905
  if (defined $val) {
934
  if (defined $val) {
906
    my(@array) = $self->perform_uniq($self->create_array($val));
935
    my(@array) = $self->perform_uniq($self->create_array($val));
907
    $self->append_current("@array");
936
    $self->append_current("@array");
908
  }
937
  }
909
}
938
}
910
 
939
 
911
 
940
 
912
sub process_compound_if {
941
sub process_compound_if {
913
  my($self)   = shift;
942
  my($self)   = shift;
914
  my($str)    = shift;
943
  my($str)    = shift;
915
  my($status) = 0;
944
  my($status) = 0;
916
 
945
 
917
  if ($str =~ /\|\|/) {
946
  if (index($str, '||') >= 0) {
918
    my($ret) = 0;
947
    my($ret) = 0;
919
    foreach my $v (split(/\s*\|\|\s*/, $str)) {
948
    foreach my $v (split(/\s*\|\|\s*/, $str)) {
920
      $ret |= $self->process_compound_if($v);
949
      $ret |= $self->process_compound_if($v);
921
      if ($ret != 0) {
950
      if ($ret != 0) {
922
        return 1;
951
        return 1;
923
      }
952
      }
924
    }
953
    }
925
  }
954
  }
926
  elsif ($str =~ /\&\&/) {
955
  elsif (index($str, '&&') >= 0) {
927
    my($ret) = 1;
956
    my($ret) = 1;
928
    foreach my $v (split(/\s*\&\&\s*/, $str)) {
957
    foreach my $v (split(/\s*\&\&\s*/, $str)) {
929
      $ret &&= $self->process_compound_if($v);
958
      $ret &&= $self->process_compound_if($v);
930
      if ($ret == 0) {
959
      if ($ret == 0) {
931
        return 0;
960
        return 0;
932
      }
961
      }
933
    }
962
    }
934
    $status = 1;
963
    $status = 1;
935
  }
964
  }
936
  else {
965
  else {
937
    ## See if we need to reverse the return value
966
    ## See if we need to reverse the return value
938
    my($not) = 0;
967
    my($not) = 0;
939
    if ($str =~ /^!(.*)/) {
968
    if ($str =~ /^!(.*)/) {
940
      $not = 1;
969
      $not = 1;
941
      $str = $1;
970
      $str = $1;
942
    }
971
    }
943
 
972
 
944
    ## Get the value based on the string
973
    ## Get the value based on the string
945
    my(@cmds) = ();
974
    my(@cmds) = ();
946
    my($val)  = undef;
975
    my($val)  = undef;
947
    while ($str =~ /(\w+)\((.+)\)(.*)/) {
976
    while ($str =~ /(\w+)\((.+)\)(.*)/) {
948
      if ($3 eq '') {
977
      if ($3 eq '') {
949
        push(@cmds, $1);
978
        push(@cmds, $1);
950
        $str = $2;
979
        $str = $2;
951
      }
980
      }
952
      else {
981
      else {
953
        ## If there is something trailing the closing parenthesis then
982
        ## If there is something trailing the closing parenthesis then
954
        ## the whole thing is considered a parameter to the first
983
        ## the whole thing is considered a parameter to the first
955
        ## function.
984
        ## function.
956
        last;
985
        last;
957
      }
986
      }
958
    }
987
    }
959
 
988
 
960
    if (defined $cmds[0]) {
989
    if (defined $cmds[0]) {
961
      ## Start out calling get_xxx on the string
990
      ## Start out calling get_xxx on the string
962
      my($type) = 0x01;
991
      my($type) = 0x01;
963
      my($prefix) = 'get_';
992
      my($prefix) = 'get_';
964
 
993
 
965
      $val = $str;
994
      $val = $str;
966
      foreach my $cmd (reverse @cmds) {
995
      foreach my $cmd (reverse @cmds) {
967
        if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) {
996
        if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) {
968
          my($func) = "$prefix$cmd";
997
          my($func) = "$prefix$cmd";
969
          $val = $self->$func($val);
998
          $val = $self->$func($val);
970
 
999
 
971
          ## Now that we have a value, we need to switch over
1000
          ## Now that we have a value, we need to switch over
972
          ## to calling doif_xxx
1001
          ## to calling doif_xxx
973
          $type = 0x04;
1002
          $type = 0x04;
974
          $prefix = 'doif_';
1003
          $prefix = 'doif_';
975
        }
1004
        }
976
        else {
1005
        else {
977
          $self->warning("Unable to use $cmd in if (no $prefix method).");
1006
          $self->warning("Unable to use $cmd in if (no $prefix method).");
978
        }
1007
        }
979
      }
1008
      }
980
    }
1009
    }
981
    else {
1010
    else {
982
      $val = $self->get_value($str);
1011
      $val = $self->get_value($str);
983
    }
1012
    }
984
 
1013
 
985
    ## See if any portion of the value is defined and not empty
1014
    ## See if any portion of the value is defined and not empty
986
    my($ret) = 0;
1015
    my($ret) = 0;
987
    if (defined $val) {
1016
    if (defined $val) {
988
      if (UNIVERSAL::isa($val, 'ARRAY')) {
1017
      if (UNIVERSAL::isa($val, 'ARRAY')) {
989
        foreach my $v (@$val) {
1018
        foreach my $v (@$val) {
990
          if ($v ne '') {
1019
          if ($v ne '') {
991
            $ret = 1;
1020
            $ret = 1;
992
            last;
1021
            last;
993
          }
1022
          }
994
        }
1023
        }
995
      }
1024
      }
996
      elsif ($val ne '') {
1025
      elsif ($val ne '') {
997
        $ret = 1;
1026
        $ret = 1;
998
      }
1027
      }
999
    }
1028
    }
1000
    return ($not ? !$ret : $ret);
1029
    return ($not ? !$ret : $ret);
1001
  }
1030
  }
1002
 
1031
 
1003
  return $status;
1032
  return $status;
1004
}
1033
}
1005
 
1034
 
1006
 
1035
 
1007
sub handle_if {
1036
sub handle_if {
1008
  my($self)   = shift;
1037
  my($self)   = shift;
1009
  my($val)    = shift;
1038
  my($val)    = shift;
1010
  my($name)   = 'endif';
1039
  my($name)   = 'endif';
1011
 
1040
 
1012
  push(@{$self->{'lstack'}}, $self->get_line_number() . " $val");
1041
  push(@{$self->{'lstack'}}, $self->get_line_number() . " $val");
1013
  if ($self->{'if_skip'}) {
1042
  if ($self->{'if_skip'}) {
1014
    push(@{$self->{'sstack'}}, "*$name");
1043
    push(@{$self->{'sstack'}}, "*$name");
1015
  }
1044
  }
1016
  else {
1045
  else {
1017
    ## Determine if we are skipping the portion of this if statement
1046
    ## Determine if we are skipping the portion of this if statement
1018
    ## $val will always be defined since we won't get into this method
1047
    ## $val will always be defined since we won't get into this method
1019
    ## without properly parsing the if statement.
1048
    ## without properly parsing the if statement.
1020
    $self->{'if_skip'} = !$self->process_compound_if($val);
1049
    $self->{'if_skip'} = !$self->process_compound_if($val);
1021
    push(@{$self->{'sstack'}}, $name);
1050
    push(@{$self->{'sstack'}}, $name);
1022
  }
1051
  }
1023
}
1052
}
1024
 
1053
 
1025
 
1054
 
1026
sub handle_else {
1055
sub handle_else {
1027
  my($self)  = shift;
1056
  my($self)  = shift;
1028
  my(@scopy) = @{$self->{'sstack'}};
1057
  my(@scopy) = @{$self->{'sstack'}};
1029
 
1058
 
1030
  if (defined $scopy[$#scopy]) {
1059
  if (defined $scopy[$#scopy]) {
1031
    my($index) = index($scopy[$#scopy], 'endif');
1060
    my($index) = index($scopy[$#scopy], 'endif');
1032
    if ($index >= 0) {
1061
    if ($index >= 0) {
1033
      if ($index == 0) {
1062
      if ($index == 0) {
1034
        $self->{'if_skip'} ^= 1;
1063
        $self->{'if_skip'} ^= 1;
1035
      }
1064
      }
1036
      $self->{'sstack'}->[$#scopy] .= ':';
1065
      $self->{'sstack'}->[$#scopy] .= ':';
1037
    }
1066
    }
1038
 
1067
 
1039
    if (($self->{'sstack'}->[$#scopy] =~ tr/:/:/) > 1) {
1068
    if (($self->{'sstack'}->[$#scopy] =~ tr/:/:/) > 1) {
1040
      return 0, 'Unmatched else';
1069
      return 0, 'Unmatched else';
1041
    }
1070
    }
1042
  }
1071
  }
1043
 
1072
 
1044
  return 1, undef;
1073
  return 1, undef;
1045
}
1074
}
1046
 
1075
 
1047
 
1076
 
1048
sub handle_foreach {
1077
sub handle_foreach {
1049
  my($self)        = shift;
1078
  my($self)        = shift;
1050
  my($val)         = shift;
1079
  my($val)         = shift;
1051
  my($name)        = 'endfor';
1080
  my($name)        = 'endfor';
1052
  my($status)      = 1;
1081
  my($status)      = 1;
1053
  my($errorString) = undef;
1082
  my($errorString) = undef;
1054
 
1083
 
1055
  push(@{$self->{'lstack'}}, $self->get_line_number());
1084
  push(@{$self->{'lstack'}}, $self->get_line_number());
1056
  if (!$self->{'if_skip'}) {
1085
  if (!$self->{'if_skip'}) {
-
 
1086
    my($base)  = 1;
1057
    my($vname) = undef;
1087
    my($vname) = undef;
1058
    if ($val =~ /flag_overrides\([^\)]+\)/) {
1088
    if ($val =~ /flag_overrides\([^\)]+\)/) {
1059
    }
1089
    }
1060
    elsif ($val =~ /([^,]+),(.*)/) {
1090
    elsif ($val =~ /([^,]*),(.*)/) {
1061
      $vname = $1;
1091
      $vname = $1;
1062
      $val   = $2;
1092
      $val   = $2;
1063
      $vname =~ s/^\s+//;
1093
      $vname =~ s/^\s+//;
1064
      $vname =~ s/\s+$//;
1094
      $vname =~ s/\s+$//;
1065
      $val   =~ s/^\s+//;
1095
      $val   =~ s/^\s+//;
1066
      $val   =~ s/\s+$//;
1096
      $val   =~ s/\s+$//;
1067
 
1097
 
1068
      ## Due to the way flag_overrides works, we can't allow
-
 
1069
      ## the user to name the foreach variable when dealing
-
 
1070
      ## with custom types.
1098
      if ($vname eq '') {
1071
      if ($val =~ /^custom_type\->/ || $val eq 'custom_types') {
-
 
1072
        $status = 0;
1099
        $status = 0;
1073
        $errorString = 'The foreach variable can not be ' .
1100
        $errorString = 'The foreach variable name is not valid';
1074
                       'named when dealing with custom types';
-
 
1075
      }
1101
      }
-
 
1102
 
-
 
1103
      if ($val =~ /([^,]*),(.*)/) {
-
 
1104
        $base = $1;
-
 
1105
        $val  = $2;
-
 
1106
        $base =~ s/^\s+//;
-
 
1107
        $base =~ s/\s+$//;
-
 
1108
        $val  =~ s/^\s+//;
-
 
1109
        $val  =~ s/\s+$//;
-
 
1110
 
-
 
1111
        if ($base !~ /^\d+$/) {
-
 
1112
          $status = 0;
-
 
1113
          $errorString = 'The forcount specified is not a valid number';
-
 
1114
        }
-
 
1115
      }
-
 
1116
      elsif ($vname =~ /^\d+$/) {
-
 
1117
        $base  = $vname;
-
 
1118
        $vname = undef;
-
 
1119
      }
-
 
1120
 
-
 
1121
      ## Due to the way flag_overrides works, we can't allow
-
 
1122
      ## the user to name the foreach variable when dealing
-
 
1123
      ## with variables that can be used with the -> operator
-
 
1124
      if (defined $vname) {
-
 
1125
        foreach my $ref (keys %arrow_op_ref) {
-
 
1126
          my($name_re)  = $ref . 's';
1076
      elsif ($val =~ /^grouped_.*_file\->/ || $val =~ /^grouped_.*files$/) {
1127
          if ($val =~ /^$ref\->/ || $val =~ /^$name_re$/) {
1077
        $status = 0;
1128
            $status = 0;
1078
        $errorString = 'The foreach variable can not be ' .
1129
            $errorString = 'The foreach variable can not be ' .
1079
                       'named when dealing with grouped files';
1130
                           'named when dealing with ' .
-
 
1131
                           $arrow_op_ref{$ref};
-
 
1132
          }
-
 
1133
        }
1080
      }
1134
      }
1081
    }
1135
    }
1082
 
1136
 
1083
    push(@{$self->{'sstack'}}, $name);
1137
    push(@{$self->{'sstack'}}, $name);
1084
    my($index) = ++$self->{'foreach'}->{'count'};
1138
    my($index) = ++$self->{'foreach'}->{'count'};
1085
 
1139
 
-
 
1140
    $self->{'foreach'}->{'base'}->[$index]  = $base;
1086
    $self->{'foreach'}->{'name'}->[$index]  = $vname;
1141
    $self->{'foreach'}->{'name'}->[$index]  = $vname;
1087
    $self->{'foreach'}->{'vars'}->[$index]  = $val;
1142
    $self->{'foreach'}->{'vars'}->[$index]  = $val;
1088
    $self->{'foreach'}->{'text'}->[$index]  = '';
1143
    $self->{'foreach'}->{'text'}->[$index]  = '';
1089
    $self->{'foreach'}->{'scope'}->[$index] = {};
1144
    $self->{'foreach'}->{'scope'}->[$index] = {};
1090
    $self->{'foreach'}->{'scope_name'}->[$index] = undef;
1145
    $self->{'foreach'}->{'scope_name'}->[$index] = undef;
1091
  }
1146
  }
1092
  else {
1147
  else {
1093
    push(@{$self->{'sstack'}}, "*$name");
1148
    push(@{$self->{'sstack'}}, "*$name");
1094
  }
1149
  }
1095
 
1150
 
1096
  return $status, $errorString;
1151
  return $status, $errorString;
1097
}
1152
}
1098
 
1153
 
1099
 
1154
 
1100
sub handle_special {
1155
sub handle_special {
1101
  my($self) = shift;
1156
  my($self) = shift;
1102
  my($name) = shift;
1157
  my($name) = shift;
1103
  my($val)  = shift;
1158
  my($val)  = shift;
1104
 
1159
 
1105
  ## If $name (fornotlast, forfirst, etc.) is set to 1
1160
  ## If $name (fornotlast, forfirst, etc.) is set to 1
1106
  ## Then we append the $val onto the current string that's
1161
  ## Then we append the $val onto the current string that's
1107
  ## being built.
1162
  ## being built.
1108
  if ($self->get_value($name)) {
1163
  if ($self->get_value($name)) {
1109
    $self->append_current($val);
1164
    $self->append_current($val);
1110
  }
1165
  }
1111
}
1166
}
1112
 
1167
 
1113
 
1168
 
1114
sub handle_uc {
1169
sub handle_uc {
1115
  my($self) = shift;
1170
  my($self) = shift;
1116
  my($name) = shift;
1171
  my($name) = shift;
1117
 
1172
 
1118
  $self->append_current(uc($self->get_value_with_default($name)));
1173
  $self->append_current(uc($self->get_value_with_default($name)));
1119
}
1174
}
1120
 
1175
 
1121
 
1176
 
1122
sub handle_lc {
1177
sub handle_lc {
1123
  my($self) = shift;
1178
  my($self) = shift;
1124
  my($name) = shift;
1179
  my($name) = shift;
1125
 
1180
 
1126
  $self->append_current(lc($self->get_value_with_default($name)));
1181
  $self->append_current(lc($self->get_value_with_default($name)));
1127
}
1182
}
1128
 
1183
 
1129
 
1184
 
1130
sub handle_ucw {
1185
sub handle_ucw {
1131
  my($self) = shift;
1186
  my($self) = shift;
1132
  my($name) = shift;
1187
  my($name) = shift;
1133
  my($val)  = $self->get_value_with_default($name);
1188
  my($val)  = $self->get_value_with_default($name);
1134
 
1189
 
1135
  substr($val, 0, 1) = uc(substr($val, 0, 1));
1190
  substr($val, 0, 1) = uc(substr($val, 0, 1));
1136
  while($val =~ /[_\s]([a-z])/) {
1191
  while($val =~ /[_\s]([a-z])/) {
1137
    my($uc) = uc($1);
1192
    my($uc) = uc($1);
1138
    $val =~ s/[_\s][a-z]/ $uc/;
1193
    $val =~ s/[_\s][a-z]/ $uc/;
1139
  }
1194
  }
1140
  $self->append_current($val);
1195
  $self->append_current($val);
1141
}
1196
}
1142
 
1197
 
1143
 
1198
 
1144
sub perform_normalize {
1199
sub perform_normalize {
1145
  my($self)  = shift;
1200
  my($self)  = shift;
1146
  my($value) = shift;
1201
  my($value) = shift;
1147
  $value =~ tr/\/\\\-$()./_/;
1202
  $value =~ tr/\/\\\-$()./_/;
1148
  return $value;
1203
  return $value;
1149
}
1204
}
1150
 
1205
 
1151
 
1206
 
1152
sub handle_normalize {
1207
sub handle_normalize {
1153
  my($self) = shift;
1208
  my($self) = shift;
1154
  my($name) = shift;
1209
  my($name) = shift;
1155
  my($val)  = $self->get_value_with_default($name);
1210
  my($val)  = $self->get_value_with_default($name);
1156
 
1211
 
1157
  $self->append_current($self->perform_normalize($val));
1212
  $self->append_current($self->perform_normalize($val));
1158
}
1213
}
1159
 
1214
 
1160
 
1215
 
1161
sub perform_noextension {
1216
sub perform_noextension {
1162
  my($self)  = shift;
1217
  my($self)  = shift;
1163
  my($value) = shift;
1218
  my($value) = shift;
1164
  $value =~ s/\.[^\.]+$//;
1219
  $value =~ s/\.[^\.]+$//;
1165
  return $value;
1220
  return $value;
1166
}
1221
}
1167
 
1222
 
1168
 
1223
 
1169
sub handle_noextension {
1224
sub handle_noextension {
1170
  my($self) = shift;
1225
  my($self) = shift;
1171
  my($name) = shift;
1226
  my($name) = shift;
1172
  my($val)  = $self->get_value_with_default($name);
1227
  my($val)  = $self->get_value_with_default($name);
1173
 
1228
 
1174
  $self->append_current($self->perform_noextension($val));
1229
  $self->append_current($self->perform_noextension($val));
1175
}
1230
}
1176
 
1231
 
1177
 
1232
 
1178
sub get_dirname {
1233
sub get_dirname {
1179
  my($self)  = shift;
1234
  my($self)  = shift;
1180
  my($name)  = shift;
1235
  my($name)  = shift;
1181
  my($value) = $self->get_value_with_default($name);
1236
  return $self->doif_dirname($self->get_value_with_default($name));
1182
  return (defined $value ?
-
 
1183
              $self->doif_dirname($value) : undef);
-
 
1184
}
1237
}
1185
 
1238
 
1186
 
1239
 
1187
sub doif_dirname {
1240
sub doif_dirname {
1188
  my($self)  = shift;
1241
  my($self)  = shift;
1189
  my($value) = shift;
1242
  my($value) = shift;
1190
 
1243
 
1191
  if (defined $value) {
1244
  if (defined $value) {
1192
    $value = $self->tp_dirname($value);
1245
    $value = $self->validated_dirname($value);
1193
    return ($value ne '.');
1246
    return ($value ne '.');
1194
  }
1247
  }
1195
  return undef;
1248
  return undef;
1196
}
1249
}
1197
 
1250
 
1198
 
1251
 
1199
sub handle_dirname {
1252
sub handle_dirname {
1200
  my($self) = shift;
1253
  my($self) = shift;
1201
  my($name) = shift;
1254
  my($name) = shift;
1202
 
1255
 
1203
  if (!$self->{'if_skip'}) {
-
 
1204
    $self->append_current(
1256
  $self->append_current(
1205
              $self->tp_dirname($self->get_value_with_default($name)));
1257
            $self->validated_dirname($self->get_value_with_default($name)));
1206
  }
-
 
1207
}
1258
}
1208
 
1259
 
1209
 
1260
 
1210
sub handle_basename {
1261
sub handle_basename {
1211
  my($self) = shift;
1262
  my($self) = shift;
1212
  my($name) = shift;
1263
  my($name) = shift;
1213
 
1264
 
1214
  if (!$self->{'if_skip'}) {
-
 
1215
    $self->append_current(
1265
  $self->append_current(
1216
              $self->basename($self->get_value_with_default($name)));
1266
            $self->tp_basename($self->get_value_with_default($name)));
1217
  }
-
 
1218
}
1267
}
1219
 
1268
 
1220
 
1269
 
1221
sub handle_basenoextension {
1270
sub handle_basenoextension {
1222
  my($self) = shift;
1271
  my($self) = shift;
1223
  my($name) = shift;
1272
  my($name) = shift;
1224
  my($val)  = $self->basename($self->get_value_with_default($name));
1273
  my($val)  = $self->tp_basename($self->get_value_with_default($name));
1225
 
1274
 
1226
  $val =~ s/\.[^\.]+$//;
1275
  $val =~ s/\.[^\.]+$//;
1227
  $self->append_current($val);
1276
  $self->append_current($val);
1228
}
1277
}
1229
 
1278
 
1230
 
1279
 
1231
sub handle_flag_overrides {
1280
sub handle_flag_overrides {
1232
  my($self)  = shift;
1281
  my($self)  = shift;
1233
  my($name)  = shift;
1282
  my($name)  = shift;
1234
  my($value) = $self->get_flag_overrides($name);
1283
  my($value) = $self->get_flag_overrides($name);
1235
 
1284
 
1236
  if (defined $value) {
1285
  if (defined $value) {
1237
    $self->append_current($value);
1286
    $self->append_current($value);
1238
  }
1287
  }
1239
}
1288
}
1240
 
1289
 
1241
 
1290
 
1242
sub handle_marker {
1291
sub handle_marker {
1243
  my($self) = shift;
1292
  my($self) = shift;
1244
  my($name) = shift;
1293
  my($name) = shift;
1245
  my($val)  = $self->{'prjc'}->get_verbatim($name);
1294
  my($val)  = $self->{'prjc'}->get_verbatim($name);
1246
 
1295
 
1247
  if (defined $val) {
1296
  if (defined $val) {
1248
    $self->append_current($val);
1297
    $self->append_current($val);
1249
  }
1298
  }
1250
}
1299
}
1251
 
1300
 
1252
 
1301
 
1253
sub handle_eval {
1302
sub handle_eval {
1254
  my($self) = shift;
1303
  my($self) = shift;
1255
  my($name) = shift;
1304
  my($name) = shift;
1256
  my($val)  = $self->get_value_with_default($name);
1305
  my($val)  = $self->get_value_with_default($name);
1257
 
1306
 
1258
  if (defined $val) {
1307
  if (defined $val) {
1259
    if ($val =~ /<%eval\($name\)%>/) {
1308
    if (index($val, "<%eval($name)%>") >= 0) {
1260
      $self->warning("Infinite recursion detected in '$name'.");
1309
      $self->warning("Infinite recursion detected in '$name'.");
1261
    }
1310
    }
1262
    else {
1311
    else {
1263
      ## Enter the eval state
1312
      ## Enter the eval state
1264
      ++$self->{'eval'};
1313
      ++$self->{'eval'};
1265
 
1314
 
1266
      ## Parse the eval line
1315
      ## Parse the eval line
1267
      my($status, $error) = $self->parse_line(undef, $val);
1316
      my($status, $error) = $self->parse_line(undef, $val);
1268
      if ($status) {
1317
      if ($status) {
1269
        $self->{'built'} .= $self->{'eval_str'};
1318
        $self->{'built'} .= $self->{'eval_str'};
1270
      }
1319
      }
1271
      else {
1320
      else {
1272
        $self->warning($error);
1321
        $self->warning($error);
1273
      }
1322
      }
1274
 
1323
 
1275
      ## Leave the eval state
1324
      ## Leave the eval state
1276
      --$self->{'eval'};
1325
      --$self->{'eval'};
1277
      $self->{'eval_str'} = '';
1326
      $self->{'eval_str'} = '';
1278
    }
1327
    }
1279
  }
1328
  }
1280
}
1329
}
1281
 
1330
 
1282
 
1331
 
1283
sub handle_pseudo {
1332
sub handle_pseudo {
1284
  my($self) = shift;
1333
  my($self) = shift;
1285
  my($name) = shift;
1334
  my($name) = shift;
1286
  $self->append_current($self->{'cmds'}->{$name});
1335
  $self->append_current($self->{'cmds'}->{$name});
1287
}
1336
}
1288
 
1337
 
1289
 
1338
 
1290
sub get_duplicate_index {
1339
sub get_duplicate_index {
1291
  my($self) = shift;
1340
  my($self) = shift;
1292
  my($name) = shift;
1341
  my($name) = shift;
1293
  return $self->doif_duplicate_index($self->get_value_with_default($name));
1342
  return $self->doif_duplicate_index($self->get_value_with_default($name));
1294
}
1343
}
1295
 
1344
 
1296
 
1345
 
1297
sub doif_duplicate_index {
1346
sub doif_duplicate_index {
1298
  my($self)  = shift;
1347
  my($self)  = shift;
1299
  my($value) = shift;
1348
  my($value) = shift;
1300
 
1349
 
1301
  if (defined $value) {
1350
  if (defined $value) {
1302
    my($base) = lc($self->basename($value));
1351
    my($base) = lc($self->tp_basename($value));
1303
    my($path) = $self->tp_dirname($value);
1352
    my($path) = $self->validated_dirname($value);
1304
 
1353
 
1305
    if (!defined $self->{'dupfiles'}->{$base}) {
1354
    if (!defined $self->{'dupfiles'}->{$base}) {
1306
      $self->{'dupfiles'}->{$base} = [$path];
1355
      $self->{'dupfiles'}->{$base} = [$path];
1307
    }
1356
    }
1308
    else {
1357
    else {
1309
      my($index) = 1;
1358
      my($index) = 1;
1310
      foreach my $file (@{$self->{'dupfiles'}->{$base}}) {
1359
      foreach my $file (@{$self->{'dupfiles'}->{$base}}) {
1311
        if ($file eq $path) {
1360
        if ($file eq $path) {
1312
          return $index;
1361
          return $index;
1313
        }
1362
        }
1314
        ++$index;
1363
        ++$index;
1315
      }
1364
      }
1316
 
1365
 
1317
      push(@{$self->{'dupfiles'}->{$base}}, $path);
1366
      push(@{$self->{'dupfiles'}->{$base}}, $path);
1318
      return 1;
1367
      return 1;
1319
    }
1368
    }
1320
  }
1369
  }
1321
 
1370
 
1322
  return undef;
1371
  return undef;
1323
}
1372
}
1324
 
1373
 
1325
 
1374
 
1326
sub handle_duplicate_index {
1375
sub handle_duplicate_index {
1327
  my($self) = shift;
1376
  my($self) = shift;
1328
  my($name) = shift;
1377
  my($name) = shift;
1329
 
1378
 
1330
  if (!$self->{'if_skip'}) {
-
 
1331
    my($value) = $self->doif_duplicate_index(
1379
  my($value) = $self->doif_duplicate_index(
1332
                          $self->get_value_with_default($name));
1380
                        $self->get_value_with_default($name));
1333
    if (defined $value) {
1381
  if (defined $value) {
1334
      $self->append_current($value);
1382
    $self->append_current($value);
-
 
1383
  }
-
 
1384
}
-
 
1385
 
-
 
1386
 
-
 
1387
sub get_transdir {
-
 
1388
  my($self)  = shift;
-
 
1389
  my($name)  = shift;
-
 
1390
  return $self->doif_transdir($self->get_value_with_default($name));
-
 
1391
}
-
 
1392
 
-
 
1393
 
-
 
1394
sub doif_transdir {
-
 
1395
  my($self)  = shift;
-
 
1396
  my($value) = shift;
-
 
1397
 
-
 
1398
  if ($value =~ /([\/\\])/) {
-
 
1399
    return $self->{'prjc'}->translate_directory(
-
 
1400
                                  $self->tp_dirname($value)) . $1;
1335
    }
1401
  }
-
 
1402
 
-
 
1403
  return undef;
-
 
1404
}
-
 
1405
 
-
 
1406
 
-
 
1407
sub handle_transdir {
-
 
1408
  my($self)  = shift;
-
 
1409
  my($name)  = shift;
-
 
1410
  my($value) = $self->doif_transdir($self->get_value_with_default($name));
-
 
1411
 
-
 
1412
  if (defined $value) {
-
 
1413
    $self->append_current($value);
1336
  }
1414
  }
1337
}
1415
}
1338
 
1416
 
1339
 
1417
 
1340
sub prepare_parameters {
1418
sub prepare_parameters {
1341
  my($self)   = shift;
1419
  my($self)   = shift;
1342
  my($prefix) = shift;
1420
  my($prefix) = shift;
1343
  my($input)  = $self->get_value($prefix . '->input_file');
1421
  my($input)  = $self->get_value($prefix . '->input_file');
1344
  my($output) = undef;
1422
  my($output) = undef;
1345
 
1423
 
1346
  if (defined $input) {
1424
  if (defined $input) {
1347
    if ($self->{'cslashes'}) {
1425
    $input =~ s/\//\\/g if ($self->{'cslashes'});
1348
      $input = $self->{'prjc'}->slash_to_backslash($input);
-
 
1349
    }
-
 
1350
    $output = $self->get_value($prefix . '->input_file->output_files');
1426
    $output = $self->get_value($prefix . '->input_file->output_files');
1351
 
1427
 
1352
    if (defined $output) {
1428
    if (defined $output) {
1353
      my($size) = scalar(@$output);
1429
      my($size) = scalar(@$output);
1354
      for(my $i = 0; $i < $size; ++$i) {
1430
      for(my $i = 0; $i < $size; ++$i) {
1355
        my($fo) = $self->get_flag_overrides($prefix . '->input_file, gendir');
1431
        my($fo) = $self->get_flag_overrides($prefix . '->input_file, gendir');
1356
        if (defined $fo) {
1432
        if (defined $fo) {
1357
          $$output[$i] = $fo . '/' . File::Basename::basename($$output[$i]);
1433
          $$output[$i] = $fo . '/' . $self->tp_basename($$output[$i]);
1358
        }
-
 
1359
        if ($self->{'cslashes'}) {
-
 
1360
          $$output[$i] = $self->{'prjc'}->slash_to_backslash($$output[$i]);
-
 
1361
        }
1434
        }
-
 
1435
        $$output[$i] =~ s/\//\\/g if ($self->{'cslashes'});
1362
      }
1436
      }
1363
    }
1437
    }
1364
  }
1438
  }
1365
 
1439
 
1366
  ## Set the parameters array with the determined input and output files
1440
  ## Set the parameters array with the determined input and output files
1367
  return $input, $output;
1441
  return $input, $output;
1368
}
1442
}
1369
 
1443
 
1370
 
1444
 
1371
sub process_name {
1445
sub process_name {
1372
  my($self)        = shift;
1446
  my($self)        = shift;
1373
  my($line)        = shift;
1447
  my($line)        = shift;
1374
  my($length)      = 0;
1448
  my($length)      = 0;
1375
  my($status)      = 1;
1449
  my($status)      = 1;
1376
  my($errorString) = undef;
1450
  my($errorString) = undef;
1377
 
1451
 
1378
  if ($line eq '') {
-
 
1379
  }
-
 
1380
  elsif ($line =~ /^\w+(\(([^\)]+|\".*\"|[!]?(\w+\s*,\s*)?\w+\(.+\))\)|\->\w+([\w\-\>]+)?)?%>/) {
1452
  if ($line =~ /^\w+(\(([^\)]+|\".*\"|[!]?(\w+\s*,\s*)?\w+\(.+\))\)|\->\w+([\w\-\>]+)?)?%>/) {
1381
    ## Split the line into a name and value
1453
    ## Split the line into a name and value
1382
    my($name, $val) = ();
1454
    my($name, $val) = ();
1383
    if ($line =~ /([^%\(]+)(\(([^%]+)\))?%>/) {
1455
    if ($line =~ /([^%\(]+)(\(([^%]+)\))?%>/) {
1384
      $name = lc($1);
1456
      $name = lc($1);
1385
      $val  = $3;
1457
      $val  = $3;
-
 
1458
      $length += length($name);
1386
    }
1459
    }
1387
 
1460
 
1388
    $length += length($name);
-
 
1389
    if (defined $val) {
1461
    if (defined $val) {
1390
      ## Check for the parenthesis
1462
      ## Check for the parenthesis
1391
      if (($val =~ tr/(//) != ($val =~ tr/)//)) {
1463
      if (($val =~ tr/(//) != ($val =~ tr/)//)) {
1392
        $status = 0;
1464
        $status = 0;
1393
        $errorString = 'Missing the closing parenthesis';
1465
        $errorString = 'Missing the closing parenthesis';
1394
      }
1466
      }
1395
 
1467
 
1396
      ## Add the length of the value plus 2 for the surrounding ()
1468
      ## Add the length of the value plus 2 for the surrounding ()
1397
      $length += length($val) + 2;
1469
      $length += length($val) + 2;
1398
    }
1470
    }
1399
 
1471
 
1400
    if ($status) {
1472
    if ($status) {
1401
      if (defined $keywords{$name}) {
1473
      if (defined $keywords{$name}) {
1402
        if ($name eq 'endif') {
1474
        if ($name eq 'endif') {
1403
          ($status, $errorString) = $self->handle_endif($name);
1475
          ($status, $errorString) = $self->handle_endif($name);
1404
        }
1476
        }
1405
        elsif ($name eq 'if') {
1477
        elsif ($name eq 'if') {
1406
          $self->handle_if($val);
1478
          $self->handle_if($val);
1407
        }
1479
        }
1408
        elsif ($name eq 'endfor') {
1480
        elsif ($name eq 'endfor') {
1409
          ($status, $errorString) = $self->handle_endfor($name);
1481
          ($status, $errorString) = $self->handle_endfor($name);
1410
        }
1482
        }
1411
        elsif ($name eq 'foreach') {
1483
        elsif ($name eq 'foreach') {
1412
          ($status, $errorString) = $self->handle_foreach($val);
1484
          ($status, $errorString) = $self->handle_foreach($val);
1413
        }
1485
        }
1414
        elsif ($name eq 'fornotlast'  || $name eq 'forlast' ||
1486
        elsif ($name eq 'fornotlast'  || $name eq 'forlast' ||
1415
               $name eq 'fornotfirst' || $name eq 'forfirst') {
1487
               $name eq 'fornotfirst' || $name eq 'forfirst') {
1416
          if (!$self->{'if_skip'}) {
1488
          if (!$self->{'if_skip'}) {
1417
            $self->handle_special($name, $self->process_special($val));
1489
            $self->handle_special($name, $self->process_special($val));
1418
          }
1490
          }
1419
        }
1491
        }
1420
        elsif ($name eq 'else') {
1492
        elsif ($name eq 'else') {
1421
          ($status, $errorString) = $self->handle_else();
1493
          ($status, $errorString) = $self->handle_else();
1422
        }
1494
        }
1423
        elsif ($name eq 'comment') {
1495
        elsif ($name eq 'comment') {
1424
          ## Ignore the contents of the comment
1496
          ## Ignore the contents of the comment
1425
        }
1497
        }
1426
        else {
1498
        else {
1427
          if (!$self->{'if_skip'}) {
1499
          if (!$self->{'if_skip'}) {
1428
            my($func) = 'handle_' . $name;
1500
            my($func) = 'handle_' . $name;
1429
            $self->$func($val);
1501
            $self->$func($val);
1430
          }
1502
          }
1431
        }
1503
        }
1432
      }
1504
      }
1433
      elsif (defined $self->{'cmds'}->{$name}) {
1505
      elsif (defined $self->{'cmds'}->{$name}) {
1434
        if (!$self->{'if_skip'}) {
1506
        if (!$self->{'if_skip'}) {
1435
          $self->handle_pseudo($name);
1507
          $self->handle_pseudo($name);
1436
        }
1508
        }
1437
      }
1509
      }
1438
      else {
1510
      else {
1439
        if (!$self->{'if_skip'}) {
1511
        if (!$self->{'if_skip'}) {
1440
          if (defined $val && !defined $self->{'defaults'}->{$name}) {
1512
          if (defined $val && !defined $self->{'defaults'}->{$name}) {
1441
            $self->{'defaults'}->{$name} = $self->process_special($val);
1513
            $self->{'defaults'}->{$name} = $self->process_special($val);
1442
          }
1514
          }
1443
          $self->append_current($self->get_value_with_default($name));
1515
          $self->append_current($self->get_value_with_default($name));
1444
        }
1516
        }
1445
      }
1517
      }
1446
    }
1518
    }
1447
  }
1519
  }
1448
  else {
1520
  else {
1449
    my($error)  = $line;
1521
    my($error)  = $line;
1450
    my($length) = length($line);
1522
    my($length) = length($line);
1451
    for(my $i = 0; $i < $length; ++$i) {
1523
    for(my $i = 0; $i < $length; ++$i) {
1452
      my($part) = substr($line, $i, 2);
1524
      my($part) = substr($line, $i, 2);
1453
      if ($part eq '%>') {
1525
      if ($part eq '%>') {
1454
        $error = substr($line, 0, $i + 2);
1526
        $error = substr($line, 0, $i + 2);
1455
        last;
1527
        last;
1456
      }
1528
      }
1457
    }
1529
    }
1458
    $status = 0;
1530
    $status = 0;
1459
    $errorString = "Unable to parse line starting at '$error'";
1531
    $errorString = "Unable to parse line starting at '$error'";
1460
  }
1532
  }
1461
 
1533
 
1462
  return $status, $errorString, $length;
1534
  return $status, $errorString, $length;
1463
}
1535
}
1464
 
1536
 
1465
 
1537
 
1466
sub collect_data {
1538
sub collect_data {
1467
  my($self)  = shift;
1539
  my($self)  = shift;
1468
  my($prjc)  = $self->{'prjc'};
1540
  my($prjc)  = $self->{'prjc'};
1469
  my($cwd)   = $self->getcwd();
1541
  my($cwd)   = $self->getcwd();
1470
 
1542
 
1471
  ## Set the current working directory
1543
  ## Set the current working directory
1472
  if ($self->{'cslashes'}) {
1544
  $cwd =~ s/\//\\/g if ($self->{'cslashes'});
1473
    $cwd = $prjc->slash_to_backslash($cwd);
-
 
1474
  }
-
 
1475
  $self->{'values'}->{'cwd'} = $cwd;
1545
  $self->{'values'}->{'cwd'} = $cwd;
1476
 
1546
 
1477
  ## Collect the components into {'values'} somehow
1547
  ## Collect the components into {'values'} somehow
1478
  foreach my $key (keys %{$prjc->{'valid_components'}}) {
1548
  foreach my $key (keys %{$prjc->{'valid_components'}}) {
1479
    my(@list) = $prjc->get_component_list($key);
1549
    my(@list) = $prjc->get_component_list($key);
1480
    if (defined $list[0]) {
1550
    if (defined $list[0]) {
1481
      $self->{'values'}->{$key} = \@list;
1551
      $self->{'values'}->{$key} = \@list;
1482
    }
1552
    }
1483
  }
1553
  }
1484
 
1554
 
1485
  ## If there is a staticname and no sharedname then this project
1555
  ## If there is a staticname and no sharedname then this project
1486
  ## 'type_is_static'.  If we are generating static projects, let
1556
  ## 'type_is_static'.  If we are generating static projects, let
1487
  ## all of the templates know that we 'need_staticflags'.
1557
  ## all of the templates know that we 'need_staticflags'.
1488
  ## If there is a sharedname then this project 'type_is_dynamic'.
1558
  ## If there is a sharedname then this project 'type_is_dynamic'.
1489
  my($sharedname) = $prjc->get_assignment('sharedname');
1559
  my($sharedname) = $prjc->get_assignment('sharedname');
1490
  my($staticname) = $prjc->get_assignment('staticname');
1560
  my($staticname) = $prjc->get_assignment('staticname');
1491
  if (!defined $sharedname && defined $staticname) {
1561
  if (!defined $sharedname && defined $staticname) {
1492
    $self->{'override_target_type'} = 1;
1562
    $self->{'override_target_type'} = 1;
1493
    $self->{'values'}->{'type_is_static'}   = 1;
1563
    $self->{'values'}->{'type_is_static'}   = 1;
1494
    $self->{'values'}->{'need_staticflags'} = 1;
1564
    $self->{'values'}->{'need_staticflags'} = 1;
1495
  }
1565
  }
1496
  elsif ($prjc->get_static() == 1) {
1566
  elsif ($prjc->get_static() == 1) {
1497
    $self->{'values'}->{'need_staticflags'} = 1;
1567
    $self->{'values'}->{'need_staticflags'} = 1;
1498
  }
1568
  }
1499
  elsif (defined $sharedname) {
1569
  elsif (defined $sharedname) {
1500
    $self->{'values'}->{'type_is_dynamic'} = 1;
1570
    $self->{'values'}->{'type_is_dynamic'} = 1;
1501
  }
1571
  }
1502
 
1572
 
1503
  ## If there is a sharedname or exename then this project
1573
  ## If there is a sharedname or exename then this project
1504
  ## 'type_is_binary'.
1574
  ## 'type_is_binary'.
1505
  if (defined $sharedname ||
1575
  if (defined $sharedname ||
1506
      defined $prjc->get_assignment('exename')) {
1576
      defined $prjc->get_assignment('exename')) {
1507
    $self->{'values'}->{'type_is_binary'} = 1;
1577
    $self->{'values'}->{'type_is_binary'} = 1;
1508
  }
1578
  }
1509
 
1579
 
1510
  ## A tiny hack (mainly for VC6 projects)
1580
  ## A tiny hack (mainly for VC6 projects)
1511
  ## for the workspace creator.  It needs to know the
1581
  ## for the workspace creator.  It needs to know the
1512
  ## target names to match up with the project name.
1582
  ## target names to match up with the project name.
1513
  $prjc->update_project_info($self, 0, ['project_name']);
1583
  $prjc->update_project_info($self, 0, ['project_name']);
1514
 
1584
 
1515
  ## This is for all projects
1585
  ## This is for all projects
1516
  $prjc->update_project_info($self, 1, ['after']);
1586
  $prjc->update_project_info($self, 1, ['after']);
1517
 
1587
 
1518
  ## VC7 Projects need to know the GUID.
1588
  ## VC7 Projects need to know the GUID.
1519
  ## We need to save this value in our known values
1589
  ## We need to save this value in our known values
1520
  ## since each guid generated will be different.  We need
1590
  ## since each guid generated will be different.  We need
1521
  ## this to correspond to the same guid used in the workspace.
1591
  ## this to correspond to the same guid used in the workspace.
1522
  my($guid) = $prjc->update_project_info($self, 1, ['guid']);
1592
  my($guid) = $prjc->update_project_info($self, 1, ['guid']);
1523
  $self->{'values'}->{'guid'} = $guid;
1593
  $self->{'values'}->{'guid'} = $guid;
1524
 
1594
 
-
 
1595
  ## In order for VC7 to mix languages, we need to keep track
-
 
1596
  ## of the language associated with each project.
-
 
1597
  $prjc->update_project_info($self, 1, ['language']);
-
 
1598
 
1525
  ## Some Windows based projects can't deal with certain version
1599
  ## Some Windows based projects can't deal with certain version
1526
  ## values.  So, for those we provide a translated version.
1600
  ## values.  So, for those we provide a translated version.
1527
  my($version) = $prjc->get_assignment('version');
1601
  my($version) = $prjc->get_assignment('version');
1528
  if (defined $version) {
1602
  if (defined $version) {
1529
    $self->{'values'}->{'win_version'} =
1603
    $self->{'values'}->{'win_version'} =
1530
                        WinVersionTranslator::translate($version);
1604
                        WinVersionTranslator::translate($version);
1531
  }
1605
  }
1532
}
1606
}
1533
 
1607
 
1534
 
1608
 
1535
sub parse_line {
1609
sub parse_line {
1536
  my($self)        = shift;
1610
  my($self)        = $_[0];
1537
  my($ih)          = shift;
1611
  #my($ih)          = $_[1];
1538
  my($line)        = shift;
1612
  my($line)        = $_[2];
1539
  my($status)      = 1;
1613
  my($status)      = 1;
1540
  my($errorString) = undef;
1614
  my($errorString) = undef;
1541
  my($startempty)  = (length($line) == 0 ? 1 : 0);
1615
  my($startempty)  = ($line eq '');
1542
 
1616
 
1543
  ## If processing a foreach or the line only
1617
  ## If processing a foreach or the line only
1544
  ## contains a keyword, then we do
1618
  ## contains a keyword, then we do
1545
  ## not need to add a newline to the end.
1619
  ## not need to add a newline to the end.
1546
  if (!$self->{'eval'} && $self->{'foreach'}->{'processing'} == 0) {
1620
  if (!$self->{'eval'} && $self->{'foreach'}->{'processing'} == 0 &&
1547
    if ($line !~ /^[ ]*<%(\w+)(\(((\w+\s*,\s*)?\w+\(.+\)|[^\)]+)\))?%>$/ ||
1621
      ($line !~ /^[ ]*<%(\w+)(\(((\w+\s*,\s*)?[!]?\w+\(.+\)|[^\)]+)\))?%>$/ ||
1548
        !defined $keywords{$1}) {
1622
       !defined $keywords{$1})) {
1549
      $line .= $self->{'crlf'};
1623
    $line .= $self->{'crlf'};
1550
    }
-
 
1551
  }
1624
  }
1552
 
1625
 
1553
  if (!$self->{'eval'} && $self->{'foreach'}->{'count'} < 0) {
1626
  if (!$self->{'eval'} && $self->{'foreach'}->{'count'} < 0) {
1554
    $self->{'built'} = '';
1627
    $self->{'built'} = '';
1555
  }
1628
  }
1556
 
1629
 
1557
  my($start) = index($line, '<%');
1630
  my($start) = index($line, '<%');
1558
  if ($start >= 0) {
1631
  if ($start >= 0) {
1559
    my($append_name) = 0;
1632
    my($append_name) = undef;
1560
    if ($start > 0) {
1633
    if ($start > 0) {
1561
      if (!$self->{'if_skip'}) {
1634
      if (!$self->{'if_skip'}) {
1562
        $self->append_current(substr($line, 0, $start));
1635
        $self->append_current(substr($line, 0, $start));
1563
      }
1636
      }
1564
      $line = substr($line, $start);
1637
      $line = substr($line, $start);
1565
    }
1638
    }
1566
    foreach my $item (split('<%', $line)) {
1639
    foreach my $item (split('<%', $line)) {
1567
      my($name)   = 1;
1640
      my($name)   = 1;
1568
      my($length) = length($item);
1641
      my($length) = length($item);
-
 
1642
      my($endi)   = index($item, '%>');
1569
      for(my $i = 0; $i < $length; ++$i) {
1643
      for(my $i = 0; $i < $length; ++$i) {
1570
        my($part) = substr($item, $i, 2);
-
 
1571
        if ($part eq '%>') {
1644
        if ($i == $endi) {
1572
          ++$i;
1645
          ++$i;
-
 
1646
          $endi = index($item, '%>', $i);
1573
          $name = 0;
1647
          $name = undef;
1574
          if ($append_name) {
1648
          if ($append_name) {
1575
            $append_name = 0;
1649
            $append_name = undef;
1576
            if (!$self->{'if_skip'}) {
1650
            if (!$self->{'if_skip'}) {
1577
              $self->append_current($part);
1651
              $self->append_current('%>');
1578
            }
1652
            }
1579
          }
1653
          }
1580
          if ($length != $i + 1) {
1654
          if ($length != $i + 1) {
1581
            if (!$self->{'if_skip'}) {
1655
            if (!$self->{'if_skip'}) {
1582
              $self->append_current(substr($item, $i + 1));
1656
              $self->append_current(substr($item, $i + 1));
1583
            }
1657
            }
1584
            last;
1658
            last;
1585
          }
1659
          }
1586
        }
1660
        }
1587
        elsif ($name) {
1661
        elsif ($name) {
1588
          my($substr)  = substr($item, $i);
1662
          my($substr)  = substr($item, $i);
1589
          my($efcheck) = ($substr =~ /^endfor\%\>/);
1663
          my($efcheck) = (index($substr, 'endfor%>') == 0);
1590
          my($focheck) = ($efcheck ? 0 : ($substr =~ /^foreach\(/));
1664
          my($focheck) = ($efcheck ? 0 : (index($substr, 'foreach(') == 0));
1591
 
1665
 
1592
          if ($focheck && $self->{'foreach'}->{'count'} >= 0) {
1666
          if ($focheck && $self->{'foreach'}->{'count'} >= 0) {
1593
            ++$self->{'foreach'}->{'nested'};
1667
            ++$self->{'foreach'}->{'nested'};
1594
          }
1668
          }
1595
 
1669
 
1596
          if ($self->{'foreach'}->{'count'} < 0 ||
1670
          if ($self->{'foreach'}->{'count'} < 0 ||
1597
              $self->{'foreach'}->{'processing'} > $self->{'foreach'}->{'nested'} ||
1671
              $self->{'foreach'}->{'processing'} > $self->{'foreach'}->{'nested'} ||
1598
              (($efcheck || $focheck) &&
1672
              (($efcheck || $focheck) &&
1599
               $self->{'foreach'}->{'nested'} == $self->{'foreach'}->{'processing'})) {
1673
               $self->{'foreach'}->{'nested'} == $self->{'foreach'}->{'processing'})) {
1600
            my($nlen) = 0;
1674
            my($nlen) = 0;
1601
            ($status,
1675
            ($status,
1602
             $errorString,
1676
             $errorString,
1603
             $nlen) = $self->process_name($substr);
1677
             $nlen) = $self->process_name($substr);
1604
 
1678
 
-
 
1679
            if (!$status) {
-
 
1680
              last;
-
 
1681
            }
1605
            if ($status && $nlen == 0) {
1682
            elsif ($nlen == 0) {
1606
              $errorString = "Could not parse this line at column $i";
1683
              $errorString = "Could not parse this line at column $i";
1607
              $status = 0;
1684
              $status = 0;
1608
            }
-
 
1609
            if (!$status) {
-
 
1610
              last;
1685
              last;
1611
            }
1686
            }
1612
 
1687
 
1613
            $i += ($nlen - 1);
1688
            $i += ($nlen - 1);
1614
          }
1689
          }
1615
          else  {
1690
          else  {
1616
            $name = 0;
1691
            $name = undef;
1617
            if (!$self->{'if_skip'}) {
1692
            if (!$self->{'if_skip'}) {
1618
              $self->append_current('<%' . substr($item, $i, 1));
1693
              $self->append_current('<%' . substr($item, $i, 1));
1619
              $append_name = 1;
1694
              $append_name = 1;
1620
            }
1695
            }
1621
          }
1696
          }
1622
 
1697
 
1623
          if ($efcheck && $self->{'foreach'}->{'nested'} > 0) {
1698
          if ($efcheck && $self->{'foreach'}->{'nested'} > 0) {
1624
            --$self->{'foreach'}->{'nested'};
1699
            --$self->{'foreach'}->{'nested'};
1625
          }
1700
          }
1626
        }
1701
        }
1627
        else {
1702
        else {
1628
          if (!$self->{'if_skip'}) {
1703
          if (!$self->{'if_skip'}) {
1629
            $self->append_current(substr($item, $i, 1));
1704
            $self->append_current(substr($item, $i, 1));
1630
          }
1705
          }
1631
        }
1706
        }
1632
      }
1707
      }
-
 
1708
      last if (!$status);
1633
    }
1709
    }
1634
  }
1710
  }
1635
  else {
1711
  else {
1636
    if (!$self->{'if_skip'}) {
1712
    if (!$self->{'if_skip'}) {
1637
      $self->append_current($line);
1713
      $self->append_current($line);
1638
    }
1714
    }
1639
  }
1715
  }
1640
 
1716
 
1641
  if (!$self->{'eval'} && $self->{'foreach'}->{'count'} < 0) {
1717
  if (!$self->{'eval'} && $self->{'foreach'}->{'count'} < 0) {
1642
    ## If the line started out empty and we're not
1718
    ## If the line started out empty and we're not
1643
    ## skipping from the start or the built up line is not empty
1719
    ## skipping from the start or the built up line is not empty
1644
    if ($startempty ||
1720
    if ($startempty ||
1645
        ($self->{'built'} ne $self->{'crlf'} && $self->{'built'} ne '')) {
1721
        ($self->{'built'} ne $self->{'crlf'} && $self->{'built'} ne '')) {
1646
      push(@{$self->{'lines'}}, $self->{'built'});
1722
      push(@{$self->{'lines'}}, $self->{'built'});
1647
    }
1723
    }
1648
  }
1724
  }
1649
 
1725
 
1650
  return $status, $errorString;
1726
  return $status, $errorString;
1651
}
1727
}
1652
 
1728
 
1653
 
1729
 
1654
sub parse_file {
1730
sub parse_file {
1655
  my($self)  = shift;
1731
  my($self)  = shift;
1656
  my($input) = shift;
1732
  my($input) = shift;
1657
 
1733
 
1658
  $self->collect_data();
1734
  $self->collect_data();
1659
  my($status, $errorString) = $self->cached_file_read($input);
1735
  my($status, $errorString) = $self->cached_file_read($input);
1660
 
1736
 
1661
  if ($status) {
1737
  if ($status) {
1662
    my($sstack) = $self->{'sstack'};
1738
    my($sstack) = $self->{'sstack'};
1663
    if (defined $$sstack[0]) {
1739
    if (defined $$sstack[0]) {
1664
      my($lstack) = $self->{'lstack'};
1740
      my($lstack) = $self->{'lstack'};
1665
      $status = 0;
1741
      $status = 0;
1666
      $errorString = "Missing an '$$sstack[0]' starting at $$lstack[0]";
1742
      $errorString = "Missing an '$$sstack[0]' starting at $$lstack[0]";
1667
    }
1743
    }
1668
  }
1744
  }
1669
 
1745
 
1670
  if (!$status) {
1746
  if (!$status) {
1671
    my($linenumber) = $self->get_line_number();
1747
    my($linenumber) = $self->get_line_number();
1672
    $errorString = "$input: line $linenumber:\n$errorString";
1748
    $errorString = "$input: line $linenumber:\n$errorString";
1673
  }
1749
  }
1674
 
1750
 
1675
  return $status, $errorString;
1751
  return $status, $errorString;
1676
}
1752
}
1677
 
1753
 
1678
 
1754
 
1679
sub get_lines {
1755
sub get_lines {
1680
  my($self) = shift;
1756
  my($self) = shift;
1681
  return $self->{'lines'};
1757
  return $self->{'lines'};
1682
}
1758
}
1683
 
1759
 
1684
 
1760
 
1685
1;
1761
1;
1686
 
1762