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 # |
|
7 package Parse::Yapp::Options; |
|
8 |
|
9 use strict; |
|
10 use 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 # |
|
25 my(%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 |
|
54 my(%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 |
|
65 my(%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 ############################################################################# |
|
78 sub __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 |
|
93 sub _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 |
|
118 sub _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 # |
|
140 sub 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 # |
|
157 sub 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 # |
|
172 sub 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 |
|
186 1; |
|