Subversion Repositories gelsvn

Rev

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

Rev 107 Rev 217
1 
package FeatureParser;
 1 
package FeatureParser;
2 
 
 2 
 
3 
# ************************************************************
 3 
# ************************************************************
4 
# Description   : Reads the feature files and store the values
 4 
# Description   : Reads the feature files and store the values
5 
# Author        : Chad Elliott
 5 
# Author        : Chad Elliott
6 
# Create Date   : 5/21/2003
 6 
# Create Date   : 5/21/2003
7 
# ************************************************************
 7 
# ************************************************************
8 
 
 8 
 
9 
# ************************************************************
 9 
# ************************************************************
10 
# Pragmas
 10 
# Pragmas
11 
# ************************************************************
 11 
# ************************************************************
12 
 
 12 
 
13 
use strict;
 13 
use strict;
14 
use File::Basename;
 - 
 
15 
 
 14 
 
16 
use Parser;
 15 
use Parser;
17 
 
 16 
 
18 
use vars qw(@ISA);
 17 
use vars qw(@ISA);
19 
@ISA = qw(Parser);
 18 
@ISA = qw(Parser);
20 
 
 19 
 
21 
# ************************************************************
 20 
# ************************************************************
22 
# Subroutine Section
 21 
# Subroutine Section
23 
# ************************************************************
 22 
# ************************************************************
24 
 
 23 
 
25 
sub new {
 24 
sub new {
26 
  my($class)    = shift;
 25 
  my($class)    = shift;
27 
  my($features) = shift;
 26 
  my($features) = shift;
28 
  my(@files)    = @_;
 27 
  my(@files)    = @_;
29 
  my($self)     = $class->SUPER::new();
 28 
  my($self)     = $class->SUPER::new();
30 
 
 29 
 
31 
  ## Set the values associative array
 30 
  ## Set the values associative array
32 
  $self->{'values'} = {};
 31 
  $self->{'values'} = {};
33 
 
 32 
 
34 
  ## Process each feature file
 33 
  ## Process each feature file
35 
  foreach my $f (@files) {
 34 
  foreach my $f (@files) {
36 
    if (defined $f) {
 35 
    if (defined $f) {
37 
      my($status, $warn) = $self->cached_file_read($f);
 36 
      my($status, $warn) = $self->cached_file_read($f);
38 
      if (!$status) {
 37 
      if (!$status) {
39 
        ## We only want to warn the user about problems
 38 
        ## We only want to warn the user about problems
40 
        ## with the feature file.
 39 
        ## with the feature file.
41 
        my($lnumber) = $self->get_line_number();
 40 
        my($lnumber) = $self->get_line_number();
42 
        $self->warning(basename($f) . ": line $lnumber: $warn");
 41 
        $self->warning($self->mpc_basename($f) . ": line $lnumber: $warn");
43 
      }
 42 
      }
44 
    }
 43 
    }
45 
  }
 44 
  }
46 
 
 45 
 
47 
  ## Process each feature definition
 46 
  ## Process each feature definition
48 
  foreach my $feature (@$features) {
 47 
  foreach my $feature (@$features) {
49 
    my($status, $warn) = $self->parse_line(undef, $feature);
 48 
    my($status, $warn) = $self->parse_line(undef, $feature);
50 
    if (!$status) {
 49 
    if (!$status) {
51 
      ## We only want to warn the user about problems
 50 
      ## We only want to warn the user about problems
52 
      ## with the -feature option.
 51 
      ## with the -feature option.
53 
      $self->warning("-features parameter: $warn");
 52 
      $self->warning("-features parameter: $warn");
54 
    }
 53 
    }
55 
  }
 54 
  }
56 
 
 55 
 
57 
  return $self;
 56 
  return $self;
58 
}
 57 
}
59 
 
 58 
 
60 
 
 59 
 
61 
sub parse_line {
 60 
sub parse_line {
62 
  my($self)   = shift;
 61 
  my($self)   = shift;
63 
  my($if)     = shift;
 62 
  my($if)     = shift;
64 
  my($line)   = shift;
 63 
  my($line)   = shift;
65 
  my($status) = 1;
 64 
  my($status) = 1;
66 
  my($error)  = undef;
 65 
  my($error)  = undef;
67 
 
 66 
 
68 
  if ($line eq '') {
 67 
  if ($line eq '') {
69 
  }
 68 
  }
70 
  elsif ($line =~ /^(\w+)\s*=\s*(\d+)$/) {
 69 
  elsif ($line =~ /^(\w+)\s*=\s*(\d+)$/) {
71 
    $self->{'values'}->{$1} = $2;
 70 
    $self->{'values'}->{lc($1)} = $2;
72 
  }
 71 
  }
73 
  else {
 72 
  else {
74 
    $status = 0;
 73 
    $status = 0;
75 
    $error  = "Unrecognized line: $line";
 74 
    $error  = "Unrecognized line: $line";
76 
  }
 75 
  }
77 
 
 76 
 
78 
  return $status, $error;
 77 
  return $status, $error;
79 
}
 78 
}
80 
 
 79 
 
81 
 
 80 
 
- 
 
 81 
sub get_names {
- 
 
 82 
  my($self)  = shift;
- 
 
 83 
  my(@names) = keys %{$self->{'values'}};
- 
 
 84 
  return \@names;
- 
 
 85 
}
- 
 
 86 
 
- 
 
 87 
 
82 
sub get_value {
 88 
sub get_value {
83 
  my($self) = shift;
 89 
  my($self) = shift;
84 
  my($tag)  = shift;
 90 
  my($tag)  = shift;
85 
  return $self->{'values'}->{$tag};
 91 
  return $self->{'values'}->{lc($tag)};
86 
}
 92 
}
87 
 
 93 
 
88 
 
 94 
 
89 
1;
 95 
1;
90 
 
 96