File Coverage

File:blib/lib/CSS/Parse/Match.pm
Coverage:96.6%

linestmtbrancondsubtimecode
1package CSS::Parse::Match;
2
3
14
14
14
14
53
22
57
use strict;
4
14
14
14
14
63
24
66
use warnings;
5
14
14
14
14
145
24
63
use Time::HiRes qw(gettimeofday tv_interval);
6
7sub new {
8
8946
8946
28193
        my ($class, $op, $tokens, $token_pc) = @_;
9
10
8946
27348
        my $self = bless {}, $class;
11
12
8946
25420
        $self->{op} = $op;
13
8946
25608
        $self->{submatches} = [];
14
8946
25276
        $self->{matched_tokens} = [];
15
8946
22838
        $self->{subrule} = undef;
16
8946
21858
        $self->{matched_text} = undef;
17
18        #my $t0 = [gettimeofday];
19        #@{$self->{tokens}} = @{$tokens} if ref $tokens eq 'ARRAY';
20        #my $t1 = [gettimeofday];
21        #print "Copy took ".(1000*tv_interval($t0, $t1))." ms\n";
22
23
8946
22320
        $self->{token_pc} = $token_pc;
24
8946
21976
        $self->{tokens} = $tokens;
25
26
8946
24752
        return $self;
27}
28
29sub add_submatch {
30
3045
3045
8275
        my ($self, $submatch) = @_;
31
32
3045
3045
4985
9819
        push @{$self->{submatches}}, $submatch;
33
34
3045
13556
        $self->{token_pc} = $submatch->{token_pc};
35}
36
37sub add_matched_token {
38
1023
1023
2881
        my ($self, $token) = @_;
39
40
1023
1023
1854
4192
        push @{$self->{matched_tokens}}, $token;
41}
42
43sub shift_token {
44
5694
5694
14839
        my ($self) = @_;
45
46
5694
13231
        $self->{token_pc}++;
47
5694
28226
        return $self->{tokens}->[$self->{token_pc}-1];
48}
49
50sub unshift_token {
51
4549
4549
11296
        my ($self) = @_;
52
53
4549
12973
        $self->{token_pc}--;
54
55        # we assume here that the token we have to unshift is the one we used to have :)
56        #unshift @{$_[0]->{tokens}}, $_[1];
57}
58
59sub scrub {
60
2727
2727
6380
        my ($self) = @_;
61
62
2727
5926
        delete $self->{tokens};
63
2727
5663
        delete $self->{token_pc};
64
2727
5857
        delete $self->{op};
65
66
2727
2727
4405
12663
        for my $submatch (@{$self->{submatches}}){
67
68
2710
6850
                $submatch->scrub;
69        }
70}
71
72sub dump {
73
2
2
7
        my ($self) = @_;
74
75
2
7
        return $self->_dump_internal('');
76}
77
78sub _dump_internal {
79
3
3
61
        my ($self, $prefix) = @_;
80
81
3
3
5
11
        my $subs = scalar @{$self->{submatches}};
82
3
3
6
10
        my $matches = scalar @{$self->{matched_tokens}};
83
84
3
100
100
23
        return '' unless $subs || $matches;
85
86
2
7
        my $text = $self->_dump_node_text;
87
88
2
9
        my $buffer = "$prefix$self->{op} \"$text\" \{\n";
89
90
2
2
4
8
        for my $submatch (@{$self->{submatches}}){
91
92
1
6
                $buffer .= $submatch->_dump_internal("$prefix\t");
93        }
94
95
2
2
5
8
        for my $token (@{$self->{matched_tokens}}){
96
97
1
8
                $buffer .= "$prefix\t$token->{type}: \"$token->{content}\"\n";
98        }
99
100
2
5
        $buffer .= "$prefix}\n";
101
102
2
7
        return $buffer;
103}
104
105sub _dump_node_text {
106
3
3
7
        my ($self) = @_;
107
108
3
7
        my $buffer = '';
109
110
3
3
6
12
        for my $submatch (@{$self->{submatches}}){
111
112
1
5
                $buffer .= $submatch->_dump_node_text;
113        }
114
115
3
3
6
11
        for my $token (@{$self->{matched_tokens}}){
116
117
2
9
                $buffer .= $token->{content};
118        }
119
120
3
10
        return $buffer;
121}
122
123sub reduce {
124
2725
2725
6550
        my ($self) = @_;
125
126        #
127        # first reduce our own submatches
128        #
129
130
2725
4892
        my $subrules = 0;
131
132
2725
2725
4347
9626
        for my $submatch (@{$self->{submatches}}){
133
134
2709
7119
                $submatch->reduce;
135
136
2709
100
12417
                if (defined $submatch->{subrule}){
137
138
570
1708
                        $subrules++;
139                }
140        }
141
142
143        #
144        # remove any submatches which don't match any content
145        #
146
147
2725
7207
        my $old_submatches = $self->{submatches};
148
2725
7355
        $self->{submatches} = [];
149
150
2725
2725
4850
7587
        for my $submatch (@{$old_submatches}){
151
152
2709
100
10054
                if (length $submatch->{matched_text}){
153
154
2370
2370
3841
10192
                        push @{$self->{submatches}}, $submatch;
155                }
156        }
157
158
159        #
160        # collect together our output
161        #
162
163
2725
7129
        $self->{matched_text} = '';
164
165
2725
2725
4702
9206
        for my $token (@{$self->{matched_tokens}}){
166
167
944
4056
                $self->{matched_text} .= $token->{content};
168        }
169
170        # this line is a bit dodgy as it deletes the original token list which we *may* want
171
2725
6617
        delete $self->{matched_tokens};
172
173
2725
2725
4495
9054
        for my $submatch (@{$self->{submatches}}){
174
175
2370
9809
                $self->{matched_text} .= $submatch->{matched_text};
176        }
177
178
179        #
180        # now reduce ourselves.
181        # if all of our submatches are not subrules, fold them into ourselves
182        #
183
184
2725
100
7942
        unless ($subrules){
185
186
2328
5794
                my $old_submatches = $self->{submatches};
187
2328
6491
                $self->{submatches} = [];
188
189
2328
2328
3967
7230
                for my $submatch (@{$old_submatches}){
190
191
1660
1660
2797
7715
                        for my $subsubmatch (@{$submatch->{submatches}}){
192
193
375
375
589
1977
                                push @{$self->{submatches}}, $subsubmatch;
194                        }
195
196                        #
197                        # this loop wont find anything as we deleted our own
198                        # matched token list on line 156 (and we called this
199                        # method on our submatches already)
200                        #
201
202                        #for my $subtoken (@{$submatch->{matched_tokens}}){
203                        # push @{$self->{matched_tokens}}, $subtoken;
204                        #}
205                }
206        }
207}
208
209sub remove_anon_matches {
210
66
66
173
        my ($self) = @_;
211
212
213        #
214        # this function removes unnamed match rules - in general we only care about the named stuff,
215        # since everything else tends to filler. this makes walking the tree a lot simpler.
216        #
217
218
219        #
220        # first, reduce our children
221        #
222
223
66
66
107
220
        for my $submatch (@{$self->{submatches}}){
224
225
62
161
                $submatch->remove_anon_matches;
226        }
227
228
229        #
230        # remove any children which have no name and no children of their own
231        #
232
233
66
194
        my $new_subs = [];
234
235
66
66
162
218
        for my $submatch (@{$self->{submatches}}){
236
237
62
100
193
                if (defined $submatch->{subrule}){
238
239
32
32
54
110
                        push @{$new_subs}, $submatch;
240
241                }else{
242
243
30
30
50
42
140
                        if (scalar @{$submatch->{submatches}}){
244
245
0
0
0
0
                                for my $child_of_child (@{$submatch->{submatches}}){
246
247
0
0
0
0
                                        push @{$new_subs}, $child_of_child;
248                                }
249                        }
250                }
251        }
252
253
66
259
        $self->{submatches} = $new_subs;
254
255}
256
257sub tokens_left {
258
25
25
25
93
160
        return scalar(@{$_[0]->{tokens}}) - $_[0]->{token_pc};
259}
260
2611;
262