| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Set::FA::Element; |
|
2
|
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
102454
|
use strict; |
|
|
4
|
|
|
|
|
12
|
|
|
|
4
|
|
|
|
|
172
|
|
|
4
|
4
|
|
|
4
|
|
24
|
use warnings; |
|
|
4
|
|
|
|
|
16
|
|
|
|
4
|
|
|
|
|
143
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
4
|
|
|
4
|
|
5268
|
use Hash::FieldHash ':all'; |
|
|
4
|
|
|
|
|
6762
|
|
|
|
4
|
|
|
|
|
9260
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
fieldhash my %accepting => 'accepting'; |
|
9
|
|
|
|
|
|
|
fieldhash my %actions => 'actions'; |
|
10
|
|
|
|
|
|
|
fieldhash my %current => 'current'; |
|
11
|
|
|
|
|
|
|
fieldhash my %data => 'data'; |
|
12
|
|
|
|
|
|
|
fieldhash my %die_on_loop => 'die_on_loop'; |
|
13
|
|
|
|
|
|
|
fieldhash my %id => 'id'; |
|
14
|
|
|
|
|
|
|
fieldhash my %logger => 'logger'; |
|
15
|
|
|
|
|
|
|
fieldhash my %match => 'match'; |
|
16
|
|
|
|
|
|
|
fieldhash my %start => 'start'; |
|
17
|
|
|
|
|
|
|
fieldhash my %stt => 'stt'; |
|
18
|
|
|
|
|
|
|
fieldhash my %transitions => 'transitions'; |
|
19
|
|
|
|
|
|
|
fieldhash my %verbose => 'verbose'; |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our $VERSION = '1.08'; |
|
22
|
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub accept |
|
26
|
|
|
|
|
|
|
{ |
|
27
|
34
|
|
|
34
|
1
|
84
|
my($self, $input) = @_; |
|
28
|
|
|
|
|
|
|
|
|
29
|
34
|
|
|
|
|
53
|
$self -> log(debug => 'Entered accept()'); |
|
30
|
|
|
|
|
|
|
|
|
31
|
34
|
|
|
|
|
53
|
return $self -> final($self -> advance($input) ); |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
} # End of accept. |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub advance |
|
38
|
|
|
|
|
|
|
{ |
|
39
|
38
|
|
|
38
|
1
|
48
|
my($self, $input) = @_; |
|
40
|
|
|
|
|
|
|
|
|
41
|
38
|
|
|
|
|
56
|
$self -> log(debug => 'Entered advance()'); |
|
42
|
|
|
|
|
|
|
|
|
43
|
38
|
|
|
|
|
34
|
my($output); |
|
44
|
|
|
|
|
|
|
|
|
45
|
38
|
|
|
|
|
75
|
while ($input) |
|
46
|
|
|
|
|
|
|
{ |
|
47
|
439
|
|
|
|
|
656
|
$output = $self -> step($input); |
|
48
|
|
|
|
|
|
|
|
|
49
|
439
|
50
|
|
|
|
859
|
if (length($output) >= length($input) ) |
|
50
|
|
|
|
|
|
|
{ |
|
51
|
0
|
0
|
0
|
|
|
0
|
my($prefix) = $input ? '<' . join('> <', map{$_ ge ' ' && $_ le '~' ? sprintf('%s', $_) : sprintf('0x%02x', ord $_)} grep{/./} split(//, substr($input, 0, 5) ) ) . '>' : ''; |
|
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
52
|
|
|
|
|
|
|
|
|
53
|
0
|
0
|
|
|
|
0
|
$self -> log( ($self -> die_on_loop ? 'error' : 'warning') => "State: '" . $self -> current . "' is not consuming input. Next 5 chars: $prefix"); |
|
54
|
|
|
|
|
|
|
} |
|
55
|
|
|
|
|
|
|
|
|
56
|
439
|
|
|
|
|
721
|
$input = $output; |
|
57
|
|
|
|
|
|
|
} |
|
58
|
|
|
|
|
|
|
|
|
59
|
38
|
|
|
|
|
142
|
return $self -> current; |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
} # End of advance. |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub build_stt |
|
66
|
|
|
|
|
|
|
{ |
|
67
|
33
|
|
|
33
|
1
|
39
|
my($self) = @_; |
|
68
|
33
|
|
|
|
|
49
|
my(%action) = %{$self -> actions}; |
|
|
33
|
|
|
|
|
120
|
|
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# Reformat the actions. |
|
71
|
|
|
|
|
|
|
|
|
72
|
33
|
|
|
|
|
39
|
my($entry_exit); |
|
73
|
|
|
|
|
|
|
my($state); |
|
74
|
0
|
|
|
|
|
0
|
my($trigger); |
|
75
|
|
|
|
|
|
|
|
|
76
|
33
|
|
|
|
|
73
|
for $state (keys %action) |
|
77
|
|
|
|
|
|
|
{ |
|
78
|
1
|
|
|
|
|
2
|
for $trigger (keys %{$action{$state} }) |
|
|
1
|
|
|
|
|
4
|
|
|
79
|
|
|
|
|
|
|
{ |
|
80
|
2
|
50
|
|
|
|
14
|
if ($trigger !~ /^(entry|exit)$/) |
|
81
|
|
|
|
|
|
|
{ |
|
82
|
0
|
|
|
|
|
0
|
$self -> log(error => "Action table contains the unknown trigger '$trigger'. Use entry/exit"); |
|
83
|
|
|
|
|
|
|
} |
|
84
|
|
|
|
|
|
|
} |
|
85
|
|
|
|
|
|
|
} |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# Reformat the acceptings. |
|
88
|
|
|
|
|
|
|
|
|
89
|
33
|
|
|
|
|
549
|
my(@accepting) = @{$self -> accepting}; |
|
|
33
|
|
|
|
|
103
|
|
|
90
|
33
|
|
|
|
|
66
|
my($row) = 0; |
|
91
|
|
|
|
|
|
|
|
|
92
|
33
|
|
|
|
|
34
|
my(%accept); |
|
93
|
33
|
|
|
|
|
38
|
my($entry_fn, $entry_name, $exit_fn, $exit_name); |
|
94
|
0
|
|
|
|
|
0
|
my($last); |
|
95
|
0
|
|
|
|
|
0
|
my($next); |
|
96
|
0
|
|
|
|
|
0
|
my($rule_sub, $rule); |
|
97
|
0
|
|
|
|
|
0
|
my(%stt); |
|
98
|
|
|
|
|
|
|
|
|
99
|
33
|
|
|
|
|
85
|
@accept{@accepting} = (1) x @accepting; |
|
100
|
|
|
|
|
|
|
|
|
101
|
33
|
|
|
|
|
38
|
for my $item (@{$self -> transitions}) |
|
|
33
|
|
|
|
|
118
|
|
|
102
|
|
|
|
|
|
|
{ |
|
103
|
124
|
|
|
|
|
131
|
$row++; |
|
104
|
|
|
|
|
|
|
|
|
105
|
124
|
50
|
33
|
|
|
634
|
if (ref($item ne 'ARRAY') || ($#$item < 2) ) |
|
106
|
|
|
|
|
|
|
{ |
|
107
|
0
|
|
|
|
|
0
|
$self -> log(error => "Transition table row $row has too few columns"); |
|
108
|
|
|
|
|
|
|
} |
|
109
|
|
|
|
|
|
|
|
|
110
|
124
|
|
|
|
|
258
|
($state, $rule, $next) = @$item; |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# Allow first column of transition table to be empty (meaning ditto), |
|
113
|
|
|
|
|
|
|
# as long as there is a state name somewhere above the missing element. |
|
114
|
|
|
|
|
|
|
|
|
115
|
124
|
50
|
|
|
|
234
|
if (! defined $state) |
|
116
|
|
|
|
|
|
|
{ |
|
117
|
0
|
|
|
|
|
0
|
$state = $last; |
|
118
|
|
|
|
|
|
|
} |
|
119
|
|
|
|
|
|
|
|
|
120
|
124
|
50
|
33
|
|
|
620
|
if (! defined($state && $rule && $next) ) |
|
121
|
|
|
|
|
|
|
{ |
|
122
|
0
|
|
|
|
|
0
|
$self -> log(error => "Transition table row $row lacks state name/rule/next state name"); |
|
123
|
|
|
|
|
|
|
} |
|
124
|
|
|
|
|
|
|
|
|
125
|
124
|
50
|
|
|
|
204
|
if (ref($rule) eq 'CODE') |
|
126
|
|
|
|
|
|
|
{ |
|
127
|
0
|
|
|
|
|
0
|
$rule_sub = $rule; |
|
128
|
|
|
|
|
|
|
} |
|
129
|
|
|
|
|
|
|
else |
|
130
|
|
|
|
|
|
|
{ |
|
131
|
|
|
|
|
|
|
# Warning: $regexp must be declared in this scope. |
|
132
|
|
|
|
|
|
|
|
|
133
|
124
|
|
|
|
|
1199
|
my($regexp) = qr/($rule)/; |
|
134
|
|
|
|
|
|
|
$rule_sub = sub |
|
135
|
|
|
|
|
|
|
{ |
|
136
|
722
|
|
|
722
|
|
853
|
my($class, $input) = @_; |
|
137
|
|
|
|
|
|
|
|
|
138
|
722
|
100
|
|
|
|
8492
|
return $input =~ /^$regexp(.*)/ ? ($1, $2) : (undef, undef); |
|
139
|
124
|
|
|
|
|
512
|
}; |
|
140
|
|
|
|
|
|
|
} |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# The 3rd item in each arrayref is only used for debugging. |
|
143
|
|
|
|
|
|
|
|
|
144
|
124
|
100
|
|
|
|
240
|
if ($stt{$state}) |
|
145
|
|
|
|
|
|
|
{ |
|
146
|
55
|
|
|
|
|
52
|
push @{$stt{$state}{rule} }, [$rule_sub, $next, $rule]; |
|
|
55
|
|
|
|
|
173
|
|
|
147
|
|
|
|
|
|
|
} |
|
148
|
|
|
|
|
|
|
else |
|
149
|
|
|
|
|
|
|
{ |
|
150
|
69
|
|
|
|
|
93
|
$entry_fn = $entry_name = $exit_fn = $exit_name = ''; |
|
151
|
|
|
|
|
|
|
|
|
152
|
69
|
100
|
66
|
|
|
170
|
if ($action{$state} && $action{$state}{entry}) |
|
153
|
|
|
|
|
|
|
{ |
|
154
|
1
|
|
|
|
|
2
|
$entry_fn = $action{$state}{entry}; |
|
155
|
|
|
|
|
|
|
|
|
156
|
1
|
50
|
|
|
|
5
|
if (ref $entry_fn eq 'ARRAY') |
|
157
|
|
|
|
|
|
|
{ |
|
158
|
0
|
|
|
|
|
0
|
$entry_name = $$entry_fn[1]; |
|
159
|
0
|
|
|
|
|
0
|
$entry_fn = $$entry_fn[0]; |
|
160
|
|
|
|
|
|
|
} |
|
161
|
|
|
|
|
|
|
else |
|
162
|
|
|
|
|
|
|
{ |
|
163
|
1
|
|
|
|
|
2
|
$entry_name = $entry_fn; |
|
164
|
|
|
|
|
|
|
} |
|
165
|
|
|
|
|
|
|
} |
|
166
|
|
|
|
|
|
|
|
|
167
|
69
|
100
|
66
|
|
|
147
|
if ($action{$state} && $action{$state}{exit}) |
|
168
|
|
|
|
|
|
|
{ |
|
169
|
1
|
|
|
|
|
2
|
$exit_fn = $action{$state}{exit}; |
|
170
|
|
|
|
|
|
|
|
|
171
|
1
|
50
|
|
|
|
3
|
if (ref $exit_fn eq 'ARRAY') |
|
172
|
|
|
|
|
|
|
{ |
|
173
|
0
|
|
|
|
|
0
|
$exit_name = $$exit_fn[1]; |
|
174
|
0
|
|
|
|
|
0
|
$exit_fn = $$exit_fn[0]; |
|
175
|
|
|
|
|
|
|
} |
|
176
|
|
|
|
|
|
|
else |
|
177
|
|
|
|
|
|
|
{ |
|
178
|
1
|
|
|
|
|
2
|
$exit_name = $exit_fn; |
|
179
|
|
|
|
|
|
|
} |
|
180
|
|
|
|
|
|
|
} |
|
181
|
|
|
|
|
|
|
|
|
182
|
69
|
|
100
|
|
|
593
|
$stt{$state} = |
|
183
|
|
|
|
|
|
|
{ |
|
184
|
|
|
|
|
|
|
accept => $accept{$state} || 0, |
|
185
|
|
|
|
|
|
|
entry_fn => $entry_fn, |
|
186
|
|
|
|
|
|
|
entry_name => $entry_name, |
|
187
|
|
|
|
|
|
|
exit_fn => $exit_fn, |
|
188
|
|
|
|
|
|
|
exit_name => $exit_name, |
|
189
|
|
|
|
|
|
|
rule => [ [$rule_sub, $next, $rule] ], |
|
190
|
|
|
|
|
|
|
start => 0, |
|
191
|
|
|
|
|
|
|
}; |
|
192
|
|
|
|
|
|
|
} |
|
193
|
|
|
|
|
|
|
|
|
194
|
124
|
|
|
|
|
258
|
$last = $state; |
|
195
|
|
|
|
|
|
|
} |
|
196
|
|
|
|
|
|
|
|
|
197
|
33
|
|
|
|
|
102
|
$state = $self -> start; |
|
198
|
|
|
|
|
|
|
|
|
199
|
33
|
50
|
|
|
|
63
|
if ($stt{$state}) |
|
200
|
|
|
|
|
|
|
{ |
|
201
|
33
|
|
|
|
|
53
|
$stt{$state}{start} = 1; |
|
202
|
|
|
|
|
|
|
} |
|
203
|
|
|
|
|
|
|
else |
|
204
|
|
|
|
|
|
|
{ |
|
205
|
0
|
|
|
|
|
0
|
$self -> log(error => "Start state '$state' is not defined in the transition table"); |
|
206
|
|
|
|
|
|
|
} |
|
207
|
|
|
|
|
|
|
|
|
208
|
33
|
|
|
|
|
40
|
for $state (@accepting) |
|
209
|
|
|
|
|
|
|
{ |
|
210
|
33
|
50
|
|
|
|
94
|
if (! $stt{$state}) |
|
211
|
|
|
|
|
|
|
{ |
|
212
|
0
|
|
|
|
|
0
|
$self -> log(error => "Accepting state '$state' is not defined in the transition table"); |
|
213
|
|
|
|
|
|
|
} |
|
214
|
|
|
|
|
|
|
} |
|
215
|
|
|
|
|
|
|
|
|
216
|
33
|
|
|
|
|
171
|
$self -> stt(\%stt); |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
} # End of build_stt. |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
221
|
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
sub clone |
|
223
|
|
|
|
|
|
|
{ |
|
224
|
15
|
|
|
15
|
1
|
21
|
my($self) = @_; |
|
225
|
|
|
|
|
|
|
|
|
226
|
15
|
|
|
|
|
23
|
$self -> log(debug => 'Entered clone()'); |
|
227
|
|
|
|
|
|
|
|
|
228
|
15
|
|
|
|
|
24
|
my($clone) = _clone($self); |
|
229
|
|
|
|
|
|
|
|
|
230
|
15
|
|
|
|
|
76
|
return bless $clone, ref $self; |
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
} # End of clone. |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub _clone |
|
237
|
|
|
|
|
|
|
{ |
|
238
|
15
|
|
|
15
|
|
17
|
my($data) = @_; |
|
239
|
|
|
|
|
|
|
|
|
240
|
4
|
|
|
4
|
|
6635
|
use attributes 'reftype'; |
|
|
4
|
|
|
|
|
41134
|
|
|
|
4
|
|
|
|
|
28
|
|
|
241
|
|
|
|
|
|
|
|
|
242
|
15
|
50
|
|
|
|
30
|
return $data if (! ref $data); |
|
243
|
|
|
|
|
|
|
|
|
244
|
15
|
50
|
|
|
|
63
|
if (reftype($data) eq 'ARRAY') |
|
|
|
50
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
{ |
|
246
|
0
|
|
|
|
|
0
|
return [map{_clone($_)} @$data]; |
|
|
0
|
|
|
|
|
0
|
|
|
247
|
|
|
|
|
|
|
} |
|
248
|
|
|
|
|
|
|
elsif (reftype($data) eq 'HASH') |
|
249
|
|
|
|
|
|
|
{ |
|
250
|
15
|
|
|
|
|
49
|
return {map{$_ => _clone($_)} keys %$data}; |
|
|
0
|
|
|
|
|
0
|
|
|
251
|
|
|
|
|
|
|
} |
|
252
|
|
|
|
|
|
|
elsif (reftype($data) eq 'SCALAR') |
|
253
|
|
|
|
|
|
|
{ |
|
254
|
0
|
|
|
|
|
0
|
my($thing) = _clone($data); |
|
255
|
|
|
|
|
|
|
|
|
256
|
0
|
|
|
|
|
0
|
return \$thing; |
|
257
|
|
|
|
|
|
|
} |
|
258
|
|
|
|
|
|
|
else |
|
259
|
|
|
|
|
|
|
{ |
|
260
|
0
|
|
|
|
|
0
|
return $data; |
|
261
|
|
|
|
|
|
|
} |
|
262
|
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
} # End of _clone. |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
266
|
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
sub final |
|
268
|
|
|
|
|
|
|
{ |
|
269
|
117
|
|
|
117
|
1
|
145
|
my($self, $state) = @_; |
|
270
|
|
|
|
|
|
|
|
|
271
|
117
|
|
|
|
|
192
|
$self -> log(debug => 'Entered final()'); |
|
272
|
|
|
|
|
|
|
|
|
273
|
117
|
|
|
|
|
243
|
my($stt) = $self -> stt; |
|
274
|
|
|
|
|
|
|
|
|
275
|
117
|
100
|
|
|
|
723
|
return defined($state) ? $$stt{$state}{accept} : $$stt{$self -> current}{accept}; |
|
276
|
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
} # End of final. |
|
278
|
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
280
|
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub _init |
|
282
|
|
|
|
|
|
|
{ |
|
283
|
33
|
|
|
33
|
|
40
|
my($self, $arg) = @_; |
|
284
|
33
|
|
50
|
|
|
82
|
$$arg{accepting} ||= []; # Caller can set. |
|
285
|
33
|
|
100
|
|
|
133
|
$$arg{actions} ||= {}; # Caller can set. |
|
286
|
33
|
|
|
|
|
58
|
$$arg{current} = ''; |
|
287
|
33
|
|
50
|
|
|
158
|
$$arg{data} ||= ''; # Caller can set. |
|
288
|
33
|
|
50
|
|
|
149
|
$$arg{die_on_loop} ||= 0; # Caller can set. |
|
289
|
33
|
|
100
|
|
|
71
|
$$arg{id} ||= 0; # Caller can set. |
|
290
|
33
|
|
50
|
|
|
123
|
$$arg{logger} ||= ''; # Caller can set. |
|
291
|
33
|
|
|
|
|
44
|
$$arg{match} = ''; |
|
292
|
33
|
|
50
|
|
|
64
|
$$arg{start} ||= ''; # Caller must set. |
|
293
|
33
|
|
|
|
|
56
|
$$arg{stt} = {}; |
|
294
|
33
|
|
50
|
|
|
64
|
$$arg{transitions} ||= []; # Caller must set. |
|
295
|
33
|
|
100
|
|
|
117
|
$$arg{verbose} ||= 0; # Caller can set. |
|
296
|
33
|
|
|
|
|
625
|
$self = from_hash($self, $arg); |
|
297
|
|
|
|
|
|
|
|
|
298
|
33
|
|
|
|
|
111
|
$self -> validate_params; |
|
299
|
33
|
|
|
|
|
82
|
$self -> build_stt; |
|
300
|
33
|
|
|
|
|
158
|
$self -> current($self -> start); |
|
301
|
|
|
|
|
|
|
|
|
302
|
33
|
|
|
|
|
192
|
return $self; |
|
303
|
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
} # End of _init. |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
307
|
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub log |
|
309
|
|
|
|
|
|
|
{ |
|
310
|
1428
|
|
|
1428
|
1
|
1725
|
my($self, $level, $message) = @_; |
|
311
|
1428
|
|
50
|
|
|
2325
|
$level ||= 'debug'; |
|
312
|
1428
|
|
50
|
|
|
2038
|
$message ||= ''; |
|
313
|
|
|
|
|
|
|
|
|
314
|
1428
|
50
|
|
|
|
2287
|
if ($level eq 'error') |
|
315
|
|
|
|
|
|
|
{ |
|
316
|
0
|
|
|
|
|
0
|
die $message; |
|
317
|
|
|
|
|
|
|
} |
|
318
|
|
|
|
|
|
|
|
|
319
|
1428
|
50
|
|
|
|
5307
|
if ($self -> logger) |
|
|
|
100
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
{ |
|
321
|
0
|
|
|
|
|
0
|
$self -> logger -> $level($message); |
|
322
|
|
|
|
|
|
|
} |
|
323
|
|
|
|
|
|
|
elsif ($self -> verbose) |
|
324
|
|
|
|
|
|
|
{ |
|
325
|
14
|
|
|
|
|
229
|
print "$level: $message\n"; |
|
326
|
|
|
|
|
|
|
} |
|
327
|
|
|
|
|
|
|
|
|
328
|
1428
|
|
|
|
|
1794
|
return $self; |
|
329
|
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
} # End of log. |
|
331
|
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
333
|
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub new |
|
335
|
|
|
|
|
|
|
{ |
|
336
|
33
|
|
|
33
|
1
|
431
|
my($class, %arg) = @_; |
|
337
|
33
|
|
|
|
|
90
|
my($self) = bless {}, $class; |
|
338
|
|
|
|
|
|
|
|
|
339
|
33
|
|
|
|
|
85
|
return $self -> _init(\%arg); |
|
340
|
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
} # End of new. |
|
342
|
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
344
|
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
sub report |
|
346
|
|
|
|
|
|
|
{ |
|
347
|
1
|
|
|
1
|
1
|
1338
|
my($self) = @_; |
|
348
|
|
|
|
|
|
|
|
|
349
|
1
|
|
|
|
|
4
|
$self -> log(debug => 'Entered report()'); |
|
350
|
1
|
|
|
|
|
2
|
$self -> log(info => 'State Transition Table'); |
|
351
|
|
|
|
|
|
|
|
|
352
|
1
|
|
|
|
|
3
|
my($stt) = $self -> stt; |
|
353
|
|
|
|
|
|
|
|
|
354
|
1
|
|
|
|
|
2
|
my($rule); |
|
355
|
|
|
|
|
|
|
my($s); |
|
356
|
|
|
|
|
|
|
|
|
357
|
1
|
|
|
|
|
7
|
for my $state (sort keys %$stt) |
|
358
|
|
|
|
|
|
|
{ |
|
359
|
3
|
|
|
|
|
5
|
$s = "State: $state"; |
|
360
|
|
|
|
|
|
|
|
|
361
|
3
|
100
|
|
|
|
13
|
if ($$stt{$state}{start}) |
|
362
|
|
|
|
|
|
|
{ |
|
363
|
1
|
|
|
|
|
2
|
$s .= '. This is the start state'; |
|
364
|
|
|
|
|
|
|
} |
|
365
|
|
|
|
|
|
|
|
|
366
|
3
|
100
|
|
|
|
8
|
if ($$stt{$state}{accept}) |
|
367
|
|
|
|
|
|
|
{ |
|
368
|
1
|
|
|
|
|
1
|
$s .= '. This is an accepting state'; |
|
369
|
|
|
|
|
|
|
} |
|
370
|
|
|
|
|
|
|
|
|
371
|
3
|
50
|
|
|
|
7
|
if ($$stt{$state}{entry_fn}) |
|
372
|
|
|
|
|
|
|
{ |
|
373
|
0
|
|
|
|
|
0
|
$s .= ". Entry fn: $$stt{$state}{entry_name}"; |
|
374
|
|
|
|
|
|
|
} |
|
375
|
|
|
|
|
|
|
|
|
376
|
3
|
50
|
|
|
|
7
|
if ($$stt{$state}{exit_fn}) |
|
377
|
|
|
|
|
|
|
{ |
|
378
|
0
|
|
|
|
|
0
|
$s .= ". Exit fn: $$stt{$state}{exit_name}"; |
|
379
|
|
|
|
|
|
|
} |
|
380
|
|
|
|
|
|
|
|
|
381
|
3
|
|
|
|
|
5
|
$self -> log(info => $s); |
|
382
|
3
|
|
|
|
|
6
|
$self -> log(info => 'Rule => Next state'); |
|
383
|
|
|
|
|
|
|
|
|
384
|
3
|
|
|
|
|
3
|
for $rule (@{$$stt{$state}{rule} }) |
|
|
3
|
|
|
|
|
7
|
|
|
385
|
|
|
|
|
|
|
{ |
|
386
|
6
|
|
|
|
|
20
|
$self -> log(info => "/$$rule[2]/ => $$rule[1]"); |
|
387
|
|
|
|
|
|
|
} |
|
388
|
|
|
|
|
|
|
} |
|
389
|
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
} # End of report. |
|
391
|
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
393
|
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
sub reset |
|
395
|
|
|
|
|
|
|
{ |
|
396
|
31
|
|
|
31
|
1
|
36
|
my($self) = @_; |
|
397
|
|
|
|
|
|
|
|
|
398
|
31
|
|
|
|
|
57
|
$self -> log(debug => 'Entered reset()'); |
|
399
|
|
|
|
|
|
|
|
|
400
|
31
|
|
|
|
|
193
|
return $self -> current($self -> start) -> current; |
|
401
|
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
} # End of reset. |
|
403
|
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
405
|
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
sub state |
|
407
|
|
|
|
|
|
|
{ |
|
408
|
129
|
|
|
129
|
1
|
780
|
my($self, $state) = @_; |
|
409
|
|
|
|
|
|
|
|
|
410
|
129
|
|
|
|
|
249
|
$self -> log(debug => 'Entered state()'); |
|
411
|
|
|
|
|
|
|
|
|
412
|
129
|
100
|
|
|
|
812
|
return defined($state) ? (${$self -> stt}{$state} ? 1 : 0) : $self -> current; |
|
|
2
|
100
|
|
|
|
14
|
|
|
413
|
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
} # End of state. |
|
415
|
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
417
|
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
sub step |
|
419
|
|
|
|
|
|
|
{ |
|
420
|
460
|
|
|
460
|
1
|
544
|
my($self, $input) = @_; |
|
421
|
|
|
|
|
|
|
|
|
422
|
460
|
|
|
|
|
705
|
$self -> log(debug => 'Entered step()'); |
|
423
|
|
|
|
|
|
|
|
|
424
|
460
|
|
|
|
|
872
|
my($current) = $self -> current; |
|
425
|
460
|
|
|
|
|
782
|
my($stt) = $self -> stt; |
|
426
|
|
|
|
|
|
|
|
|
427
|
460
|
|
|
|
|
420
|
my($match); |
|
428
|
|
|
|
|
|
|
my($next); |
|
429
|
0
|
|
|
|
|
0
|
my($output); |
|
430
|
0
|
|
|
|
|
0
|
my($rule_sub, $rule); |
|
431
|
|
|
|
|
|
|
|
|
432
|
460
|
|
|
|
|
407
|
for my $item (@{$$stt{$current}{rule} }) |
|
|
460
|
|
|
|
|
930
|
|
|
433
|
|
|
|
|
|
|
{ |
|
434
|
722
|
|
|
|
|
1236
|
($rule_sub, $next, $rule) = @$item; |
|
435
|
722
|
|
|
|
|
1227
|
($match, $output) = $rule_sub -> ($self, $input); |
|
436
|
|
|
|
|
|
|
|
|
437
|
722
|
100
|
|
|
|
1618
|
if (defined $match) |
|
438
|
|
|
|
|
|
|
{ |
|
439
|
460
|
|
|
|
|
1222
|
$self -> match($match); |
|
440
|
460
|
|
|
|
|
796
|
$self -> step_state($next, $rule, $match); |
|
441
|
|
|
|
|
|
|
|
|
442
|
460
|
|
|
|
|
994
|
return $output; |
|
443
|
|
|
|
|
|
|
} |
|
444
|
|
|
|
|
|
|
} |
|
445
|
|
|
|
|
|
|
|
|
446
|
0
|
|
|
|
|
0
|
return $input; |
|
447
|
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
} # End of step. |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
451
|
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
sub step_state |
|
453
|
|
|
|
|
|
|
{ |
|
454
|
460
|
|
|
460
|
1
|
573
|
my($self, $next, $rule, $match) = @_; |
|
455
|
|
|
|
|
|
|
|
|
456
|
460
|
|
|
|
|
694
|
$self -> log(debug => 'Entered step_state()'); |
|
457
|
|
|
|
|
|
|
|
|
458
|
460
|
|
|
|
|
940
|
my($current) = $self -> current; |
|
459
|
|
|
|
|
|
|
|
|
460
|
460
|
100
|
|
|
|
893
|
return 0 if ($next eq $current); |
|
461
|
|
|
|
|
|
|
|
|
462
|
130
|
|
|
|
|
235
|
my($stt) = $self -> stt; |
|
463
|
|
|
|
|
|
|
|
|
464
|
130
|
100
|
|
|
|
272
|
if ($$stt{$current}{exit_fn}) |
|
465
|
|
|
|
|
|
|
{ |
|
466
|
9
|
|
|
|
|
23
|
$$stt{$current}{exit_fn} -> ($self); |
|
467
|
|
|
|
|
|
|
} |
|
468
|
|
|
|
|
|
|
|
|
469
|
130
|
|
|
|
|
339
|
$self -> current($next); |
|
470
|
|
|
|
|
|
|
|
|
471
|
130
|
100
|
|
|
|
287
|
if ($$stt{$next}{entry_fn}) |
|
472
|
|
|
|
|
|
|
{ |
|
473
|
9
|
|
|
|
|
32
|
$$stt{$next}{entry_fn} -> ($self); |
|
474
|
|
|
|
|
|
|
} |
|
475
|
|
|
|
|
|
|
|
|
476
|
130
|
|
|
|
|
381
|
$self -> log(info => "Stepped from state '$current' to '$next' using rule /$rule/ to match '$match'"); |
|
477
|
|
|
|
|
|
|
|
|
478
|
130
|
|
|
|
|
190
|
return 1; |
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
} # End of step_state; |
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
483
|
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
sub validate_params |
|
485
|
|
|
|
|
|
|
{ |
|
486
|
33
|
|
|
33
|
0
|
45
|
my($self) = @_; |
|
487
|
|
|
|
|
|
|
|
|
488
|
33
|
50
|
33
|
|
|
137
|
if ( (ref $self -> accepting ne 'ARRAY') || ($#{$self -> accepting} < 0) ) |
|
|
33
|
|
|
|
|
162
|
|
|
489
|
|
|
|
|
|
|
{ |
|
490
|
0
|
|
|
|
|
0
|
$self -> log(error => 'No accepting states specified. Use accepting'); |
|
491
|
|
|
|
|
|
|
} |
|
492
|
|
|
|
|
|
|
|
|
493
|
33
|
50
|
|
|
|
149
|
if (! $self -> start) |
|
494
|
|
|
|
|
|
|
{ |
|
495
|
0
|
|
|
|
|
0
|
$self -> log(error => 'No start state specified. Use start'); |
|
496
|
|
|
|
|
|
|
} |
|
497
|
|
|
|
|
|
|
|
|
498
|
33
|
50
|
33
|
|
|
131
|
if ( (ref $self -> transitions ne 'ARRAY') || ($#{$self -> transitions} < 0) ) |
|
|
33
|
|
|
|
|
151
|
|
|
499
|
|
|
|
|
|
|
{ |
|
500
|
0
|
|
|
|
|
|
$self -> log(error => 'No state transition table specified. Use transitions'); |
|
501
|
|
|
|
|
|
|
} |
|
502
|
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
} # End of validate_params; |
|
504
|
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
# ----------------------------------------------- |
|
506
|
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
1; |
|
508
|
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=pod |
|
510
|
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=head1 NAME |
|
512
|
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
L<Set::FA::Element> - Discrete Finite Automaton |
|
514
|
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=head1 Synopsis |
|
516
|
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
#!/usr/bin/perl |
|
518
|
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
use strict; |
|
520
|
|
|
|
|
|
|
use warnings; |
|
521
|
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
use Set::FA::Element; |
|
523
|
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
# -------------------------- |
|
525
|
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
my($dfa) = Set::FA::Element -> new |
|
527
|
|
|
|
|
|
|
( |
|
528
|
|
|
|
|
|
|
accepting => ['baz'], |
|
529
|
|
|
|
|
|
|
start => 'foo', |
|
530
|
|
|
|
|
|
|
transitions => |
|
531
|
|
|
|
|
|
|
[ |
|
532
|
|
|
|
|
|
|
['foo', 'b', 'bar'], |
|
533
|
|
|
|
|
|
|
['foo', '.', 'foo'], |
|
534
|
|
|
|
|
|
|
['bar', 'a', 'foo'], |
|
535
|
|
|
|
|
|
|
['bar', 'b', 'bar'], |
|
536
|
|
|
|
|
|
|
['bar', 'c', 'baz'], |
|
537
|
|
|
|
|
|
|
['baz', '.', 'baz'], |
|
538
|
|
|
|
|
|
|
], |
|
539
|
|
|
|
|
|
|
); |
|
540
|
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
my($boolean) = $dfa -> accept($input); |
|
542
|
|
|
|
|
|
|
my($current) = $dfa -> advance($input); |
|
543
|
|
|
|
|
|
|
my($state) = $dfa -> current; |
|
544
|
|
|
|
|
|
|
my($boolean) = $dfa -> final; |
|
545
|
|
|
|
|
|
|
my($acceptor) = $dfa -> final($state); |
|
546
|
|
|
|
|
|
|
my($string) = $dfa -> match; |
|
547
|
|
|
|
|
|
|
my($current) = $dfa -> reset; |
|
548
|
|
|
|
|
|
|
my($current) = $dfa -> state; |
|
549
|
|
|
|
|
|
|
my($boolean) = $dfa -> state($state); |
|
550
|
|
|
|
|
|
|
my($string) = $dfa -> step($input); |
|
551
|
|
|
|
|
|
|
my($boolean) = $dfa -> step_state($next); |
|
552
|
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
=head1 Description |
|
554
|
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
L<Set::FA::Element> provides a mechanism to define and run a DFA. |
|
556
|
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
=head1 Installation |
|
558
|
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
Install L<Set::FA> as you would for any C<Perl> module: |
|
560
|
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
Run: |
|
562
|
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
cpanm Set::FA |
|
564
|
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
or run: |
|
566
|
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
sudo cpan Set::FA |
|
568
|
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
or unpack the distro, and then either: |
|
570
|
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
perl Build.PL |
|
572
|
|
|
|
|
|
|
./Build |
|
573
|
|
|
|
|
|
|
./Build test |
|
574
|
|
|
|
|
|
|
sudo ./Build install |
|
575
|
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
or: |
|
577
|
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
perl Makefile.PL |
|
579
|
|
|
|
|
|
|
make (or dmake or nmake) |
|
580
|
|
|
|
|
|
|
make test |
|
581
|
|
|
|
|
|
|
make install |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head1 Constructor and Initialization |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=head2 Parentage |
|
586
|
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
You can easily subclass L<Set::FA::Element> by having your subclass use exactly the same logic as in the code, |
|
588
|
|
|
|
|
|
|
- see new(), and _init() - after declaring your getters and setters using the Hash::FieldHash syntax. |
|
589
|
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
=head2 Using new() |
|
591
|
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
C<new()> is called as C<< my($dfa) = Set::FA::Element -> new(k1 => v1, k2 => v2, ...) >>. |
|
593
|
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
It returns a new object of type C<Set::FA::Element>. |
|
595
|
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
Key-value pairs accepted in the parameter list are as follows. Also, each is also a method, |
|
597
|
|
|
|
|
|
|
so you can retrieve the value and update it at any time. |
|
598
|
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
Naturally, after the internal state transition table has been constructed (during the call to new() ), |
|
600
|
|
|
|
|
|
|
updating some of these fields will be ignored. Methods which I<are> effective later are documented. |
|
601
|
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
=over 4 |
|
603
|
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
=item o accepting => [] |
|
605
|
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
Provides an arrayref of accepting state names. |
|
607
|
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
This key is optional. |
|
609
|
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
The default is []. |
|
611
|
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
=item o actions => {} |
|
613
|
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
Provides a hashref of entry/exit functions keyed by state name. |
|
615
|
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
This means you can have only 1 entry function and 1 exit function per state. |
|
617
|
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
For a module which gives you the power to have a different entry and exit function |
|
619
|
|
|
|
|
|
|
for each different regexp which matches the input, see the (as yet unwritten) Set::FA::Manifold. |
|
620
|
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
Format: |
|
622
|
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
=over 4 |
|
624
|
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
=item o entry => \&function or => [\&function, 'function_name'] |
|
626
|
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
The 'entry' key points to a reference to a function to be called upon entry to a state. |
|
628
|
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
Alternately, you can pass in an arrayref, with the function reference as the first element, |
|
630
|
|
|
|
|
|
|
and a string, e.g. the function name, as the second element. |
|
631
|
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
The point of the [\&fn, 'fn'] version is when you call report(), and the 'fn' string is output. |
|
633
|
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
=item o exit => \&function or => [\&function, 'function_name'] |
|
635
|
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
The 'exit' key points to a reference to a function to be called upon exit from a state. |
|
637
|
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
Alternately, you can pass in an arrayref, with the function reference as the first element, |
|
639
|
|
|
|
|
|
|
and a string, e.g. the function name, as the second element. |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
The point of the [\&fn, 'fn'] version is when you call report(), and the 'fn' string is output. |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=back |
|
644
|
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
Each of these functions is called (in method step_state() ) with the DFA object as the only parameter. |
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
This key is optional. |
|
648
|
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
The default is {}. |
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=item o data => $string |
|
652
|
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
A place to store anything you want, per DFA. |
|
654
|
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
Retrieve and update the value with the data() method. |
|
656
|
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
This key is optional. |
|
658
|
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
The default is ''. |
|
660
|
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
=item o die_on_loop => $boolean |
|
662
|
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
Provides a way for the code to keep running, or die, when the advance() method determines that |
|
664
|
|
|
|
|
|
|
input is not being consumed. |
|
665
|
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
Setting die_on_loop to 0 means keep running. |
|
667
|
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
Setting die_on_loop to 1 means the code dies, after outputting an error message. |
|
669
|
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
Retrieve and update the value with the die_on_loop() method. |
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
This key is optional. |
|
673
|
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
The default is 0. |
|
675
|
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=item o id => $string |
|
677
|
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
Provides a place to store some sort of identifier per DFA object. |
|
679
|
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
Retrieve and update the value with the id() method. |
|
681
|
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
This key is optional. |
|
683
|
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
The default is ''. |
|
685
|
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=item o logger => $logger_object |
|
687
|
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
Provides a logger object whose $level($message) method is called at certain times. |
|
689
|
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
See L</Why such a different approach to logging?> in the L</FAQ> for details. |
|
691
|
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
Retrieve and update the value with the logger() method. |
|
693
|
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
This key is optional. |
|
695
|
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
The default is ''. |
|
697
|
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
See also the verbose option, which can interact with the logger option. |
|
699
|
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=item o start => $name_of_start_state |
|
701
|
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
Provides the name of the start state. |
|
703
|
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
Retrieve and update the value with the start() method. |
|
705
|
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
This key is mandatory. |
|
707
|
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
There is no default. |
|
709
|
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
=item o transitions => [] |
|
711
|
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
Provides a complex arrayref of state names and regexps which control the transitions between states. |
|
713
|
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
Each element of this arrayref is itself an arrayref of 3 elements: |
|
715
|
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
=over 4 |
|
717
|
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=item o [0] ($state) |
|
719
|
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
The name of the state, which has to match the 'current' state, before other elements of this |
|
721
|
|
|
|
|
|
|
arrayref are utilized. |
|
722
|
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
=item o [1] ($regexp) |
|
724
|
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
The regexp, as a string, against which the input is tested, to determine whether or not to |
|
726
|
|
|
|
|
|
|
move to the next state. |
|
727
|
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
This string may be a coderef. As such, it should contain 2 pairs of parentheses. The first |
|
729
|
|
|
|
|
|
|
must capture the matched portion of the input, and the second must capture the unmatched portion |
|
730
|
|
|
|
|
|
|
of the input. |
|
731
|
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
If it is not a coderef, it is wrapped in qr/($regexp)/ and turned into a coderef which returns |
|
733
|
|
|
|
|
|
|
the 2 portions of the input as described in the previous sentence. |
|
734
|
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
The code supplies the extra parentheses in the qr// above so that the matched portion of the input |
|
736
|
|
|
|
|
|
|
can be retrieved with the match() method. |
|
737
|
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
If the regexp does not match, (undef, undef) must be returned by the coderef. |
|
739
|
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=item o [2] ($next) |
|
741
|
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
The name of the state to which the DFA will move when the regexp matches the input. |
|
743
|
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
The string which matched, if any, can be retrieved with the match() method. |
|
745
|
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
The name of the new state can be retrieved with the current() method. |
|
747
|
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=back |
|
749
|
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
This key is mandatory. |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
There is no default. |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=item o verbose => $boolean |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Provides a way to control the amount of output when a logger is not specified. |
|
757
|
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
Setting verbose to 0 means print nothing. |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
Setting verbose to 1 means print the log level and the message to STDOUT, when a logger is not specified. |
|
761
|
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
This key is optional. |
|
763
|
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
Retrieve and update the value with the verbose() method. |
|
765
|
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
The default is 0. |
|
767
|
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
See also the logger option, which can interact with the verbose option. |
|
769
|
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
=back |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=head1 Methods |
|
773
|
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
Note: Methods generated by Hash::FieldHash are designed to operate like this: |
|
775
|
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
=over 4 |
|
777
|
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
=item o When called without a parameter... |
|
779
|
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
They return the value they are managing. Hence: |
|
781
|
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
my($current_state) = $dfa -> current. |
|
783
|
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
=item o When called with a parameter... |
|
785
|
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
They return the object, to allow method chaining. Hence: |
|
787
|
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
$dfa -> current($new_state); |
|
789
|
|
|
|
|
|
|
my($current_state) = $dfa -> current; |
|
790
|
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
Don't do this: |
|
792
|
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
my($current_state_no_no) = $dfa -> current($new_state); |
|
794
|
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
You could do this: |
|
796
|
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
my($current_state) = $dfa -> current($new_state) -> current; |
|
798
|
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=back |
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
All such methods below warn of this. |
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=head2 accept($input) |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
Calls L</advance($input)>. |
|
806
|
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
Returns 1 if the 'current' state - after processing the input - is an accepting state. |
|
808
|
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
Returns 0 otherwise. |
|
810
|
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
=head2 advance($input) |
|
812
|
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
Calls L</step($input)> repeatedly on the unconsumed portion of the input. |
|
814
|
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
Returns the 'current' state at the end of that process. |
|
816
|
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
Since L</step($input)> calls L</match($consumed_input)> upon every match, and L</step_state($next)> too, you |
|
818
|
|
|
|
|
|
|
necessarily lose access to the individual portions of the input matched by successive |
|
819
|
|
|
|
|
|
|
runs of the coderef per transition table entry. |
|
820
|
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
At the end of this process, then, L</match($consumed_input)> can only return the last portion matched. |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
See L</step($input)> for advancing the DFA by a single transition. |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
Logging note: |
|
826
|
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=over 4 |
|
828
|
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=item o When die_on_loop is 0 |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
Then, advance() calls $your_logger -> warning($message) when input is not consumed. |
|
832
|
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
If there is no logger, calls print "warning: $message\n". But, when verbose is 0, prints nothing. |
|
834
|
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=item o When die_on_loop is 1 |
|
836
|
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
Calls die($message). |
|
838
|
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
=back |
|
840
|
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
=head2 build_stt() |
|
842
|
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
Use these parameters to new() to construct a state transition table: |
|
844
|
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=over 4 |
|
846
|
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=item o accepting |
|
848
|
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=item o actions |
|
850
|
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
=item o start |
|
852
|
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=item o transitions |
|
854
|
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
=back |
|
856
|
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
Note: The private method _init() calls validate_params() I<before> calling build_stt(), so if |
|
858
|
|
|
|
|
|
|
you call accepting($new_accepting), actions($new_actions), start($new_start) and transtions($new_transitions), |
|
859
|
|
|
|
|
|
|
for some reason, and then call build_stt(), you will miss out on the benefit of calling validate_params(). |
|
860
|
|
|
|
|
|
|
So don't do that! |
|
861
|
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=head2 clone() |
|
863
|
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
Returns a deep copy of the L<Set::FA::Element> object. |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
=head2 current([$state]) |
|
867
|
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
|
869
|
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
=over 4 |
|
871
|
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
=item o When $state is not provided |
|
873
|
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
Returns the 'current' state of the DFA. |
|
875
|
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
=item o When $state is provided |
|
877
|
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
Sets the 'current' state of the DFA. |
|
879
|
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
Returns the object, for method chaining. |
|
881
|
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
=back |
|
883
|
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
=head2 data([$string]) |
|
885
|
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
|
887
|
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
=over 4 |
|
889
|
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
=item o When $string is not provided |
|
891
|
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
Returns the data associated with the object. |
|
893
|
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
=item o When $data is provided |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
Sets the data associated with the object. |
|
897
|
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
Returns the object, for method chaining. |
|
899
|
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
=back |
|
901
|
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
=head2 final([$state]) |
|
903
|
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
|
905
|
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=over 4 |
|
907
|
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
=item o When $state is not provided |
|
909
|
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
Returns 1 if the 'current' state is an accepting state. |
|
911
|
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
Returns 0 otherwise. |
|
913
|
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=item o When $state is provided |
|
915
|
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
Returns 1 if $state is an accepting state. |
|
917
|
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
Returns 0 otherwise. |
|
919
|
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
=back |
|
921
|
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=head2 id([$id]) |
|
923
|
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
|
925
|
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
=over 4 |
|
927
|
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=item o When $id is not provided |
|
929
|
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
Returns the id of the object. |
|
931
|
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
=item o When $id is provided |
|
933
|
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
Sets the id of the object. |
|
935
|
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
Returns the object, for method chaining. |
|
937
|
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
=back |
|
939
|
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
=head2 log([$level, $message]) |
|
941
|
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
Here, the [] indicate an optional parameters. |
|
943
|
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
If you call it as $dfa -> log(), $level defaults to 'debug' and $message defaults to ''. |
|
945
|
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
Firstly, the error level is checked: |
|
947
|
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
if ($level eq 'error') |
|
949
|
|
|
|
|
|
|
{ |
|
950
|
|
|
|
|
|
|
die $message; |
|
951
|
|
|
|
|
|
|
} |
|
952
|
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
If not an error, log() then executes this line: |
|
954
|
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
if ($self -> logger) # If there is a logger... |
|
956
|
|
|
|
|
|
|
{ |
|
957
|
|
|
|
|
|
|
$self -> logger -> $level($message); # Call it. |
|
958
|
|
|
|
|
|
|
} |
|
959
|
|
|
|
|
|
|
elsif ($self -> verbose) # Otherwise (no logger) and we're in verbose mode... |
|
960
|
|
|
|
|
|
|
{ |
|
961
|
|
|
|
|
|
|
print "$level: $message\n"; # Print. |
|
962
|
|
|
|
|
|
|
} |
|
963
|
|
|
|
|
|
|
# Otherwise (silent) do nothing. |
|
964
|
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
Returns the object, for method chaining. |
|
966
|
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
=head2 logger([$logger_object]) |
|
968
|
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
|
970
|
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
=over 4 |
|
972
|
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
=item o When $logger_object is not provided |
|
974
|
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
Sets the internal logger object to ''. |
|
976
|
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
=item o When $logger_object is provided |
|
978
|
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
Sets the internal logger object to $logger_object. |
|
980
|
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
This allows you to change the log levels accepted and suppressed by the logger object, |
|
982
|
|
|
|
|
|
|
during the run of the DFA. |
|
983
|
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
You are strongly advised to read L</Why such a different approach to logging?>, as well as the notes |
|
985
|
|
|
|
|
|
|
on the logging and verbose options to new(). |
|
986
|
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
=back |
|
988
|
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
Returns the internal logger object, or ''. |
|
990
|
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
=head2 match([$consumed_input]) |
|
992
|
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
|
994
|
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
=over 4 |
|
996
|
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
=item o When $consumed_input is not provided |
|
998
|
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
Returns the portion of the input matched by the most recent step of the DFA. |
|
1000
|
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
=item o When $consumed_input is provided |
|
1002
|
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
Sets the internal string which will be returned by calling match(). |
|
1004
|
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
Returns the object, for method chaining. |
|
1006
|
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
=back |
|
1008
|
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
=head2 report() |
|
1010
|
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
Log the state transition table, at log level 'info'. |
|
1012
|
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
=head2 reset() |
|
1014
|
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
Resets the DFA object to the start state. |
|
1016
|
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
Returns the 'current' state, which will be the start state. |
|
1018
|
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
Does not reset the id or anything else associated with the object. |
|
1020
|
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=head2 start([$start]) |
|
1022
|
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
|
1024
|
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
=over 4 |
|
1026
|
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
=item o When $start is not provided |
|
1028
|
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
Returns the start state of the object. |
|
1030
|
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
=item o When $start is provided |
|
1032
|
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
Sets the start state of the object. |
|
1034
|
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
Returns the object, for method chaining. |
|
1036
|
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
=back |
|
1038
|
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
=head2 state([$state]) |
|
1040
|
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
|
1042
|
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
=over 4 |
|
1044
|
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=item o When $state is not provided |
|
1046
|
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
Returns the 'current' state. |
|
1048
|
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
=item o When $state is provided |
|
1050
|
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
Returns 1 if $state was defined in the transitions arrayref supplied to new(). |
|
1052
|
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
Returns 0 otherwise. |
|
1054
|
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
=back |
|
1056
|
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
=head2 step($input) |
|
1058
|
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
Advances the DFA by a single transition, if possible. |
|
1060
|
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
The code checks each entry in the transitions arrayref supplied to new(), in order, |
|
1062
|
|
|
|
|
|
|
looking for entries whose 1st element ($state) matches the 'current' state. |
|
1063
|
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
Upon the first match found (if any), the code runs the coderef in the 2nd element ($rule_sub) of that entry. |
|
1065
|
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
If there is a match: |
|
1067
|
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
=over 4 |
|
1069
|
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
=item o Calls L</match($consumed_input)> so you can retrieve that value with the match() method |
|
1071
|
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
=item o Calls L</step_state($next)>, passing in the 3rd element ($next) in that entry |
|
1073
|
|
|
|
|
|
|
as the only parameter |
|
1074
|
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
=back |
|
1076
|
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
Returns the unconsumed portion of the input. |
|
1078
|
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
=head2 step_state($next) |
|
1080
|
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
Performs these steps: |
|
1082
|
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
=over 4 |
|
1084
|
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
=item o Compares the 'current' state to $next |
|
1086
|
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
If they match, returns 0 immediately. |
|
1088
|
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
=item o Calls the exit function, if any, of the 'current' state |
|
1090
|
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
=item o Set the 'current' state to $next |
|
1092
|
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
=item o Calls the entry function, if any, of the new 'current' state |
|
1094
|
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
=item o Returns 1. |
|
1096
|
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
=back |
|
1098
|
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
=head2 validate() |
|
1100
|
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
Perform validation checks on these parameters to new(): |
|
1102
|
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
=over 4 |
|
1104
|
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
=item o accepting |
|
1106
|
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
=item o start |
|
1108
|
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
=item o transitions |
|
1110
|
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
=back |
|
1112
|
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
=head1 FAQ |
|
1114
|
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
=head2 What's changed in V 1.00 of L<Set::FA::Element>? |
|
1116
|
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
=over 4 |
|
1118
|
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
=item o Use Hash::FieldHash for getters and setters |
|
1120
|
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
Originally, L<Set::FA::Element> used direct hash access to implement the logic. |
|
1122
|
|
|
|
|
|
|
I did not want to do that. At the same time, I did not want users to incur the overhead |
|
1123
|
|
|
|
|
|
|
of L<Moose>. |
|
1124
|
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
So, I've adopted my standard policy of using L<Hash::FieldHash> in stand-alone modules and L<Moose> in apps. |
|
1126
|
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
=item o Rename the new() parameter from accept to accepting |
|
1128
|
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
While direct hash access allowed the author of L<Set::FA::Element> to have a hash key and a method with the |
|
1130
|
|
|
|
|
|
|
same name, accept, I can't do that now. |
|
1131
|
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
So, the parameter to new() (in L<Set::FA::Element>) is called accepting, and the method is still called accept(). |
|
1133
|
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
=item o Add a parameter to new(), die_on_loop |
|
1135
|
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
This makes it easy to stop a run-away program during development. |
|
1137
|
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
=item o Add a parameter to new(), logger |
|
1139
|
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
See below for details. |
|
1141
|
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=item o Add a parameter to new(), start |
|
1143
|
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
This must be used to name the start state. |
|
1145
|
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
=item o Chop the states parameter to new() |
|
1147
|
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
The state names are taken from the transitions parameter to new(). |
|
1149
|
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
=item o Add a parameter to new(), verbose |
|
1151
|
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
This makes it easy to change the quantity of progress reports. |
|
1153
|
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
=item o Add a method, build_stt() to convert new()'s parameters into a state transition table |
|
1155
|
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=item o Add a method, current() to set/get the current state |
|
1157
|
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
=item o Add a method, data() to set/get the arbitrary data per object |
|
1159
|
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
=item o Add a method, die_on_loop() to set/get the like-named option |
|
1161
|
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
=item o Add a method, id() to set/get the id per object |
|
1163
|
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
=item o Add a method, log() to call the logger object |
|
1165
|
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
=item o Add a method, logger() to set/get the logger object |
|
1167
|
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
=item o Add a method, match(), to retrieve exactly what matched at each transition |
|
1169
|
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
=item o Add a method, report(), to print the state transition table |
|
1171
|
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
=item o Add a method, start() to set/get the start state per object |
|
1173
|
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
=item o Add a method, validate() to validate new()'s parameters |
|
1175
|
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
=item o Add a method, verbose() to set/get the like-named option |
|
1177
|
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
=back |
|
1179
|
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
=head2 Why such a different approach to logging? |
|
1181
|
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
Firstly, L<Set::FA::Element> used L<Log::Agent>. I always use L<Log::Handler> these days. |
|
1183
|
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
By default (i.e. without a logger object), L<Set::FA::Element> prints messages to STDOUT, and dies upon errors. |
|
1185
|
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
However, by supplying a log object, you can capture these events. |
|
1187
|
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
Not only that, you can change the behaviour of your log object at any time, by calling |
|
1189
|
|
|
|
|
|
|
L</logger($logger_object)>. |
|
1190
|
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
Specifically, $logger_object -> log(debug => 'Entered x()') is called at the start of each public method. |
|
1192
|
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
Setting your log level to 'debug' will cause these messages to appear. |
|
1194
|
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
Setting your log level to anything below 'debug', e.g. 'info, 'notice', 'warning' or 'error', will suppress them. |
|
1196
|
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
Also, L</step_state($next)> calls: |
|
1198
|
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
$self -> log(info => "Stepped from state '$current' to '$next' using rule /$rule/ to match '$match'"); |
|
1200
|
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
just before it returns. |
|
1202
|
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
Setting your log level to anything below 'info', e.g. 'notice', 'warning' or 'error', will suppress this message. |
|
1204
|
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
Hence, by setting the log level to 'info', you can log just 1 line per state transition, and no other |
|
1206
|
|
|
|
|
|
|
messages, to minimize output. |
|
1207
|
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
Lastly, although this logging mechanism may seem complex, it has distinct advantages: |
|
1209
|
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=over 4 |
|
1211
|
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
=item o A design fault in L<Log::Agent> (used by the previous author): |
|
1213
|
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
This method uses a global variable to control the level of logging. This means the code using |
|
1215
|
|
|
|
|
|
|
L<Set::FA::Element> can (also) use L<Log::Agent> and call logconfig(...), |
|
1216
|
|
|
|
|
|
|
which in turn affects the behaviour of the logging calls inside those other modules. |
|
1217
|
|
|
|
|
|
|
I assume this design is deliberate, but I certainly don't like it, because (I suspect) it means any running Perl |
|
1218
|
|
|
|
|
|
|
program which changes the configuration affects all other running programs using L<Log::Agent>. |
|
1219
|
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
=item o Log levels |
|
1221
|
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
You can configure your logger object, either before calling new(), or at any later time, by changing your logger object, |
|
1223
|
|
|
|
|
|
|
and then calling L</logger($logger_object)>. |
|
1224
|
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
That allows you complete control over the logging activity. |
|
1226
|
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
=back |
|
1228
|
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
The only log levels output by this code are (from high to low): debug, info, warning and error. |
|
1230
|
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
Error messages are self-documenting, in that when you trigger them, you get to read them... |
|
1232
|
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
=head1 Machine-Readable Change Log |
|
1234
|
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
The file CHANGES was converted into Changelog.ini by L<Module::Metadata::Changes>. |
|
1236
|
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
=head1 Version Numbers |
|
1238
|
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions. |
|
1240
|
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
=head1 Credit |
|
1242
|
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
See L<Set::FA/Credit>. |
|
1244
|
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
=head1 See Also |
|
1246
|
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
See L<Set::FA/See Also>. |
|
1248
|
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
=head1 Support |
|
1250
|
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
Email the author, or log a bug on RT: |
|
1252
|
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
L<https://rt.cpan.org/Public/Dist/Display.html?Name=Set::FA>. |
|
1254
|
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
=head1 Author |
|
1256
|
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
L<Set::FA::Element> was written by Mark Rogaski and Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2011. |
|
1258
|
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
Home page: L<http://savage.net.au/index.html>. |
|
1260
|
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
=head1 Copyright |
|
1262
|
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
Australian copyright (c) 2011, Ron Savage. |
|
1264
|
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
All Programs of mine are 'OSI Certified Open Source Software'; |
|
1266
|
|
|
|
|
|
|
you can redistribute them and/or modify them under the terms of |
|
1267
|
|
|
|
|
|
|
The Artistic License, a copy of which is available at: |
|
1268
|
|
|
|
|
|
|
http://www.opensource.org/licenses/index.html |
|
1269
|
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
=cut |