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