1#
2# Module Parse::Yapp::Options
3#
4# (c) Copyright 1999-2001 Francois Desarmenien, all rights reserved.
5# (see the pod text in Parse::Yapp module for use and distribution rights)
6#
7package Parse::Yapp::Options;
8
9use strict;
10use Carp;
11
12############################################################################
13#Definitions of options
14#
15# %known_options    allowed options
16#
17# %default_options  default
18#
19# %actions          sub refs to execute if option is set with ($self,$value)
20#                   as parameters
21############################################################################
22#
23#A value of '' means any value can do
24#
25my(%known_options)= (
26    language    =>  {
27        perl    => "Ouput parser for Perl language",
28# for future use...
29#       'c++'   =>  "Output parser for C++ language",
30#       c       =>  "Output parser for C language"
31    },
32    linenumbers =>  {
33        0       =>  "Don't embbed line numbers in parser",
34        1       =>  "Embbed source line numbers in parser"
35    },
36    inputfile   =>  {
37        ''      =>  "Input file name: will automagically fills input"
38    },
39    classname   =>  {
40        ''      =>  "Class name of parser object (Perl and C++)"
41    },
42    standalone  =>  {
43        0       =>  "Don't create a standalone parser (Perl and C++)",
44        1       =>  "Create a standalone parser"
45    },
46    input       =>  {
47        ''      =>  "Input text of grammar"
48    },
49    template    => {
50        ''      =>  "Template text for generating grammar file"
51    },
52);
53
54my(%default_options)= (
55    language => 'perl',
56    linenumbers => 1,
57    inputfile => undef,
58    classname   => 'Parser',
59    standalone => 0,
60    input => undef,
61    template => undef,
62    shebang => undef,
63);
64
65my(%actions)= (
66    inputfile => \&__LoadFile
67);
68
69#############################################################################
70#
71# Actions
72#
73# These are NOT a method, although they look like...
74#
75# They are super-private routines (that's why I prepend __ to their names)
76#
77#############################################################################
78sub __LoadFile {
79    my($self,$filename)=@_;
80
81        open(IN,"<$filename")
82    or  croak "Cannot open input file '$filename' for reading";
83    $self->{OPTIONS}{input}=join('',<IN>);
84    close(IN);
85}
86
87#############################################################################
88#
89# Private methods
90#
91#############################################################################
92
93sub _SetOption {
94    my($self)=shift;
95    my($key,$value)=@_;
96
97    $key=lc($key);
98
99        @_ == 2
100    or  croak "Invalid number of arguments";
101
102        exists($known_options{$key})
103    or  croak "Unknown option: '$key'";
104
105    if(exists($known_options{$key}{lc($value)})) {
106        $value=lc($value);
107    }
108    elsif(not exists($known_options{$key}{''})) {
109        croak "Invalid value '$value' for option '$key'";
110    }
111
112        exists($actions{$key})
113    and &{$actions{$key}}($self,$value);
114
115    $self->{OPTIONS}{$key}=$value;
116}
117
118sub _GetOption {
119    my($self)=shift;
120    my($key)=map { lc($_) } @_;
121
122        @_ == 1
123    or  croak "Invalid number of arguments";
124
125        exists($known_options{$key})
126    or  croak "Unknown option: '$key'";
127
128    $self->{OPTIONS}{$key};
129}
130
131#############################################################################
132#
133# Public methods
134#
135#############################################################################
136
137#
138# Constructor
139#
140sub new {
141    my($class)=shift;
142    my($self)={ OPTIONS => { %default_options } };
143
144        ref($class)
145    and $class=ref($class);
146
147    bless($self,$class);
148
149    $self->Options(@_);
150
151    $self;
152}
153
154#
155# Specify one or more options to set
156#
157sub Options {
158    my($self)=shift;
159    my($key,$value);
160
161        @_ % 2 == 0
162    or  croak "Invalid number of arguments";
163
164    while(($key,$value)=splice(@_,0,2)) {
165        $self->_SetOption($key,$value);
166    }
167}
168
169#
170# Set (2 parameters) or Get (1 parameter) values for one option
171#
172sub Option {
173    my($self)=shift;
174    my($key,$value)=@_;
175
176        @_ == 1
177    and return $self->_GetOption($key);
178
179        @_ == 2
180    and return $self->_SetOption($key,$value);
181
182    croak "Invalid number of arguments";
183
184}
185
1861;
187