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 |