Wed Jun 9 07:35:19 UTC 2010 Johnny Willemsen <jwillemsen@remedy.nl>
[MPC.git] / modules / FeatureParser.pm
blobe0a5ced6843ca015382814b053605195ae70d0cb
1 package FeatureParser;
3 # ************************************************************
4 # Description : Reads the feature files and store the values
5 # Author : Chad Elliott
6 # Create Date : 5/21/2003
7 # ************************************************************
9 # ************************************************************
10 # Pragmas
11 # ************************************************************
13 use strict;
15 use Parser;
17 use vars qw(@ISA);
18 @ISA = qw(Parser);
20 # ************************************************************
21 # Subroutine Section
22 # ************************************************************
24 sub new {
25 my $class = shift;
26 my $features = shift;
27 my @files = @_;
28 my $self = $class->SUPER::new();
30 ## Set the values associative array
31 $self->{'values'} = {};
33 ## Process each feature file
34 foreach my $f (@files) {
35 if (defined $f) {
36 my($status, $warn) = $self->read_file($f);
37 if (!$status) {
38 ## We only want to warn the user about problems
39 ## with the feature file.
40 my $lnumber = $self->get_line_number();
41 $self->warning($self->mpc_basename($f) . ": line $lnumber: $warn");
46 ## Process each feature definition
47 foreach my $feature (@$features) {
48 my($status, $warn) = $self->parse_line(undef, $feature);
49 ## We only want to warn the user about problems
50 ## with the -feature option.
51 $self->warning("-features parameter: $warn") if (!$status);
54 return $self;
58 sub parse_line {
59 my($self, $if, $line) = @_;
60 my $error;
62 if ($line eq '') {
64 elsif ($line =~ /^(\w+)\s*=\s*(\d+)$/) {
65 ## This is a valid value, so we can store it.
66 $self->{'values'}->{lc($1)} = $2;
68 else {
69 $error = "Unrecognized line: $line";
72 return (defined $error ? 0 : 1), $error;
76 sub get_names {
77 my @names = sort keys %{$_[0]->{'values'}};
78 return \@names;
82 sub get_value {
83 ## All feature names are case-insensitive.
84 my($self, $tag) = @_;
85 return $self->{'values'}->{lc($tag)};