Subversion Repositories gelsvn

Rev

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

Rev 68 Rev 71
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;
 14 
use File::Basename;
15 
 
 15 
 
16 
use Parser;
 16 
use Parser;
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 
# Subroutine Section
 22 
# Subroutine Section
23 
# ************************************************************
 23 
# ************************************************************
24 
 
 24 
 
25 
sub new {
 25 
sub new {
26 
  my($class)       = shift;
 26 
  my($class)    = shift;
27 
  my($global_file) = shift;
 27 
  my($features) = shift;
28 
  my($file)        = shift;
 - 
 
29 
  my($features)    = shift;
 28 
  my(@files)    = @_;
30 
  my($self)        = $class->SUPER::new();
 29 
  my($self)     = $class->SUPER::new();
31 
 
 30 
 
32 
  ## Set the values associative array
 31 
  ## Set the values associative array
33 
  $self->{'values'} = {};
 32 
  $self->{'values'} = {};
34 
 
 33 
 
35 
  ## Process each feature file
 34 
  ## Process each feature file
36 
  foreach my $f ($global_file, $file) {
 35 
  foreach my $f (@files) {
37 
    if (defined $f) {
 36 
    if (defined $f) {
38 
      my($status, $warn) = $self->cached_file_read($f);
 37 
      my($status, $warn) = $self->cached_file_read($f);
39 
      if (!$status) {
 38 
      if (!$status) {
40 
        ## We only want to warn the user about problems
 39 
        ## We only want to warn the user about problems
41 
        ## with the feature file.
 40 
        ## with the feature file.
42 
        my($lnumber) = $self->get_line_number();
 41 
        my($lnumber) = $self->get_line_number();
43 
        $self->warning(basename($f) . ": line $lnumber: $warn");
 42 
        $self->warning(basename($f) . ": line $lnumber: $warn");
44 
      }
 43 
      }
45 
    }
 44 
    }
46 
  }
 45 
  }
47 
 
 46 
 
48 
  ## Process each feature definition
 47 
  ## Process each feature definition
49 
  foreach my $feature (@$features) {
 48 
  foreach my $feature (@$features) {
50 
    my($status, $warn) = $self->parse_line(undef, $feature);
 49 
    my($status, $warn) = $self->parse_line(undef, $feature);
51 
    if (!$status) {
 50 
    if (!$status) {
52 
      ## We only want to warn the user about problems
 51 
      ## We only want to warn the user about problems
53 
      ## with the -feature option.
 52 
      ## with the -feature option.
54 
      $self->warning("-features parameter: $warn");
 53 
      $self->warning("-features parameter: $warn");
55 
    }
 54 
    }
56 
  }
 55 
  }
57 
 
 56 
 
58 
  return $self;
 57 
  return $self;
59 
}
 58 
}
60 
 
 59 
 
61 
 
 60 
 
62 
sub parse_line {
 61 
sub parse_line {
63 
  my($self)   = shift;
 62 
  my($self)   = shift;
64 
  my($if)     = shift;
 63 
  my($if)     = shift;
65 
  my($line)   = shift;
 64 
  my($line)   = shift;
66 
  my($status) = 1;
 65 
  my($status) = 1;
67 
  my($error)  = undef;
 66 
  my($error)  = undef;
68 
 
 67 
 
69 
  if ($line eq '') {
 68 
  if ($line eq '') {
70 
  }
 69 
  }
71 
  elsif ($line =~ /^(\w+)\s*=\s*(\d+)$/) {
 70 
  elsif ($line =~ /^(\w+)\s*=\s*(\d+)$/) {
72 
    $self->{'values'}->{$1} = $2;
 71 
    $self->{'values'}->{$1} = $2;
73 
  }
 72 
  }
74 
  else {
 73 
  else {
75 
    $status = 0;
 74 
    $status = 0;
76 
    $error  = "Unrecognized line: $line";
 75 
    $error  = "Unrecognized line: $line";
77 
  }
 76 
  }
78 
 
 77 
 
79 
  return $status, $error;
 78 
  return $status, $error;
80 
}
 79 
}
81 
 
 80 
 
82 
 
 81 
 
83 
sub get_value {
 82 
sub get_value {
84 
  my($self) = shift;
 83 
  my($self) = shift;
85 
  my($tag)  = shift;
 84 
  my($tag)  = shift;
86 
  return $self->{'values'}->{$tag};
 85 
  return $self->{'values'}->{$tag};
87 
}
 86 
}
88 
 
 87 
 
89 
 
 88 
 
90 
1;
 89 
1;
91 
 
 90