line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# Module Parse::Eyapp::Options |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# This module is based on Francois Desarmenien Parse::Yapp module |
5
|
|
|
|
|
|
|
# (c) Parse::Yapp Copyright 1998-2001 Francois Desarmenien, all rights reserved. |
6
|
|
|
|
|
|
|
# (c) Parse::Eyapp Copyright 2006-2008 Casiano Rodriguez-Leon, all rights reserved. |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package Parse::Eyapp::Options; |
9
|
|
|
|
|
|
|
|
10
|
61
|
|
|
61
|
|
325
|
use strict; |
|
61
|
|
|
|
|
131
|
|
|
61
|
|
|
|
|
2890
|
|
11
|
61
|
|
|
61
|
|
574
|
use Carp; |
|
61
|
|
|
|
|
124
|
|
|
61
|
|
|
|
|
65224
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
############################################################################ |
14
|
|
|
|
|
|
|
#Definitions of options |
15
|
|
|
|
|
|
|
# |
16
|
|
|
|
|
|
|
# %known_options allowed options |
17
|
|
|
|
|
|
|
# |
18
|
|
|
|
|
|
|
# %default_options default |
19
|
|
|
|
|
|
|
# |
20
|
|
|
|
|
|
|
# %actions sub refs to execute if option is set with ($self,$value) |
21
|
|
|
|
|
|
|
# as parameters |
22
|
|
|
|
|
|
|
############################################################################ |
23
|
|
|
|
|
|
|
# |
24
|
|
|
|
|
|
|
#A value of '' means any value can do |
25
|
|
|
|
|
|
|
# |
26
|
|
|
|
|
|
|
my(%known_options)= ( |
27
|
|
|
|
|
|
|
language => { |
28
|
|
|
|
|
|
|
perl => "Ouput parser for Perl language", |
29
|
|
|
|
|
|
|
# for future use... |
30
|
|
|
|
|
|
|
# 'c++' => "Output parser for C++ language", |
31
|
|
|
|
|
|
|
# c => "Output parser for C language" |
32
|
|
|
|
|
|
|
}, |
33
|
|
|
|
|
|
|
linenumbers => { |
34
|
|
|
|
|
|
|
0 => "Don't embbed line numbers in parser", |
35
|
|
|
|
|
|
|
1 => "Embbed source line numbers in parser" |
36
|
|
|
|
|
|
|
}, |
37
|
|
|
|
|
|
|
firstline => { |
38
|
|
|
|
|
|
|
'' => "Line number where the input grammar starts" |
39
|
|
|
|
|
|
|
}, |
40
|
|
|
|
|
|
|
inputfile => { |
41
|
|
|
|
|
|
|
'' => "Input file name: will automagically fills input" |
42
|
|
|
|
|
|
|
}, |
43
|
|
|
|
|
|
|
prefix => { |
44
|
|
|
|
|
|
|
'' => "Accept if a prefix of the input belongs to the language" |
45
|
|
|
|
|
|
|
}, |
46
|
|
|
|
|
|
|
classname => { |
47
|
|
|
|
|
|
|
'' => "Class name of parser object (Perl and C++)" |
48
|
|
|
|
|
|
|
}, |
49
|
|
|
|
|
|
|
standalone => { |
50
|
|
|
|
|
|
|
0 => "Don't create a standalone parser (Perl and C++)", |
51
|
|
|
|
|
|
|
1 => "Create a standalone parser" |
52
|
|
|
|
|
|
|
}, |
53
|
|
|
|
|
|
|
buildingtree => { |
54
|
|
|
|
|
|
|
0 => "Not building AST (for lists)", |
55
|
|
|
|
|
|
|
1 => "Building AST (for lists)" |
56
|
|
|
|
|
|
|
}, |
57
|
|
|
|
|
|
|
input => { |
58
|
|
|
|
|
|
|
'' => "Input text of grammar" |
59
|
|
|
|
|
|
|
}, |
60
|
|
|
|
|
|
|
template => { |
61
|
|
|
|
|
|
|
'' => "Template text for generating grammar file" |
62
|
|
|
|
|
|
|
}, |
63
|
|
|
|
|
|
|
prefixname => { |
64
|
|
|
|
|
|
|
'' => "Prefix for the Tree Classes" |
65
|
|
|
|
|
|
|
}, |
66
|
|
|
|
|
|
|
modulino => { |
67
|
|
|
|
|
|
|
'' => "Produce modulino code at the end of the generated module" |
68
|
|
|
|
|
|
|
}, |
69
|
|
|
|
|
|
|
start => { |
70
|
|
|
|
|
|
|
'' => "Specify start symbol" |
71
|
|
|
|
|
|
|
}, |
72
|
|
|
|
|
|
|
tree => { |
73
|
|
|
|
|
|
|
0 => "don't build AST", |
74
|
|
|
|
|
|
|
1 => "build AST" |
75
|
|
|
|
|
|
|
}, |
76
|
|
|
|
|
|
|
nocompact => { |
77
|
|
|
|
|
|
|
0 => "Do not compact action tables. No DEFAULT field for 'STATES'", |
78
|
|
|
|
|
|
|
1 => "Compact action tables" |
79
|
|
|
|
|
|
|
}, |
80
|
|
|
|
|
|
|
lexerisdefined => { |
81
|
|
|
|
|
|
|
0 => "Built a lexer", |
82
|
|
|
|
|
|
|
1 => "don't build a lexer" |
83
|
|
|
|
|
|
|
}, |
84
|
|
|
|
|
|
|
); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
my(%default_options)= ( |
87
|
|
|
|
|
|
|
language => 'perl', |
88
|
|
|
|
|
|
|
firstline => 1, |
89
|
|
|
|
|
|
|
linenumbers => 1, |
90
|
|
|
|
|
|
|
inputfile => undef, |
91
|
|
|
|
|
|
|
classname => 'Parser', |
92
|
|
|
|
|
|
|
standalone => 0, |
93
|
|
|
|
|
|
|
buildingtree => 1, |
94
|
|
|
|
|
|
|
input => undef, |
95
|
|
|
|
|
|
|
template => undef, |
96
|
|
|
|
|
|
|
shebang => undef, |
97
|
|
|
|
|
|
|
prefixname => '', |
98
|
|
|
|
|
|
|
modulino => undef, |
99
|
|
|
|
|
|
|
tree => undef, |
100
|
|
|
|
|
|
|
nocompact => 0, |
101
|
|
|
|
|
|
|
lexerisdefined => 0, |
102
|
|
|
|
|
|
|
); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
my(%actions)= ( |
105
|
|
|
|
|
|
|
inputfile => \&__LoadFile |
106
|
|
|
|
|
|
|
); |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
############################################################################# |
109
|
|
|
|
|
|
|
# |
110
|
|
|
|
|
|
|
# Actions |
111
|
|
|
|
|
|
|
# |
112
|
|
|
|
|
|
|
# These are NOT a method, although they look like... |
113
|
|
|
|
|
|
|
# |
114
|
|
|
|
|
|
|
# They are super-private routines (that's why I prepend __ to their names) |
115
|
|
|
|
|
|
|
# |
116
|
|
|
|
|
|
|
############################################################################# |
117
|
|
|
|
|
|
|
sub __LoadFile { |
118
|
54
|
|
|
54
|
|
348
|
my($self,$filename)=@_; |
119
|
|
|
|
|
|
|
|
120
|
54
|
50
|
|
|
|
389
|
return if defined($self->{OPTIONS}{input}); |
121
|
|
|
|
|
|
|
|
122
|
0
|
0
|
|
|
|
0
|
open(IN,"<$filename") |
123
|
|
|
|
|
|
|
or croak "Cannot open input file '$filename' for reading"; |
124
|
0
|
|
|
|
|
0
|
$self->{OPTIONS}{input}=join('',); |
125
|
0
|
|
|
|
|
0
|
close(IN); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
############################################################################# |
129
|
|
|
|
|
|
|
# |
130
|
|
|
|
|
|
|
# Private methods |
131
|
|
|
|
|
|
|
# |
132
|
|
|
|
|
|
|
############################################################################# |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub _SetOption { |
135
|
270
|
|
|
270
|
|
484
|
my($self)=shift; |
136
|
270
|
|
|
|
|
492
|
my($key,$value)=@_; |
137
|
|
|
|
|
|
|
|
138
|
270
|
|
|
|
|
502
|
$key=lc($key); |
139
|
|
|
|
|
|
|
|
140
|
270
|
50
|
|
|
|
847
|
@_ == 2 |
141
|
|
|
|
|
|
|
or croak "Invalid number of arguments"; |
142
|
|
|
|
|
|
|
|
143
|
270
|
50
|
|
|
|
734
|
exists($known_options{$key}) |
144
|
|
|
|
|
|
|
or croak "Unknown option: '$key'"; |
145
|
|
|
|
|
|
|
|
146
|
270
|
100
|
|
|
|
3198
|
if(exists($known_options{$key}{lc($value)})) { |
|
|
50
|
|
|
|
|
|
147
|
54
|
50
|
|
|
|
294
|
$value=lc($value) if defined($value); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
elsif(not exists($known_options{$key}{''})) { |
150
|
0
|
|
|
|
|
0
|
croak "Invalid value '$value' for option '$key'"; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
54
|
|
|
|
|
264
|
exists($actions{$key}) |
154
|
270
|
100
|
|
|
|
1411
|
and &{$actions{$key}}($self,$value); |
155
|
|
|
|
|
|
|
|
156
|
270
|
|
|
|
|
2162
|
$self->{OPTIONS}{$key}=$value; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub _GetOption { |
160
|
1192
|
|
|
1192
|
|
1532
|
my($self)=shift; |
161
|
1192
|
|
|
|
|
1706
|
my($key)=map { lc($_) } @_; |
|
1192
|
|
|
|
|
3246
|
|
162
|
|
|
|
|
|
|
|
163
|
1192
|
50
|
|
|
|
3340
|
@_ == 1 |
164
|
|
|
|
|
|
|
or croak "Invalid number of arguments"; |
165
|
|
|
|
|
|
|
|
166
|
1192
|
50
|
|
|
|
3731
|
exists($known_options{$key}) |
167
|
|
|
|
|
|
|
or croak "Unknown option: '$key'"; |
168
|
|
|
|
|
|
|
|
169
|
1192
|
|
|
|
|
6683
|
$self->{OPTIONS}{$key}; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
############################################################################# |
173
|
|
|
|
|
|
|
# |
174
|
|
|
|
|
|
|
# Public methods |
175
|
|
|
|
|
|
|
# |
176
|
|
|
|
|
|
|
############################################################################# |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# |
179
|
|
|
|
|
|
|
# Constructor |
180
|
|
|
|
|
|
|
# |
181
|
|
|
|
|
|
|
sub new { |
182
|
54
|
|
|
54
|
0
|
166
|
my($class)=shift; |
183
|
54
|
|
|
|
|
942
|
my($self)={ OPTIONS => { %default_options } }; |
184
|
|
|
|
|
|
|
|
185
|
54
|
50
|
|
|
|
300
|
ref($class) |
186
|
|
|
|
|
|
|
and $class=ref($class); |
187
|
|
|
|
|
|
|
|
188
|
54
|
|
|
|
|
247
|
bless($self,$class); |
189
|
|
|
|
|
|
|
|
190
|
54
|
|
|
|
|
671
|
$self->Options(@_); |
191
|
|
|
|
|
|
|
|
192
|
54
|
|
|
|
|
197
|
$self; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# |
196
|
|
|
|
|
|
|
# Specify one or more options to set |
197
|
|
|
|
|
|
|
# |
198
|
|
|
|
|
|
|
sub Options { |
199
|
108
|
|
|
108
|
0
|
278
|
my($self)=shift; |
200
|
108
|
|
|
|
|
205
|
my($key,$value); |
201
|
|
|
|
|
|
|
|
202
|
108
|
50
|
|
|
|
546
|
@_ % 2 == 0 |
203
|
|
|
|
|
|
|
or croak "Invalid number of arguments"; |
204
|
|
|
|
|
|
|
|
205
|
108
|
|
|
|
|
724
|
while(($key,$value)=splice(@_,0,2)) { |
206
|
270
|
|
|
|
|
2599
|
$self->_SetOption($key,$value); |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# |
211
|
|
|
|
|
|
|
# Set (2 parameters) or Get (1 parameter) values for one option |
212
|
|
|
|
|
|
|
# |
213
|
|
|
|
|
|
|
sub Option { |
214
|
1192
|
|
|
1192
|
0
|
2819
|
my($self)=shift; |
215
|
1192
|
|
|
|
|
1940
|
my($key,$value)=@_; |
216
|
|
|
|
|
|
|
|
217
|
1192
|
50
|
|
|
|
4830
|
@_ == 1 |
218
|
|
|
|
|
|
|
and return $self->_GetOption($key); |
219
|
|
|
|
|
|
|
|
220
|
0
|
0
|
|
|
|
|
@_ == 2 |
221
|
|
|
|
|
|
|
and return $self->_SetOption($key,$value); |
222
|
|
|
|
|
|
|
|
223
|
0
|
|
|
|
|
|
croak "Invalid number of arguments"; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
1; |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
__END__ |