1#!/usr/bin/perl -w
2
3use strict;
4use Test::More;
5
6BEGIN { require "t/utils.pl" }
7our (@AvailableDrivers);
8
9use constant TESTS_PER_DRIVER => 59;
10
11my $total = scalar(@AvailableDrivers) * TESTS_PER_DRIVER;
12plan tests => $total;
13
14foreach my $d ( @AvailableDrivers ) {
15SKIP: {
16    unless( has_schema( 'TestApp', $d ) ) {
17        skip "No schema for '$d' driver", TESTS_PER_DRIVER;
18    }
19    unless( should_test( $d ) ) {
20        skip "ENV is not defined for driver '$d'", TESTS_PER_DRIVER;
21    }
22
23    my $handle = get_handle( $d );
24    connect_handle( $handle );
25    isa_ok($handle->dbh, 'DBI::db');
26
27    my $ret = init_schema( 'TestApp', $handle );
28    isa_ok($ret, 'DBI::st', "Inserted the schema. got a statement handle back");
29
30    my $count_users = init_data( 'TestApp::User', $handle );
31    ok( $count_users,  "init users data" );
32    my $count_groups = init_data( 'TestApp::Group', $handle );
33    ok( $count_groups,  "init groups data" );
34    my $count_us2gs = init_data( 'TestApp::UsersToGroup', $handle );
35    ok( $count_us2gs,  "init users&groups relations data" );
36
37    my $clean_obj = TestApp::Users->new( $handle );
38    my $users_obj = $clean_obj->Clone;
39    is_deeply( $users_obj, $clean_obj, 'after Clone looks the same');
40
41diag "inner JOIN with ->Join method" if $ENV{'TEST_VERBOSE'};
42{
43    ok( !$users_obj->_isJoined, "new object isn't joined");
44    my $alias = $users_obj->Join(
45        FIELD1 => 'id',
46        TABLE2 => 'UsersToGroups',
47        FIELD2 => 'UserId'
48    );
49    ok( $alias, "Join returns alias" );
50    TODO: {
51        local $TODO = "is joined doesn't mean is limited, count returns 0";
52        is( $users_obj->Count, 3, "three users are members of the groups" );
53    }
54    # fake limit to check if join actually joins
55    $users_obj->Limit( FIELD => 'id', OPERATOR => 'IS NOT', VALUE => 'NULL' );
56    is( $users_obj->Count, 3, "three users are members of the groups" );
57}
58
59diag "LEFT JOIN with ->Join method" if $ENV{'TEST_VERBOSE'};
60{
61    $users_obj->CleanSlate;
62    is_deeply( $users_obj, $clean_obj, 'after CleanSlate looks like new object');
63    ok( !$users_obj->_isJoined, "new object isn't joined");
64    my $alias = $users_obj->Join(
65        TYPE   => 'LEFT',
66        FIELD1 => 'id',
67        TABLE2 => 'UsersToGroups',
68        FIELD2 => 'UserId'
69    );
70    ok( $alias, "Join returns alias" );
71    $users_obj->Limit( ALIAS => $alias, FIELD => 'id', OPERATOR => 'IS', VALUE => 'NULL' );
72    ok( $users_obj->BuildSelectQuery =~ /LEFT JOIN/, 'LJ is not optimized away');
73    is( $users_obj->Count, 1, "user is not member of any group" );
74    is( $users_obj->First->id, 3, "correct user id" );
75}
76
77diag "LEFT JOIN with IS NOT NULL on the right side" if $ENV{'TEST_VERBOSE'};
78{
79    $users_obj->CleanSlate;
80    is_deeply( $users_obj, $clean_obj, 'after CleanSlate looks like new object');
81    ok( !$users_obj->_isJoined, "new object isn't joined");
82    my $alias = $users_obj->Join(
83        TYPE   => 'LEFT',
84        FIELD1 => 'id',
85        TABLE2 => 'UsersToGroups',
86        FIELD2 => 'UserId'
87    );
88    ok( $alias, "Join returns alias" );
89    $users_obj->Limit( ALIAS => $alias, FIELD => 'id', OPERATOR => 'IS NOT', VALUE => 'NULL' );
90    ok( $users_obj->BuildSelectQuery !~ /LEFT JOIN/, 'LJ is optimized away');
91    is( $users_obj->Count, 3, "users whos is memebers of at least one group" );
92}
93
94diag "LEFT JOIN with ->Join method and using alias" if $ENV{'TEST_VERBOSE'};
95{
96    $users_obj->CleanSlate;
97    is_deeply( $users_obj, $clean_obj, 'after CleanSlate looks like new object');
98    ok( !$users_obj->_isJoined, "new object isn't joined");
99    my $alias = $users_obj->NewAlias( 'UsersToGroups' );
100    ok( $alias, "new alias" );
101    is($users_obj->Join(
102            TYPE   => 'LEFT',
103            FIELD1 => 'id',
104            ALIAS2 => $alias,
105            FIELD2 => 'UserId' ),
106        $alias, "joined table"
107    );
108    $users_obj->Limit( ALIAS => $alias, FIELD => 'id', OPERATOR => 'IS', VALUE => 'NULL' );
109    ok( $users_obj->BuildSelectQuery =~ /LEFT JOIN/, 'LJ is not optimized away');
110    is( $users_obj->Count, 1, "user is not member of any group" );
111}
112
113diag "main <- alias <- join" if $ENV{'TEST_VERBOSE'};
114{
115    # The join depends on the alias, we should build joins with correct order.
116    $users_obj->CleanSlate;
117    is_deeply( $users_obj, $clean_obj, 'after CleanSlate looks like new object');
118    ok( !$users_obj->_isJoined, "new object isn't joined");
119    my $alias = $users_obj->NewAlias( 'UsersToGroups' );
120    ok( $alias, "new alias" );
121    ok( $users_obj->_isJoined, "object with aliases is joined");
122    $users_obj->Limit( FIELD => 'id', VALUE => "$alias.UserId", QUOTEVALUE => 0);
123    ok( my $groups_alias = $users_obj->Join(
124            ALIAS1 => $alias,
125            FIELD1 => 'GroupId',
126            TABLE2 => 'Groups',
127            FIELD2 => 'id',
128        ),
129        "joined table"
130    );
131    $users_obj->Limit( ALIAS => $groups_alias, FIELD => 'Name', VALUE => 'Developers' );
132    is( $users_obj->Count, 3, "three members" );
133}
134
135diag "main <- alias <- join into main" if $ENV{'TEST_VERBOSE'};
136{
137    # DBs' parsers don't like: FROM X, Y JOIN C ON C.f = X.f
138    $users_obj->CleanSlate;
139    is_deeply( $users_obj, $clean_obj, 'after CleanSlate looks like new object');
140    ok( !$users_obj->_isJoined, "new object isn't joined");
141
142    ok( my $groups_alias = $users_obj->NewAlias( 'Groups' ), "new alias" );
143    ok( my $g2u_alias = $users_obj->Join(
144            ALIAS1 => 'main',
145            FIELD1 => 'id',
146            TABLE2 => 'UsersToGroups',
147            FIELD2 => 'UserId',
148        ),
149        "joined table"
150    );
151    $users_obj->Limit( ALIAS => $g2u_alias, FIELD => 'GroupId', VALUE => "$groups_alias.id", QUOTEVALUE => 0);
152    $users_obj->Limit( ALIAS => $groups_alias, FIELD => 'Name', VALUE => 'Developers' );
153    #diag $users_obj->BuildSelectQuery;
154    is( $users_obj->Count, 3, "three members" );
155}
156
157diag "cascaded LEFT JOIN optimization" if $ENV{'TEST_VERBOSE'};
158{
159    $users_obj->CleanSlate;
160    is_deeply( $users_obj, $clean_obj, 'after CleanSlate looks like new object');
161    ok( !$users_obj->_isJoined, "new object isn't joined");
162    my $alias = $users_obj->Join(
163        TYPE   => 'LEFT',
164        FIELD1 => 'id',
165        TABLE2 => 'UsersToGroups',
166        FIELD2 => 'UserId'
167    );
168    ok( $alias, "Join returns alias" );
169    $alias = $users_obj->Join(
170        TYPE   => 'LEFT',
171        ALIAS1 => $alias,
172        FIELD1 => 'GroupId',
173        TABLE2 => 'Groups',
174        FIELD2 => 'id'
175    );
176    $users_obj->Limit( ALIAS => $alias, FIELD => 'id', OPERATOR => 'IS NOT', VALUE => 'NULL' );
177    ok( $users_obj->BuildSelectQuery !~ /LEFT JOIN/, 'both LJs are optimized away');
178    is( $users_obj->Count, 3, "users whos is memebers of at least one group" );
179}
180
181diag "LEFT JOIN optimization and OR clause" if $ENV{'TEST_VERBOSE'};
182{
183    $users_obj->CleanSlate;
184    is_deeply( $users_obj, $clean_obj, 'after CleanSlate looks like new object');
185    ok( !$users_obj->_isJoined, "new object isn't joined");
186    my $alias = $users_obj->Join(
187        TYPE   => 'LEFT',
188        FIELD1 => 'id',
189        TABLE2 => 'UsersToGroups',
190        FIELD2 => 'UserId'
191    );
192    $users_obj->_OpenParen('my_clause');
193    $users_obj->Limit(
194        SUBCLAUSE => 'my_clause',
195        ALIAS => $alias,
196        FIELD => 'id',
197        OPERATOR => 'IS NOT',
198        VALUE => 'NULL'
199    );
200    $users_obj->Limit(
201        SUBCLAUSE => 'my_clause',
202        ENTRY_AGGREGATOR => 'OR',
203        FIELD => 'id',
204        VALUE => 3
205    );
206    $users_obj->_CloseParen('my_clause');
207    ok( $users_obj->BuildSelectQuery =~ /LEFT JOIN/, 'LJ is not optimized away');
208    is( $users_obj->Count, 4, "all users" );
209}
210
211diag "DISTINCT in Join" if $ENV{'TEST_VERBOSE'};
212{
213    $users_obj->CleanSlate;
214    is_deeply( $users_obj, $clean_obj, 'after CleanSlate looks like new object');
215    ok( !$users_obj->_isJoined, "new object isn't joined");
216    my $alias = $users_obj->Join(
217        FIELD1 => 'id',
218        TABLE2 => 'UsersToGroups',
219        FIELD2 => 'UserId',
220        DISTINCT => 1,
221    );
222    $users_obj->Limit(
223        ALIAS => $alias,
224        FIELD => 'GroupId',
225        VALUE => 1,
226    );
227    ok( $users_obj->BuildSelectQuery !~ /DISTINCT|GROUP\s+BY/i, 'no distinct in SQL');
228    is_deeply(
229        [ sort map $_->Login, @{$users_obj->ItemsArrayRef} ],
230        [ 'aurelia', 'ivan', 'john' ],
231        "members of dev group"
232    );
233}
234
235diag "DISTINCT in NewAlias" if $ENV{'TEST_VERBOSE'};
236{
237    $users_obj->CleanSlate;
238    is_deeply( $users_obj, $clean_obj, 'after CleanSlate looks like new object');
239    ok( !$users_obj->_isJoined, "new object isn't joined");
240    my $alias = $users_obj->NewAlias('UsersToGroups', DISTINCT => 1);
241    $users_obj->Join(
242        FIELD1 => 'id',
243        ALIAS2 => $alias,
244        FIELD2 => 'UserId',
245    );
246    $users_obj->Limit(
247        ALIAS => $alias,
248        FIELD => 'GroupId',
249        VALUE => 1,
250    );
251    ok( $users_obj->BuildSelectQuery !~ /DISTINCT|GROUP\s+BY/i, 'no distinct in SQL');
252    is_deeply(
253        [ sort map $_->Login, @{$users_obj->ItemsArrayRef} ],
254        [ 'aurelia', 'ivan', 'john' ],
255        "members of dev group"
256    );
257}
258
259diag "mixing DISTINCT" if $ENV{'TEST_VERBOSE'};
260{
261    $users_obj->CleanSlate;
262    is_deeply( $users_obj, $clean_obj, 'after CleanSlate looks like new object');
263    ok( !$users_obj->_isJoined, "new object isn't joined");
264    my $u2g_alias = $users_obj->Join(
265        FIELD1 => 'id',
266        TABLE2 => 'UsersToGroups',
267        FIELD2 => 'UserId',
268        DISTINCT => 0,
269    );
270    my $g_alias = $users_obj->Join(
271        ALIAS1 => $u2g_alias,
272        FIELD1 => 'GroupId',
273        TABLE2 => 'Groups',
274        FIELD2 => 'id',
275        DISTINCT => 1,
276    );
277
278    $users_obj->Limit(
279        ALIAS => $g_alias,
280        FIELD => 'Name',
281        VALUE => 'Developers',
282    );
283    $users_obj->Limit(
284        ALIAS => $g_alias,
285        FIELD => 'Name',
286        VALUE => 'Sales',
287    );
288    ok( $users_obj->BuildSelectQuery =~ /DISTINCT|GROUP\s+BY/i, 'distinct in SQL');
289    is_deeply(
290        [ sort map $_->Login, @{$users_obj->ItemsArrayRef} ],
291        [ 'aurelia', 'ivan', 'john' ],
292        "members of dev group"
293    );
294}
295
296    cleanup_schema( 'TestApp', $handle );
297
298}} # SKIP, foreach blocks
299
3001;
301
302
303package TestApp;
304sub schema_sqlite {
305[
306q{
307CREATE TABLE Users (
308    id integer primary key,
309    Login varchar(36)
310) },
311q{
312CREATE TABLE UsersToGroups (
313    id integer primary key,
314    UserId  integer,
315    GroupId integer
316) },
317q{
318CREATE TABLE Groups (
319    id integer primary key,
320    Name varchar(36)
321) },
322]
323}
324
325sub schema_mysql {
326[
327q{
328CREATE TEMPORARY TABLE Users (
329    id integer primary key AUTO_INCREMENT,
330    Login varchar(36)
331) },
332q{
333CREATE TEMPORARY TABLE UsersToGroups (
334    id integer primary key AUTO_INCREMENT,
335    UserId  integer,
336    GroupId integer
337) },
338q{
339CREATE TEMPORARY TABLE Groups (
340    id integer primary key AUTO_INCREMENT,
341    Name varchar(36)
342) },
343]
344}
345
346sub schema_pg {
347[
348q{
349CREATE TEMPORARY TABLE Users (
350    id serial primary key,
351    Login varchar(36)
352) },
353q{
354CREATE TEMPORARY TABLE UsersToGroups (
355    id serial primary key,
356    UserId integer,
357    GroupId integer
358) },
359q{
360CREATE TEMPORARY TABLE Groups (
361    id serial primary key,
362    Name varchar(36)
363) },
364]
365}
366
367sub schema_oracle { [
368    "CREATE SEQUENCE Users_seq",
369    "CREATE TABLE Users (
370        id integer CONSTRAINT Users_Key PRIMARY KEY,
371        Login varchar(36)
372    )",
373    "CREATE SEQUENCE UsersToGroups_seq",
374    "CREATE TABLE UsersToGroups (
375        id integer CONSTRAINT UsersToGroups_Key PRIMARY KEY,
376        UserId integer,
377        GroupId integer
378    )",
379    "CREATE SEQUENCE Groups_seq",
380    "CREATE TABLE Groups (
381        id integer CONSTRAINT Groups_Key PRIMARY KEY,
382        Name varchar(36)
383    )",
384] }
385
386sub cleanup_schema_oracle { [
387    "DROP SEQUENCE Users_seq",
388    "DROP TABLE Users",
389    "DROP SEQUENCE Groups_seq",
390    "DROP TABLE Groups",
391    "DROP SEQUENCE UsersToGroups_seq",
392    "DROP TABLE UsersToGroups",
393] }
394
395package TestApp::User;
396
397use base $ENV{SB_TEST_CACHABLE}?
398    qw/DBIx::SearchBuilder::Record::Cachable/:
399    qw/DBIx::SearchBuilder::Record/;
400
401sub _Init {
402    my $self = shift;
403    my $handle = shift;
404    $self->Table('Users');
405    $self->_Handle($handle);
406}
407
408sub _ClassAccessible {
409    {
410
411        id =>
412        {read => 1, type => 'int(11)'},
413        Login =>
414        {read => 1, write => 1, type => 'varchar(36)'},
415
416    }
417}
418
419sub init_data {
420    return (
421    [ 'Login' ],
422
423    [ 'ivan' ],
424    [ 'john' ],
425    [ 'bob' ],
426    [ 'aurelia' ],
427    );
428}
429
430package TestApp::Users;
431
432use base qw/DBIx::SearchBuilder/;
433
434sub _Init {
435    my $self = shift;
436    $self->SUPER::_Init( Handle => shift );
437    $self->Table('Users');
438}
439
440sub NewItem
441{
442    my $self = shift;
443    return TestApp::User->new( $self->_Handle );
444}
445
4461;
447
448package TestApp::Group;
449
450use base $ENV{SB_TEST_CACHABLE}?
451    qw/DBIx::SearchBuilder::Record::Cachable/:
452    qw/DBIx::SearchBuilder::Record/;
453
454sub _Init {
455    my $self = shift;
456    my $handle = shift;
457    $self->Table('Groups');
458    $self->_Handle($handle);
459}
460
461sub _ClassAccessible {
462    {
463        id =>
464        {read => 1, type => 'int(11)'},
465        Name =>
466        {read => 1, write => 1, type => 'varchar(36)'},
467    }
468}
469
470sub init_data {
471    return (
472    [ 'Name' ],
473
474    [ 'Developers' ],
475    [ 'Sales' ],
476    [ 'Support' ],
477    );
478}
479
480package TestApp::Groups;
481
482use base qw/DBIx::SearchBuilder/;
483
484sub _Init {
485    my $self = shift;
486    $self->SUPER::_Init( Handle => shift );
487    $self->Table('Groups');
488}
489
490sub NewItem { return TestApp::Group->new( (shift)->_Handle ) }
491
4921;
493
494package TestApp::UsersToGroup;
495
496use base $ENV{SB_TEST_CACHABLE}?
497    qw/DBIx::SearchBuilder::Record::Cachable/:
498    qw/DBIx::SearchBuilder::Record/;
499
500sub _Init {
501    my $self = shift;
502    my $handle = shift;
503    $self->Table('UsersToGroups');
504    $self->_Handle($handle);
505}
506
507sub _ClassAccessible {
508    {
509
510        id =>
511        {read => 1, type => 'int(11)'},
512        UserId =>
513        {read => 1, type => 'int(11)'},
514        GroupId =>
515        {read => 1, type => 'int(11)'},
516    }
517}
518
519sub init_data {
520    return (
521    [ 'GroupId',    'UserId' ],
522# dev group
523    [ 1,        1 ],
524    [ 1,        2 ],
525    [ 1,        4 ],
526# sales
527#    [ 2,        0 ],
528# support
529    [ 3,        1 ],
530    );
531}
532
533package TestApp::UsersToGroups;
534
535use base qw/DBIx::SearchBuilder/;
536
537sub _Init {
538    my $self = shift;
539    $self->Table('UsersToGroups');
540    return $self->SUPER::_Init( Handle => shift );
541}
542
543sub NewItem { return TestApp::UsersToGroup->new( (shift)->_Handle ) }
544
5451;
546