line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
33
|
|
|
33
|
|
176592
|
use strict; |
|
33
|
|
|
|
|
290
|
|
|
33
|
|
|
|
|
1004
|
|
2
|
33
|
|
|
33
|
|
173
|
use warnings; |
|
33
|
|
|
|
|
66
|
|
|
33
|
|
|
|
|
1694
|
|
3
|
|
|
|
|
|
|
package SQL::SplitStatement; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
our $VERSION = '1.00022'; # TRIAL |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
8
|
33
|
|
|
33
|
|
176
|
use base 'Class::Accessor::Fast'; |
|
33
|
|
|
|
|
74
|
|
|
33
|
|
|
|
|
17055
|
|
9
|
|
|
|
|
|
|
|
10
|
33
|
|
|
33
|
|
102908
|
use Carp qw(croak); |
|
33
|
|
|
|
|
85
|
|
|
33
|
|
|
|
|
2492
|
|
11
|
33
|
|
|
33
|
|
16049
|
use SQL::SplitStatement::Tokenizer qw(tokenize_sql); |
|
33
|
|
|
|
|
99
|
|
|
33
|
|
|
|
|
2285
|
|
12
|
33
|
|
|
33
|
|
20273
|
use List::MoreUtils qw(firstval firstidx each_array); |
|
33
|
|
|
|
|
488131
|
|
|
33
|
|
|
|
|
269
|
|
13
|
33
|
|
|
33
|
|
63600
|
use Regexp::Common qw(delimited); |
|
33
|
|
|
|
|
232036
|
|
|
33
|
|
|
|
|
175
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
use constant { |
16
|
33
|
|
|
|
|
155314
|
NEWLINE => "\n", |
17
|
|
|
|
|
|
|
SEMICOLON => ';', |
18
|
|
|
|
|
|
|
DOT => '.', |
19
|
|
|
|
|
|
|
FORWARD_SLASH => '/', |
20
|
|
|
|
|
|
|
QUESTION_MARK => '?', |
21
|
|
|
|
|
|
|
SINGLE_DOLLAR => '$', |
22
|
|
|
|
|
|
|
DOUBLE_DOLLAR => '$$', |
23
|
|
|
|
|
|
|
OPEN_BRACKET => '(', |
24
|
|
|
|
|
|
|
CLOSED_BRACKET => ')', |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
SEMICOLON_TERMINATOR => 1, |
27
|
|
|
|
|
|
|
SLASH_TERMINATOR => 2, |
28
|
|
|
|
|
|
|
CUSTOM_DELIMITER => 3 |
29
|
33
|
|
|
33
|
|
3380651
|
}; |
|
33
|
|
|
|
|
151
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
my $transaction_RE = qr[^(?: |
32
|
|
|
|
|
|
|
; |
33
|
|
|
|
|
|
|
|/ |
34
|
|
|
|
|
|
|
|WORK |
35
|
|
|
|
|
|
|
|TRAN |
36
|
|
|
|
|
|
|
|TRANSACTION |
37
|
|
|
|
|
|
|
|ISOLATION |
38
|
|
|
|
|
|
|
|READ |
39
|
|
|
|
|
|
|
)$]xi; |
40
|
|
|
|
|
|
|
my $procedural_END_RE = qr/^(?:IF|CASE|LOOP)$/i; |
41
|
|
|
|
|
|
|
my $terminator_RE = qr[ |
42
|
|
|
|
|
|
|
;\s*\n\s*\.\s*\n\s*/\s*\n? |
43
|
|
|
|
|
|
|
|;\s*\n\s*/\s*\n? |
44
|
|
|
|
|
|
|
|\.\s*\n\s*/\s*\n? |
45
|
|
|
|
|
|
|
|\n\s*/\s*\n? |
46
|
|
|
|
|
|
|
|; |
47
|
|
|
|
|
|
|
]x; |
48
|
|
|
|
|
|
|
my $begin_comment_RE = qr/^(?:--|\/\*)/; |
49
|
|
|
|
|
|
|
my $quoted_RE = $RE{delimited}{ -delim=>q{"'`} }; |
50
|
|
|
|
|
|
|
my $dollar_placeholder_RE = qr/^\$\d+$/; |
51
|
|
|
|
|
|
|
my $inner_identifier_RE = qr/[_a-zA-Z][_a-zA-Z0-9]*/; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
my $CURSOR_RE = qr/^CURSOR$/i; |
54
|
|
|
|
|
|
|
my $DELIMITER_RE = qr/^DELIMITER$/i; |
55
|
|
|
|
|
|
|
my $DECLARE_RE = qr/^DECLARE$/i; |
56
|
|
|
|
|
|
|
my $PROCEDURE_FUNCTION_RE = qr/^(?:FUNCTION|PROCEDURE)$/i; |
57
|
|
|
|
|
|
|
my $PACKAGE_RE = qr/^PACKAGE$/i; |
58
|
|
|
|
|
|
|
my $BEGIN_RE = qr/^BEGIN$/i; |
59
|
|
|
|
|
|
|
my $END_RE = qr/^END$/i; |
60
|
|
|
|
|
|
|
my $AS_RE = qr/^AS$/i; |
61
|
|
|
|
|
|
|
my $IS_RE = qr/^IS$/i; |
62
|
|
|
|
|
|
|
my $TYPE_RE = qr/^TYPE$/i; |
63
|
|
|
|
|
|
|
my $BODY_RE = qr/^BODY$/i; |
64
|
|
|
|
|
|
|
my $DROP_RE = qr/^DROP$/i; |
65
|
|
|
|
|
|
|
my $CRUD_RE = qr/^(?:DELETE|INSERT|SELECT|UPDATE|REPLACE)$/i; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my $GRANT_REVOKE_RE = qr/^(?:GRANT|REVOKE)$/i;; |
68
|
|
|
|
|
|
|
my $CREATE_ALTER_RE = qr/^(?:CREATE|ALTER)$/i; |
69
|
|
|
|
|
|
|
my $CREATE_REPLACE_RE = qr/^(?:CREATE|REPLACE)$/i; |
70
|
|
|
|
|
|
|
my $OR_REPLACE_RE = qr/^(?:OR|REPLACE)$/i; |
71
|
|
|
|
|
|
|
my $OR_REPLACE_PACKAGE_RE = qr/^(?:OR|REPLACE|PACKAGE)$/i; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my $pre_identifier_RE = qr/^(?: |
74
|
|
|
|
|
|
|
BODY |
75
|
|
|
|
|
|
|
|CONSTRAINT |
76
|
|
|
|
|
|
|
|CURSOR |
77
|
|
|
|
|
|
|
|DECLARE |
78
|
|
|
|
|
|
|
|FUNCTION |
79
|
|
|
|
|
|
|
|INDEX |
80
|
|
|
|
|
|
|
|PACKAGE |
81
|
|
|
|
|
|
|
|PROCEDURE |
82
|
|
|
|
|
|
|
|REFERENCES |
83
|
|
|
|
|
|
|
|TABLE |
84
|
|
|
|
|
|
|
|[.,(] |
85
|
|
|
|
|
|
|
)$/xi; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
SQL::SplitStatement->mk_accessors( qw/ |
88
|
|
|
|
|
|
|
keep_terminators |
89
|
|
|
|
|
|
|
keep_extra_spaces |
90
|
|
|
|
|
|
|
keep_empty_statements |
91
|
|
|
|
|
|
|
keep_comments |
92
|
|
|
|
|
|
|
slash_terminates |
93
|
|
|
|
|
|
|
_tokens |
94
|
|
|
|
|
|
|
_current_statement |
95
|
|
|
|
|
|
|
_custom_delimiter |
96
|
|
|
|
|
|
|
_terminators |
97
|
|
|
|
|
|
|
_tokens_in_custom_delimiter |
98
|
|
|
|
|
|
|
/); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# keep_terminators alias |
101
|
14
|
|
|
14
|
1
|
65180
|
sub keep_terminator { shift->keep_terminators(@_) } |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub new { |
104
|
56
|
|
|
56
|
1
|
29726
|
my $class = shift; |
105
|
56
|
100
|
100
|
|
|
510
|
my $parameters = @_ > 1 ? { @_ } : $_[0] || {}; |
106
|
56
|
100
|
|
|
|
328
|
if ( exists $parameters->{keep_terminators} ) { |
|
|
100
|
|
|
|
|
|
107
|
|
|
|
|
|
|
croak( q[keep_terminator and keep_terminators can't be both assigned'] ) |
108
|
|
|
|
|
|
|
if exists $parameters->{keep_terminator} |
109
|
3
|
100
|
|
|
|
24
|
} |
110
|
|
|
|
|
|
|
elsif ( exists $parameters->{keep_terminator} ) { |
111
|
|
|
|
|
|
|
$parameters->{keep_terminators} = delete $parameters->{keep_terminator} |
112
|
15
|
|
|
|
|
60
|
} |
113
|
|
|
|
|
|
|
$parameters->{slash_terminates} = 1 |
114
|
55
|
100
|
|
|
|
278
|
unless exists $parameters->{slash_terminates}; |
115
|
55
|
|
|
|
|
553
|
$class->SUPER::new( $parameters ) |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub split { |
119
|
72
|
|
|
72
|
1
|
18441
|
my ($self, $code) = @_; |
120
|
72
|
|
|
|
|
637
|
my ($statements, undef) = $self->split_with_placeholders($code); |
121
|
72
|
|
|
|
|
204
|
return @{ $statements } |
|
72
|
|
|
|
|
711
|
|
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub split_with_placeholders { |
125
|
78
|
|
|
78
|
1
|
946
|
my ($self, $code) = @_; |
126
|
|
|
|
|
|
|
|
127
|
78
|
|
|
|
|
192
|
my @placeholders = (); |
128
|
78
|
|
|
|
|
215
|
my @statements = (); |
129
|
78
|
|
|
|
|
152
|
my $statement_placeholders = 0; |
130
|
|
|
|
|
|
|
|
131
|
78
|
|
|
|
|
183
|
my $inside_block = 0; |
132
|
78
|
|
|
|
|
142
|
my $inside_brackets = 0; |
133
|
78
|
|
|
|
|
136
|
my $inside_sub = 0; |
134
|
78
|
|
|
|
|
146
|
my $inside_is_as = 0; |
135
|
78
|
|
|
|
|
145
|
my $inside_cursor = 0; |
136
|
78
|
|
|
|
|
153
|
my $inside_is_cursor = 0; |
137
|
78
|
|
|
|
|
145
|
my $inside_declare = 0; |
138
|
78
|
|
|
|
|
147
|
my $inside_package = 0; |
139
|
78
|
|
|
|
|
135
|
my $inside_grant_revoke = 0; |
140
|
78
|
|
|
|
|
137
|
my $inside_crud = 0; |
141
|
78
|
|
|
|
|
190
|
my $extra_end_found = 0; |
142
|
|
|
|
|
|
|
|
143
|
78
|
|
|
|
|
151
|
my @sub_names = (); |
144
|
78
|
|
|
|
|
170
|
my $package_name = ''; |
145
|
|
|
|
|
|
|
|
146
|
78
|
|
|
|
|
164
|
my $dollar_quote; |
147
|
|
|
|
|
|
|
my $dollar_quote_to_add; |
148
|
|
|
|
|
|
|
|
149
|
78
|
|
|
|
|
150
|
my $prev_token = ''; |
150
|
78
|
|
|
|
|
142
|
my $prev_keyword = ''; |
151
|
|
|
|
|
|
|
|
152
|
78
|
|
|
|
|
140
|
my $custom_delimiter_def_found = 0; |
153
|
|
|
|
|
|
|
|
154
|
78
|
50
|
|
|
|
270
|
if ( !defined $code ) { |
155
|
0
|
|
|
|
|
0
|
$code = "\n" |
156
|
|
|
|
|
|
|
} else { |
157
|
78
|
|
|
|
|
435
|
$code .= "\n" |
158
|
|
|
|
|
|
|
}; |
159
|
78
|
|
|
|
|
430
|
$self->_tokens( [ tokenize_sql($code) ] ); |
160
|
78
|
|
|
|
|
5191
|
$self->_terminators( [] ); # Needed (only) to remove them afterwards |
161
|
|
|
|
|
|
|
# when keep_terminators is false. |
162
|
|
|
|
|
|
|
|
163
|
78
|
|
|
|
|
2109
|
$self->_current_statement(''); |
164
|
|
|
|
|
|
|
|
165
|
78
|
|
|
|
|
645
|
while ( defined( my $token = shift @{ $self->_tokens } ) ) { |
|
58267
|
|
|
|
|
1004837
|
|
166
|
58189
|
|
|
|
|
299060
|
my $terminator_found = 0; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
# Skip this token if it's a comment and we don't want to keep it. |
169
|
58189
|
100
|
100
|
|
|
106372
|
next if $self->_is_comment($token) && ! $self->keep_comments; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# Append the token to the current statement; |
172
|
57431
|
|
|
|
|
151999
|
$self->_add_to_current_statement($token); |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# The token is gathered even if it was a space-only token, |
175
|
|
|
|
|
|
|
# but in this case we can skip any further analysis. |
176
|
57431
|
100
|
|
|
|
586891
|
next if $token =~ /^\s+$/; |
177
|
|
|
|
|
|
|
|
178
|
30517
|
100
|
|
|
|
57748
|
if ( $dollar_quote ) { |
179
|
2435
|
100
|
|
|
|
4932
|
if ( $self->_dollar_quote_close_found($token, $dollar_quote) ) { |
180
|
41
|
|
|
|
|
113
|
$self->_add_to_current_statement($dollar_quote_to_add); |
181
|
41
|
|
|
|
|
374
|
undef $dollar_quote; |
182
|
|
|
|
|
|
|
# Saving $prev_token not necessary in this case. |
183
|
|
|
|
|
|
|
|
184
|
41
|
|
|
|
|
83
|
$inside_sub = 0; # Silence sub opening before dollar quote. |
185
|
41
|
|
|
|
|
100
|
@sub_names = (); |
186
|
41
|
|
|
|
|
65
|
$inside_is_as = 0; # Silence is_as opening before dollar quote. |
187
|
41
|
|
|
|
|
65
|
$inside_declare = 0; |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
next |
190
|
41
|
|
|
|
|
88
|
} |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
30476
|
100
|
100
|
|
|
201998
|
if ( |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
194
|
|
|
|
|
|
|
$prev_token =~ $AS_RE |
195
|
|
|
|
|
|
|
and !$dollar_quote |
196
|
|
|
|
|
|
|
and $dollar_quote = $self->_dollar_quote_open_found($token) |
197
|
|
|
|
|
|
|
) { |
198
|
41
|
|
|
|
|
633
|
( $dollar_quote_to_add = $dollar_quote ) =~ s/^\Q$token//; |
199
|
41
|
|
|
|
|
126
|
$self->_add_to_current_statement($dollar_quote_to_add) |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
elsif ( $token =~ $DELIMITER_RE && !$prev_token ) { |
202
|
41
|
|
|
|
|
129
|
my $tokens_to_shift = $self->_custom_delimiter_def_found; |
203
|
|
|
|
|
|
|
$self->_add_to_current_statement( |
204
|
41
|
|
|
|
|
86
|
join '', splice @{ $self->_tokens }, 0, $tokens_to_shift |
|
41
|
|
|
|
|
701
|
|
205
|
|
|
|
|
|
|
); |
206
|
41
|
|
|
|
|
383
|
$custom_delimiter_def_found = 1; |
207
|
41
|
100
|
|
|
|
771
|
$self->_custom_delimiter(undef) |
208
|
|
|
|
|
|
|
if $self->_custom_delimiter eq SEMICOLON |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
elsif ( $token eq OPEN_BRACKET ) { |
211
|
2113
|
|
|
|
|
3567
|
$inside_brackets++ |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
elsif ( $token eq CLOSED_BRACKET ) { |
214
|
2113
|
|
|
|
|
3632
|
$inside_brackets-- |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
elsif ( $self->_is_BEGIN_of_block($token, $prev_token) ) { |
217
|
216
|
50
|
|
|
|
599
|
$extra_end_found = 0 if $extra_end_found; |
218
|
216
|
|
|
|
|
343
|
$inside_block++ |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
elsif ( $token =~ $CREATE_ALTER_RE ) { |
221
|
717
|
|
|
|
|
1950
|
my $next_token = $self->_peek_at_next_significant_token( |
222
|
|
|
|
|
|
|
$OR_REPLACE_RE |
223
|
|
|
|
|
|
|
); |
224
|
717
|
100
|
|
|
|
3199
|
if ( $next_token =~ $PACKAGE_RE ) { |
225
|
39
|
|
|
|
|
89
|
$inside_package = 1; |
226
|
39
|
|
|
|
|
172
|
$package_name = $self->_peek_at_package_name |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
elsif ( |
230
|
|
|
|
|
|
|
$token =~ $PROCEDURE_FUNCTION_RE |
231
|
|
|
|
|
|
|
|| $token =~ $BODY_RE && $prev_token =~ $TYPE_RE |
232
|
|
|
|
|
|
|
) { |
233
|
256
|
100
|
66
|
|
|
3956
|
if ( |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
234
|
|
|
|
|
|
|
!$inside_block && !$inside_brackets |
235
|
|
|
|
|
|
|
&& $prev_token !~ $DROP_RE |
236
|
|
|
|
|
|
|
&& $prev_token !~ $pre_identifier_RE |
237
|
|
|
|
|
|
|
) { |
238
|
227
|
|
|
|
|
457
|
$inside_sub++; |
239
|
227
|
|
|
|
|
421
|
$prev_keyword = $token; |
240
|
227
|
|
|
|
|
636
|
push @sub_names, $self->_peek_at_next_significant_token |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
elsif ( $token =~ /$IS_RE|$AS_RE/ ) { |
244
|
473
|
100
|
100
|
|
|
5077
|
if ( |
|
|
|
66
|
|
|
|
|
245
|
|
|
|
|
|
|
$prev_keyword =~ /$PROCEDURE_FUNCTION_RE|$BODY_RE/ |
246
|
|
|
|
|
|
|
&& !$inside_block && $prev_token !~ $pre_identifier_RE |
247
|
|
|
|
|
|
|
) { |
248
|
140
|
|
|
|
|
289
|
$inside_is_as++; |
249
|
140
|
|
|
|
|
274
|
$prev_keyword = '' |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
473
|
100
|
100
|
|
|
1468
|
$inside_is_cursor = 1 |
253
|
|
|
|
|
|
|
if $inside_declare && $inside_cursor |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
elsif ( $token =~ $DECLARE_RE ) { |
256
|
|
|
|
|
|
|
# In MySQL a declare can only appear inside a BEGIN ... END block. |
257
|
102
|
100
|
100
|
|
|
1245
|
$inside_declare = 1 |
258
|
|
|
|
|
|
|
if !$inside_block |
259
|
|
|
|
|
|
|
&& $prev_token !~ $pre_identifier_RE |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
elsif ( $token =~ $CURSOR_RE ) { |
262
|
33
|
50
|
66
|
|
|
281
|
$inside_cursor = 1 |
|
|
|
66
|
|
|
|
|
263
|
|
|
|
|
|
|
if $inside_declare |
264
|
|
|
|
|
|
|
&& $prev_token !~ $DROP_RE |
265
|
|
|
|
|
|
|
&& $prev_token !~ $pre_identifier_RE |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
elsif ( $token =~ /$GRANT_REVOKE_RE/ ) { |
268
|
8
|
50
|
|
|
|
28
|
$inside_grant_revoke = 1 unless $prev_token |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
elsif ( |
271
|
|
|
|
|
|
|
defined ( my $name = $self->_is_END_of_block($token) ) |
272
|
|
|
|
|
|
|
) { |
273
|
252
|
100
|
|
|
|
1138
|
$extra_end_found = 1 if !$inside_block; |
274
|
|
|
|
|
|
|
|
275
|
252
|
100
|
|
|
|
634
|
$inside_block-- if $inside_block; |
276
|
|
|
|
|
|
|
|
277
|
252
|
100
|
|
|
|
655
|
if ( !$inside_block ) { |
278
|
|
|
|
|
|
|
# $name contains the next (significant) token. |
279
|
238
|
100
|
|
|
|
620
|
if ( $name eq SEMICOLON ) { |
280
|
|
|
|
|
|
|
# Keep this order! |
281
|
91
|
100
|
66
|
|
|
474
|
if ( $inside_sub && $inside_is_as ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
282
|
35
|
|
|
|
|
76
|
$inside_sub--; |
283
|
35
|
|
|
|
|
54
|
$inside_is_as--; |
284
|
35
|
50
|
|
|
|
107
|
pop @sub_names if $inside_sub < @sub_names |
285
|
|
|
|
|
|
|
} elsif ( $inside_declare ) { |
286
|
32
|
|
|
|
|
71
|
$inside_declare = 0 |
287
|
|
|
|
|
|
|
} elsif ( $inside_package ) { |
288
|
10
|
|
|
|
|
19
|
$inside_package = 0; |
289
|
10
|
|
|
|
|
22
|
$package_name = '' |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
238
|
100
|
66
|
|
|
1232
|
if ( $inside_sub && @sub_names && $name eq $sub_names[-1] ) { |
|
|
|
100
|
|
|
|
|
294
|
76
|
|
|
|
|
140
|
$inside_sub--; |
295
|
76
|
50
|
|
|
|
274
|
pop @sub_names if $inside_sub < @sub_names |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
238
|
100
|
100
|
|
|
940
|
if ( $inside_package && $name eq $package_name ) { |
299
|
29
|
|
|
|
|
63
|
$inside_package = 0; |
300
|
29
|
|
|
|
|
75
|
$package_name = '' |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
elsif ( $token =~ $CRUD_RE ) { |
305
|
680
|
|
|
|
|
1351
|
$inside_crud = 1 |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
elsif ( |
308
|
|
|
|
|
|
|
$inside_crud && ( |
309
|
|
|
|
|
|
|
my $placeholder_token |
310
|
|
|
|
|
|
|
= $self->_questionmark_placeholder_found($token) |
311
|
|
|
|
|
|
|
|| $self->_named_placeholder_found($token) |
312
|
|
|
|
|
|
|
|| $self->_dollar_placeholder_found($token) |
313
|
|
|
|
|
|
|
) |
314
|
|
|
|
|
|
|
) { |
315
|
104
|
50
|
33
|
|
|
1995
|
$statement_placeholders++ |
316
|
|
|
|
|
|
|
if !$self->_custom_delimiter |
317
|
|
|
|
|
|
|
|| $self->_custom_delimiter ne $placeholder_token; |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
# Needed by SQL::Tokenizer pre-0.21 |
320
|
|
|
|
|
|
|
# The only multi-token placeholder is a dollar placeholder. |
321
|
|
|
|
|
|
|
# if ( ( my $token_to_add = $placeholder_token ) =~ s[^\$][] ) { |
322
|
|
|
|
|
|
|
# $self->_add_to_current_statement($token_to_add) |
323
|
|
|
|
|
|
|
# } |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
else { |
326
|
23327
|
|
|
|
|
52385
|
$terminator_found = $self->_is_terminator($token); |
327
|
|
|
|
|
|
|
|
328
|
23327
|
100
|
100
|
|
|
58399
|
if ( |
|
|
|
66
|
|
|
|
|
329
|
|
|
|
|
|
|
$terminator_found && $terminator_found == SEMICOLON_TERMINATOR |
330
|
|
|
|
|
|
|
&& !$inside_brackets |
331
|
|
|
|
|
|
|
) { |
332
|
1815
|
100
|
100
|
|
|
5246
|
if ( $inside_sub && !$inside_is_as && !$inside_block ) { |
|
|
|
66
|
|
|
|
|
333
|
|
|
|
|
|
|
# Needed to close PL/SQL sub forward declarations such as: |
334
|
|
|
|
|
|
|
# PROCEDURE proc(number1 NUMBER); |
335
|
73
|
|
|
|
|
141
|
$inside_sub-- |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
1815
|
100
|
100
|
|
|
4627
|
if ( $inside_declare && $inside_cursor && !$inside_is_cursor ) { |
|
|
|
100
|
|
|
|
|
339
|
|
|
|
|
|
|
# Needed to close CURSOR decl. other than those in PL/SQL |
340
|
|
|
|
|
|
|
# inside a DECLARE; |
341
|
9
|
|
|
|
|
16
|
$inside_declare = 0 |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
1815
|
100
|
|
|
|
3809
|
$inside_crud = 0 if $inside_crud |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
30476
|
100
|
66
|
|
|
111037
|
$prev_token = $token |
349
|
|
|
|
|
|
|
if $token =~ /\S/ && ! $self->_is_comment($token); |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
# If we've just found a new custom DELIMITER definition, we certainly |
352
|
|
|
|
|
|
|
# have a new statement (and no terminator). |
353
|
30476
|
100
|
100
|
|
|
102348
|
unless ( |
|
|
|
100
|
|
|
|
|
354
|
|
|
|
|
|
|
$custom_delimiter_def_found |
355
|
|
|
|
|
|
|
|| $terminator_found && $terminator_found == CUSTOM_DELIMITER |
356
|
|
|
|
|
|
|
) { |
357
|
|
|
|
|
|
|
# Let's examine any condition that can make us remain in the |
358
|
|
|
|
|
|
|
# current statement. |
359
|
|
|
|
|
|
|
next if |
360
|
30403
|
50
|
100
|
|
|
115886
|
!$terminator_found || $dollar_quote || $inside_brackets |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
361
|
|
|
|
|
|
|
|| $self->_custom_delimiter; |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
next if |
364
|
1604
|
50
|
66
|
|
|
22406
|
$terminator_found |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
365
|
|
|
|
|
|
|
&& $terminator_found == SEMICOLON_TERMINATOR |
366
|
|
|
|
|
|
|
&& ( |
367
|
|
|
|
|
|
|
$inside_block || $inside_sub |
368
|
|
|
|
|
|
|
|| $inside_declare || $inside_package || $inside_crud |
369
|
|
|
|
|
|
|
) && !$inside_grant_revoke && !$extra_end_found |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# Whenever we get this far, we have a new statement. |
373
|
|
|
|
|
|
|
|
374
|
1004
|
|
|
|
|
17830
|
push @statements, $self->_current_statement; |
375
|
1004
|
|
|
|
|
5334
|
push @placeholders, $statement_placeholders; |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
# If $terminator_found == CUSTOM_DELIMITER |
378
|
|
|
|
|
|
|
# @{ $self->_terminators } element has already been pushed, |
379
|
|
|
|
|
|
|
# so we have to set it only in the case tested below. |
380
|
1004
|
100
|
100
|
|
|
2882
|
push @{ $self->_terminators }, [ $terminator_found, undef ] |
|
931
|
|
|
|
|
16169
|
|
381
|
|
|
|
|
|
|
if ( |
382
|
|
|
|
|
|
|
$terminator_found == SEMICOLON_TERMINATOR |
383
|
|
|
|
|
|
|
|| $terminator_found == SLASH_TERMINATOR |
384
|
|
|
|
|
|
|
); |
385
|
|
|
|
|
|
|
|
386
|
1004
|
|
|
|
|
21761
|
$self->_current_statement(''); |
387
|
1004
|
|
|
|
|
5593
|
$statement_placeholders = 0; |
388
|
|
|
|
|
|
|
|
389
|
1004
|
|
|
|
|
1601
|
$prev_token = ''; |
390
|
1004
|
|
|
|
|
1684
|
$prev_keyword = ''; |
391
|
|
|
|
|
|
|
|
392
|
1004
|
|
|
|
|
1608
|
$inside_brackets = 0; |
393
|
1004
|
|
|
|
|
1380
|
$inside_block = 0; |
394
|
1004
|
|
|
|
|
1617
|
$inside_cursor = 0; |
395
|
1004
|
|
|
|
|
1573
|
$inside_is_cursor = 0; |
396
|
1004
|
|
|
|
|
1521
|
$inside_sub = 0; |
397
|
1004
|
|
|
|
|
1491
|
$inside_is_as = 0; |
398
|
1004
|
|
|
|
|
1471
|
$inside_declare = 0; |
399
|
1004
|
|
|
|
|
1426
|
$inside_package = 0; |
400
|
1004
|
|
|
|
|
1395
|
$inside_grant_revoke = 0; |
401
|
1004
|
|
|
|
|
1399
|
$inside_crud = 0; |
402
|
1004
|
|
|
|
|
1429
|
$extra_end_found = 0; |
403
|
1004
|
|
|
|
|
1747
|
@sub_names = (); |
404
|
|
|
|
|
|
|
|
405
|
1004
|
|
|
|
|
2450
|
$custom_delimiter_def_found = 0 |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
# Last statement. |
409
|
78
|
|
|
|
|
1689
|
chomp( my $last_statement = $self->_current_statement ); |
410
|
78
|
|
|
|
|
562
|
push @statements, $last_statement; |
411
|
78
|
|
|
|
|
153
|
push @{ $self->_terminators }, [undef, undef]; |
|
78
|
|
|
|
|
1494
|
|
412
|
78
|
|
|
|
|
508
|
push @placeholders, $statement_placeholders; |
413
|
|
|
|
|
|
|
|
414
|
78
|
|
|
|
|
309
|
my @filtered_statements; |
415
|
|
|
|
|
|
|
my @filtered_terminators; |
416
|
78
|
|
|
|
|
0
|
my @filtered_placeholders; |
417
|
|
|
|
|
|
|
|
418
|
78
|
100
|
|
|
|
1542
|
if ( $self->keep_empty_statements ) { |
419
|
37
|
|
|
|
|
556
|
@filtered_statements = @statements; |
420
|
37
|
|
|
|
|
85
|
@filtered_terminators = @{ $self->_terminators }; |
|
37
|
|
|
|
|
719
|
|
421
|
37
|
|
|
|
|
386
|
@filtered_placeholders = @placeholders |
422
|
|
|
|
|
|
|
} else { |
423
|
|
|
|
|
|
|
my $sp = each_array( |
424
|
41
|
|
|
|
|
347
|
@statements, @{ $self->_terminators }, @placeholders |
|
41
|
|
|
|
|
791
|
|
425
|
|
|
|
|
|
|
); |
426
|
41
|
|
|
|
|
1489
|
while ( my ($statement, $terminator, $placeholder_num) = $sp->() ) { |
427
|
563
|
100
|
100
|
|
|
6922
|
my $only_terminator_RE |
428
|
|
|
|
|
|
|
= $terminator->[0] && $terminator->[0] == CUSTOM_DELIMITER |
429
|
|
|
|
|
|
|
? qr/^\s*\Q$terminator->[1]\E?\s*$/ |
430
|
|
|
|
|
|
|
: qr/^\s*$terminator_RE?\z/; |
431
|
563
|
100
|
|
|
|
3735
|
unless ( $statement =~ $only_terminator_RE ) { |
432
|
531
|
|
|
|
|
1031
|
push @filtered_statements, $statement; |
433
|
531
|
|
|
|
|
773
|
push @filtered_terminators, $terminator; |
434
|
531
|
|
|
|
|
2469
|
push @filtered_placeholders, $placeholder_num |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
|
439
|
78
|
100
|
|
|
|
1845
|
unless ( $self->keep_terminators ) { |
440
|
44
|
|
|
|
|
503
|
for ( my $i = 0; $i < @filtered_statements; $i++ ) { |
441
|
547
|
|
|
|
|
1020
|
my $terminator = $filtered_terminators[$i]; |
442
|
547
|
100
|
|
|
|
1074
|
if ( $terminator->[0] ) { |
443
|
511
|
100
|
|
|
|
912
|
if ( $terminator->[0] == CUSTOM_DELIMITER ) { |
444
|
16
|
|
|
|
|
211
|
$filtered_statements[$i] =~ s/\Q$terminator->[1]\E$// |
445
|
|
|
|
|
|
|
} else { |
446
|
495
|
|
|
|
|
7085
|
$filtered_statements[$i] =~ s/$terminator_RE$// |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
|
452
|
78
|
100
|
|
|
|
1958
|
unless ( $self->keep_extra_spaces ) { |
453
|
43
|
|
|
|
|
12176
|
s/^\s+|\s+$//g foreach @filtered_statements |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
|
456
|
78
|
|
|
|
|
828
|
return ( \@filtered_statements, \@filtered_placeholders ) |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
sub _add_to_current_statement { |
460
|
57586
|
|
|
57586
|
|
98568
|
my ($self, $token) = @_; |
461
|
57586
|
|
|
|
|
954524
|
$self->_current_statement( $self->_current_statement() . $token ) |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
sub _is_comment { |
465
|
116422
|
|
|
116422
|
|
221012
|
my ($self, $token) = @_; |
466
|
116422
|
|
|
|
|
522179
|
return $token =~ $begin_comment_RE |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
sub _is_BEGIN_of_block { |
470
|
26168
|
|
|
26168
|
|
57613
|
my ($self, $token, $prev_token) = @_; |
471
|
|
|
|
|
|
|
return |
472
|
26168
|
|
100
|
|
|
374716
|
$token =~ $BEGIN_RE |
473
|
|
|
|
|
|
|
&& $prev_token !~ $pre_identifier_RE |
474
|
|
|
|
|
|
|
&& $self->_peek_at_next_significant_token !~ $transaction_RE |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
sub _is_END_of_block { |
478
|
24363
|
|
|
24363
|
|
52288
|
my ($self, $token) = @_; |
479
|
24363
|
|
|
|
|
45590
|
my $next_token = $self->_peek_at_next_significant_token; |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
# Return possible package name. |
482
|
24363
|
100
|
66
|
|
|
93011
|
if ( |
|
|
|
100
|
|
|
|
|
483
|
|
|
|
|
|
|
$token =~ $END_RE && ( |
484
|
|
|
|
|
|
|
!defined($next_token) |
485
|
|
|
|
|
|
|
|| $next_token !~ $procedural_END_RE |
486
|
|
|
|
|
|
|
) |
487
|
252
|
50
|
|
|
|
1061
|
) { return defined $next_token ? $next_token : '' } |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
return |
490
|
24111
|
|
|
|
|
123625
|
} |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
sub _dollar_placeholder_found { |
493
|
8896
|
|
|
8896
|
|
16511
|
my ($self, $token) = @_; |
494
|
|
|
|
|
|
|
|
495
|
8896
|
100
|
|
|
|
41605
|
return $token =~ $dollar_placeholder_RE ? $token : ''; |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
# Needed by SQL::Tokenizer pre-0.21 |
498
|
|
|
|
|
|
|
# return '' if $token ne SINGLE_DOLLAR; |
499
|
|
|
|
|
|
|
# |
500
|
|
|
|
|
|
|
# # $token must be: '$' |
501
|
|
|
|
|
|
|
# my $tokens = $self->_tokens; |
502
|
|
|
|
|
|
|
# |
503
|
|
|
|
|
|
|
# return $tokens->[0] =~ /^\d+$/ && $tokens->[1] !~ /^\$/ |
504
|
|
|
|
|
|
|
# ? $token . shift( @$tokens ) : '' |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
sub _named_placeholder_found { |
508
|
8905
|
|
|
8905
|
|
16069
|
my ($self, $token) = @_; |
509
|
|
|
|
|
|
|
|
510
|
8905
|
100
|
|
|
|
35354
|
return $token =~ /^:(?:\d+|[_a-z][_a-z\d]*)$/ ? $token : '' |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
sub _questionmark_placeholder_found { |
514
|
8934
|
|
|
8934
|
|
18807
|
my ($self, $token) = @_; |
515
|
|
|
|
|
|
|
|
516
|
8934
|
100
|
|
|
|
30212
|
return $token eq QUESTION_MARK ? $token : '' |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
sub _dollar_quote_open_found { |
520
|
336
|
|
|
336
|
|
791
|
my ($self, $token) = @_; |
521
|
|
|
|
|
|
|
|
522
|
336
|
100
|
|
|
|
2350
|
return '' if $token !~ /^\$/; |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
# Includes the DOUBLE_DOLLAR case |
525
|
41
|
100
|
|
|
|
626
|
return $token if $token =~ /^\$$inner_identifier_RE?\$$/; |
526
|
|
|
|
|
|
|
# Used with SQL::Tokenizer pre-0.21 |
527
|
|
|
|
|
|
|
# return $token if $token eq DOUBLE_DOLLAR; |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
# $token must be: '$' or '$1', '$2' etc. |
530
|
8
|
50
|
|
|
|
92
|
return '' if $token =~ $dollar_placeholder_RE; |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
# $token must be: '$' |
533
|
8
|
|
|
|
|
172
|
my $tokens = $self->_tokens; |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
# False alarm! |
536
|
8
|
50
|
|
|
|
68
|
return '' if $tokens->[1] !~ /^\$/; |
537
|
|
|
|
|
|
|
|
538
|
8
|
50
|
33
|
|
|
295
|
return $token . shift( @$tokens ) . shift( @$tokens ) |
539
|
|
|
|
|
|
|
if $tokens->[0] =~ /^$inner_identifier_RE$/ |
540
|
|
|
|
|
|
|
&& $tokens->[1] eq SINGLE_DOLLAR; |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
# $tokens->[1] must match: /$.+/ |
543
|
0
|
|
|
|
|
0
|
my $quote = $token . shift( @$tokens ) . '$'; |
544
|
0
|
|
|
|
|
0
|
$tokens->[0] = substr $tokens->[0], 1; |
545
|
0
|
|
|
|
|
0
|
return $quote |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
sub _dollar_quote_close_found { |
549
|
2435
|
|
|
2435
|
|
4680
|
my ($self, $token, $dollar_quote) = @_; |
550
|
|
|
|
|
|
|
|
551
|
2435
|
100
|
|
|
|
7119
|
return if $token !~ /^\$/; |
552
|
98
|
100
|
|
|
|
291
|
return 1 if $token eq $dollar_quote; # $token matches /$.*$/ |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
# $token must be: '$' or '$1', '$2' etc. |
555
|
65
|
100
|
|
|
|
511
|
return if $token =~ $dollar_placeholder_RE; |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
# $token must be: '$' |
558
|
9
|
|
|
|
|
198
|
my $tokens = $self->_tokens; |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
# False alarm! |
561
|
9
|
100
|
|
|
|
107
|
return if $tokens->[1] !~ /^\$/; |
562
|
|
|
|
|
|
|
|
563
|
8
|
50
|
|
|
|
38
|
if ( $dollar_quote eq $token . $tokens->[0] . $tokens->[1] ) { |
564
|
8
|
|
|
|
|
16
|
shift( @$tokens ); shift( @$tokens ); |
|
8
|
|
|
|
|
18
|
|
565
|
8
|
|
|
|
|
30
|
return 1 |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
# $tokens->[1] must match: /$.+/ |
569
|
0
|
0
|
|
|
|
0
|
if ( $dollar_quote eq $token . $tokens->[0] . '$' ) { |
570
|
0
|
|
|
|
|
0
|
shift( @$tokens ); |
571
|
0
|
|
|
|
|
0
|
$tokens->[0] = substr $tokens->[0], 1; |
572
|
0
|
|
|
|
|
0
|
return 1 |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
return |
576
|
0
|
|
|
|
|
0
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
sub _peek_at_package_name { |
579
|
|
|
|
|
|
|
shift->_peek_at_next_significant_token( |
580
|
39
|
|
|
39
|
|
731
|
qr/$OR_REPLACE_PACKAGE_RE|$BODY_RE/ |
581
|
|
|
|
|
|
|
) |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
sub _custom_delimiter_def_found { |
585
|
41
|
|
|
41
|
|
128
|
my $self = shift; |
586
|
|
|
|
|
|
|
|
587
|
41
|
|
|
|
|
740
|
my $tokens = $self->_tokens; |
588
|
|
|
|
|
|
|
|
589
|
41
|
|
|
|
|
200
|
my $base_index = 0; |
590
|
41
|
|
|
|
|
214
|
$base_index++ while $tokens->[$base_index] =~ /^\s$/; |
591
|
|
|
|
|
|
|
|
592
|
41
|
|
|
|
|
87
|
my $first_token_in_delimiter = $tokens->[$base_index]; |
593
|
41
|
|
|
|
|
64
|
my $delimiter = ''; |
594
|
41
|
|
|
|
|
76
|
my $tokens_in_delimiter; |
595
|
|
|
|
|
|
|
my $tokens_to_shift; |
596
|
|
|
|
|
|
|
|
597
|
41
|
100
|
|
|
|
481
|
if ( $first_token_in_delimiter =~ $quoted_RE ) { |
598
|
|
|
|
|
|
|
# Quoted custom delimiter: it's just a single token (to shift)... |
599
|
1
|
|
|
|
|
137
|
$tokens_to_shift = $base_index + 1; |
600
|
|
|
|
|
|
|
# ... However it can be composed by several tokens |
601
|
|
|
|
|
|
|
# (according to SQL::Tokenizer), once removed the quotes. |
602
|
1
|
|
|
|
|
4
|
$delimiter = substr $first_token_in_delimiter, 1, -1; |
603
|
1
|
|
|
|
|
5
|
$tokens_in_delimiter =()= tokenize_sql($delimiter) |
604
|
|
|
|
|
|
|
} else { |
605
|
|
|
|
|
|
|
# Gather an unquoted custom delimiter, which could be composed |
606
|
|
|
|
|
|
|
# by several tokens (that's the SQL::Tokenizer behaviour). |
607
|
40
|
|
|
|
|
6546
|
foreach ( $base_index .. $#{ $tokens } ) { |
|
40
|
|
|
|
|
156
|
|
608
|
99
|
100
|
|
|
|
368
|
last if $tokens->[$_] =~ /^\s+$/; |
609
|
59
|
|
|
|
|
106
|
$delimiter .= $tokens->[$_]; |
610
|
59
|
|
|
|
|
109
|
$tokens_in_delimiter++ |
611
|
|
|
|
|
|
|
} |
612
|
40
|
|
|
|
|
84
|
$tokens_to_shift = $base_index + $tokens_in_delimiter |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
|
615
|
41
|
|
|
|
|
1077
|
$self->_custom_delimiter($delimiter); |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
# We've just found a custom delimiter definition, |
618
|
|
|
|
|
|
|
# which means that this statement has no (additional) terminator, |
619
|
|
|
|
|
|
|
# therefore we won't have to delete anything. |
620
|
41
|
|
|
|
|
326
|
push @{ $self->_terminators }, [undef, undef]; |
|
41
|
|
|
|
|
720
|
|
621
|
|
|
|
|
|
|
|
622
|
41
|
|
|
|
|
912
|
$self->_tokens_in_custom_delimiter($tokens_in_delimiter); |
623
|
|
|
|
|
|
|
|
624
|
41
|
|
|
|
|
300
|
return $tokens_to_shift |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
sub _is_custom_delimiter { |
628
|
1439
|
|
|
1439
|
|
2646
|
my ($self, $token) = @_; |
629
|
|
|
|
|
|
|
|
630
|
1439
|
|
|
|
|
24323
|
my $tokens = $self->_tokens; |
631
|
|
|
|
|
|
|
my @delimiter_tokens |
632
|
1439
|
|
|
|
|
5831
|
= splice @{$tokens}, 0, $self->_tokens_in_custom_delimiter() - 1; |
|
1439
|
|
|
|
|
24425
|
|
633
|
1439
|
|
|
|
|
7852
|
my $lookahead_delimiter = join '', @delimiter_tokens; |
634
|
1439
|
100
|
|
|
|
24734
|
if ( $self->_custom_delimiter eq $token . $lookahead_delimiter ) { |
635
|
32
|
|
|
|
|
209
|
$self->_add_to_current_statement($lookahead_delimiter); |
636
|
32
|
|
|
|
|
286
|
push @{ $self->_terminators }, |
|
32
|
|
|
|
|
558
|
|
637
|
|
|
|
|
|
|
[ CUSTOM_DELIMITER, $self->_custom_delimiter ]; |
638
|
32
|
|
|
|
|
842
|
return 1 |
639
|
|
|
|
|
|
|
} else { |
640
|
1407
|
|
|
|
|
7203
|
unshift @{$tokens}, @delimiter_tokens; |
|
1407
|
|
|
|
|
2769
|
|
641
|
|
|
|
|
|
|
return |
642
|
1407
|
|
|
|
|
3915
|
} |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
sub _is_terminator { |
646
|
23327
|
|
|
23327
|
|
41715
|
my ($self, $token) = @_; |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
# This is the first test to perform! |
649
|
23327
|
100
|
|
|
|
449141
|
if ( $self->_custom_delimiter ) { |
650
|
|
|
|
|
|
|
# If a custom delimiter is currently defined, |
651
|
|
|
|
|
|
|
# no other token can terminate a statement. |
652
|
1439
|
100
|
|
|
|
8771
|
return CUSTOM_DELIMITER if $self->_is_custom_delimiter($token); |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
return |
655
|
1407
|
|
|
|
|
2599
|
} |
656
|
|
|
|
|
|
|
|
657
|
21888
|
100
|
100
|
|
|
161782
|
return if $token ne FORWARD_SLASH && $token ne SEMICOLON; |
658
|
|
|
|
|
|
|
|
659
|
1971
|
|
|
|
|
33714
|
my $tokens = $self->_tokens; |
660
|
|
|
|
|
|
|
|
661
|
1971
|
100
|
|
|
|
10188
|
if ( $token eq FORWARD_SLASH ) { |
662
|
|
|
|
|
|
|
# Remove the trailing FORWARD_SLASH from the current statement |
663
|
125
|
|
|
|
|
2123
|
chop( my $current_statement = $self->_current_statement ); |
664
|
|
|
|
|
|
|
|
665
|
125
|
|
|
|
|
833
|
my $next_token = $tokens->[0]; |
666
|
125
|
|
|
|
|
270
|
my $next_next_token = $tokens->[1]; |
667
|
|
|
|
|
|
|
|
668
|
125
|
100
|
66
|
|
|
917
|
if ( |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
669
|
|
|
|
|
|
|
!defined($next_token) |
670
|
|
|
|
|
|
|
|| $next_token eq NEWLINE |
671
|
|
|
|
|
|
|
|| $next_token =~ /^\s+$/ && $next_next_token eq NEWLINE |
672
|
|
|
|
|
|
|
) { |
673
|
97
|
100
|
100
|
|
|
838
|
return SLASH_TERMINATOR |
674
|
|
|
|
|
|
|
if $current_statement =~ /;\s*\n\s*\z/ |
675
|
|
|
|
|
|
|
|| $current_statement =~ /\n\s*\.\s*\n\s*\z/; |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
# Slash with no preceding semicolon or period: |
678
|
|
|
|
|
|
|
# this is to be treated as a semicolon terminator... |
679
|
39
|
|
|
|
|
103
|
my $next_significant_token_idx |
680
|
|
|
|
|
|
|
= $self->_next_significant_token_idx; |
681
|
|
|
|
|
|
|
# ... provided that it's not a division operator |
682
|
|
|
|
|
|
|
# (at least not a blatant one ;-) |
683
|
39
|
100
|
66
|
|
|
771
|
return SEMICOLON_TERMINATOR |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
684
|
|
|
|
|
|
|
if $self->slash_terminates |
685
|
|
|
|
|
|
|
&& $current_statement =~ /\n\s*\z/ |
686
|
|
|
|
|
|
|
&& ( |
687
|
|
|
|
|
|
|
$next_significant_token_idx == -1 |
688
|
|
|
|
|
|
|
|| |
689
|
|
|
|
|
|
|
$tokens->[$next_significant_token_idx] ne OPEN_BRACKET |
690
|
|
|
|
|
|
|
&& $tokens->[$next_significant_token_idx] !~ /^\d/ |
691
|
|
|
|
|
|
|
&& !( |
692
|
|
|
|
|
|
|
$tokens->[$next_significant_token_idx] eq DOT |
693
|
|
|
|
|
|
|
&& $tokens->[$next_significant_token_idx + 1] =~ /^\d/ |
694
|
|
|
|
|
|
|
) |
695
|
|
|
|
|
|
|
) |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
return |
699
|
40
|
|
|
|
|
264
|
} |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
# $token eq SEMICOLON. |
702
|
|
|
|
|
|
|
|
703
|
1846
|
|
|
|
|
3083
|
my $next_code_portion = ''; |
704
|
1846
|
|
|
|
|
2791
|
my $i = 0; |
705
|
1846
|
|
100
|
|
|
31766
|
$next_code_portion .= $tokens->[$i++] |
706
|
|
|
|
|
|
|
while $i <= 8 && defined $tokens->[$i]; |
707
|
|
|
|
|
|
|
|
708
|
1846
|
100
|
66
|
|
|
15523
|
return SEMICOLON_TERMINATOR |
|
|
|
100
|
|
|
|
|
709
|
|
|
|
|
|
|
if $token eq SEMICOLON |
710
|
|
|
|
|
|
|
&& $next_code_portion !~ m#\A\s*\n\s*/\s*$#m |
711
|
|
|
|
|
|
|
&& $next_code_portion !~ m#\A\s*\n\s*\.\s*\n\s*/\s*$#m; |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
# there is a FORWARD_SLASH next: let's wait for it to terminate. |
714
|
|
|
|
|
|
|
return |
715
|
58
|
|
|
|
|
161
|
} |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
sub _peek_at_next_significant_token { |
718
|
25580
|
|
|
25580
|
|
42067
|
my ($self, $skiptoken_RE) = @_; |
719
|
|
|
|
|
|
|
|
720
|
25580
|
|
|
|
|
454959
|
my $tokens = $self->_tokens; |
721
|
|
|
|
|
|
|
my $next_significant_token = $skiptoken_RE |
722
|
|
|
|
|
|
|
? firstval { |
723
|
1853
|
100
|
100
|
1853
|
|
6763
|
/\S/ && ! $self->_is_comment($_) && ! /$skiptoken_RE/ |
724
|
756
|
|
|
|
|
11849
|
} @{ $tokens } |
725
|
|
|
|
|
|
|
: firstval { |
726
|
52488
|
100
|
|
52488
|
|
168873
|
/\S/ && ! $self->_is_comment($_) |
727
|
25580
|
100
|
|
|
|
174134
|
} @{ $tokens }; |
|
24824
|
|
|
|
|
299788
|
|
728
|
|
|
|
|
|
|
|
729
|
25580
|
100
|
|
|
|
108506
|
return $next_significant_token if defined $next_significant_token; |
730
|
74
|
|
|
|
|
232
|
return '' |
731
|
|
|
|
|
|
|
} |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
sub _next_significant_token_idx { |
734
|
39
|
|
|
39
|
|
113
|
my ($self, $skiptoken_RE) = @_; |
735
|
|
|
|
|
|
|
|
736
|
39
|
|
|
|
|
671
|
my $tokens = $self->_tokens; |
737
|
|
|
|
|
|
|
return $skiptoken_RE |
738
|
|
|
|
|
|
|
? firstidx { |
739
|
0
|
0
|
0
|
0
|
|
0
|
/\S/ && ! $self->_is_comment($_) && ! /$skiptoken_RE/ |
740
|
0
|
|
|
|
|
0
|
} @{ $tokens } |
741
|
|
|
|
|
|
|
: firstidx { |
742
|
108
|
100
|
|
108
|
|
312
|
/\S/ && ! $self->_is_comment($_) |
743
|
39
|
50
|
|
|
|
258
|
} @{ $tokens } |
|
39
|
|
|
|
|
188
|
|
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
1; |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
__END__ |