6 use SQL::Abstract::Tree;
8 my $sqlat = SQL::Abstract::Tree->new;
9 is_deeply($sqlat->parse("SELECT a, b.*, * FROM foo WHERE foo.a =1 and foo.b LIKE 'station'"), [
93 ], 'simple statement parsed correctly');
95 is_deeply($sqlat->parse( "SELECT * FROM (SELECT * FROM foobar) foo WHERE foo.a =1 and foo.b LIKE 'station'"), [
194 ], 'subquery statement parsed correctly');
196 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]"), [
218 "[screen].[section_id]"
306 "[roles_permissions]"
328 "[role_permissions].[role_id]"
378 "[role_permissions].[permission_id]"
394 "[permissionscreens]"
400 "[permission_screens]"
416 "[permission_screens].[permission_id]"
466 "[permission_screens].[screen_id]"
521 "[screen].[section_id]"
534 ], 'real life statement 1 parsed correctly');
536 is_deeply($sqlat->parse("CASE WHEN FOO() > BAR()"), [
579 is_deeply($sqlat->parse("SELECT [me].[id], ROW_NUMBER ( ) OVER (ORDER BY (SELECT 1)) AS [rno__row__index] FROM bar"), [
652 is_deeply($sqlat->parse("SELECT x, y FROM foo WHERE x IN (?, ?, ?, ?)"), [
736 ], 'Lists parsed correctly');
738 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'), [
928 ], 'Crazy ORDER BY parsed correctly');
930 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"), [
1323 ], 'Deliberately malformed SQL parsed "correctly"');
1326 # test for recursion warnings on huge selectors
1327 my @lst = ('AA' .. 'zz');
1328 #@lst = ('AAA' .. 'zzz'); # if you really want to wait a while
1330 my $sql = sprintf 'SELECT %s FROM foo', join (', ', (map { qq|( "$_" )| } @lst), (map { qq|"$_"| } @lst), (map { qq|"$_", ( "$_" )| } @lst) );
1331 my $tree = $sqlat->parse($sql);
1340 (map { [ -PAREN => [ [ -LITERAL => [ qq|"$_"| ] ] ] ] } @lst),
1341 (map { [ -LITERAL => [ qq|"$_"| ] ] } @lst),
1342 (map { [ -LITERAL => [ qq|"$_"| ] ], [ -PAREN => [ [ -LITERAL => [ qq|"$_"| ] ] ] ] } @lst),
1358 ], 'long list parsed correctly');
1360 is( $sqlat->unparse($tree), $sql, 'roundtrip ok');
1361 } [], 'no recursion warnings on insane SQL';