File Coverage

File:	grammar/Select.yp
Coverage:	88.4%

line	stmt	bran	cond	sub	pod	time	code
1							#
2							# Select.yp
3							#
4							#
5							%{
6
7							my (
8							@Models, @Columns, @OutVars,
9							$InVals, %Defaults, $Quote, $QuoteIdent,
10							@Unbound,
11							);
12
13							%}
14
15							%left 'and'
16	88			88	0	625	%left 'or'
17
18							%%
19
20							miniSQL: statement
21							;
22
23							statement: select_stmt ';'
24							\| select_stmt
25							;
26
27							select_stmt: 'select' pattern_list postfix_clause_list
28	79			79		20030	{ join(' ', @_[1..$#_]) }
29							\| 'select' pattern_list
30	1			1		363	{ join(' ', @_[1..$#_]) }
31							;
32
33							models: model ',' models
34	11			11		3377	{ join(' ', @_[1..$#_]) }
35							\| model
36							;
37
38	91 91			91		26933 765	model: symbol { push @Models, $_[1]; $QuoteIdent->($_[1]) }
39							;
40
41							pattern_list: pattern ',' pattern_list
42	0			0		0	{ join(' ', @_[1..$#_]) }
43							\| pattern
44							;
45
46							pattern: aggregate alias
47							\| aggregate
48							\| proc_call
49							\| column
50							\| '*'
51							;
52
53							aggregate: func '(' column ')'
54	0			0		0	{ join(' ', @_[1..$#_]) }
55							\| func '(' '*' ')'
56	3			3		743	{ join(' ', @_[1..$#_]) }
57							;
58
59							func: 'max'
60							\| 'min'
61							\| 'count'
62							\| 'sum'
63							;
64
65							proc_call: IDENT '(' parameter_list ')'
66	6			6		2182	{ join(' ', @_[1..$#_]) }
67							;
68
69							parameter_list: parameter ',' parameter_list
70	5			5		1761	{ join(' ', @_[1..$#_]) }
71							\| parameter
72							;
73
74							parameter: string
75							\| NUM
76							;
77
78							constant: STRING \| NUM;
79
80	29			29		6127	string: STRING { $Quote->(parse_string($_[1])) }
81							\| VAR '\|' constant
82	6			6		2503	{ push @OutVars, $_[1];
83	6					37	my $val = $InVals->{$_[1]};
84	6	100				45	if (!defined $val) {
85	5					15	my $default;
86	5					36	$Defaults{$_[1]} = $default = parse_string($_[3]);
87	5					39	return $Quote->($default);
88							}
89	1					8	$Quote->($val);
90							}
91							\| VAR
92	8			8		970	{ push @OutVars, $_[1];
93	8					60	my $val = $InVals->{$_[1]};
94	8	100				63	if (!defined $val) {
95	4					21	push @Unbound, $_[1];
96	4					29	return $Quote->("");
97							}
98	4					30	$Quote->($val);
99							}
100							;
101
102							column: qualified_symbol
103	99 99			99		16808 872	\| symbol { push @Columns, $_[1]; $QuoteIdent->($_[1]) }
104							;
105
106							qualified_symbol: symbol '.' symbol
107							{
108	24			24		7990	push @Models, $_[1];
109	24					96	push @Columns, $_[3];
110	24					147	$QuoteIdent->($_[1]).'.'.$QuoteIdent->($_[3]);
111							}
112							;
113
114							symbol: IDENT
115							\| VAR '\|' IDENT
116	26			26		6167	{ push @OutVars, $_[1];
117	26					173	my $val = $InVals->{$_[1]};
118	26	100				192	if (!defined $val) {
119	19					58	my $default;
120	19					148	$Defaults{$_[1]} = $default = $_[3];
121	19	50				116	_IDENT($default) or die "Bad symbol: $default\n";
122	19					170	return $default;
123							}
124	7	100				37	_IDENT($val) or die "Bad symbol: $val\n";
125	6					39	$val;
126							}
127							\| VAR
128	44			44		5793	{ push @OutVars, $_[1];
129	44					329	my $val = $InVals->{$_[1]};
130	44	100				315	if (!defined $val) {
131	15					81	push @Unbound, $_[1];
132	15					118	return '';
133							}
134							#warn _IDENT($val);
135	29	50				183	_IDENT($val) or die "Bad symbol: $val\n";
136	29					220	$val;
137							}
138							;
139
140							alias: symbol
141							;
142
143							postfix_clause_list: postfix_clause postfix_clause_list
144	94			94		46410	{ join(' ', @_[1..$#_]) }
145							\| postfix_clause
146							;
147
148							postfix_clause: where_clause
149							\| group_by_clause
150							\| order_by_clause
151							\| limit_clause
152							\| offset_clause
153							\| from_clause
154							;
155
156							from_clause: 'from' models
157	80			80		33744	{ join(' ', @_[1..$#_]) }
158							\| 'from' proc_call
159	2			2		453	{ join(' ', @_[1..$#_]) }
160							;
161
162							where_clause: 'where' condition
163	45			45		29718	{ join(' ', @_[1..$#_]) }
164							;
165
166							condition: disjunction
167							;
168
169							disjunction: conjunction 'or' conjunction
170	4			4		1391	{ join(' ', @_[1..$#_]) }
171							\| conjunction
172							;
173
174							conjunction: comparison 'and' comparison
175	9			9		2261	{ join(' ', @_[1..$#_]) }
176							\| comparison
177							;
178
179							comparison: column operator literal
180	51			51		22007	{ join(' ', @_[1..$#_]) }
181							\| column operator column
182	8			8		3430	{ join(' ', @_[1..$#_]) }
183							\| '(' condition ')'
184	0			0		0	{ join(' ', @_[1..$#_]) }
185							;
186
187							operator: '>'
188							\| '>='
189							\| '<='
190							\| '<'
191							\| '<>'
192							\| '='
193							\| 'like'
194							;
195
196							literal: string
197							\| NUM
198							;
199
200							group_by_clause: 'group by' column_list
201	1			1		429	{ join(' ', @_[1..$#_]) }
202							;
203
204							column_list: column ',' column_list
205	0			0		0	{ join(' ', @_[1..$#_]) }
206							\| column
207							;
208
209							order_by_clause: 'order by' column_list
210	34			34		15189	{ join(' ', @_[1..$#_]) }
211							;
212
213							limit_clause: 'limit' NUM
214	7 7			7		1527 297	{ delete $_[0]->YYData->{limit}; join(' ', @_[1..$#_]) }
215							;
216
217							offset_clause: 'offset' NUM {
218	7 7			7		1536 292	delete $_[0]->YYData->{offset}; join(' ', @_[1..$#_]) }
219	88					96687	;
220
221							%%
222
223							#use Smart::Comments;
224
225							sub _Error {
226	10			10		2011	my ($value) = $_[0]->YYCurval;
227
228	10					331	my $token = 1;
229							## $value
230	10					100	my @expect = $_[0]->YYExpect;
231							### expect: @expect
232	10	100				558	my ($what) = $value ? "input: \"$value\"" : "end of input";
233
234	10 16	100	100			53 361	map { $_ = "'$_'" if $_ ne '' and !/^\w+$/ } @expect;
235	10					81	my $expected = join " or ", @expect;
236	10	100				160	_SyntaxError(1, "Unexpected $what".($expected?" ($expected expected)":''), $.);
237							}
238
239							sub _SyntaxError {
240	10			10		80	my ($level, $message, $lineno) = @_;
241
242	10					87	$message= "line $lineno: error: $message";
243	10					33	die $message, ".\n";
244							}
245
246							sub _Lexer {
247	947			947		246611	my ($parser) = shift;
248
249	947					5993	my $yydata = $parser->YYData;
250	947					26270	my $source = $yydata->{source};
251							#local $" = "\n";
252	947	100				11329	defined $yydata->{input} && $yydata->{input} =~ s/^\s+//s;
253
254	947	100	100			16276	if (!defined $yydata->{input} \|\| $yydata->{input} eq '') {
255							### HERE!!!
256	196					2060	$yydata->{input} = <$source>;
257							}
258	947	100				6638	if (!defined $yydata->{input}) {
259	77					906	return ('', undef);
260							}
261
262							## other data: <$source>
263							### data: $yydata->{input}
264							### lineno: $.
265
266	870					6338	for ($yydata->{input}) {
267	870	100				7222	s/^\s*(\d+(?:\.\d+)?)\b//s
268							and return ('NUM', $1);
269	836	100				5656	s/^\s('(?:\\.\|''\|[^'])')//
270							and return ('STRING', $1);
271	806	100				4319	s/^\s"(\w)"//
272							and return ('IDENT', $1);
273	804	100				4654	s/^\s(\$(\w)\$.*?\$\2\$)//
274							and return ('STRING', $1);
275	799	100				10840	s/^\s(\\|count\|sum\|max\|min\|select\|and\|or\|from\|where\|delete\|update\|set\|order by\|group by\|limit\|offset)\b//is
276							and return (lc($1), lc($1));
277	510	100				3087	s/^\s*(<=\|>=\|<>)//s
278							and return ($1, $1);
279	505	100				5840	s/^\s([A-Za-z][A-Za-z0-9_])\b//s
280							and return ('IDENT', $1);
281	304	100				3000	s/^\$(\w+)//s
282							and return ('VAR', $1);
283	219	50				4130	s/^\s*(\S)//s
284							and return ($1, $1);
285							}
286							}
287
288							sub parse_string {
289	34			34	0	194	my $s = $_[0];
290	34	100 100 50				381	if ($s =~ /^'(.*)'$/) {
291	28					152	$s = $1;
292	28					148	$s =~ s/''/'/g;
293	28					124	$s =~ s/\\n/\n/g;
294	28					110	$s =~ s/\\t/\t/g;
295	28					110	$s =~ s/\\r/\r/g;
296	28					136	$s =~ s/\\(.)/$1/g;
297	28					273	return $s;
298							} elsif ($s =~ /^\$(\w)\$(.)\$\1\$$/) {
299	5					35	$s = $2;
300	5					56	return $s;
301							} elsif ($s =~ /^[\d\.]*$/) {
302	1					16	return $s;
303							} else {
304	0					0	die "Unknown string literal: $s";
305							}
306							}
307
308							sub parse {
309	87			87	0	683	my ($self, $sql, $params) = @_;
310	87 0 0 0			0		2866 0 0 0	open my $source, '<', \$sql;
311	87					1059	my $yydata = $self->YYData;
312	87					3573	$yydata->{source} = $source;
313	87					662	$yydata->{limit} = $params->{limit};
314	87					632	$yydata->{offset} = $params->{offset};
315
316	87 0		50	0		761 0	$Quote = $params->{quote} \|\| sub { "''" };
317	87 0		50	0		664 0	$QuoteIdent = $params->{quote_ident} \|\| sub { '""' };
318	87		100			829	$InVals = $params->{vars} \|\| {};
319							#$QuoteIdent = $params->{quote_ident};
320
321							#$self->YYData->{INPUT} = ;
322							### $sql
323	87					508	@Unbound = ();
324	87					445	@Models = ();
325	87					402	@Columns = ();
326	87					386	@OutVars = ();
327	87					427	%Defaults = ();
328	87					1365	my $sql = $self->YYParse( yydebug => 0 & 0x1F, yylex => \&_Lexer, yyerror => \&_Error );
329	76					51873	close $source;
330							return {
331	76					2904	limit => $yydata->{limit},
332							offset => $yydata->{offset},
333							models => [@Models],
334							columns => [@Columns],
335							sql => $sql,
336							vars => [@OutVars],
337							defaults => {%Defaults},
338							unbound => [@Unbound],
339							};
340							}
341
342							sub _IDENT {
343	55	100	67	55		1339	(defined $_[0] && $_[0] =~ /^[A-Za-z]\w*$/) ? $_[0] : undef;
344							}
345
346							#my ($select) =new Select;
347							#my $var = $select->Run;
348
349							1;
350