File Coverage

File:	blib/lib/CSS/Parse/Op.pm
Coverage:	99.1%

line	stmt	bran	cond	sub	time	code
1						package CSS::Parse::Op;
2
3	14 14 14			14	51 20 63	use strict;
4	14 14 14			14	63 70 57	use warnings;
5
6	14 14 14			14	88 128 161	use CSS::Parse::Match;
7	14 14 14			14	123 26 134	use Data::Dumper;
8
9						sub new {
10	9956			9956	33208	my ($class, $rule, $type, $content) = @_;
11
12	9956				30961	my $self = bless {}, $class;
13
14	9956				28490	$self->{rule} = $rule;
15	9956				25107	$self->{error} = 0;
16	9956				26564	$self->{type} = $type;
17	9956				25868	$self->{content} = $content;
18	9956				27763	$self->{ops} = [];
19
20	9956				28162	return $self;
21						}
22
23						sub reduce_alternations {
24	6463			6463	15572	my ($self) = @_;
25
26	6463	100			30642	return 1 unless $self->{type} eq 'list';
27
28
29						#
30						# reduce our own children first
31						#
32
33	948 948				1527 3295	for my $op (@{$self->{ops}}){
34
35						#
36						# if this could actually fail, we'd need to check the result here
37						#
38
39	5941				15357	$op->reduce_alternations();
40						}
41
42
43						#
44						# now check if we have any alts
45						#
46
47	948				2074	my $alts = 0;
48	948 948				1617 3218	for my $op (@{$self->{ops}}){
49	5941	100			26108	$alts++ if $op->{type} eq 'alt';
50						}
51
52	948	100			3757	return 1 unless $alts;
53
54
55						#
56						# we have alts - change our base type and create new alt children
57						#
58
59	351				908	my $our_ops = $self->{ops};
60	351				995	$self->{ops} = [];
61	351				919	$self->{type} = 'alternation';
62
63	351				1373	my $current = CSS::Parse::Op->new($self->{rule}, 'list');
64	351				1074	$current->{ops} = [];
65
66	351 351				600 1033	for my $op (@{$our_ops}){
67
68	2998	100			10118	if ($op->{type} eq 'alt'){
69
70	929 929				1562 2864	push @{$self->{ops}}, $current;
71
72	929				3419	$current = CSS::Parse::Op->new($self->{rule}, 'list');
73	929				3842	$current->{ops} = [];
74
75						}else{
76	2069 2069				3439 8723	push @{$current->{ops}}, $op;
77						}
78						}
79
80	351 351				683 1102	push @{$self->{ops}}, $current;
81
82	351				1968	return 1;
83						}
84
85						sub reduce_repetition {
86	6814			6814	16831	my ($self) = @_;
87
88	6814	100	100		59801	return 1 unless (($self->{type} eq 'list') \|\| ($self->{type} eq 'alternation'));
89
90						#
91						# reduce our own children first
92						#
93
94	2228 2228				3666 7419	for my $op (@{$self->{ops}}){
95	6292	100			16119	unless ($op->reduce_repetition()){
96	1				4	$self->{error} = $op->{error};
97	1				5	return 0;
98						}
99						}
100
101
102						#
103						# do it
104						#
105
106	2227				6131	my $old_ops = $self->{ops};
107	2227				6215	$self->{ops} = [];
108
109	2227 2227				3872 6382	for my $op (@{$old_ops}){
110
111	6290	100			22320	if ($op->{type} =~ m!^rep (.*)$!){
112
113	1348				6621	my $new = CSS::Parse::Op->new($self->{rule}, 'repeat '.$1);
114	1348				4036	$new->{ops} = [];
115
116	1348 1348				2199 4430	my $subject = pop @{$self->{ops}};
117
118	1348	100			4069	unless (defined $subject){
119	1				3	$self->{error} = "Repetition operator without subject";
120	1				5	return 0;
121						}
122
123	1347 1347				2267 4213	push @{$new->{ops}}, $subject;
124
125	1347 1347				2289 5826	push @{$self->{ops}}, $new;
126						}else{
127
128	4942 4942				8185 20478	push @{$self->{ops}}, $op;
129						}
130						}
131
132	2226				10233	return 1;
133						}
134
135						sub reduce_empty {
136	6807			6807	16529	my ($self) = @_;
137
138
139						#
140						# reduce our own children first
141						#
142
143	6807	100			24433	if (defined($self->{ops})){
144	6806 6806				11517 24125	for my $op (@{$self->{ops}}){
145	6286				16138	$op->reduce_empty();
146						}
147						}
148
149
150						#
151						# reduce self?
152						#
153
154	6807	100			25601	if ($self->{type} eq 'list'){
155	1874 1874	100			2741 8118	if (scalar(@{$self->{ops}}) == 1){
156	987				2932	my $child = $self->{ops}->[0];
157
158	987 987 4939				1656 3678 14729	for my $key(keys %{$self}){ delete $self->{$key}; }
159	987 987 4935				2186 3377 20093	for my $key(keys %{$child}){ $self->{$key} = $child->{$key}; }
160						}
161						}
162
163	6807				21750	return 1;
164						}
165
166						sub match {
167	8942			8942	25967	my ($self, $tokens, $token_pc) = @_;
168
169						#
170						# given a list of input tokens ($tokens) we
171						# try to create a tree of match objects to
172						# return, else we return undef
173						#
174
175	8942	50			23428	if ($CSS::TraceParser){
176	0				0	print "\tMatching op $self->{type} against token stack ".$self->stack_peek(5, $tokens, $token_pc)."\n";
177						}
178
179
180						#
181						# prepare a match object
182						#
183
184	8942				37786	my $match = CSS::Parse::Match->new($self->{type}, $tokens, $token_pc);
185
186
187						#
188						# for list types we need to match against each subrule
189						# and return a single match object
190						#
191
192	8942	100			33448	if ($self->{type} eq 'list'){
193
194	1491 1491				2426 5066	for my $op(@{$self->{ops}}){
195
196	2564				11177	my $submatch = $op->match($match->{tokens}, $match->{token_pc});
197
198	2564	100			7095	if (defined $submatch){
199
200	1655				5244	$match->add_submatch($submatch);
201						}else{
202	909				3000	return undef;
203						}
204						}
205
206	582				1852	return $match;
207						}
208
209
210						#
211						# for subrule ops we just need to match against
212						# the literal token
213						#
214
215	7451	100			27514	if ($self->{type} eq 'subrule'){
216
217	5694				16286	my $token = $match->shift_token;
218
219	5694	100			16490	return undef unless defined $token;
220						#return undef unless scalar keys %{$token};
221
222	5571	100			23669	if ($token->{type} eq $self->{content}){
223
224	1022				3315	$match->add_matched_token($token);
225
226	1022				2652	return $match;
227						}
228
229						#
230						# failed to match the next token - is this
231						# a rule we can lex by itself?
232						#
233
234	4549				13653	$match->unshift_token($token);
235
236	4549				19999	my $rule = $self->{rule}->find_lex_rule($self->{content});
237
238	4549	100			13056	if (defined $rule){
239
240						#print "Descending into subrule $self->{content} (".$self->stack_peek(5, $match->{tokens}, $match->{token_pc}).")...\n";
241
242	1042				4777	my $ret = $rule->match($match->{tokens}, $match->{token_pc});
243
244						#print "Returning from subrule $self->{content} (".(defined $ret ? 'MATCHED ('.$self->stack_peek(5, $ret->{tokens}, $ret->{token_pc}).')' : 'no match').")...\n";
245
246	1042				3648	return $ret;
247						}
248
249
250	3507				12021	return undef;
251						}
252
253
254						#
255						# optional repeats can only ever match - it's just a case of whether the
256						# match alters the token list
257						#
258
259	1757	100			6262	if ($self->{type} eq 'repeat quest'){
260
261	188				625	my $subop = $self->{ops}->[0];
262
263	188				786	my $submatch = $subop->match($match->{tokens}, $match->{token_pc});
264
265	188	100			648	if (defined $submatch){
266
267	105				323	$match->add_submatch($submatch);
268						}
269
270	188				486	return $match;
271						}
272
273
274						#
275						# for alternation ops we try each sub-op in turn until one matches
276						#
277
278	1569	100			5793	if ($self->{type} eq 'alternation'){
279
280	755 755				1244 2626	for my $subop (@{$self->{ops}}){
281
282	3501				15215	my $submatch = $subop->match($match->{tokens}, $match->{token_pc});
283
284	3501	100			12700	if (defined $submatch){
285
286	471				1594	$match->add_submatch($submatch);
287
288	471				1339	return $match;
289						}
290						}
291	284				1030	return undef;
292						}
293
294
295						#
296						# for repeat ops we loop matching until we can't
297						# match any more, then we check the match count
298						#
299
300	814	100	100		6816	if ($self->{type} eq 'repeat plus' \|\| $self->{type} eq 'repeat star'){
301
302	813				2743	my $subop = $self->{ops}->[0];
303
304	813				1587	my $match_count = 0;
305	813				1625	my $loop = 1;
306	813				2041	my $last_pc = $match->{token_pc};
307
308	813				2319	while ($loop){
309
310	1621				2971	$loop = 0;
311
312	1621				7001	my $submatch = $subop->match($match->{tokens}, $match->{token_pc});
313
314	1621	100			6217	if (defined $submatch){
315
316	813				2455	$match->add_submatch($submatch);
317
318	813				2004	my $this_pc = $match->{token_pc};
319
320	813	100			2628	if ($this_pc > $last_pc){
321
322	808				1663	$loop = 1;
323						}
324
325	813				1525	$last_pc = $this_pc;
326
327	813				2797	$match_count++;
328						}
329						}
330
331	813	100	100		4226	if ($self->{type} eq 'repeat plus' && !$match_count){
332
333	8				32	return undef;
334						}
335
336	805				2293	return $match;
337						}
338
339
340
341						#
342						# fall through
343						#
344
345	1				2	die "Don't know how to match against a '$self->{type}' op.";
346						}
347
348						sub stack_peek {
349	2			2	8	my ($self, $count, $tokens, $token_pc) = @_;
350
351	2				3	my @sample;
352	2 2 10 2				7 11 45 6	push @sample, $_->{type} for grep{ defined } @{$tokens}[$token_pc..$token_pc+$count-1];
353	2				13	return "@sample";
354						}
355
356						1;