From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

use strict;
my $sqlat = SQL::Abstract::Tree->new;
is_deeply($sqlat->parse("SELECT a, b.*, * FROM foo WHERE foo.a =1 and foo.b LIKE 'station'"), [
[
"SELECT",
[
[
"-LIST",
[
[
"-LITERAL",
[
"a"
]
],
[
"-LITERAL",
[
"b.*"
]
],
[
"-LITERAL",
[
"*"
]
]
]
]
]
],
[
"FROM",
[
[
"-LITERAL",
[
"foo"
]
]
]
],
[
"WHERE",
[
[
"AND",
[
[
"=",
[
[
"-LITERAL",
[
"foo.a"
]
],
[
"-LITERAL",
[
1
]
]
]
],
[
"LIKE",
[
[
"-LITERAL",
[
"foo.b"
]
],
[
"-LITERAL",
[
"'station'"
]
]
]
]
]
]
]
]
], 'simple statement parsed correctly');
is_deeply($sqlat->parse( "SELECT * FROM (SELECT * FROM foobar) foo WHERE foo.a =1 and foo.b LIKE 'station'"), [
[
"SELECT",
[
[
"-LITERAL",
[
"*"
]
]
]
],
[
"FROM",
[
[
"-MISC",
[
[
"-PAREN",
[
[
"SELECT",
[
[
"-LITERAL",
[
"*"
]
]
]
],
[
"FROM",
[
[
"-LITERAL",
[
"foobar"
]
]
]
]
]
],
[
"-LITERAL",
[
"foo"
]
]
]
]
]
],
[
"WHERE",
[
[
"AND",
[
[
"=",
[
[
"-LITERAL",
[
"foo.a"
]
],
[
"-LITERAL",
[
1
]
]
]
],
[
"LIKE",
[
[
"-LITERAL",
[
"foo.b"
]
],
[
"-LITERAL",
[
"'station'"
]
]
]
]
]
]
]
]
], 'subquery statement parsed correctly');
is_deeply($sqlat->parse( "SELECT [screen].[id], [screen].[name], [screen].[section_id], [screen].[xtype] FROM [users_roles] [me] JOIN [roles] [role] ON [role].[id] = [me].[role_id] JOIN [roles_permissions] [role_permissions] ON [role_permissions].[role_id] = [role].[id] JOIN [permissions] [permission] ON [permission].[id] = [role_permissions].[permission_id] JOIN [permissionscreens] [permission_screens] ON [permission_screens].[permission_id] = [permission].[id] JOIN [screens] [screen] ON [screen].[id] = [permission_screens].[screen_id] WHERE ( [me].[user_id] = ? ) GROUP BY [screen].[id], [screen].[name], [screen].[section_id], [screen].[xtype]"), [
[
"SELECT",
[
[
"-LIST",
[
[
"-LITERAL",
[
"[screen].[id]"
]
],
[
"-LITERAL",
[
"[screen].[name]"
]
],
[
"-LITERAL",
[
"[screen].[section_id]"
]
],
[
"-LITERAL",
[
"[screen].[xtype]"
]
]
]
]
]
],
[
"FROM",
[
[
"-MISC",
[
[
"-LITERAL",
[
"[users_roles]"
]
],
[
"-LITERAL",
[
"[me]"
]
]
]
]
]
],
[
"JOIN",
[
[
"-MISC",
[
[
"-LITERAL",
[
"[roles]"
]
],
[
"-LITERAL",
[
"[role]"
]
]
]
]
]
],
[
"ON",
[
[
"=",
[
[
"-LITERAL",
[
"[role].[id]"
]
],
[
"-LITERAL",
[
"[me].[role_id]"
]
]
]
]
]
],
[
"JOIN",
[
[
"-MISC",
[
[
"-LITERAL",
[
"[roles_permissions]"
]
],
[
"-LITERAL",
[
"[role_permissions]"
]
]
]
]
]
],
[
"ON",
[
[
"=",
[
[
"-LITERAL",
[
"[role_permissions].[role_id]"
]
],
[
"-LITERAL",
[
"[role].[id]"
]
]
]
]
]
],
[
"JOIN",
[
[
"-MISC",
[
[
"-LITERAL",
[
"[permissions]"
]
],
[
"-LITERAL",
[
"[permission]"
]
]
]
]
]
],
[
"ON",
[
[
"=",
[
[
"-LITERAL",
[
"[permission].[id]"
]
],
[
"-LITERAL",
[
"[role_permissions].[permission_id]"
]
]
]
]
]
],
[
"JOIN",
[
[
"-MISC",
[
[
"-LITERAL",
[
"[permissionscreens]"
]
],
[
"-LITERAL",
[
"[permission_screens]"
]
]
]
]
]
],
[
"ON",
[
[
"=",
[
[
"-LITERAL",
[
"[permission_screens].[permission_id]"
]
],
[
"-LITERAL",
[
"[permission].[id]"
]
]
]
]
]
],
[
"JOIN",
[
[
"-MISC",
[
[
"-LITERAL",
[
"[screens]"
]
],
[
"-LITERAL",
[
"[screen]"
]
]
]
]
]
],
[
"ON",
[
[
"=",
[
[
"-LITERAL",
[
"[screen].[id]"
]
],
[
"-LITERAL",
[
"[permission_screens].[screen_id]"
]
]
]
]
]
],
[
"WHERE",
[
[
"-PAREN",
[
[
"=",
[
[
"-LITERAL",
[
"[me].[user_id]"
]
],
[
"-PLACEHOLDER",
[
"?"
]
]
]
]
]
]
]
],
[
"GROUP BY",
[
[
"-LIST",
[
[
"-LITERAL",
[
"[screen].[id]"
]
],
[
"-LITERAL",
[
"[screen].[name]"
]
],
[
"-LITERAL",
[
"[screen].[section_id]"
]
],
[
"-LITERAL",
[
"[screen].[xtype]"
]
]
]
]
]
]
], 'real life statement 1 parsed correctly');
is_deeply($sqlat->parse("CASE WHEN FOO() > BAR()"), [
[
"-MISC",
[
[
"-LITERAL",
[
"CASE"
]
],
[
"-LITERAL",
[
"WHEN"
]
]
]
],
[
">",
[
[
"FOO",
[
[
"-PAREN",
[]
]
]
],
[
"BAR",
[
[
"-PAREN",
[]
]
]
]
]
]
]);
is_deeply($sqlat->parse("SELECT [me].[id], ROW_NUMBER ( ) OVER (ORDER BY (SELECT 1)) AS [rno__row__index] FROM bar"), [
[
"SELECT",
[
[
"-LIST",
[
[
"-LITERAL",
[
"[me].[id]"
]
],
[
"AS",
[
[
"ROW_NUMBER() OVER",
[
[
"-PAREN",
[
[
"ORDER BY",
[
[
"-PAREN",
[
[
"SELECT",
[
[
"-LITERAL",
[
1
]
]
]
]
]
]
]
]
]
]
]
],
[
"-LITERAL",
[
"[rno__row__index]"
]
]
]
]
]
]
]
],
[
"FROM",
[
[
"-LITERAL",
[
"bar"
]
]
]
]
]);
is_deeply($sqlat->parse("SELECT x, y FROM foo WHERE x IN (?, ?, ?, ?)"), [
[
"SELECT",
[
[
"-LIST",
[
[
"-LITERAL",
[
"x"
]
],
[
"-LITERAL",
[
"y"
]
]
]
]
]
],
[
"FROM",
[
[
"-LITERAL",
[
"foo"
]
]
]
],
[
"WHERE",
[
[
"IN",
[
[
"-LITERAL",
[
"x"
]
],
[
"-PAREN",
[
[
"-LIST",
[
[
"-PLACEHOLDER",
[
"?"
]
],
[
"-PLACEHOLDER",
[
"?"
]
],
[
"-PLACEHOLDER",
[
"?"
]
],
[
"-PLACEHOLDER",
[
"?"
]
]
]
]
]
]
]
]
]
]
], 'Lists parsed correctly');
is_deeply($sqlat->parse('SELECT foo FROM bar ORDER BY x + ? DESC, oomph, y - ? DESC, unf, baz.g / ? ASC, buzz * 0 DESC, foo LIKE ? DESC, ickk ASC'), [
[
"SELECT",
[
[
"-LITERAL",
[
"foo"
]
]
]
],
[
"FROM",
[
[
"-LITERAL",
[
"bar"
]
]
]
],
[
"ORDER BY",
[
[
"-LIST",
[
[
"-DESC",
[
[
"-MISC",
[
[
"-LITERAL",
[
"x"
]
],
[
"-LITERAL",
[
"+"
]
],
[
"-PLACEHOLDER",
[
"?"
]
]
]
],
]
],
[
"-LITERAL",
[
"oomph"
]
],
[
"-DESC",
[
[
"-MISC",
[
[
"-LITERAL",
[
"y"
]
],
[
"-LITERAL",
[
"-"
]
],
[
"-PLACEHOLDER",
[
"?"
]
],
]
],
]
],
[
"-LITERAL",
[
"unf"
]
],
[
"-ASC",
[
[
"-MISC",
[
[
"-LITERAL",
[
"baz.g"
]
],
[
"-LITERAL",
[
"/"
]
],
[
"-PLACEHOLDER",
[
"?"
]
],
]
],
]
],
[
"-DESC",
[
[
"-MISC",
[
[
"-LITERAL",
[
"buzz"
]
],
[
"-LITERAL",
[
"*"
]
],
[
"-LITERAL",
[
0
]
]
]
]
]
],
[
"-DESC",
[
[
"LIKE",
[
[
"-LITERAL",
[
"foo"
]
],
[
"-PLACEHOLDER",
[
"?"
]
],
],
],
]
],
[
"-ASC",
[
[
"-LITERAL",
[
"ickk"
]
]
]
]
]
]
]
]
], 'Crazy ORDER BY parsed correctly');
is_deeply( $sqlat->parse("META SELECT * * FROM (SELECT *, FROM foobar baz buzz) foo bar WHERE NOT NOT NOT EXISTS (SELECT 'cr,ap') AND foo.a = ? STUFF moar(stuff) and not (foo.b LIKE 'station') and x = y and z in ((1, 2)) and a = b and GROUP BY , ORDER BY x x1 x2 y asc, max(y) desc x z desc"), [
[
"-LITERAL",
[
"META"
]
],
[
"SELECT",
[
[
"-MISC",
[
[
"-LITERAL",
[
"*"
]
],
[
"-LITERAL",
[
"*"
]
]
]
]
]
],
[
"FROM",
[
[
"-MISC",
[
[
"-PAREN",
[
[
"SELECT",
[
[
"-LIST",
[
[
"-LITERAL",
[
"*"
]
],
[]
]
]
]
],
[
"FROM",
[
[
"-MISC",
[
[
"-LITERAL",
[
"foobar"
]
],
[
"-LITERAL",
[
"baz"
]
],
[
"-LITERAL",
[
"buzz"
]
]
]
]
]
]
]
],
[
"-LITERAL",
[
"foo"
]
],
[
"-LITERAL",
[
"bar"
]
]
]
]
]
],
[
"WHERE",
[
[
"AND",
[
[
"NOT",
[]
],
[
"NOT",
[]
],
[
"NOT EXISTS",
[
[
"-PAREN",
[
[
"SELECT",
[
[
"-LIST",
[
[
"-LITERAL",
[
"'cr"
]
],
[
"-LITERAL",
[
"ap'"
]
]
]
]
]
]
]
]
]
],
[
"-MISC",
[
[
"=",
[
[
"-LITERAL",
[
"foo.a"
]
],
[
"-PLACEHOLDER",
[
"?"
]
],
],
],
[
"-LITERAL",
[
"STUFF"
]
],
],
],
[
'moar',
[
[
'-PAREN',
[
[
'-LITERAL',
[
'stuff'
]
]
]
]
]
],
[
"NOT",
[
[
"-PAREN",
[
[
"LIKE",
[
[
"-LITERAL",
[
"foo.b"
]
],
[
"-LITERAL",
[
"'station'"
]
]
]
]
]
]
]
],
[
"=",
[
[
"-LITERAL",
[
"x"
]
],
[
"-LITERAL",
[
"y"
]
]
]
],
[
'IN',
[
[
'-LITERAL',
[
'z',
],
],
[
'-PAREN',
[
[
'-PAREN',
[
[
'-LIST',
[
[
'-LITERAL',
[
'1'
]
],
[
'-LITERAL',
[
'2'
]
],
],
],
],
],
],
],
],
],
[
"=",
[
[
"-LITERAL",
[
"a"
]
],
[
"-LITERAL",
[
"b"
]
]
]
]
]
]
]
],
[
"GROUP BY",
[
[
"-LIST",
[
[],
[]
]
]
]
],
[
"ORDER BY",
[
[
"-LIST",
[
[
"-ASC",
[
[
"-MISC",
[
[
"-LITERAL",
[
"x"
]
],
[
"-LITERAL",
[
"x1"
]
],
[
"-LITERAL",
[
"x2"
]
],
[
"-LITERAL",
[
"y"
]
]
]
],
],
],
[
"-DESC",
[
[
"-MISC",
[
[
"-DESC",
[
[
"max",
[
[
"-PAREN",
[
[
"-LITERAL",
[
"y"
]
]
]
]
],
]
]
],
[
"-LITERAL",
[
"x"
]
],
[
"-LITERAL",
[
"z"
]
]
]
]
]
]
]
]
]
]
], 'Deliberately malformed SQL parsed "correctly"');
# test for recursion warnings on huge selectors
my @lst = ('AA' .. 'zz');
#@lst = ('AAA' .. 'zzz'); # if you really want to wait a while
warnings_are {
my $sql = sprintf 'SELECT %s FROM foo', join (', ', (map { qq|( "$_" )| } @lst), (map { qq|"$_"| } @lst), (map { qq|"$_", ( "$_" )| } @lst) );
my $tree = $sqlat->parse($sql);
is_deeply( $tree, [
[
"SELECT",
[
[
"-LIST",
[
(map { [ -PAREN => [ [ -LITERAL => [ qq|"$_"| ] ] ] ] } @lst),
(map { [ -LITERAL => [ qq|"$_"| ] ] } @lst),
(map { [ -LITERAL => [ qq|"$_"| ] ], [ -PAREN => [ [ -LITERAL => [ qq|"$_"| ] ] ] ] } @lst),
]
]
]
],
[
"FROM",
[
[
"-LITERAL",
[
"foo"
]
]
]
]
], 'long list parsed correctly');
is( $sqlat->unparse($tree), $sql, 'roundtrip ok');
} [], 'no recursion warnings on insane SQL';
done_testing;