root/branches/release-40/t/driver-tests.pl @ 2572

Revision 2572, 28.6 kB (checked in by mpaschal, 18 months ago)

Move existing group_by tests into a package
Rewrite sum_group_by test to explicitly check full state of the iterator

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
Line 
1#!/usr/bin/perl
2
3# Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd.
4# This program is distributed under the terms of the
5# GNU General Public License, version 2.
6#
7# $Id$
8
9use strict;
10use warnings;
11use Data::Dumper;
12use English qw( -no_match_vars );
13
14$OUTPUT_AUTOFLUSH = 1;
15
16# Run this script as a symlink, in the form of 99-driver.t, ie:
17# ln -s driver-tests.pl 99-driver.t
18
19BEGIN {
20    # Set config to driver-test.cfg when run as /path/to/99-driver.t
21    $ENV{MT_CONFIG} = "$1-test.cfg"
22        if __FILE__ =~ m{ [\\/] \d+- ([^\\/]+) \.t \z }xms;
23}
24
25use Test::More;
26use Test::Deep;
27use lib 't/lib';
28
29BEGIN {
30    plan skip_all => "Configuration file $ENV{MT_CONFIG} not found"
31        if !-r "t/$ENV{MT_CONFIG}";
32}
33
34use MT::Test qw(:testdb :time);
35
36
37package Zot;
38use base 'MT::Object';
39__PACKAGE__->install_properties({
40    column_defs => {
41        'id' => 'integer not null auto_increment',
42        'x' => 'string(255)',
43    },
44    primary_key => 'id',
45    datasource => 'zot',
46});
47
48
49package Test::GroupBy;
50use base qw( Test::Class MT::Test );
51use Test::More;
52use POSIX qw(strftime);
53
54sub reset_db : Test(setup) {
55    my $self = shift;
56    $self->clean_db();
57
58    my @obj_data = (
59        { class => 'Foo',
60          id => 1,
61          name => 'foo',
62          text => 'bar',
63          status => 2, },
64        { class => 'Foo',
65          id => 2,
66          name => 'baz',
67          text => 'quux',
68          status => 1, },
69        { class => 'Bar',
70          id => 1,
71          foo_id => 2,
72          name => 'bar0',
73          status => 0, },
74        { class => 'Bar',
75          id => 2,
76          foo_id => 2,
77          name => 'bar1',
78          status => 1, },
79        { class => 'Bar',
80          id => 3,
81          foo_id => 1,
82          name => 'bar2',
83          status => 0, },
84    );
85
86    for my $data (@obj_data) {
87        my $class = delete $data->{class};
88        my $obj = $class->new;
89        $obj->set_values($data);
90        $obj->save();
91    }
92}
93
94sub count_group_by : Tests(26) {
95    # legacy way of specifying sort direction
96    my $cgb_iter = Bar->count_group_by({
97            status => '0',
98        }, {
99            group => [ 'foo_id' ],
100            sort => 'foo_id desc',
101        });
102    my ($count, $bfid, $month);
103    isa_ok($cgb_iter, 'CODE');
104    ok(($count, $bfid) = $cgb_iter->(), 'set');
105    is($bfid, 2, 'id');
106    is($count, 1, 'count4');
107    ok(($count, $bfid) = $cgb_iter->(), 'set');
108    is($bfid, 1, 'id');
109    is($count, 1, 'count5');
110    ok(!$cgb_iter->(), 'no $iter');
111
112    # new way of specifying sort direction
113    my $cgb_iter2 = Bar->count_group_by({
114            status => '0',
115        }, {
116            group => [ 'foo_id' ],
117            sort => 'foo_id',
118            direction => 'descend'
119        });
120
121    isa_ok($cgb_iter2, 'CODE');
122    ok(($count, $bfid) = $cgb_iter2->(), 'set');
123    is($bfid, 2, 'id');
124    is($count, 1, 'count4');
125    ok(($count, $bfid) = $cgb_iter2->(), 'set');
126    is($bfid, 1, 'id');
127    is($count, 1, 'count5');
128    ok(!$cgb_iter2->(), 'no $iter');
129
130    # legacy way of specifying sort direction
131    my $cgb_iter3 = Bar->count_group_by(undef, {
132            group => [ 'extract(month from created_on)' ],
133            sort => 'extract(month from created_on) desc',
134        });
135    isa_ok($cgb_iter3, 'CODE');
136    ok(($count, $month) = $cgb_iter3->(), 'set');
137    is(int($month), int(strftime("%m", localtime)), 'month');
138    is($count, 3, 'count6');
139    ok(!$cgb_iter3->(), 'no $iter');
140
141    # new way of specifying sort direction
142    my $cgb_iter4 = Bar->count_group_by(undef, {
143            group => [ 'extract(month from created_on)' ],
144            sort => [{ column => 'extract(month from created_on)',
145                desc => 'desc' }]
146        });
147    isa_ok($cgb_iter4, 'CODE');
148    ok(($count, $month) = $cgb_iter4->(), 'set');
149    is(int($month), int(strftime("%m", localtime)), 'month');
150    is($count, 3, 'count6');
151    ok(!$cgb_iter4->(), 'no $iter');
152}
153
154sub sum_group_by : Tests(7) {
155    # Sum status values across groups of ids (that is, a group for each Foo).
156    my $sgb = Foo->sum_group_by(undef, {
157        sum       => 'status',
158        group     => ['id'],
159        direction => 'ascend',
160    });
161
162    my ($status, $id) = $sgb->();
163    ok($status && $id, 'sum_group_by results had a first result');
164    is($status, 1, q{sum_group_by result #1's status is 1});
165    is($id, 2, 'sum_group_by result #1 was for Foo #2');
166   
167    ($status, $id) = $sgb->();
168    ok($status && $id, 'sum_group_by results had a second result');
169    is($status, 2, q{sum_group_by result #2's status is 2});
170    is($id, 1, 'sum-group_by result #2 was for Foo #1');
171   
172    ($status, $id) = $sgb->();
173    ok(!$status, 'sum_group_by only had two results');
174}
175
176sub clean_db : Test(teardown) {
177    for my $class (qw( Foo Bar )) {
178        my $driver    = $class->dbi_driver;
179        my $dbh       = $driver->rw_handle;
180        my $ddl_class = $driver->dbd->ddl_class;
181       
182        $dbh->do($ddl_class->drop_table_sql($class)) or die $dbh->errstr;
183        $dbh->do($ddl_class->create_table_sql($class)) or die $dbh->errstr;
184        $dbh->do($_) or die $dbh->errstr for $ddl_class->index_table_sql($class);
185        $ddl_class->create_sequence($class);  # may do nothing
186    }
187}
188
189package main;
190
191Test::GroupBy->runtests( +152 );
192
193my($foo, @foo, @bar);
194my($tmp, @tmp);
195
196# Test for existing table
197ok(MT::Object->driver->dbd->ddl_class->column_defs('Foo'), "table mt_foo exists after upgrade");
198# Test for non-existent table
199ok(!MT::Object->driver->dbd->ddl_class->column_defs('Zot'), "table mt_zot does not exist after upgrade where undefined");
200
201## Test creating object with new
202##     test column access through column, then through AUTOLOAD
203$foo = Foo->new;
204isa_ok($foo, 'Foo', 'New Foo could be created');
205$foo->column('name', 'foo');
206is($foo->column('name'), 'foo', 'Setting name field with column() persists through access');
207$foo->name('foo');
208is($foo->name, 'foo', 'Setting name field with mutator method persists through access');
209$foo->status(2);
210$foo->text('bar');
211
212## Test saving created object
213ok($foo->save, 'A Foo could be saved');
214is($foo->id, 1, 'First Foo was given an id of 1, says accessor method');
215is($foo->column('id'), 1, 'First Foo was given an id of 1, says column()');
216
217sub _is_object {
218    my ($got, $expected, $name) = @_;
219
220    if (!defined $got) {
221        fail($name);
222        diag('    got undef, not an object');
223        return;
224    }
225
226    if (!$got->isa(ref $expected)) {
227        fail($name);
228        diag('    got a ', ref($got), ' but expected a ', ref $expected);
229        return;
230    }
231
232    if ($got == $expected) {
233        fail($name);
234        diag('    got the exact same instance as expected, when really expected a different but equivalent object');
235        return;
236    }
237
238    # Ignore object columns that have undefined values.
239    my (%got_values, %expected_values);
240    while (my ($field, $value) = each %{ $got->{column_values} }) {
241        $got_values{$field} = $value if defined $value;
242    }
243    while (my ($field, $value) = each %{ $expected->{column_values} }) {
244        $expected_values{$field} = $value if defined $value;
245    }
246
247    if (!eq_deeply(\%got_values, \%expected_values)) {
248        # 'Test' again so the helpful failure diagnostics are output.
249        is_deeply(\%got_values, \%expected_values, $name);
250        return;
251    }
252
253    return 1;
254}
255
256sub is_object {
257    my ($got, $expected, $name) = @_;
258    pass($name) if _is_object(@_);
259}
260
261sub are_objects {
262    my ($got, $expected, $name) = @_;
263
264    my $count = scalar @$expected;
265    if ($count != scalar @$got) {
266        fail($name);
267        diag('    got ', scalar(@$got), ' objects but expected ', $count);
268        return;
269    }
270
271    for my $i (0..$count-1) {
272        return if !_is_object($$got[$i], $$expected[$i], "$name (#$i)");
273    }
274    pass($name);
275}
276
277is_object(scalar Foo->load(1), $foo, 'Foo #1 by id is Foo #1');
278is_object(scalar Foo->load({ id => 1 }), $foo, 'Foo #1 by id hash is Foo #1');
279is_object(scalar Foo->load({ id => 1, name => 'foo' }), $foo, 'Foo #1 by id-name hash is Foo #1');
280is_object(scalar Foo->load({ name => 'foo' }), $foo, 'Foo #1 by name hash is Foo #1');
281is_object(scalar Foo->load({ created_on => $foo->created_on }), $foo, 'Foo #1 by created_on hash is Foo #1');
282is_object(scalar Foo->load({ status => 2 }), $foo, 'Foo #1 by status hash is Foo #1');
283
284##     Change column value, save, try to load using old value (fail?),
285##     then load again using new value
286$foo->status(0);
287ok($foo->save, 'Foo #1 saved with new status (0)');
288$tmp = Foo->load({ status => 2 });
289ok(!$tmp, 'Foo #1 no longer loads with old status (2)');
290$tmp = Foo->load({ status => 0 });
291is_object($tmp, $foo, 'Foo #1 by new status (0) is Foo #1');
292
293## Create a new object so we can do range and last/first lookups.
294## Sleep first so that they get different created_on timestamps.
295sleep(3);
296
297## Create new object for iterator testing
298$foo[0] = $foo;
299$foo[1] = Foo->new;
300$foo[1]->name('baz');
301$foo[1]->text('quux');
302$foo[1]->status(1);
303$foo[1]->save;
304
305## TEST LOADING IN VARIOUS WAYS
306
307## Load all objects via iterator
308my $iter = Foo->load_iter(undef, { sort => 'created_on', direction => 'ascend' });
309isa_ok($iter, 'CODE', "Iterator for all Foos");
310ok($tmp = $iter->(), 'Iterator for our two Foos had one object');
311is_object($tmp, $foo[0], "All Foo iterator's first Foo is Foo #1");
312ok($tmp = $iter->(), 'Iterator for our two Foos had two objects');
313is_object($tmp, $foo[1], "All Foo iterator's second Foo is Foo #2");
314ok(!$iter->(), 'Iterator for our two Foos did not have a third object');
315
316## Load all objects with status == 1 via iterator
317$iter = Foo->load_iter({ status => 1 });
318isa_ok($iter, 'CODE', "Iterator for status=1 Foos");
319ok($tmp = $iter->(), 'Iterator for our status=1 Foos had one object');
320is_object($tmp, $foo[1], "Status=1 Foo iterator's first Foo is Foo #2");
321ok(!$iter->(), "Iterator for our status=1 Foos did not have a second object");
322
323## Load using non-existent ID (should fail)
324$tmp = Foo->load(3);
325ok(!$tmp, 'There is no Foo #3');
326
327## Load using descending sort (newest)
328$tmp = Foo->load(undef, {
329    sort => 'created_on',
330    direction => 'descend',
331    limit => 1 });
332is_object($tmp, $foo[1], 'Newest Foo is Foo #2');
333
334## Load using ascending sort (oldest)
335$tmp = Foo->load(undef, {
336    sort => 'created_on',
337    direction => 'ascend',
338    limit => 1 });
339is_object($tmp, $foo[0], 'Oldest Foo is Foo #1');
340
341## Load using descending sort with limit = 2
342@tmp = Foo->load(undef, {
343    sort => 'created_on',
344    direction => 'descend',
345    limit => 2 });
346are_objects(\@tmp, [ reverse @foo ], 'Two Foos newest-first load() finds Foos #2 and #1');
347
348## Load using descending sort by created_on, no limit
349@tmp = Foo->load(undef, {
350    sort => 'created_on',
351    direction => 'descend' });
352are_objects(\@tmp, [ reverse @foo ], 'All Foos newest-first load() finds Foos #2 and #1');
353
354## Load using ascending sort by status, no limit
355@tmp = Foo->load(undef, { sort => 'status', });
356are_objects(\@tmp, \@foo, 'All Foos lowest-status-first load() finds Foos #1 and #2');
357
358## Load using 'last' where status == 0
359$tmp = Foo->load({ status => 0 }, {
360    sort => 'created_on',
361    direction => 'descend',
362    limit => 1 });
363is_object($tmp, $foo[0], 'Newest status=0 Foo is Foo #1');
364
365## Load using range search, one less than foo[1]->created_on and newer
366$tmp = Foo->load(
367    { created_on => [ $foo[1]->column('created_on')-1 ] },
368    { range => { created_on => 1 } });
369is_object($tmp, $foo[1], 'Foo from open-ended date range before Foo #2 is Foo #2');
370
371## Load using EXCLUSIVE range search, up through the momment $foo[1] created
372$tmp = Foo->load(
373    { created_on => [ $foo[1]->column('created_on')-1, 
374                      $foo[1]->column('created_on') ] },
375    { range => { created_on => 1 } });
376ok(!$tmp, "Exclusive date range load() ending at Foo #1's date found no Foos");
377
378$tmp = Foo->load(
379    { created_on => [ $foo[1]->column('created_on'), 
380                      $foo[1]->column('created_on')+1 ] },
381    { range => { created_on => 1 } });
382ok(!$tmp, "Exclusive date range load() starting at Foo #1's date found no Foos");
383
384## Load using INCLUSIVE range search, up through the momment $foo[1] created
385$tmp = Foo->load(
386    { created_on => [ $foo[1]->column('created_on')-1, 
387                      $foo[1]->column('created_on') ] },
388    { range_incl => { created_on => 1 } });
389ok($tmp, 'Loaded an object based on range_incl (ts-1 to ts)');
390is_object($tmp, $foo[1], "Foo from inclusive date-range load() ending at Foo #1's date is Foo #2");
391
392$tmp = Foo->load(
393    { created_on => [ $foo[1]->column('created_on'), 
394                      $foo[1]->column('created_on')+1 ] },
395    { range_incl => { created_on => 1 } });
396ok($tmp, 'Loaded an object based on range_incl (ts to ts+1)');
397is_object($tmp, $foo[1], "Foo from inclusive date-range load() starting at Foo #1's date is Foo #2");
398
399## Check that range searches return nothing when nothing is in the range.
400$tmp = Foo->load( { created_on => [ undef, '19690101000000' ] },
401                  { range => { created_on => 1 } });
402ok(!$tmp, 'Prehistoric date range load() found no Foos');
403
404## Range search, all items with created_on less than foo[1]->created_on
405$tmp = Foo->load(
406    { created_on => [ undef, $foo[1]->column('created_on')-1 ] },
407    { range => { created_on => 1 } });
408is_object($tmp, $foo[0], "Foo from exclusive open-started date-range load() ending before Foo #1 is Foo #1");
409
410## Get count of objects
411is(Foo->count(), 2, 'Count of all Foos finds both');
412is(Foo->count({ status => 0 }), 1, 'Count of all status=0 Foos finds all one');
413my $ranged_count = Foo->count(
414    { created_on => [ $foo[1]->column('created_on')-1 ] },
415    { range => { created_on => 1 } }
416);
417is($ranged_count, 1, 'Count of all Foos in open-ended date range starting before Foo #1 finds all one');
418
419## Update status for later tests.
420$foo[0]->status(2);
421$foo[0]->save;
422
423## Test start_val loads.
424## Given the first Foo object, should load the "next" one
425## (the one with a larger created_on time)
426$tmp = Foo->load(undef, {
427    limit => 1,
428    sort => 'created_on',
429    direction => 'ascend',
430    start_val => $foo[0]->created_on });
431is_object($tmp, $foo[1], 'Next newer Foo after Foo #1 is Foo #2');
432
433## Given the first Foo object, try to load the "previous" one
434## (the one with a smaller created_on time). This should fail.
435$tmp = Foo->load(undef, {
436    limit => 1,
437    sort => 'created_on',
438    direction => 'descend',
439    start_val => $foo[0]->created_on });
440ok(!$tmp, 'Search for next older Foo before Foo #1 found none');
441
442## Given the second Foo object, try to load the "previous" one
443## (the one with a smaller created_on time). This should work.
444$tmp = Foo->load(undef, {
445    limit => 1,
446    sort => 'created_on',
447    direction => 'descend',
448    start_val => $foo[1]->created_on });
449is_object($tmp, $foo[0], 'Next older Foo before Foo #2 is Foo #1');
450
451## Given the second Foo object, try to load the "next" one
452## (the one with a larger created_on time). This should fail.
453$tmp = Foo->load(undef, {
454    limit => 1,
455    sort => 'created_on',
456    direction => 'ascend',
457    start_val => $foo[1]->created_on });
458ok(!$tmp, 'Search for next newer Foo after Foo #2 found none');
459
460## Now, given the second Foo object's created_on - 1, try to
461## load the "previous" one. This should work.
462$tmp = Foo->load(undef, {
463    limit => 1,
464    sort => 'created_on',
465    direction => 'descend',
466    start_val => $foo[1]->created_on-1 });
467is_object($tmp, $foo[0], 'Next older Foo before just before Foo #2 is Foo #1');
468
469## Now, given the second Foo object's created_on - 1, try to
470## load the "next" one. This should work.
471$tmp = Foo->load(undef, {
472    limit => 1,
473    sort => 'created_on',
474    direction => 'ascend',
475    start_val => $foo[1]->created_on-1 });
476is_object($tmp, $foo[1], 'Next newer Foo after just before Foo #2 is Foo #2');
477
478## Override created_on timestamp, make sure it works
479my $ts = substr($foo[1]->created_on, 0, -4) . '0000';
480$foo[1]->created_on($ts);
481$foo[1]->save;
482
483@tmp = Foo->load(undef, {
484    sort => 'created_on',
485    direction => 'descend',
486    limit => 2 });
487are_objects(\@tmp, \@foo, 'Time-traveled Foos newest-first are Foos #1 and #2');
488
489## Test limit of 2 with direction descend, but without
490## a sort option. This should sort by the most recently-added
491## records, ie. sorted by ID, basically.
492@tmp = Foo->load(undef, {
493    direction => 'descend',
494    limit => 2 });
495are_objects(\@tmp, [ reverse @foo ], 'Foos highest-id-first are Foos #2 and #1');
496
497## Test loading using offset.
498## Should load the second Foo object.
499$tmp = Foo->load(undef, {
500    direction => 'descend',
501    sort => 'created_on',
502    limit => 1,
503    offset => 1 });
504is_object($tmp, $foo[1], 'Second newest Foo is Foo #2');
505
506## We only have 2 Foo objects, so this should load
507## only the second Foo object (because offset is 1).
508@tmp = Foo->load(undef, {
509    direction => 'descend',
510    sort => 'created_on',
511    limit => 2,
512    offset => 1 });
513are_objects(\@tmp, [ $foo[1] ], 'Second and third newest Foos is just Foo #2');
514
515## Should load the first Foo object (ascend with offset of 1).
516$tmp = Foo->load(undef, {
517    direction => 'ascend',
518    sort => 'created_on',
519    limit => 1,
520    offset => 1 });
521is_object($tmp, $foo[0], 'Second oldest Foo is Foo #1');
522
523## Now test join loads.
524## First we need to create a couple of Bar objects.
525$bar[0] = Bar->new;
526$bar[0]->foo_id($foo[1]->id);
527$bar[0]->name('bar0');
528$bar[0]->status(0);
529ok($bar[0]->save, 'saved');
530sleep(2);  ## Sleep to ensure created_on timestamps are unique
531
532$bar[1] = Bar->new;
533$bar[1]->foo_id($foo[1]->id);
534$bar[1]->name('bar1');
535$bar[1]->status(1);
536ok($bar[1]->save, 'saved');
537sleep(2);  ## Sleep to ensure created_on timestamps are unique
538
539$bar[2] = Bar->new;
540$bar[2]->foo_id($foo[0]->id);
541$bar[2]->name('bar2');
542$bar[2]->status(0);
543ok($bar[2]->save, 'saved');
544sleep(2);  ## Sleep to ensure created_on timestamps are unique
545
546## Get a count of all Foo objects in order of most recently
547## created Bar object. No uniqueness requirement. This tests
548## the on_load_complete temporary table stuff with count.
549
550is(Foo->count(undef,
551    { join => [ 'Bar', 'foo_id',
552                undef,
553                { unique => 1,
554                  sort => 'created_on',
555                  direction => 'descend', } ] }), 2, 'There are 2 unique Foos associated with Bars');
556
557## Now load all Foo objects in order of most recently
558## created Bar object. Make sure they are unique.
559@tmp = Foo->load(undef,
560    { join => [ 'Bar', 'foo_id',
561                undef,
562                { sort => 'created_on',
563                  direction => 'descend',
564                  unique => 1 } ] });
565are_objects(\@tmp, \@foo, 'unique Foos associated with Bars, oldest first');
566
567## Load all Foo objects in order of most recently
568## created Bar object. No uniqueness requirement.
569@tmp = Foo->load(undef,
570    { join => [ 'Bar', 'foo_id',
571                undef,
572                { sort => 'created_on',
573                  direction => 'descend', } ] });
574are_objects(\@tmp, [ @foo, $foo[1] ], 'Foos associated with Bars, oldest first');
575
576## Load last 1 Foo object in order of most recently
577## created Bar object.
578@tmp = Foo->load(undef,
579    { join => [ 'Bar', 'foo_id',
580                undef,
581                { sort => 'created_on',
582                  direction => 'descend',
583                  unique => 1,
584                  limit => 1, } ] });
585are_objects(\@tmp, [ $foo[0] ], 'Foos associated with oldest Bar');
586
587## Load all Foo objects where Bar.name = 'bar0'
588@tmp = Foo->load(undef,
589    { join => [ 'Bar', 'foo_id',
590                { name => 'bar0' },
591                { sort => 'created_on',
592                  direction => 'descend',
593                  unique => 1, } ] });
594are_objects(\@tmp, [ $foo[1] ], 'Foos associated with Bars named bar0');
595
596## foo[1] is older than foo[0] because we overrode the timestamp,
597## so this should load foo[0]
598@tmp = Foo->load(undef,
599    { sort => 'created_on', direction => 'descend', limit => 1,
600    join => [ 'Bar', 'foo_id', { status => 0 }, { unique => 1 } ] });
601are_objects(\@tmp, [ $foo[0] ], 'One Foo associated with Bars of status=0');
602
603## This is the same join as the last one, but without the limit--so
604## we should get both Foo objects this time, in descending order.
605@tmp = Foo->load(undef,
606    { sort => 'created_on', direction => 'descend',
607      join => [ 'Bar', 'foo_id', { status => 0 }, { unique => 1 } ] });
608are_objects(\@tmp, \@foo, 'All Foos associated with Bars of status=0');
609
610## Filter join results by providing a value for 'status'; only Foo[0]
611## has a 'status' == 2, so only that record should be returned.
612@tmp = Foo->load({ status => 2 },
613    { sort => 'created_on', direction => 'descend',
614      join => [ 'Bar', 'foo_id', { status => 0 }, { unique => 1 } ] });
615are_objects(\@tmp, [ $foo[0] ], 'Foos of status=2 associated with Bars of status=0');
616
617# Join across a column.
618@tmp = Foo->load({},
619    { sort => 'created_on', direction => 'descend',
620      join => [ 'Bar', undef, { foo_id => \'= foo_id', status => 0 }, { unique => 1 } ] });
621are_objects(\@tmp, \@foo, 'Foos loaded by explicit join across columns');
622
623@tmp = Foo->load({ status => 2 },
624    { sort => 'created_on', direction => 'descend',
625      join => [ 'Bar', undef, { foo_id => \'= foo_id', status => 0 }, { unique => 1 } ] });
626are_objects(\@tmp, [ $foo[0] ], 'Foos of status=2 loaded by explicit join across columns');
627
628## TEST EXISTS METHOD
629ok($foo->exists, 'First Foo long saved exists in db');
630$tmp = Foo->new;
631ok(!$tmp->exists, 'New Foo just created does not exist in db');
632$tmp->id(5);
633ok(!$tmp->exists, 'New Foo just created with fake id does not exist in db');
634
635## Change foo[1]->status so that its value is unique (for index)
636$foo[1]->status(5);
637ok($foo[1]->save, 'saved');
638ok(Foo->load({ status => 5 }), 'loaded' );
639
640## Test remove
641ok($foo[1]->remove, 'removed');
642ok(! Foo->load(2), 'not loaded');
643ok(! Foo->load({ status => 5 }), 'not loaded');
644ok(! Foo->load({ name => $foo[1]->name }), 'not loaded');
645ok(! Foo->load({ created_on => $foo[1]->created_on }), 'not loaded');
646
647## Test methods:
648##     * properties
649my $props1 = Foo->properties;
650is($props1->{audit}, 1, 'audit');
651is(scalar keys %{ $props1->{indexes} }, 3, 'indexes');
652is($props1->{primary_key}, 'id', 'id');
653is(scalar @{ $props1->{columns} }, 9, 'columns');
654my $props2 = $foo->properties;
655is($props1, $props2, "$props1 is $props2");  ## Same address, because same hashref
656
657##     * column_names
658my $cols = $foo->column_names;
659isa_ok($cols, 'ARRAY');
660my %cols = map { $_ => 1 } @$cols;
661for (qw(id name status text data created_on created_by modified_on modified_by)) {
662    ok($cols{$_}, 'cols');
663}
664
665##     * column_values
666my $vals = $foo->column_values;
667isa_ok($vals, 'HASH');
668is($vals->{id}, $foo->id, 'id');
669is($vals->{name}, $foo->name, 'name');
670is($vals->{status}, $foo->status, 'status');
671is($vals->{text}, $foo->text, 'text');
672is($vals->{created_on}, $foo->created_on, 'created_on');
673is($vals->{created_by}, $foo->created_by, 'created_by');
674is($vals->{modified_on}, $foo->modified_on, 'modified_on');
675is($vals->{modified_by}, $foo->modified_by, 'modified_by');
676
677##     * set_values
678$vals = {
679    id => 5,
680    name => 'baz',
681    status => 7,
682    text => 'quux',
683    created_on => 13209,
684    created_by => 'bar',
685    #modified_on => 39023, modified_by auto-set modified_on in our new code.
686    modified_by => 'foo',
687};
688$foo->set_values($vals);
689for my $col (keys %$vals) {
690    is($vals->{$col}, $foo->column($col), $col);
691}
692
693##     * binary data
694
695my $binmonster = Foo->new;
696
697$vals = {
698    funky => "yes",
699    monkey => "no",
700};
701
702require MT::Serialize;
703my $srlzr = MT::Serialize->new('MT');
704$binmonster->data($srlzr->serialize(\$vals));
705my $x = $binmonster->save();
706warn 'Failed binary data test: ' . $binmonster->errstr() unless $x;
707ok($x, 'saved');
708ok($binmonster->id, 'id');
709Foo->driver->clear_cache if Foo->driver->can('clear_cache');
710my $chk = Foo->load($binmonster->id);
711if ($chk) {
712    my $chk_data = $chk->data;
713    my $chk_vals = $srlzr->unserialize($chk_data);
714    foreach (keys %$vals) {
715        is($$chk_vals->{$_}, $vals->{$_}, $_);
716    }
717} else {
718    foreach (keys %$vals) {
719        ok(0, $_);
720    }
721}
722
723##     * datasource
724is($foo->table_name, 'mt_' . $foo->datasource, 'datasource');
725
726##     * clone
727my $clone = $foo->clone_all;
728for my $col (@$cols) {
729    is($clone->column($col), $foo->column($col), $col);
730}
731
732## Sleep first so that they get different created_on timestamps.
733sleep(3);
734
735Foo->set_by_key({name => "this"});
736my $obj = Foo->load({name => "this"});
737isa_ok($obj, 'Foo');
738
739Foo->set_by_key({name => "this"}, {status => 42});
740$obj = Foo->load({name => "this"});
741is($obj && $obj->status, 42, 'status');
742
743Foo->set_by_key({name => "this"}, {status => 47});
744$obj = Foo->load({name => "this"});
745is($obj && $obj->status, 47, 'status');
746
747Foo->set_by_key({name => "this", status => 47}, {text => "spiffy"});
748$obj = Foo->load({name => "this", status => 47});
749is($obj && $obj->text, 'spiffy', 'text');
750
751sleep(3);
752
753Foo->set_by_key({name => "that"}, {text => "Once"});
754$obj = Foo->load({name => "that"});
755is($obj && $obj->text, 'Once', 'text');
756
757Foo->driver->clear_cache if Foo->driver->can('clear_cache');
758## Load use direct set of values for non-PK column
759@tmp = Foo->load({ name => [qw(foo this)] });
760@tmp = sort {$a->name cmp $b->name} @tmp;
761is(@tmp, 2, 'array length 2');
762
763is(Foo->count(), 4, 'check number of Foos');
764
765## check offsets without limits
766## Should load the third and fourth Foo objects.
767my $foo4 = Foo->load({name => "this"});
768my $foo5 = Foo->load({name => "that"});
769my $foo1 = Foo->load(undef, { 'sort' => 'created_on', 'direction' => 'ascend' });
770my @offs = Foo->load(undef, {
771    direction => 'ascend',
772    sort => 'created_on',
773    offset => 2 });
774is(@offs, 2, 'array length 2');
775isa_ok($offs[0], 'Foo');
776is($offs[0]->id, $foo4->id, 'id');
777isa_ok($offs[1], 'Foo');
778is($offs[1]->id, $foo5->id, 'id');
779
780## Should load the third and fourth Foo objects.
781@offs = Foo->load(undef, {
782    direction => 'descend',
783    sort => 'created_on',
784    offset => 1 });
785is(@offs, 3, 'array length 3');
786isa_ok($offs[0], 'Foo');
787is($offs[0]->id, $foo4->id, 'id');
788isa_ok($offs[1], 'Foo');
789is($offs[1]->id, $binmonster->id, 'id');
790isa_ok($offs[2], 'Foo');
791is($offs[2]->id, $foo1->id, 'id');
792
793# TODO: what are these even about?
794SKIP: {
795    skip(1, '$tmp[0] undefined') unless $tmp[0];
796    ok($tmp[0] && ($tmp[0]->name eq 'foo'), 'name')
797}
798SKIP: {
799    skip(1, '$tmp[1] undefined') unless $tmp[1];
800    ok($tmp[1] && ($tmp[1]->name eq 'this'), 'name');
801}
802
803# -or
804my $newdata = Foo->new;
805$newdata->status(11);
806$newdata->name('Apple');
807$newdata->text('MacBook');
808$newdata->save;
809$newdata = Foo->new;
810$newdata->status(12);
811$newdata->name('Linux');
812$newdata->text('Ubuntu');
813$newdata->save;
814$newdata = Foo->new;
815$newdata->status(13);
816$newdata->name('Microsoft');
817$newdata->text('Vista');
818$newdata->save;
819$newdata = Foo->new;
820$newdata->status(10);
821$newdata->name('Microsoft');
822$newdata->text('XP');
823$newdata->save;
824$newdata = Foo->new;
825$newdata->status(10);
826$newdata->name('Apple');
827$newdata->text('iBook');
828$newdata->save;
829
830my $count = Foo->count( [{status => 10}, -or => {name => 'Apple'}] );
831# ==> select count(*) from mt_foo where foo_status = 10 or foo_name = 'Apple'
832is($count, 3, '-or count');
833
834$count = Foo->count( [ { status => { '<=' => 20 }, name => 'Apple' }, -and_not => { status => 11 } ] );
835# ==> select count(*) from mt_foo where (foo_status <= 20 and foo_name = 'Apple') and not (foo_status = 11)
836is($count, 1, '-and_not count');
837
838$count = Foo->count( [
839    { status => 10 },
840    -or => { name => 'Apple' },
841    -or => { name => { like => '%nux' } },
842] );
843# ==> select count(*) from mt_foo where (foo_status = 10) or (foo_name = 'Apple') or (foo_name like '%nux')
844# (selects Apple+MacBook, Apple+iBook, Microsoft+XP, Linux+Ubuntu)
845is($count, 4, '-or count, 3 clauses');
846
847# alias support
848my $vista = Foo->load({name=>'Microsoft', status=>13});
849my $newbar = Bar->new;
850$newbar->foo_id($vista->id);
851$newbar->name('Silverlight');
852$newbar->status(2);
853$newbar->save;
854sleep(3);
855$newbar = Bar->new;
856$newbar->foo_id($vista->id);
857$newbar->name('IronPython');
858$newbar->status(3);
859$newbar->save;
860sleep(3);
861my $mb = Foo->load({name=>'Apple', status=>11});
862$newbar = Bar->new;
863$newbar->foo_id($mb->id);
864$newbar->name('IronRuby');
865$newbar->status(0);
866$newbar->save;
867
868# select * from foo, bar bar1, bar bar2
869# where bar1.bar_foo_id = foo_id
870# and bar2.bar_foo_id = bar1.bar_foo_id
871# and bar1.status = 2
872# and bar2.status = 3
873my @a_foos = Foo->load(
874    undef,
875    { join => [ 'Bar', undef, { foo_id => \'= foo_id', status => 2 },
876        { join => [ 'Bar', undef, { foo_id => \'= bar1.bar_foo_id', status => 3 },
877            { alias => 'bar2' } ],
878          alias => 'bar1'
879        }
880      ],
881      sort => 'created_on', direction => 'descend',
882    }
883);
884is(scalar(@a_foos), 1, 'join the same table using alias 1');
885is($a_foos[0]->id, $vista->id, 'join the same table using alias 2');
886
887@a_foos = Foo->load(
888    undef,
889    { join => [ 'Bar', undef, { foo_id => \'= foo_id', status => 2 },
890        { join => [ 'Bar', undef, { foo_id => \'= bar1.bar_foo_id', status => 0 },
891            { alias => 'bar2' } ],
892          alias => 'bar1'
893        }
894      ],
895      sort => 'created_on', direction => 'descend',
896    }
897);
898is(scalar(@a_foos), 0, 'join the same table using alias 3');
899 
900
9011;
Note: See TracBrowser for help on using the browser.