summaryrefslogtreecommitdiff
path: root/ACE/MPC/modules/TemplateInputReader.pm
blob: c1fc7c455d407c215561fca0ab027552c697d84e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
package TemplateInputReader;

# ************************************************************
# Description   : Reads the template input and stores the values
# Author        : Chad Elliott
# Create Date   : 5/16/2002
# ************************************************************

# ************************************************************
# Pragmas
# ************************************************************

use strict;

use Parser;

use vars qw(@ISA);
@ISA = qw(Parser);

# ************************************************************
# Data Section
# ************************************************************

my $mpt = 'mpt';

# ************************************************************
# Subroutine Section
# ************************************************************

sub new {
  my($class, $inc) = @_;
  my $self = Parser::new($class, $inc);

  ## Set up the internal data members
  $self->{'values'}    = {};
  $self->{'cindex'}    = 0;
  $self->{'current'}   = [ $self->{'values'} ];
  $self->{'realnames'} = {};

  return $self;
}


sub parse_line {
  my($self, $ih, $line) = @_;
  my $status = 1;
  my $errorString;
  my $current = $self->{'current'};

  if ($line eq '') {
  }
  elsif ($line =~ /^([\w\s\(\)\.]+)\s*{$/) {
    ## Entering a new scope, we need to save the real name so that it can
    ## be accessed at a later time.
    my $rname = $1;
    $rname =~ s/\s+$//;
    my $name = lc($rname);
    $self->{'realnames'}->{$name} = $rname;

    ## Scopes are reentrant, so we only create a new map when we haven't
    ## got one.
    if (!defined $$current[$self->{'cindex'}]->{$name}) {
      $$current[$self->{'cindex'}]->{$name} = {};
    }

    ## Keep track of the current scope
    push(@$current, $$current[$self->{'cindex'}]->{$name});
    $self->{'cindex'}++;
  }
  elsif ($line =~ /^}$/) {
    ## Maintain the scope and make sure there aren't any unmatched
    ## braces.
    if ($self->{'cindex'} > 0) {
      pop(@$current);
      $self->{'cindex'}--;
    }
    else {
      $status = 0;
      $errorString = 'Unmatched curly brace';
    }
  }
  elsif ($line =~ /^(\w+)\s*(\+=|=)\s*(.*)?/) {
    ## Save the name, operation type and value.
    my $name  = lc($1);
    my $op    = $2;
    my $value = $3;

    ## Turn the value into an array
    if (defined $value) {
      $value = $self->create_array($value);
    }
    else {
      $value = [];
    }

    ## Store the value
    if ($op eq '+=' && defined $$current[$self->{'cindex'}]->{$name}) {
      push(@{$$current[$self->{'cindex'}]->{$name}}, @$value);
    }
    else {
      $$current[$self->{'cindex'}]->{$name} = $value;
    }
  }
  elsif ($line =~ /^conditional_include\s+"([\w\s\-\+\/\\\.]+)"$/) {
    ## Search for the include template file.  If it does not exist, we
    ## don't complain.  It's likely that these sort of files won't exist.
    my $file = $self->search_include_path("$1.$mpt");
    if (defined $file) {
      ## Process the file making sure to restore the line number seting
      ## when we get done.
      my $ol = $self->get_line_number();
      ($status, $errorString) = $self->read_file($file);
      $self->set_line_number($ol);
    }
  }
  else {
    $status = 0;
    $errorString = "Unrecognized line: $line";
  }

  return $status, $errorString;
}


sub get_value {
  ## All template names are case-insensitive.
  my($self, $tag) = @_;
  return $self->{'values'}->{lc($tag)};
}


sub get_realname {
  ## Sometimes, we need to get back to the name retaining the case so we
  ## access the hash map containing them.
  my($self, $tag) = @_;
  return $self->{'realnames'}->{lc($tag)};
}


1;