#State->has_many(cities => "City");
sub accessor_name_for {
- my ($class, $column) = @_;
- my $return = $column eq "Rain" ? "Rainfall" : $column;
- return $return;
+ my ($class, $column) = @_;
+ my $return = $column eq "Rain" ? "Rainfall" : $column;
+ return $return;
}
sub mutator_name_for {
- my ($class, $column) = @_;
- my $return = $column eq "Rain" ? "set_Rainfall" : "set_$column";
- return $return;
+ my ($class, $column) = @_;
+ my $return = $column eq "Rain" ? "set_Rainfall" : "set_$column";
+ return $return;
}
sub Snowfall { 1 }
is(State->table, 'State', 'State table()');
is(State->primary_column, 'name', 'State primary()');
is_deeply [ State->columns('Primary') ] => [qw/name/],
- 'State Primary:' . join ", ", State->columns('Primary');
+ 'State Primary:' . join ", ", State->columns('Primary');
is_deeply [ sort State->columns('Essential') ] => [qw/abbreviation name/],
- 'State Essential:' . join ", ", State->columns('Essential');
+ 'State Essential:' . join ", ", State->columns('Essential');
is_deeply [ sort State->columns('All') ] =>
- [ sort qw/name abbreviation rain snowfall capital population/ ],
- 'State All:' . join ", ", State->columns('All');
+ [ sort qw/name abbreviation rain snowfall capital population/ ],
+ 'State All:' . join ", ", State->columns('All');
is(CD->primary_column, 'artist', 'CD primary()');
is_deeply [ CD->columns('Primary') ] => [qw/artist/],
- 'CD primary:' . join ", ", CD->columns('Primary');
+ 'CD primary:' . join ", ", CD->columns('Primary');
is_deeply [ sort CD->columns('All') ] => [qw/artist length title/],
- 'CD all:' . join ", ", CD->columns('All');
+ 'CD all:' . join ", ", CD->columns('All');
is_deeply [ sort CD->columns('Essential') ] => [qw/artist/],
- 'CD essential:' . join ", ", CD->columns('Essential');
+ 'CD essential:' . join ", ", CD->columns('Essential');
ok(State->find_column('Rain'), 'find_column Rain');
ok(State->find_column('rain'), 'find_column rain');
ok(!State->find_column('HGLAGAGlAG'), '!find_column HGLAGAGlAG');
{
-
+
can_ok +State => qw/Rainfall _Rainfall_accessor set_Rainfall
- _set_Rainfall_accessor Snowfall _Snowfall_accessor set_Snowfall
- _set_Snowfall_accessor/;
-
- foreach my $method (qw/Rain _Rain_accessor rain snowfall/) {
- ok !State->can($method), "State can't $method";
+ _set_Rainfall_accessor Snowfall _Snowfall_accessor set_Snowfall
+ _set_Snowfall_accessor/;
+
+ foreach my $method (qw/Rain _Rain_accessor rain snowfall/) {
+ ok !State->can($method), "State can't $method";
}
}
{
- SKIP: {
- skip "No column objects", 1;
+ SKIP: {
+ skip "No column objects", 1;
- eval { my @grps = State->__grouper->groups_for("Huh"); };
- ok $@, "Huh not in groups";
- }
+ eval { my @grps = State->__grouper->groups_for("Huh"); };
+ ok $@, "Huh not in groups";
+ }
- my @grps = sort State->__grouper->groups_for(State->_find_columns(qw/rain capital/));
- is @grps, 2, "Rain and Capital = 2 groups";
+ my @grps = sort State->__grouper->groups_for(State->_find_columns(qw/rain capital/));
+ is @grps, 2, "Rain and Capital = 2 groups";
@grps = sort @grps; # Because the underlying API is hash-based
- is $grps[0], 'Other', " - Other";
- is $grps[1], 'Weather', " - Weather";
+ is $grps[0], 'Other', " - Other";
+ is $grps[1], 'Weather', " - Weather";
}
#{
-#
+#
# package DieTest;
# @DieTest::ISA = qw(DBIx::Class);
# DieTest->load_components(qw/CDBICompat::Retrieve Core/);
# package main;
-# local $SIG{__WARN__} = sub { };
-# eval { DieTest->retrieve(1) };
-# like $@, qr/unless primary columns are defined/, "Need primary key for retrieve";
+# local $SIG{__WARN__} = sub { };
+# eval { DieTest->retrieve(1) };
+# like $@, qr/unless primary columns are defined/, "Need primary key for retrieve";
#}
#-----------------------------------------------------------------------
}
INIT {
- use lib 't/cdbi/testlib';
- use Film;
+ use lib 't/cdbi/testlib';
+ use Film;
}
ok(Film->can('db_Main'), 'set_db()');
is(Film->__driver, "SQLite", "Driver set correctly");
{
- my $nul = eval { Film->retrieve() };
- is $nul, undef, "Can't retrieve nothing";
- like $@, qr/./, "retrieve needs parameters"; # TODO fix this...
+ my $nul = eval { Film->retrieve() };
+ is $nul, undef, "Can't retrieve nothing";
+ like $@, qr/./, "retrieve needs parameters"; # TODO fix this...
}
{
- eval { my $id = Film->id };
- like $@, qr/class method/, "Can't get id with no object";
+ eval { my $id = Film->id };
+ like $@, qr/class method/, "Can't get id with no object";
}
{
- eval { my $id = Film->title };
- #like $@, qr/class method/, "Can't get title with no object";
- ok $@, "Can't get title with no object";
+ eval { my $id = Film->title };
+ #like $@, qr/class method/, "Can't get title with no object";
+ ok $@, "Can't get title with no object";
}
eval { my $duh = Film->insert; };
is($btaste->NumExplodingSheep, 1, 'NumExplodingSheep() get');
{
- my $bt2 = Film->find_or_create(Title => 'Bad Taste');
- is $bt2->Director, $btaste->Director, "find_or_create";
- my @bt = Film->search(Title => 'Bad Taste');
- is @bt, 1, " doesn't create a new one";
+ my $bt2 = Film->find_or_create(Title => 'Bad Taste');
+ is $bt2->Director, $btaste->Director, "find_or_create";
+ my @bt = Film->search(Title => 'Bad Taste');
+ is @bt, 1, " doesn't create a new one";
}
ok my $gone = Film->find_or_create(
- {
- Title => 'Gone With The Wind',
- Director => 'Bob Baggadonuts',
- Rating => 'PG',
- NumExplodingSheep => 0
- }
- ),
- "Add Gone With The Wind";
+ {
+ Title => 'Gone With The Wind',
+ Director => 'Bob Baggadonuts',
+ Rating => 'PG',
+ NumExplodingSheep => 0
+ }
+ ),
+ "Add Gone With The Wind";
isa_ok $gone, 'Film';
ok $gone = Film->retrieve(Title => 'Gone With The Wind'),
- "Fetch it back again";
+ "Fetch it back again";
isa_ok $gone, 'Film';
# Shocking new footage found reveals bizarre Scarlet/sheep scene!
$gone->update;
{
- my @films = eval { Film->retrieve_all };
- cmp_ok(@films, '==', 2, "We have 2 films in total");
+ my @films = eval { Film->retrieve_all };
+ cmp_ok(@films, '==', 2, "We have 2 films in total");
}
# EXTRA TEST: added by mst to check a bug found by Numa
# Grab the 'Bladerunner' entry.
Film->create(
- {
- Title => 'Bladerunner',
- Director => 'Bob Ridley Scott',
- Rating => 'R'
- }
+ {
+ Title => 'Bladerunner',
+ Director => 'Bob Ridley Scott',
+ Rating => 'R'
+ }
);
my $blrunner = Film->retrieve('Bladerunner');
# Make a copy of 'Bladerunner' and create an entry of the directors cut
my $blrunner_dc = $blrunner->copy(
- {
- title => "Bladerunner: Director's Cut",
- rating => "15",
- }
+ {
+ title => "Bladerunner: Director's Cut",
+ rating => "15",
+ }
);
is(ref $blrunner_dc, 'Film', "copy() produces a film");
is($blrunner_dc->Title, "Bladerunner: Director's Cut", 'Title correct');
# Set up own SQL:
{
- Film->add_constructor(title_asc => "title LIKE ? ORDER BY title");
- Film->add_constructor(title_desc => "title LIKE ? ORDER BY title DESC");
+ Film->add_constructor(title_asc => "title LIKE ? ORDER BY title");
+ Film->add_constructor(title_desc => "title LIKE ? ORDER BY title DESC");
Film->add_constructor(title_asc_nl => q{
title LIKE ?
ORDER BY title
LIMIT 1
});
- {
- my @films = Film->title_asc("Bladerunner%");
- is @films, 2, "We have 2 Bladerunners";
- is $films[0]->Title, $blrunner->Title, "Ordered correctly";
- }
- {
- my @films = Film->title_desc("Bladerunner%");
- is @films, 2, "We have 2 Bladerunners";
- is $films[0]->Title, $blrunner_dc->Title, "Ordered correctly";
- }
- {
- my @films = Film->title_asc_nl("Bladerunner%");
- is @films, 1, "We have 2 Bladerunners";
- is $films[0]->Title, $blrunner->Title, "Ordered correctly";
- }
+ {
+ my @films = Film->title_asc("Bladerunner%");
+ is @films, 2, "We have 2 Bladerunners";
+ is $films[0]->Title, $blrunner->Title, "Ordered correctly";
+ }
+ {
+ my @films = Film->title_desc("Bladerunner%");
+ is @films, 2, "We have 2 Bladerunners";
+ is $films[0]->Title, $blrunner_dc->Title, "Ordered correctly";
+ }
+ {
+ my @films = Film->title_asc_nl("Bladerunner%");
+ is @films, 1, "We have 2 Bladerunners";
+ is $films[0]->Title, $blrunner->Title, "Ordered correctly";
+ }
}
# Multi-column search
{
- my @films = $blrunner->search (title => { -like => "Bladerunner%"}, rating => '15');
- is @films, 1, "Only one Bladerunner is a 15";
+ my @films = $blrunner->search (title => { -like => "Bladerunner%"}, rating => '15');
+ is @films, 1, "Only one Bladerunner is a 15";
}
# Inline SQL
{
- my @films = Film->retrieve_from_sql("numexplodingsheep > 0 ORDER BY title");
- is @films, 2, "Inline SQL";
- is $films[0]->id, $btaste->id, "Correct film";
- is $films[1]->id, $gone->id, "Correct film";
+ my @films = Film->retrieve_from_sql("numexplodingsheep > 0 ORDER BY title");
+ is @films, 2, "Inline SQL";
+ is $films[0]->id, $btaste->id, "Correct film";
+ is $films[1]->id, $gone->id, "Correct film";
}
# Inline SQL removes WHERE
{
- my @films =
- Film->retrieve_from_sql(" WHErE numexplodingsheep > 0 ORDER BY title");
- is @films, 2, "Inline SQL";
- is $films[0]->id, $btaste->id, "Correct film";
- is $films[1]->id, $gone->id, "Correct film";
+ my @films =
+ Film->retrieve_from_sql(" WHErE numexplodingsheep > 0 ORDER BY title");
+ is @films, 2, "Inline SQL";
+ is $films[0]->id, $btaste->id, "Correct film";
+ is $films[1]->id, $gone->id, "Correct film";
}
eval {
- my $ishtar = Film->insert({ Title => 'Ishtar', Director => 'Elaine May' });
- my $mandn =
- Film->insert({ Title => 'Mikey and Nicky', Director => 'Elaine May' });
- my $new_leaf =
- Film->insert({ Title => 'A New Leaf', Director => 'Elaine May' });
+ my $ishtar = Film->insert({ Title => 'Ishtar', Director => 'Elaine May' });
+ my $mandn =
+ Film->insert({ Title => 'Mikey and Nicky', Director => 'Elaine May' });
+ my $new_leaf =
+ Film->insert({ Title => 'A New Leaf', Director => 'Elaine May' });
#use Data::Dumper; die Dumper(Film->search( Director => 'Elaine May' ));
- cmp_ok(Film->search(Director => 'Elaine May'), '==', 3,
- "3 Films by Elaine May");
- ok(Film->retrieve('Ishtar')->delete,
- "Ishtar doesn't deserve an entry any more");
- ok(!Film->retrieve('Ishtar'), 'Ishtar no longer there');
- {
- my $deprecated = 0;
- local $SIG{__WARN__} = sub { $deprecated++ if $_[0] =~ /deprecated/ };
- ok(
- Film->delete(Director => 'Elaine May'),
- "In fact, delete all films by Elaine May"
- );
- cmp_ok(Film->search(Director => 'Elaine May'), '==',
- 0, "0 Films by Elaine May");
- is $deprecated, 0, "No deprecated warnings from compat layer";
- }
+ cmp_ok(Film->search(Director => 'Elaine May'), '==', 3,
+ "3 Films by Elaine May");
+ ok(Film->retrieve('Ishtar')->delete,
+ "Ishtar doesn't deserve an entry any more");
+ ok(!Film->retrieve('Ishtar'), 'Ishtar no longer there');
+ {
+ my $deprecated = 0;
+ local $SIG{__WARN__} = sub { $deprecated++ if $_[0] =~ /deprecated/ };
+ ok(
+ Film->delete(Director => 'Elaine May'),
+ "In fact, delete all films by Elaine May"
+ );
+ cmp_ok(Film->search(Director => 'Elaine May'), '==',
+ 0, "0 Films by Elaine May");
+ is $deprecated, 0, "No deprecated warnings from compat layer";
+ }
};
is $@, '', "No problems with deletes";
@films = Film->search ( { 'Director' => { -like => 'Bob %' } });
is(scalar @films, 3, ' search_like returns 3 films');
ok(
- eq_array(
- [ sort map { $_->id } @films ],
- [ sort map { $_->id } $blrunner_dc, $gone, $blrunner ]
- ),
- 'the correct ones'
+ eq_array(
+ [ sort map { $_->id } @films ],
+ [ sort map { $_->id } $blrunner_dc, $gone, $blrunner ]
+ ),
+ 'the correct ones'
);
# Find Ridley Scott films which don't have vomit
@films =
- Film->search(numExplodingSheep => undef, Director => 'Bob Ridley Scott');
+ Film->search(numExplodingSheep => undef, Director => 'Bob Ridley Scott');
is(scalar @films, 2, ' search where attribute is null returns 2 films');
ok(
- eq_array(
- [ sort map { $_->id } @films ],
- [ sort map { $_->id } $blrunner_dc, $blrunner ]
- ),
- 'the correct ones'
+ eq_array(
+ [ sort map { $_->id } @films ],
+ [ sort map { $_->id } $blrunner_dc, $blrunner ]
+ ),
+ 'the correct ones'
);
# Test that a disconnect doesnt harm anything.
}
SKIP: {
- skip "ActiveState perl produces additional warnings", 3
+ skip "ActiveState perl produces additional warnings", 3
if ($^O eq 'MSWin32');
- Film->autoupdate(1);
- my $btaste2 = Film->retrieve($btaste->id);
- $btaste->NumExplodingSheep(18);
- my @warnings;
- local $SIG{__WARN__} = sub { push(@warnings, @_); };
- {
-
- # unhook from live object cache, so next one is not from cache
- $btaste2->remove_from_object_index;
- my $btaste3 = Film->retrieve($btaste->id);
- is $btaste3->NumExplodingSheep, 18, "Class based AutoCommit";
- $btaste3->autoupdate(0); # obj a/c should override class a/c
- is @warnings, 0, "No warnings so far";
- $btaste3->NumExplodingSheep(13);
- }
- is @warnings, 1, "DESTROY without update warns";
- Film->autoupdate(0);
+ Film->autoupdate(1);
+ my $btaste2 = Film->retrieve($btaste->id);
+ $btaste->NumExplodingSheep(18);
+ my @warnings;
+ local $SIG{__WARN__} = sub { push(@warnings, @_); };
+ {
+
+ # unhook from live object cache, so next one is not from cache
+ $btaste2->remove_from_object_index;
+ my $btaste3 = Film->retrieve($btaste->id);
+ is $btaste3->NumExplodingSheep, 18, "Class based AutoCommit";
+ $btaste3->autoupdate(0); # obj a/c should override class a/c
+ is @warnings, 0, "No warnings so far";
+ $btaste3->NumExplodingSheep(13);
+ }
+ is @warnings, 1, "DESTROY without update warns";
+ Film->autoupdate(0);
}
{ # update unchanged object
- my $film = Film->retrieve($btaste->id);
- my $retval = $film->update;
- is $retval, -1, "Unchanged object";
+ my $film = Film->retrieve($btaste->id);
+ my $retval = $film->update;
+ is $retval, -1, "Unchanged object";
}
{ # update deleted object
- my $rt = "Royal Tenenbaums";
- my $ten = Film->insert({ title => $rt, Rating => "R" });
- $ten->rating(18);
- Film->set_sql(drt => "DELETE FROM __TABLE__ WHERE title = ?");
- Film->sql_drt->execute($rt);
- my @films = Film->search({ title => $rt });
- is @films, 0, "RT gone";
- my $retval = eval { $ten->update };
- like $@, qr/row not found/, "Update deleted object throws error";
- $ten->discard_changes;
+ my $rt = "Royal Tenenbaums";
+ my $ten = Film->insert({ title => $rt, Rating => "R" });
+ $ten->rating(18);
+ Film->set_sql(drt => "DELETE FROM __TABLE__ WHERE title = ?");
+ Film->sql_drt->execute($rt);
+ my @films = Film->search({ title => $rt });
+ is @films, 0, "RT gone";
+ my $retval = eval { $ten->update };
+ like $@, qr/row not found/, "Update deleted object throws error";
+ $ten->discard_changes;
}
{
- $btaste->autoupdate(1);
- $btaste->NumExplodingSheep(32);
- my $btaste2 = Film->retrieve($btaste->id);
- is $btaste2->NumExplodingSheep, 32, "Object based AutoCommit";
- $btaste->autoupdate(0);
+ $btaste->autoupdate(1);
+ $btaste->NumExplodingSheep(32);
+ my $btaste2 = Film->retrieve($btaste->id);
+ is $btaste2->NumExplodingSheep, 32, "Object based AutoCommit";
+ $btaste->autoupdate(0);
}
# Primary key of 0
{
- my $zero = Film->insert({ Title => 0, Rating => "U" });
- ok defined $zero, "Create 0";
- ok my $ret = Film->retrieve(0), "Retrieve 0";
- is $ret->Title, 0, "Title OK";
- is $ret->Rating, "U", "Rating OK";
+ my $zero = Film->insert({ Title => 0, Rating => "U" });
+ ok defined $zero, "Create 0";
+ ok my $ret = Film->retrieve(0), "Retrieve 0";
+ is $ret->Title, 0, "Title OK";
+ is $ret->Rating, "U", "Rating OK";
}
# Change after_update policy
SKIP: {
skip "DBIx::Class compat doesn't handle the exists stuff quite right yet", 4;
- my $bt = Film->retrieve($btaste->id);
- $bt->autoupdate(1);
-
- $bt->rating("17");
- ok !$bt->_attribute_exists('rating'), "changed column needs reloaded";
- ok $bt->_attribute_exists('title'), "but we still have the title";
-
- # Don't re-load
- $bt->add_trigger(
- after_update => sub {
- my ($self, %args) = @_;
- my $discard_columns = $args{discard_columns};
- @$discard_columns = qw/title/;
- }
- );
- $bt->rating("19");
- ok $bt->_attribute_exists('rating'), "changed column needs reloaded";
- ok !$bt->_attribute_exists('title'), "but no longer have the title";
+ my $bt = Film->retrieve($btaste->id);
+ $bt->autoupdate(1);
+
+ $bt->rating("17");
+ ok !$bt->_attribute_exists('rating'), "changed column needs reloaded";
+ ok $bt->_attribute_exists('title'), "but we still have the title";
+
+ # Don't re-load
+ $bt->add_trigger(
+ after_update => sub {
+ my ($self, %args) = @_;
+ my $discard_columns = $args{discard_columns};
+ @$discard_columns = qw/title/;
+ }
+ );
+ $bt->rating("19");
+ ok $bt->_attribute_exists('rating'), "changed column needs reloaded";
+ ok !$bt->_attribute_exists('title'), "but no longer have the title";
}
# Make sure that we can have other accessors. (Bugfix in 0.28)
if (0) {
- Film->mk_accessors(qw/temp1 temp2/);
- my $blrunner = Film->retrieve('Bladerunner');
- $blrunner->temp1("Foo");
- $blrunner->NumExplodingSheep(2);
- eval { $blrunner->update };
- ok(!$@, "Other accessors");
+ Film->mk_accessors(qw/temp1 temp2/);
+ my $blrunner = Film->retrieve('Bladerunner');
+ $blrunner->temp1("Foo");
+ $blrunner->NumExplodingSheep(2);
+ eval { $blrunner->update };
+ ok(!$@, "Other accessors");
}
# overloading
{
- is "$blrunner", "Bladerunner", "stringify";
+ is "$blrunner", "Bladerunner", "stringify";
- ok(Film->columns(Stringify => 'rating'), "Can change stringify column");
- is "$blrunner", "R", "And still stringifies correctly";
+ ok(Film->columns(Stringify => 'rating'), "Can change stringify column");
+ is "$blrunner", "R", "And still stringifies correctly";
- ok(
- Film->columns(Stringify => qw/title rating/),
- "Can have multiple stringify columns"
- );
- is "$blrunner", "Bladerunner/R", "And still stringifies correctly";
+ ok(
+ Film->columns(Stringify => qw/title rating/),
+ "Can have multiple stringify columns"
+ );
+ is "$blrunner", "Bladerunner/R", "And still stringifies correctly";
- no warnings 'once';
- local *Film::stringify_self = sub { join ":", $_[0]->title, $_[0]->rating };
- is "$blrunner", "Bladerunner:R", "Provide stringify_self()";
+ no warnings 'once';
+ local *Film::stringify_self = sub { join ":", $_[0]->title, $_[0]->rating };
+ is "$blrunner", "Bladerunner:R", "Provide stringify_self()";
}
{
- {
- ok my $byebye = DeletingFilm->insert(
- {
- Title => 'Goodbye Norma Jean',
- Rating => 'PG',
- }
- ),
- "Add a deleting Film";
-
- isa_ok $byebye, 'DeletingFilm';
- isa_ok $byebye, 'Film';
- ok(Film->retrieve('Goodbye Norma Jean'), "Fetch it back again");
- }
- my $film;
- eval { $film = Film->retrieve('Goodbye Norma Jean') };
- ok !$film, "It destroys itself";
+ {
+ ok my $byebye = DeletingFilm->insert(
+ {
+ Title => 'Goodbye Norma Jean',
+ Rating => 'PG',
+ }
+ ),
+ "Add a deleting Film";
+
+ isa_ok $byebye, 'DeletingFilm';
+ isa_ok $byebye, 'Film';
+ ok(Film->retrieve('Goodbye Norma Jean'), "Fetch it back again");
+ }
+ my $film;
+ eval { $film = Film->retrieve('Goodbye Norma Jean') };
+ ok !$film, "It destroys itself";
}
SKIP: {
skip "Caching has been removed", 5
if Film->isa("DBIx::Class::CDBICompat::NoObjectIndex");
- # my bad taste is your bad taste
- my $btaste = Film->retrieve('Bad Taste');
- my $btaste2 = Film->retrieve('Bad Taste');
- is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2),
- "Retrieving twice gives ref to same object";
-
- my ($btaste5) = Film->search(title=>'Bad Taste');
- is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste5),
- "Searching also gives ref to same object";
-
- $btaste2->remove_from_object_index;
- my $btaste3 = Film->retrieve('Bad Taste');
- isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste3),
- "Removing from object_index and retrieving again gives new object";
-
- $btaste3->clear_object_index;
- my $btaste4 = Film->retrieve('Bad Taste');
- isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste4),
- "Clearing cache and retrieving again gives new object";
+ # my bad taste is your bad taste
+ my $btaste = Film->retrieve('Bad Taste');
+ my $btaste2 = Film->retrieve('Bad Taste');
+ is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2),
+ "Retrieving twice gives ref to same object";
+
+ my ($btaste5) = Film->search(title=>'Bad Taste');
+ is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste5),
+ "Searching also gives ref to same object";
+
+ $btaste2->remove_from_object_index;
+ my $btaste3 = Film->retrieve('Bad Taste');
+ isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste3),
+ "Removing from object_index and retrieving again gives new object";
+
+ $btaste3->clear_object_index;
+ my $btaste4 = Film->retrieve('Bad Taste');
+ isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste4),
+ "Clearing cache and retrieving again gives new object";
$btaste=Film->insert({
- Title => 'Bad Taste 2',
- Director => 'Peter Jackson',
- Rating => 'R',
- NumExplodingSheep => 2,
- });
- $btaste2 = Film->retrieve('Bad Taste 2');
- is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2),
- "Creating and retrieving gives ref to same object";
+ Title => 'Bad Taste 2',
+ Director => 'Peter Jackson',
+ Rating => 'R',
+ NumExplodingSheep => 2,
+ });
+ $btaste2 = Film->retrieve('Bad Taste 2');
+ is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2),
+ "Creating and retrieving gives ref to same object";
}
ok(Film::Threat->db_Main->ping, 'subclass db_Main()');
is_deeply [ sort Film::Threat->columns ], [ sort Film->columns ],
- 'has the same columns';
+ 'has the same columns';
my $bt = Film->create_test_film;
ok my $btaste = Film::Threat->retrieve('Bad Taste'), "subclass retrieve";
}
INIT {
- use lib 't/cdbi/testlib';
- use Lazy;
+ use lib 't/cdbi/testlib';
+ use Lazy;
}
is_deeply [ Lazy->columns('Primary') ], [qw/this/], "Pri";
is_deeply [ sort Lazy->columns('All') ], [qw/eep oop opop orp that this/], "All";
{
- my @groups = Lazy->__grouper->groups_for(Lazy->find_column('this'));
- is_deeply [ sort @groups ], [sort qw/things Essential Primary/], "this (@groups)";
+ my @groups = Lazy->__grouper->groups_for(Lazy->find_column('this'));
+ is_deeply [ sort @groups ], [sort qw/things Essential Primary/], "this (@groups)";
}
{
- my @groups = Lazy->__grouper->groups_for(Lazy->find_column('that'));
- is_deeply \@groups, [qw/things/], "that (@groups)";
+ my @groups = Lazy->__grouper->groups_for(Lazy->find_column('that'));
+ is_deeply \@groups, [qw/things/], "that (@groups)";
}
Lazy->create({ this => 1, that => 2, oop => 3, opop => 4, eep => 5 });
ok(!$obj->_attribute_exists('that'), 'nor that');
{
- Lazy->columns(All => qw/this that eep orp oop opop/);
- ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
- ok !$obj->_attribute_exists('oop'), " Don't have oop";
- my $null = $obj->eep;
- ok !$obj->_attribute_exists('oop'),
- " Don't have oop - even after getting eep";
+ Lazy->columns(All => qw/this that eep orp oop opop/);
+ ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
+ ok !$obj->_attribute_exists('oop'), " Don't have oop";
+ my $null = $obj->eep;
+ ok !$obj->_attribute_exists('oop'),
+ " Don't have oop - even after getting eep";
}
# Test contructor breaking.
eval { # Need a hashref
- Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50);
+ Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50);
};
ok($@, $@);
eval { # False column
- Lazy->create({ this => 10, that => 20, theother => 30 });
+ Lazy->create({ this => 10, that => 20, theother => 30 });
};
ok($@, $@);
eval { # Multiple false columns
- Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 });
+ Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 });
};
ok($@, $@);
#local $SIG{__WARN__} = sub { };
INIT {
- use lib 't/cdbi/testlib';
- use Film;
- use Director;
+ use lib 't/cdbi/testlib';
+ use Film;
+ use Director;
}
Film->create_test_film;
ok(Film->has_a('Director' => 'Director'), "Link Director table");
ok(
- Director->create(
- {
- Name => 'Peter Jackson',
- Birthday => -300000000,
- IsInsane => 1
- }
- ),
- 'create Director'
+ Director->create(
+ {
+ Name => 'Peter Jackson',
+ Birthday => -300000000,
+ IsInsane => 1
+ }
+ ),
+ 'create Director'
);
$btaste = Film->retrieve('Bad Taste');
# Oh no! Its Peter Jacksons even twin, Skippy! Born one minute after him.
my $sj = Director->create(
- {
- Name => 'Skippy Jackson',
- Birthday => (-300000000 + 60),
- IsInsane => 1,
- }
+ {
+ Name => 'Skippy Jackson',
+ Birthday => (-300000000 + 60),
+ IsInsane => 1,
+ }
);
is($sj->id, 'Skippy Jackson', 'We have a new director');
$btaste->update;
is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
is(
- $btaste->Director->Name,
- 'Peter Jackson',
- "Didnt interfere with each other"
+ $btaste->Director->Name,
+ 'Peter Jackson',
+ "Didnt interfere with each other"
);
{ # Ensure search can take an object
- my @films = Film->search(Director => $pj);
- is @films, 1, "1 Film directed by $pj";
- is $films[0]->id, "Bad Taste", "Bad Taste";
+ my @films = Film->search(Director => $pj);
+ is @films, 1, "1 Film directed by $pj";
+ is $films[0]->id, "Bad Taste", "Bad Taste";
}
inheriting_hasa();
{
- # Skippy directs a film and Peter helps!
- $sj = Director->retrieve('Skippy Jackson');
- $pj = Director->retrieve('Peter Jackson');
+ # Skippy directs a film and Peter helps!
+ $sj = Director->retrieve('Skippy Jackson');
+ $pj = Director->retrieve('Peter Jackson');
- fail_with_bad_object($sj, $btaste);
- taste_bad($sj, $pj);
+ fail_with_bad_object($sj, $btaste);
+ taste_bad($sj, $pj);
}
sub inheriting_hasa {
- my $btaste = YA::Film->retrieve('Bad Taste');
- is(ref($btaste->Director), 'Director', 'inheriting has_a()');
- is(ref($btaste->CoDirector), 'Director', 'inheriting has_a()');
- is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
+ my $btaste = YA::Film->retrieve('Bad Taste');
+ is(ref($btaste->Director), 'Director', 'inheriting has_a()');
+ is(ref($btaste->CoDirector), 'Director', 'inheriting has_a()');
+ is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
}
sub taste_bad {
- my ($dir, $codir) = @_;
- my $tastes_bad = YA::Film->create(
- {
- Title => 'Tastes Bad',
- Director => $dir,
- CoDirector => $codir,
- Rating => 'R',
- NumExplodingSheep => 23
- }
- );
- is($tastes_bad->_Director_accessor, 'Skippy Jackson', 'Director_accessor');
- is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
- is($tastes_bad->CoDirector->Name, 'Peter Jackson', 'CoDirector');
- is(
- $tastes_bad->_CoDirector_accessor,
- 'Peter Jackson',
- 'CoDirector_accessor'
- );
+ my ($dir, $codir) = @_;
+ my $tastes_bad = YA::Film->create(
+ {
+ Title => 'Tastes Bad',
+ Director => $dir,
+ CoDirector => $codir,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ }
+ );
+ is($tastes_bad->_Director_accessor, 'Skippy Jackson', 'Director_accessor');
+ is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
+ is($tastes_bad->CoDirector->Name, 'Peter Jackson', 'CoDirector');
+ is(
+ $tastes_bad->_CoDirector_accessor,
+ 'Peter Jackson',
+ 'CoDirector_accessor'
+ );
}
sub fail_with_bad_object {
- my ($dir, $codir) = @_;
- eval {
- YA::Film->create(
- {
- Title => 'Tastes Bad',
- Director => $dir,
- CoDirector => $codir,
- Rating => 'R',
- NumExplodingSheep => 23
- }
- );
- };
- ok $@, $@;
+ my ($dir, $codir) = @_;
+ eval {
+ YA::Film->create(
+ {
+ Title => 'Tastes Bad',
+ Director => $dir,
+ CoDirector => $codir,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ }
+ );
+ };
+ ok $@, $@;
}
package Foo;
# fav is a film
__PACKAGE__->db_Main->do( qq{
CREATE TABLE foo (
- id INTEGER,
- fav VARCHAR(255)
+ id INTEGER,
+ fav VARCHAR(255)
)
});
# fav is a foo
__PACKAGE__->db_Main->do( qq{
CREATE TABLE bar (
- id INTEGER,
- fav INTEGER
+ id INTEGER,
+ fav INTEGER
)
});
isa_ok($foo->fav, "Film");
{
- my $foo;
- Foo->add_trigger(after_create => sub { $foo = shift->fav });
- my $gwh = Foo->create({ id => 93, fav => 'Good Will Hunting' });
- isa_ok $foo, "Film", "Object in after_create trigger";
+ my $foo;
+ Foo->add_trigger(after_create => sub { $foo = shift->fav });
+ my $gwh = Foo->create({ id => 93, fav => 'Good Will Hunting' });
+ isa_ok $foo, "Film", "Object in after_create trigger";
}
ok(my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste");
ok(
- my $pvj = Actor->create(
- {
- Name => 'Peter Vere-Jones',
- Film => undef,
- Salary => '30_000', # For a voice!
- }
- ),
- 'create Actor'
+ my $pvj = Actor->create(
+ {
+ Name => 'Peter Vere-Jones',
+ Film => undef,
+ Salary => '30_000', # For a voice!
+ }
+ ),
+ 'create Actor'
);
is $pvj->Name, "Peter Vere-Jones", "PVJ name ok";
is $pvj->Film, undef, "No film";
$pvj->update;
is $pvj->Film->id, $btaste->id, "Now film";
{
- my @actors = $btaste->actors;
- is(@actors, 1, "Bad taste has one actor");
- is($actors[0]->Name, $pvj->Name, " - the correct one");
+ my @actors = $btaste->actors;
+ is(@actors, 1, "Bad taste has one actor");
+ is($actors[0]->Name, $pvj->Name, " - the correct one");
}
my %pj_data = (
- Name => 'Peter Jackson',
- Salary => '0', # it's a labour of love
+ Name => 'Peter Jackson',
+ Salary => '0', # it's a labour of love
);
eval { my $pj = Film->add_to_actors(\%pj_data) };
like $@, qr/needs/, "add_to_actors takes hash";
ok(
- my $pj = $btaste->add_to_actors(
- {
- Name => 'Peter Jackson',
- Salary => '0', # it's a labour of love
- }
- ),
- 'add_to_actors'
+ my $pj = $btaste->add_to_actors(
+ {
+ Name => 'Peter Jackson',
+ Salary => '0', # it's a labour of love
+ }
+ ),
+ 'add_to_actors'
);
is $pj->Name, "Peter Jackson", "PJ ok";
is $pvj->Name, "Peter Vere-Jones", "PVJ still ok";
{
- my @actors = $btaste->actors;
- is @actors, 2, " - so now we have 2";
- is $actors[0]->Name, $pj->Name, "PJ first";
- is $actors[1]->Name, $pvj->Name, "PVJ first";
+ my @actors = $btaste->actors;
+ is @actors, 2, " - so now we have 2";
+ is $actors[0]->Name, $pj->Name, "PJ first";
+ is $actors[1]->Name, $pvj->Name, "PVJ first";
}
eval {
- my @actors = $btaste->actors(Name => $pj->Name);
- is @actors, 1, "One actor from restricted (sorted) has_many";
- is $actors[0]->Name, $pj->Name, "It's PJ";
+ my @actors = $btaste->actors(Name => $pj->Name);
+ is @actors, 1, "One actor from restricted (sorted) has_many";
+ is $actors[0]->Name, $pj->Name, "It's PJ";
};
is $@, '', "No errors";
my $as = Actor->create(
- {
- Name => 'Arnold Schwarzenegger',
- Film => 'Terminator 2',
- Salary => '15_000_000'
- }
+ {
+ Name => 'Arnold Schwarzenegger',
+ Film => 'Terminator 2',
+ Salary => '15_000_000'
+ }
);
eval { $btaste->actors($pj, $pvj, $as) };
sub delete_trigger { ::ok(1, "Deleting " . shift->Title) }
sub pre_up_trigger {
- $_[0]->_attribute_set(numexplodingsheep => 1);
- ::ok(1, "Running pre-update trigger");
+ $_[0]->_attribute_set(numexplodingsheep => 1);
+ ::ok(1, "Running pre-update trigger");
}
sub pst_up_trigger { ::ok(1, "Running post-update trigger"); }
Film->add_trigger(after_update => \&pst_up_trigger);
ok(
- my $ver = Film->create({
- title => 'La Double Vie De Veronique',
- director => 'Kryzstof Kieslowski',
+ my $ver = Film->create({
+ title => 'La Double Vie De Veronique',
+ director => 'Kryzstof Kieslowski',
- # rating => '15',
- numexplodingsheep => 0,
- }
- ),
- "Create Veronique"
+ # rating => '15',
+ numexplodingsheep => 0,
+ }
+ ),
+ "Create Veronique"
);
is $ver->Rating, 15, "Default rating";
ok $ver->Rating('12') && $ver->update, "Change the rating";
is $ver->NumExplodingSheep, 1, "Updated object's sheep count";
is + (
- $ver->db_Main->selectall_arrayref(
- 'SELECT numexplodingsheep FROM '
- . $ver->table
- . ' WHERE '
- . $ver->primary_column . ' = '
- . $ver->db_Main->quote($ver->id))
+ $ver->db_Main->selectall_arrayref(
+ 'SELECT numexplodingsheep FROM '
+ . $ver->table
+ . ' WHERE '
+ . $ver->primary_column . ' = '
+ . $ver->db_Main->quote($ver->id))
)->[0]->[0], 1, "Updated database's sheep count";
ok $ver->delete, "Delete";
{
- Film->add_trigger(before_create => sub {
- my $self = shift;
- ok !$self->_attribute_exists('title'), "PK doesn't auto-vivify";
- });
- Film->create({director => "Me"});
+ Film->add_trigger(before_create => sub {
+ my $self = shift;
+ ok !$self->_attribute_exists('title'), "PK doesn't auto-vivify";
+ });
+ Film->create({director => "Me"});
}
my $film2 = Film->create({ Title => 'Another Film' });
my @act = (
- Actor->create(
- {
- name => 'Actor 1',
- film => $film,
- salary => 10,
- }
- ),
- Actor->create(
- {
- name => 'Actor 2',
- film => $film,
- salary => 20,
- }
- ),
- Actor->create(
- {
- name => 'Actor 3',
- film => $film,
- salary => 30,
- }
- ),
- Actor->create(
- {
- name => 'Actor 4',
- film => $film2,
- salary => 50,
- }
- ),
+ Actor->create(
+ {
+ name => 'Actor 1',
+ film => $film,
+ salary => 10,
+ }
+ ),
+ Actor->create(
+ {
+ name => 'Actor 2',
+ film => $film,
+ salary => 20,
+ }
+ ),
+ Actor->create(
+ {
+ name => 'Actor 3',
+ film => $film,
+ salary => 30,
+ }
+ ),
+ Actor->create(
+ {
+ name => 'Actor 4',
+ film => $film2,
+ salary => 50,
+ }
+ ),
);
eval {
- my @actors = $film->actors(name => 'Actor 1');
- is @actors, 1, "Got one actor from restricted has_many";
- is $actors[0]->name, "Actor 1", "Correct name";
+ my @actors = $film->actors(name => 'Actor 1');
+ is @actors, 1, "Got one actor from restricted has_many";
+ is $actors[0]->name, "Actor 1", "Correct name";
};
is $@, '', "No errors";
{
- my @actors = Actor->double_search("Actor 1", 10);
- is @actors, 1, "Got one actor";
- is $actors[0]->name, "Actor 1", "Correct name";
+ my @actors = Actor->double_search("Actor 1", 10);
+ is @actors, 1, "Got one actor";
+ is $actors[0]->name, "Actor 1", "Correct name";
}
{
- ok my @actors = Actor->salary_between(0, 100), "Range 0 - 100";
- is @actors, 4, "Got all";
+ ok my @actors = Actor->salary_between(0, 100), "Range 0 - 100";
+ is @actors, 4, "Got all";
}
{
- my @actors = Actor->salary_between(100, 200);
- is @actors, 0, "None in Range 100 - 200";
+ my @actors = Actor->salary_between(100, 200);
+ is @actors, 0, "None in Range 100 - 200";
}
{
- ok my @actors = Actor->salary_between(0, 10), "Range 0 - 10";
- is @actors, 1, "Got 1";
- is $actors[0]->name, $act[0]->name, "Actor 1";
+ ok my @actors = Actor->salary_between(0, 10), "Range 0 - 10";
+ is @actors, 1, "Got 1";
+ is $actors[0]->name, $act[0]->name, "Actor 1";
}
{
- ok my @actors = Actor->salary_between(20, 30), "Range 20 - 20";
- @actors = sort { $a->salary <=> $b->salary } @actors;
- is @actors, 2, "Got 2";
- is $actors[0]->name, $act[1]->name, "Actor 2";
- is $actors[1]->name, $act[2]->name, "and Actor 3";
+ ok my @actors = Actor->salary_between(20, 30), "Range 20 - 20";
+ @actors = sort { $a->salary <=> $b->salary } @actors;
+ is @actors, 2, "Got 2";
+ is $actors[0]->name, $act[1]->name, "Actor 2";
+ is $actors[1]->name, $act[2]->name, "and Actor 3";
}
{
- ok my @actors = Actor->search(Film => $film), "Search by object";
- is @actors, 3, "3 actors in film 1";
+ ok my @actors = Actor->search(Film => $film), "Search by object";
+ is @actors, 3, "3 actors in film 1";
}
#----------------------------------------------------------------------
my $it_class = 'DBIx::Class::ResultSet';
sub test_normal_iterator {
- my $it = $film->actors;
- isa_ok $it, $it_class;
- is $it->count, 3, " - with 3 elements";
- my $i = 0;
- while (my $film = $it->next) {
- is $film->name, $act[ $i++ ]->name, "Get $i";
- }
- ok !$it->next, "No more";
- is $it->first->name, $act[0]->name, "Get first";
+ my $it = $film->actors;
+ isa_ok $it, $it_class;
+ is $it->count, 3, " - with 3 elements";
+ my $i = 0;
+ while (my $film = $it->next) {
+ is $film->name, $act[ $i++ ]->name, "Get $i";
+ }
+ ok !$it->next, "No more";
+ is $it->first->name, $act[0]->name, "Get first";
}
test_normal_iterator;
{
- Film->has_many(actor_ids => [ Actor => 'id' ]);
- my $it = $film->actor_ids;
- isa_ok $it, $it_class;
- is $it->count, 3, " - with 3 elements";
- my $i = 0;
- while (my $film_id = $it->next) {
- is $film_id, $act[ $i++ ]->id, "Get id $i";
- }
- ok !$it->next, "No more";
- is $it->first, $act[0]->id, "Get first";
+ Film->has_many(actor_ids => [ Actor => 'id' ]);
+ my $it = $film->actor_ids;
+ isa_ok $it, $it_class;
+ is $it->count, 3, " - with 3 elements";
+ my $i = 0;
+ while (my $film_id = $it->next) {
+ is $film_id, $act[ $i++ ]->id, "Get id $i";
+ }
+ ok !$it->next, "No more";
+ is $it->first, $act[0]->id, "Get first";
}
# make sure nothing gets clobbered;
{
- my @acts = $film->actors->slice(1, 2);
- is @acts, 2, "Slice gives 2 actor";
- is $acts[0]->name, "Actor 2", "Actor 2";
- is $acts[1]->name, "Actor 3", "and actor 3";
+ my @acts = $film->actors->slice(1, 2);
+ is @acts, 2, "Slice gives 2 actor";
+ is $acts[0]->name, "Actor 2", "Actor 2";
+ is $acts[1]->name, "Actor 3", "and actor 3";
}
{
- my @acts = $film->actors->slice(1);
- is @acts, 1, "Slice of 1 actor";
- is $acts[0]->name, "Actor 2", "Actor 2";
+ my @acts = $film->actors->slice(1);
+ is @acts, 1, "Slice of 1 actor";
+ is $acts[0]->name, "Actor 2", "Actor 2";
}
{
- my @acts = $film->actors->slice(2, 8);
- is @acts, 1, "Slice off the end";
- is $acts[0]->name, "Actor 3", "Gets last actor only";
+ my @acts = $film->actors->slice(2, 8);
+ is @acts, 1, "Slice off the end";
+ is $acts[0]->name, "Actor 3", "Gets last actor only";
}
package Class::DBI::My::Iterator;
delete $film->{related_resultsets};
{
- my @acts = $film->actors->slice(1, 2);
- is @acts, 2, "Slice gives 2 results";
- ok eq_set(\@acts, [qw/fred barney/]), "Fred and Barney";
+ my @acts = $film->actors->slice(1, 2);
+ is @acts, 2, "Slice gives 2 results";
+ ok eq_set(\@acts, [qw/fred barney/]), "Fred and Barney";
- ok $film->actors->delete_all, "Can delete via iterator";
- is $film->actors, 0, "no actors left";
+ ok $film->actors->delete_all, "Can delete via iterator";
+ is $film->actors, 0, "no actors left";
- eval { $film->actors->delete_all };
- is $@, '', "Deleting again does no harm";
+ eval { $film->actors->delete_all };
+ is $@, '', "Deleting again does no harm";
}
} # end SKIP block
Film->create_test_film;
{
- ok my $bt = Film->retrieve('Bad Taste'), "Get Film";
- isa_ok $bt, "Film";
- is $bt->info, undef, "No blurb yet";
- # bug where we couldn't write a class with a might_have that didn't_have
- $bt->rating(16);
- eval { $bt->update };
- is $@, '', "No problems updating when don't have";
- is $bt->rating, 16, "Updated OK";
+ ok my $bt = Film->retrieve('Bad Taste'), "Get Film";
+ isa_ok $bt, "Film";
+ is $bt->info, undef, "No blurb yet";
+ # bug where we couldn't write a class with a might_have that didn't_have
+ $bt->rating(16);
+ eval { $bt->update };
+ is $@, '', "No problems updating when don't have";
+ is $bt->rating, 16, "Updated OK";
- is $bt->blurb, undef, "Bad taste has no blurb";
- $bt->blurb("Wibble bar");
- $bt->update;
- is $bt->blurb, "Wibble bar", "And we can write the info";
+ is $bt->blurb, undef, "Bad taste has no blurb";
+ $bt->blurb("Wibble bar");
+ $bt->update;
+ is $bt->blurb, "Wibble bar", "And we can write the info";
}
{
- my $bt = Film->retrieve('Bad Taste');
- my $info = $bt->info;
- isa_ok $info, 'Blurb';
+ my $bt = Film->retrieve('Bad Taste');
+ my $info = $bt->info;
+ isa_ok $info, 'Blurb';
- is $bt->blurb, $info->blurb, "Blurb is the same as fetching the long way";
- ok $bt->blurb("New blurb"), "We can set the blurb";
- $bt->update;
- is $bt->blurb, $info->blurb, "Blurb has been set";
+ is $bt->blurb, $info->blurb, "Blurb is the same as fetching the long way";
+ ok $bt->blurb("New blurb"), "We can set the blurb";
+ $bt->update;
+ is $bt->blurb, $info->blurb, "Blurb has been set";
- $bt->rating(18);
- eval { $bt->update };
- is $@, '', "No problems updating when do have";
- is $bt->rating, 18, "Updated OK";
+ $bt->rating(18);
+ eval { $bt->update };
+ is $@, '', "No problems updating when do have";
+ is $bt->rating, 18, "Updated OK";
- # cascade delete?
- {
- my $blurb = Blurb->retrieve('Bad Taste');
- isa_ok $blurb => "Blurb";
- $bt->delete;
- $blurb = Blurb->retrieve('Bad Taste');
- is $blurb, undef, "Blurb has gone";
- }
-
+ # cascade delete?
+ {
+ my $blurb = Blurb->retrieve('Bad Taste');
+ isa_ok $blurb => "Blurb";
+ $bt->delete;
+ $blurb = Blurb->retrieve('Bad Taste');
+ is $blurb, undef, "Blurb has gone";
+ }
+
}
{
my $data = { %$data };
$data->{NumExplodingSheep} = 1;
ok my $bt = Film->find_or_create($data),
- "find_or_create Modified accessor - find with column name";
+ "find_or_create Modified accessor - find with column name";
isa_ok $bt, "Film";
is $bt->sheep, 1, 'sheep bursting violently';
};
my $data = { %$data };
$data->{sheep} = 1;
ok my $bt = Film->find_or_create($data),
- "find_or_create Modified accessor - find with accessor";
+ "find_or_create Modified accessor - find with accessor";
isa_ok $bt, "Film";
is $bt->sheep, 1, 'sheep bursting violently';
};
my $data = { %$data };
$data->{NumExplodingSheep} = 3;
ok my $bt = Film->find_or_create($data),
- "find_or_create Modified accessor - create with column name";
+ "find_or_create Modified accessor - create with column name";
isa_ok $bt, "Film";
is $bt->sheep, 3, 'sheep bursting violently';
};
my $data = { %$data };
$data->{sheep} = 4;
ok my $bt = Film->find_or_create($data),
- "find_or_create Modified accessor - create with accessor";
+ "find_or_create Modified accessor - create with accessor";
isa_ok $bt, "Film";
is $bt->sheep, 4, 'sheep bursting violently';
};
ok(Film->has_a('Director' => 'Director'), "Link Director table");
ok(
- Director->create({
- Name => 'Peter Jackson',
- Birthday => -300000000,
- IsInsane => 1
- }
- ),
- 'create Director'
+ Director->create({
+ Name => 'Peter Jackson',
+ Birthday => -300000000,
+ IsInsane => 1
+ }
+ ),
+ 'create Director'
);
{
- ok $btaste = Film->retrieve('Bad Taste'), "Reretrieve Bad Taste";
- ok $pj = $btaste->Director, "Bad taste now hasa() director";
- isa_ok $pj => 'Director';
- {
- no warnings qw(redefine once);
- local *Ima::DBI::st::execute =
- sub { ::fail("Shouldn't need to query db"); };
- is $pj->id, 'Peter Jackson', 'ID already stored';
- }
- ok $pj->IsInsane, "But we know he's insane";
+ ok $btaste = Film->retrieve('Bad Taste'), "Reretrieve Bad Taste";
+ ok $pj = $btaste->Director, "Bad taste now hasa() director";
+ isa_ok $pj => 'Director';
+ {
+ no warnings qw(redefine once);
+ local *Ima::DBI::st::execute =
+ sub { ::fail("Shouldn't need to query db"); };
+ is $pj->id, 'Peter Jackson', 'ID already stored';
+ }
+ ok $pj->IsInsane, "But we know he's insane";
}
# Oh no! Its Peter Jacksons even twin, Skippy! Born one minute after him.
my $sj = Director->create({
- Name => 'Skippy Jackson',
- Birthday => (-300000000 + 60),
- IsInsane => 1,
- });
+ Name => 'Skippy Jackson',
+ Birthday => (-300000000 + 60),
+ IsInsane => 1,
+ });
{
- eval { $btaste->Director($btaste) };
- like $@, qr/Director/, "Can't set film as director";
- is $btaste->Director->id, $pj->id, "PJ still the director";
+ eval { $btaste->Director($btaste) };
+ like $@, qr/Director/, "Can't set film as director";
+ is $btaste->Director->id, $pj->id, "PJ still the director";
- # drop from cache so that next retrieve() is from db
- $btaste->remove_from_object_index;
+ # drop from cache so that next retrieve() is from db
+ $btaste->remove_from_object_index;
}
{ # Still inflated after update
- my $btaste = Film->retrieve('Bad Taste');
- isa_ok $btaste->Director, "Director";
- $btaste->numexplodingsheep(17);
- $btaste->update;
- isa_ok $btaste->Director, "Director";
-
- $btaste->Director('Someone Else');
- $btaste->update;
- isa_ok $btaste->Director, "Director";
- is $btaste->Director->id, "Someone Else", "Can change director";
+ my $btaste = Film->retrieve('Bad Taste');
+ isa_ok $btaste->Director, "Director";
+ $btaste->numexplodingsheep(17);
+ $btaste->update;
+ isa_ok $btaste->Director, "Director";
+
+ $btaste->Director('Someone Else');
+ $btaste->update;
+ isa_ok $btaste->Director, "Director";
+ is $btaste->Director->id, "Someone Else", "Can change director";
}
is $sj->id, 'Skippy Jackson', 'Create new director - Skippy';
Film->has_a('CoDirector' => 'Director');
{
- eval { $btaste->CoDirector("Skippy Jackson") };
- is $@, "", "Auto inflates";
- isa_ok $btaste->CoDirector, "Director";
- is $btaste->CoDirector->id, $sj->id, "To skippy";
+ eval { $btaste->CoDirector("Skippy Jackson") };
+ is $@, "", "Auto inflates";
+ isa_ok $btaste->CoDirector, "Director";
+ is $btaste->CoDirector->id, $sj->id, "To skippy";
}
$btaste->CoDirector($sj);
$btaste->update;
is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
is(
- $btaste->Director->Name,
- 'Peter Jackson',
- "Didnt interfere with each other"
+ $btaste->Director->Name,
+ 'Peter Jackson',
+ "Didnt interfere with each other"
);
{ # Inheriting hasa
- my $btaste = YA::Film->retrieve('Bad Taste');
- is(ref($btaste->Director), 'Director', 'inheriting hasa()');
- is(ref($btaste->CoDirector), 'Director', 'inheriting hasa()');
- is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
+ my $btaste = YA::Film->retrieve('Bad Taste');
+ is(ref($btaste->Director), 'Director', 'inheriting hasa()');
+ is(ref($btaste->CoDirector), 'Director', 'inheriting hasa()');
+ is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
}
{
- $sj = Director->retrieve('Skippy Jackson');
- $pj = Director->retrieve('Peter Jackson');
-
- my $fail;
- eval {
- $fail = YA::Film->create({
- Title => 'Tastes Bad',
- Director => $sj,
- codirector => $btaste,
- Rating => 'R',
- NumExplodingSheep => 23
- });
- };
- ok $@, "Can't have film as codirector: $@";
- is $fail, undef, "We didn't get anything";
-
- my $tastes_bad = YA::Film->create({
- Title => 'Tastes Bad',
- Director => $sj,
- codirector => $pj,
- Rating => 'R',
- NumExplodingSheep => 23
- });
- is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
- is(
- $tastes_bad->_director_accessor->Name,
- 'Skippy Jackson',
- 'director_accessor'
- );
- is($tastes_bad->codirector->Name, 'Peter Jackson', 'codirector');
- is(
- $tastes_bad->_codirector_accessor->Name,
- 'Peter Jackson',
- 'codirector_accessor'
- );
+ $sj = Director->retrieve('Skippy Jackson');
+ $pj = Director->retrieve('Peter Jackson');
+
+ my $fail;
+ eval {
+ $fail = YA::Film->create({
+ Title => 'Tastes Bad',
+ Director => $sj,
+ codirector => $btaste,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ });
+ };
+ ok $@, "Can't have film as codirector: $@";
+ is $fail, undef, "We didn't get anything";
+
+ my $tastes_bad = YA::Film->create({
+ Title => 'Tastes Bad',
+ Director => $sj,
+ codirector => $pj,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ });
+ is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
+ is(
+ $tastes_bad->_director_accessor->Name,
+ 'Skippy Jackson',
+ 'director_accessor'
+ );
+ is($tastes_bad->codirector->Name, 'Peter Jackson', 'codirector');
+ is(
+ $tastes_bad->_codirector_accessor->Name,
+ 'Peter Jackson',
+ 'codirector_accessor'
+ );
}
SKIP: {
skip "Non-standard CDBI relationships not supported by compat", 9;
- {
-
- YA::Film->add_relationship_type(has_a => "YA::HasA");
-
- package YA::HasA;
- #use base 'Class::DBI::Relationship::HasA';
-
- sub _inflator {
- my $self = shift;
- my $col = $self->accessor;
- my $super = $self->SUPER::_inflator($col);
-
- return $super
- unless $col eq $self->class->find_column('Director');
-
- return sub {
- my $self = shift;
- $self->_attribute_store($col, 'Ghostly Peter')
- if $self->_attribute_exists($col)
- and not defined $self->_attrs($col);
- return &$super($self);
- };
- }
- }
- {
-
- package Rating;
-
- sub new {
- my ($class, $mpaa, @details) = @_;
- bless {
- MPAA => $mpaa,
- WHY => "@details"
- }, $class;
- }
- sub mpaa { shift->{MPAA}; }
- sub why { shift->{WHY}; }
- }
- local *Director::mapme = sub {
- my ($class, $val) = @_;
- $val =~ s/Skippy/Peter/;
- $val;
- };
- no warnings 'once';
- local *Director::sanity_check = sub { $_[0]->IsInsane ? undef: $_[0] };
- YA::Film->has_a(
- director => 'Director',
- inflate => 'mapme',
- deflate => 'sanity_check'
- );
- YA::Film->has_a(
- rating => 'Rating',
- inflate => sub {
- my ($val, $parent) = @_;
- my $sheep = $parent->find_column('NumexplodingSheep');
- if ($parent->_attrs($sheep) || 0 > 20) {
- return new Rating 'NC17', 'Graphic ovine violence';
- } else {
- return new Rating $val, 'Just because';
- }
- },
- deflate => sub {
- shift->mpaa;
- });
-
- my $tbad = YA::Film->retrieve('Tastes Bad');
-
- isa_ok $tbad->Director, 'Director';
- is $tbad->Director->Name, 'Peter Jackson', 'Director shuffle';
- $tbad->Director('Skippy Jackson');
- $tbad->update;
- is $tbad->Director, 'Ghostly Peter', 'Sanity checked';
-
- isa_ok $tbad->Rating, 'Rating';
- is $tbad->Rating->mpaa, 'NC17', 'Rating bumped';
- $tbad->Rating(new Rating 'NS17', 'Shaken sheep');
- no warnings 'redefine';
- local *Director::mapme = sub {
- my ($class, $obj) = @_;
- $obj->isa('Film') ? $obj->Director : $obj;
- };
-
- $pj->IsInsane(0);
- $pj->update; # Hush warnings
-
- ok $tbad->Director($btaste), 'Cross-class mapping';
- is $tbad->Director, 'Peter Jackson', 'Yields PJ';
- $tbad->update;
-
- $tbad = Film->retrieve('Tastes Bad');
- ok !ref($tbad->Rating), 'Unmagical rating';
- is $tbad->Rating, 'NS17', 'but prior change stuck';
+ {
+
+ YA::Film->add_relationship_type(has_a => "YA::HasA");
+
+ package YA::HasA;
+ #use base 'Class::DBI::Relationship::HasA';
+
+ sub _inflator {
+ my $self = shift;
+ my $col = $self->accessor;
+ my $super = $self->SUPER::_inflator($col);
+
+ return $super
+ unless $col eq $self->class->find_column('Director');
+
+ return sub {
+ my $self = shift;
+ $self->_attribute_store($col, 'Ghostly Peter')
+ if $self->_attribute_exists($col)
+ and not defined $self->_attrs($col);
+ return &$super($self);
+ };
+ }
+ }
+ {
+
+ package Rating;
+
+ sub new {
+ my ($class, $mpaa, @details) = @_;
+ bless {
+ MPAA => $mpaa,
+ WHY => "@details"
+ }, $class;
+ }
+ sub mpaa { shift->{MPAA}; }
+ sub why { shift->{WHY}; }
+ }
+ local *Director::mapme = sub {
+ my ($class, $val) = @_;
+ $val =~ s/Skippy/Peter/;
+ $val;
+ };
+ no warnings 'once';
+ local *Director::sanity_check = sub { $_[0]->IsInsane ? undef: $_[0] };
+ YA::Film->has_a(
+ director => 'Director',
+ inflate => 'mapme',
+ deflate => 'sanity_check'
+ );
+ YA::Film->has_a(
+ rating => 'Rating',
+ inflate => sub {
+ my ($val, $parent) = @_;
+ my $sheep = $parent->find_column('NumexplodingSheep');
+ if ($parent->_attrs($sheep) || 0 > 20) {
+ return new Rating 'NC17', 'Graphic ovine violence';
+ } else {
+ return new Rating $val, 'Just because';
+ }
+ },
+ deflate => sub {
+ shift->mpaa;
+ });
+
+ my $tbad = YA::Film->retrieve('Tastes Bad');
+
+ isa_ok $tbad->Director, 'Director';
+ is $tbad->Director->Name, 'Peter Jackson', 'Director shuffle';
+ $tbad->Director('Skippy Jackson');
+ $tbad->update;
+ is $tbad->Director, 'Ghostly Peter', 'Sanity checked';
+
+ isa_ok $tbad->Rating, 'Rating';
+ is $tbad->Rating->mpaa, 'NC17', 'Rating bumped';
+ $tbad->Rating(new Rating 'NS17', 'Shaken sheep');
+ no warnings 'redefine';
+ local *Director::mapme = sub {
+ my ($class, $obj) = @_;
+ $obj->isa('Film') ? $obj->Director : $obj;
+ };
+
+ $pj->IsInsane(0);
+ $pj->update; # Hush warnings
+
+ ok $tbad->Director($btaste), 'Cross-class mapping';
+ is $tbad->Director, 'Peter Jackson', 'Yields PJ';
+ $tbad->update;
+
+ $tbad = Film->retrieve('Tastes Bad');
+ ok !ref($tbad->Rating), 'Unmagical rating';
+ is $tbad->Rating, 'NS17', 'but prior change stuck';
}
{ # Broken has_a declaration
- eval { Film->has_a(driector => "Director") };
- like $@, qr/driector/, "Sensible error from has_a with incorrect column: $@";
+ eval { Film->has_a(driector => "Director") };
+ like $@, qr/driector/, "Sensible error from has_a with incorrect column: $@";
}
use Actor;
{ # Check __ESSENTIAL__ expansion (RT#13038)
- my @cols = Film->columns('Essential');
- is_deeply \@cols, ['title'], "1 Column in essential";
- is +Film->transform_sql('__ESSENTIAL__'), 'title', '__ESSENTIAL__ expansion';
-
- # This provides a more interesting test
- Film->columns(Essential => qw(title rating));
- is +Film->transform_sql('__ESSENTIAL__'), 'title, rating',
- 'multi-col __ESSENTIAL__ expansion';
+ my @cols = Film->columns('Essential');
+ is_deeply \@cols, ['title'], "1 Column in essential";
+ is +Film->transform_sql('__ESSENTIAL__'), 'title', '__ESSENTIAL__ expansion';
+
+ # This provides a more interesting test
+ Film->columns(Essential => qw(title rating));
+ is +Film->transform_sql('__ESSENTIAL__'), 'title, rating',
+ 'multi-col __ESSENTIAL__ expansion';
}
my $f1 = Film->create({ title => 'A', director => 'AA', rating => 'PG' });
my $f5 = Film->create({ title => 'E', director => 'AA', rating => '18' });
Film->set_sql(
- pgs => qq{
- SELECT __ESSENTIAL__
- FROM __TABLE__
- WHERE __TABLE__.rating = 'PG'
- ORDER BY title DESC
+ pgs => qq{
+ SELECT __ESSENTIAL__
+ FROM __TABLE__
+ WHERE __TABLE__.rating = 'PG'
+ ORDER BY title DESC
}
);
{
- (my $sth = Film->sql_pgs())->execute;
- my @pgs = Film->sth_to_objects($sth);
- is @pgs, 2, "Execute our own SQL";
- is $pgs[0]->id, $f2->id, "get F2";
- is $pgs[1]->id, $f1->id, "and F1";
+ (my $sth = Film->sql_pgs())->execute;
+ my @pgs = Film->sth_to_objects($sth);
+ is @pgs, 2, "Execute our own SQL";
+ is $pgs[0]->id, $f2->id, "get F2";
+ is $pgs[1]->id, $f1->id, "and F1";
}
{
- my @pgs = Film->search_pgs;
- is @pgs, 2, "SQL creates search() method";
- is $pgs[0]->id, $f2->id, "get F2";
- is $pgs[1]->id, $f1->id, "and F1";
+ my @pgs = Film->search_pgs;
+ is @pgs, 2, "SQL creates search() method";
+ is $pgs[0]->id, $f2->id, "get F2";
+ is $pgs[1]->id, $f1->id, "and F1";
};
Film->set_sql(
- rating => qq{
- SELECT __ESSENTIAL__
- FROM __TABLE__
- WHERE rating = ?
- ORDER BY title DESC
+ rating => qq{
+ SELECT __ESSENTIAL__
+ FROM __TABLE__
+ WHERE rating = ?
+ ORDER BY title DESC
}
);
{
- my @pgs = Film->search_rating('18');
- is @pgs, 2, "Can pass parameters to created search()";
- is $pgs[0]->id, $f5->id, "F5";
- is $pgs[1]->id, $f4->id, "and F4";
+ my @pgs = Film->search_rating('18');
+ is @pgs, 2, "Can pass parameters to created search()";
+ is $pgs[0]->id, $f5->id, "F5";
+ is $pgs[1]->id, $f4->id, "and F4";
};
{
{
- Actor->has_a(film => "Film");
- Film->set_sql(
- namerate => qq{
- SELECT __ESSENTIAL(f)__
- FROM __TABLE(=f)__, __TABLE(Actor=a)__
- WHERE __JOIN(a f)__
- AND a.name LIKE ?
- AND f.rating = ?
- ORDER BY title
- }
- );
-
- my $a1 = Actor->create({ name => "A1", film => $f1 });
- my $a2 = Actor->create({ name => "A2", film => $f2 });
- my $a3 = Actor->create({ name => "B1", film => $f1 });
-
- my @apg = Film->search_namerate("A_", "PG");
- is @apg, 2, "2 Films with A* that are PG";
- is $apg[0]->title, "A", "A";
- is $apg[1]->title, "B", "and B";
+ Actor->has_a(film => "Film");
+ Film->set_sql(
+ namerate => qq{
+ SELECT __ESSENTIAL(f)__
+ FROM __TABLE(=f)__, __TABLE(Actor=a)__
+ WHERE __JOIN(a f)__
+ AND a.name LIKE ?
+ AND f.rating = ?
+ ORDER BY title
+ }
+ );
+
+ my $a1 = Actor->create({ name => "A1", film => $f1 });
+ my $a2 = Actor->create({ name => "A2", film => $f2 });
+ my $a3 = Actor->create({ name => "B1", film => $f1 });
+
+ my @apg = Film->search_namerate("A_", "PG");
+ is @apg, 2, "2 Films with A* that are PG";
+ is $apg[0]->title, "A", "A";
+ is $apg[1]->title, "B", "and B";
}
{ # join in reverse
- Actor->has_a(film => "Film");
- Film->set_sql(
- ratename => qq{
- SELECT __ESSENTIAL(f)__
- FROM __TABLE(=f)__, __TABLE(Actor=a)__
- WHERE __JOIN(f a)__
- AND f.rating = ?
- AND a.name LIKE ?
- ORDER BY title
- }
- );
-
- my @apg = Film->search_ratename(PG => "A_");
- is @apg, 2, "2 Films with A* that are PG";
- is $apg[0]->title, "A", "A";
- is $apg[1]->title, "B", "and B";
+ Actor->has_a(film => "Film");
+ Film->set_sql(
+ ratename => qq{
+ SELECT __ESSENTIAL(f)__
+ FROM __TABLE(=f)__, __TABLE(Actor=a)__
+ WHERE __JOIN(f a)__
+ AND f.rating = ?
+ AND a.name LIKE ?
+ ORDER BY title
+ }
+ );
+
+ my @apg = Film->search_ratename(PG => "A_");
+ is @apg, 2, "2 Films with A* that are PG";
+ is $apg[0]->title, "A", "A";
+ is $apg[1]->title, "B", "and B";
}
my $it_class = "DBIx::Class::ResultSet";
my @film = (
- Film->create({ Title => 'Film 1' }),
- Film->create({ Title => 'Film 2' }),
- Film->create({ Title => 'Film 3' }),
- Film->create({ Title => 'Film 4' }),
- Film->create({ Title => 'Film 5' }),
- Film->create({ Title => 'Film 6' }),
+ Film->create({ Title => 'Film 1' }),
+ Film->create({ Title => 'Film 2' }),
+ Film->create({ Title => 'Film 3' }),
+ Film->create({ Title => 'Film 4' }),
+ Film->create({ Title => 'Film 5' }),
+ Film->create({ Title => 'Film 6' }),
);
{
- my $it1 = Film->retrieve_all;
- isa_ok $it1, $it_class;
+ my $it1 = Film->retrieve_all;
+ isa_ok $it1, $it_class;
- my $it2 = Film->retrieve_all;
- isa_ok $it2, $it_class;
+ my $it2 = Film->retrieve_all;
+ isa_ok $it2, $it_class;
- while (my $from1 = $it1->next) {
- my $from2 = $it2->next;
- is $from1->id, $from2->id, "Both iterators get $from1";
- }
+ while (my $from1 = $it1->next) {
+ my $from2 = $it2->next;
+ is $from1->id, $from2->id, "Both iterators get $from1";
+ }
}
{
- my $it = Film->retrieve_all;
- is $it->first->title, "Film 1", "Film 1 first";
- is $it->next->title, "Film 2", "Film 2 next";
- is $it->first->title, "Film 1", "First goes back to 1";
- is $it->next->title, "Film 2", "With 2 still next";
- $it->reset;
- is $it->next->title, "Film 1", "Reset brings us to film 1 again";
- is $it->next->title, "Film 2", "And 2 is still next";
+ my $it = Film->retrieve_all;
+ is $it->first->title, "Film 1", "Film 1 first";
+ is $it->next->title, "Film 2", "Film 2 next";
+ is $it->first->title, "Film 1", "First goes back to 1";
+ is $it->next->title, "Film 2", "With 2 still next";
+ $it->reset;
+ is $it->next->title, "Film 1", "Reset brings us to film 1 again";
+ is $it->next->title, "Film 2", "And 2 is still next";
}
{
- my $it = Film->retrieve_all;
- my @slice = $it->slice(2,4);
- is @slice, 3, "correct slice size (array)";
- is $slice[0]->title, "Film 3", "Film 3 first";
- is $slice[2]->title, "Film 5", "Film 5 last";
+ my $it = Film->retrieve_all;
+ my @slice = $it->slice(2,4);
+ is @slice, 3, "correct slice size (array)";
+ is $slice[0]->title, "Film 3", "Film 3 first";
+ is $slice[2]->title, "Film 5", "Film 5 last";
}
{
- my $it = Film->retrieve_all;
- my $slice = $it->slice(2,4);
- isa_ok $slice, $it_class, "slice as iterator";
- is $slice->count, 3,"correct slice size (array)";
- is $slice->first->title, "Film 3", "Film 3 first";
- is $slice->next->title, "Film 4", "Film 4 next";
- is $slice->first->title, "Film 3", "First goes back to 3";
- is $slice->next->title, "Film 4", "With 4 still next";
- $slice->reset;
- is $slice->next->title, "Film 3", "Reset brings us to film 3 again";
- is $slice->next->title, "Film 4", "And 4 is still next";
+ my $it = Film->retrieve_all;
+ my $slice = $it->slice(2,4);
+ isa_ok $slice, $it_class, "slice as iterator";
+ is $slice->count, 3,"correct slice size (array)";
+ is $slice->first->title, "Film 3", "Film 3 first";
+ is $slice->next->title, "Film 4", "Film 4 next";
+ is $slice->first->title, "Film 3", "First goes back to 3";
+ is $slice->next->title, "Film 4", "With 4 still next";
+ $slice->reset;
+ is $slice->next->title, "Film 3", "Reset brings us to film 3 again";
+ is $slice->next->title, "Film 4", "And 4 is still next";
- # check if the original iterator still works
- is $it->count, 6, "back to the original iterator, is of right size";
- is $it->first->title, "Film 1", "Film 1 first";
- is $it->next->title, "Film 2", "Film 2 next";
- is $it->first->title, "Film 1", "First goes back to 1";
- is $it->next->title, "Film 2", "With 2 still next";
- is $it->next->title, "Film 3", "Film 3 is still in original Iterator";
- $it->reset;
- is $it->next->title, "Film 1", "Reset brings us to film 1 again";
- is $it->next->title, "Film 2", "And 2 is still next";
+ # check if the original iterator still works
+ is $it->count, 6, "back to the original iterator, is of right size";
+ is $it->first->title, "Film 1", "Film 1 first";
+ is $it->next->title, "Film 2", "Film 2 next";
+ is $it->first->title, "Film 1", "First goes back to 1";
+ is $it->next->title, "Film 2", "With 2 still next";
+ is $it->next->title, "Film 3", "Film 3 is still in original Iterator";
+ $it->reset;
+ is $it->next->title, "Film 1", "Reset brings us to film 1 again";
+ is $it->next->title, "Film 2", "And 2 is still next";
}
{
}
BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? (skip_all => 'needs DBD::SQLite for testing')
- : (tests => 6);
+ eval "use DBD::SQLite";
+ plan $@
+ ? (skip_all => 'needs DBD::SQLite for testing')
+ : (tests => 6);
}
use lib 't/cdbi/testlib';
require Film;
sub Film::accessor_name_for {
- my ($class, $col) = @_;
- return "sheep" if lc $col eq "numexplodingsheep";
- return $col;
+ my ($class, $col) = @_;
+ return "sheep" if lc $col eq "numexplodingsheep";
+ return $col;
}
my $data = {
- Title => 'Bad Taste',
- Director => 'Peter Jackson',
- Rating => 'R',
+ Title => 'Bad Taste',
+ Director => 'Peter Jackson',
+ Rating => 'R',
};
my $bt;
eval {
- my $data = $data;
- $data->{sheep} = 1;
- ok $bt = Film->insert($data), "Modified accessor - with
+ my $data = $data;
+ $data->{sheep} = 1;
+ ok $bt = Film->insert($data), "Modified accessor - with
accessor";
- isa_ok $bt, "Film";
+ isa_ok $bt, "Film";
};
is $@, '', "No errors";
eval {
- ok $bt->sheep(2), 'Modified accessor, set';
- ok $bt->update, 'Update';
+ ok $bt->sheep(2), 'Modified accessor, set';
+ ok $bt->update, 'Update';
};
is $@, '', "No errors";
use Film;
my @film = (
- Film->create({ Title => 'Film 1' }),
- Film->create({ Title => 'Film 2' }),
- Film->create({ Title => 'Film 3' }),
- Film->create({ Title => 'Film 4' }),
- Film->create({ Title => 'Film 5' }),
+ Film->create({ Title => 'Film 1' }),
+ Film->create({ Title => 'Film 2' }),
+ Film->create({ Title => 'Film 3' }),
+ Film->create({ Title => 'Film 4' }),
+ Film->create({ Title => 'Film 5' }),
);
# first page
Film->create_test_film;
{
- my $btaste = Film->retrieve('Bad Taste');
- isa_ok $btaste, 'Film', "We have Bad Taste";
- {
- no warnings 'redefine';
- local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
- eval { $btaste->delete };
- ::like $@, qr/Database died/s, "We failed";
- }
- my $still = Film->retrieve('Bad Taste');
- isa_ok $btaste, 'Film', "We still have Bad Taste";
+ my $btaste = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We have Bad Taste";
+ {
+ no warnings 'redefine';
+ local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
+ eval { $btaste->delete };
+ ::like $@, qr/Database died/s, "We failed";
+ }
+ my $still = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We still have Bad Taste";
}
{
- my $btaste = Film->retrieve('Bad Taste');
- isa_ok $btaste, 'Film', "We have Bad Taste";
- $btaste->numexplodingsheep(10);
- {
- no warnings 'redefine';
- local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
- eval { $btaste->update };
- ::like $@, qr/Database died/s, "We failed";
- }
- $btaste->discard_changes;
- my $still = Film->retrieve('Bad Taste');
- isa_ok $btaste, 'Film', "We still have Bad Taste";
- is $btaste->numexplodingsheep, 1, "with 1 sheep";
+ my $btaste = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We have Bad Taste";
+ $btaste->numexplodingsheep(10);
+ {
+ no warnings 'redefine';
+ local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
+ eval { $btaste->update };
+ ::like $@, qr/Database died/s, "We failed";
+ }
+ $btaste->discard_changes;
+ my $still = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We still have Bad Taste";
+ is $btaste->numexplodingsheep, 1, "with 1 sheep";
}
if (0) {
- my $sheep = Film->maximum_value_of('numexplodingsheep');
- is $sheep, 1, "1 exploding sheep";
- {
- local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
- my $sheep = eval { Film->maximum_value_of('numexplodingsheep') };
- ::like $@, qr/select.*Database died/s,
- "Handle database death in single value select";
- }
+ my $sheep = Film->maximum_value_of('numexplodingsheep');
+ is $sheep, 1, "1 exploding sheep";
+ {
+ local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
+ my $sheep = eval { Film->maximum_value_of('numexplodingsheep') };
+ ::like $@, qr/select.*Database died/s,
+ "Handle database death in single value select";
+ }
}
}
INIT {
- use lib 't/cdbi/testlib';
- use Film;
+ use lib 't/cdbi/testlib';
+ use Film;
}
sub mutator_name_for { "set_$_[1]" }
sub create_sql {
- return qq{
- id INTEGER PRIMARY KEY,
- name CHAR(40),
- film VARCHAR(255),
- salary INT
- }
+ return qq{
+ id INTEGER PRIMARY KEY,
+ name CHAR(40),
+ film VARCHAR(255),
+ salary INT
+ }
}
1;
__PACKAGE__->has_a( alias => 'Actor' );
sub create_sql {
- return qq{
- id INTEGER PRIMARY KEY,
- actor INTEGER,
- alias INTEGER
- }
+ return qq{
+ id INTEGER PRIMARY KEY,
+ actor INTEGER,
+ alias INTEGER
+ }
}
1;
__PACKAGE__->columns('Blurb', qw/ blurb/);
sub create_sql {
- return qq{
- title VARCHAR(255) PRIMARY KEY,
- blurb VARCHAR(255) NOT NULL
+ return qq{
+ title VARCHAR(255) PRIMARY KEY,
+ blurb VARCHAR(255) NOT NULL
}
}
__PACKAGE__->columns('All' => qw/ Name Birthday IsInsane /);
sub create_sql {
- return qq{
- name VARCHAR(80),
- birthday INTEGER,
- isinsane INTEGER
- };
+ return qq{
+ name VARCHAR(80),
+ birthday INTEGER,
+ isinsane INTEGER
+ };
}
1;
__PACKAGE__->columns('Other', qw( Rating NumExplodingSheep HasVomit ));
sub create_sql {
- return qq{
- title VARCHAR(255),
- director VARCHAR(80),
- codirector VARCHAR(80),
- rating CHAR(5),
- numexplodingsheep INTEGER,
- hasvomit CHAR(1)
+ return qq{
+ title VARCHAR(255),
+ director VARCHAR(80),
+ codirector VARCHAR(80),
+ rating CHAR(5),
+ numexplodingsheep INTEGER,
+ hasvomit CHAR(1)
}
}
sub create_test_film {
- return shift->create({
- Title => 'Bad Taste',
- Director => 'Peter Jackson',
- Rating => 'R',
- NumExplodingSheep => 1,
- });
+ return shift->create({
+ Title => 'Bad Taste',
+ Director => 'Peter Jackson',
+ Rating => 'R',
+ NumExplodingSheep => 1,
+ });
}
package DeletingFilm;
__PACKAGE__->columns('vertical', qw(oop opop));
sub create_sql {
- return qq{
- this INTEGER,
- that INTEGER,
- eep INTEGER,
- orp INTEGER,
- oop INTEGER,
- opop INTEGER
- };
+ return qq{
+ this INTEGER,
+ that INTEGER,
+ eep INTEGER,
+ orp INTEGER,
+ oop INTEGER,
+ opop INTEGER
+ };
}
1;
__PACKAGE__->set_table();
__PACKAGE__->columns(All => qw/id message datetime_stamp/);
__PACKAGE__->has_a(
- datetime_stamp => 'Time::Piece',
- inflate => 'from_mysql_datetime',
- deflate => 'mysql_datetime'
+ datetime_stamp => 'Time::Piece',
+ inflate => 'from_mysql_datetime',
+ deflate => 'mysql_datetime'
);
__PACKAGE__->add_trigger(before_create => \&set_dts);
__PACKAGE__->add_trigger(before_update => \&set_dts);
sub set_dts {
- shift->datetime_stamp(
- POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime(time)));
+ shift->datetime_stamp(
+ POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime(time)));
}
sub create_sql {
- return qq{
+ return qq{
id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY,
message VARCHAR(255),
datetime_stamp DATETIME
__PACKAGE__->connection(@connect);
sub set_table {
- my $class = shift;
- $class->table($class->create_test_table);
+ my $class = shift;
+ $class->table($class->create_test_table);
}
sub create_test_table {
- my $self = shift;
- my $table = $self->next_available_table;
- my $create = sprintf "CREATE TABLE $table ( %s )", $self->create_sql;
- push @table, $table;
- $dbh->do($create);
- return $table;
+ my $self = shift;
+ my $table = $self->next_available_table;
+ my $create = sprintf "CREATE TABLE $table ( %s )", $self->create_sql;
+ push @table, $table;
+ $dbh->do($create);
+ return $table;
}
sub next_available_table {
- my $self = shift;
- my @tables = sort @{
- $dbh->selectcol_arrayref(
- qq{
+ my $self = shift;
+ my @tables = sort @{
+ $dbh->selectcol_arrayref(
+ qq{
SHOW TABLES
}
- )
- };
- my $table = $tables[-1] || "aaa";
- return "z$table";
+ )
+ };
+ my $table = $tables[-1] || "aaa";
+ return "z$table";
}
1;
sub stars { map $_->star, shift->_stars }
sub create_sql {
- return qq{
+ return qq{
filmid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY,
title VARCHAR(255)
};
__PACKAGE__->set_table();
__PACKAGE__->columns(All => qw/myid name val tdate/);
__PACKAGE__->has_a(
- tdate => 'Date::Simple',
- inflate => sub { Date::Simple->new(shift) },
- deflate => 'format',
+ tdate => 'Date::Simple',
+ inflate => sub { Date::Simple->new(shift) },
+ deflate => 'format',
);
#__PACKAGE__->find_column('tdate')->placeholder("IF(1, CURDATE(), ?)");
sub create_sql {
- return qq{
+ return qq{
myid mediumint not null auto_increment primary key,
name varchar(50) not null default '',
val char(1) default 'A',
# sub films { map $_->film, shift->_films }
sub create_sql {
- return qq{
- starid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY,
- name VARCHAR(255)
- };
+ return qq{
+ starid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY,
+ name VARCHAR(255)
+ };
}
1;
__PACKAGE__->has_a(star => 'MyStar');
sub create_sql {
- return qq{
+ return qq{
linkid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY,
film TINYINT NOT NULL,
star TINYINT NOT NULL
__PACKAGE__->has_a(star => 'MyStar');
sub create_sql {
- return qq{
+ return qq{
film INTEGER NOT NULL,
star INTEGER NOT NULL,
PRIMARY KEY (film, star)
__PACKAGE__->columns(Others => qw/orders/);
sub create_sql {
- return qq{
- film VARCHAR(255),
- orders INTEGER
- };
+ return qq{
+ film VARCHAR(255),
+ orders INTEGER
+ };
}
1;
-package # hide from PAUSE
+package # hide from PAUSE
OtherFilm;
use strict;
__PACKAGE__->set_table('Different_Film');
sub create_sql {
- return qq{
- title VARCHAR(255),
- director VARCHAR(80),
- codirector VARCHAR(80),
- rating CHAR(5),
- numexplodingsheep INTEGER,
- hasvomit CHAR(1)
- };
+ return qq{
+ title VARCHAR(255),
+ director VARCHAR(80),
+ codirector VARCHAR(80),
+ rating CHAR(5),
+ numexplodingsheep INTEGER,
+ hasvomit CHAR(1)
+ };
}
1;
projects / dbsrgits/DBIx-Class.git / commitdiff