PageRenderTime 67ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 0ms

/dep/ACE_wrappers/MPC/modules/TemplateParser.pm

https://bitbucket.org/wownsk/core_tbc
Perl | 2036 lines | 1636 code | 268 blank | 132 comment | 219 complexity | 40716755ae6ca600fb20898d500a45d6 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.1, CC-BY-SA-3.0, Unlicense, Cube

Large files files are truncated, but you can click here to view the full file

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

Large files files are truncated, but you can click here to view the full file