modules/TemplateInputReader.pm

   1 package TemplateInputReader;
   2
   3 # ************************************************************
   4 # Description   : Reads the template input and stores the values
   5 # Author        : Chad Elliott
   6 # Create Date   : 5/16/2002
   7 # ************************************************************
   8
   9 # ************************************************************
  10 # Pragmas
  11 # ************************************************************
  12
  13 use strict;
  14
  15 use Parser;
  16
  17 use vars qw(@ISA);
  18 @ISA = qw(Parser);
  19
  20 # ************************************************************
  21 # Data Section
  22 # ************************************************************
  23
  24 my $mpt = 'mpt';
  25
  26 # ************************************************************
  27 # Subroutine Section
  28 # ************************************************************
  29
  30 sub new {
  31   my($class, $inc) = @_;
  32   my $self = Parser::new($class, $inc);
  33
  34   ## Set up the internal data members
  35   $self->{'values'}    = {};
  36   $self->{'cindex'}    = 0;
  37   $self->{'current'}   = [ $self->{'values'} ];
  38   $self->{'realnames'} = {};
  39
  40   return $self;
  41 }
  42
  43
  44 sub parse_line {
  45   my($self, $ih, $line) = @_;
  46   my $status = 1;
  47   my $errorString;
  48   my $current = $self->{'current'};
  49
  50   if ($line eq '') {
  51   }
  52   elsif ($line =~ /^([-\w\s\(\)\.]+)\s*{$/) {
  53     ## Entering a new scope, we need to save the real name so that it can
  54     ## be accessed at a later time.
  55     my $rname = $1;
  56     $rname =~ s/\s+$//;
  57     my $name = lc($rname);
  58     $self->{'realnames'}->{$name} = $rname;
  59
  60     ## Scopes are reentrant, so we only create a new map when we haven't
  61     ## got one.
  62     if (!defined $$current[$self->{'cindex'}]->{$name}) {
  63       $$current[$self->{'cindex'}]->{$name} = {};
  64     }
  65
  66     ## Keep track of the current scope
  67     push(@$current, $$current[$self->{'cindex'}]->{$name});
  68     $self->{'cindex'}++;
  69   }
  70   elsif ($line =~ /^}$/) {
  71     ## Maintain the scope and make sure there aren't any unmatched
  72     ## braces.
  73     if ($self->{'cindex'} > 0) {
  74       pop(@$current);
  75       $self->{'cindex'}--;
  76     }
  77     else {
  78       $status = 0;
  79       $errorString = 'Unmatched curly brace';
  80     }
  81   }
  82   elsif ($line =~ /^(\w+)\s*(\+=|=)\s*(.*)?/) {
  83     ## Save the name, operation type and value.
  84     my $name  = lc($1);
  85     my $op    = $2;
  86     my $value = $3;
  87
  88     ## Turn the value into an array
  89     if (defined $value) {
  90       $value = $self->create_array($value);
  91     }
  92     else {
  93       $value = [];
  94     }
  95
  96     ## Store the value
  97     if ($op eq '+=' && defined $$current[$self->{'cindex'}]->{$name}) {
  98       push(@{$$current[$self->{'cindex'}]->{$name}}, @$value);
  99     }
 100     else {
 101       $$current[$self->{'cindex'}]->{$name} = $value;
 102     }
 103   }
 104   elsif ($line =~ /^conditional_include\s+"([\w\s\-\+\/\\\.]+)"$/) {
 105     ## Search for the include template file.  If it does not exist, we
 106     ## don't complain.  It's likely that these sort of files won't exist.
 107     my $file = $self->search_include_path("$1.$mpt");
 108     if (defined $file) {
 109       ## Process the file making sure to restore the line number seting
 110       ## when we get done.
 111       my $ol = $self->get_line_number();
 112       ($status, $errorString) = $self->read_file($file);
 113       $self->set_line_number($ol);
 114     }
 115   }
 116   else {
 117     $status = 0;
 118     $errorString = "Unrecognized line: $line";
 119   }
 120
 121   return $status, $errorString;
 122 }
 123
 124
 125 sub get_value {
 126   ## All template names are case-insensitive.
 127   my($self, $tag) = @_;
 128   return $self->{'values'}->{lc($tag)};
 129 }
 130
 131
 132 sub get_realname {
 133   ## Sometimes, we need to get back to the name retaining the case so we
 134   ## access the hash map containing them.
 135   my($self, $tag) = @_;
 136   return $self->{'realnames'}->{lc($tag)};
 137 }
 138
 139
 140 1;