use strict;
use Test::More;
INIT {
#local $SIG{__WARN__} =
#sub { like $_[0], qr/clashes with built-in method/, $_[0] };
use lib 't/cdbi/testlib';
require Film;
require Actor;
require Director;
Actor->has_a(film => 'Film');
Film->has_a(director => 'Director');
sub Class::DBI::sheep { ok 0; }
}
# Install the deprecation warning intercept here for the rest of the 08 dev cycle
local $SIG{__WARN__} = sub {
warn @_ unless (DBIx::Class->VERSION < 0.09 and $_[0] =~ /Query returned more than one row/);
};
sub Film::mutator_name {
my ($class, $col) = @_;
return "set_sheep" if lc $col eq "numexplodingsheep";
return $col;
}
sub Film::accessor_name {
my ($class, $col) = @_;
return "sheep" if lc $col eq "numexplodingsheep";
return $col;
}
sub Actor::accessor_name_for {
my ($class, $col) = @_;
return "movie" if lc $col eq "film";
return $col;
}
# This is a class with accessor_name_for() but no corresponding mutator_name_for()
sub Director::accessor_name_for {
my($class, $col) = @_;
return "nutty_as_a_fruitcake" if lc $col eq "isinsane";
return $col;
}
my $data = {
Title => 'Bad Taste',
Director => 'Peter Jackson',
Rating => 'R',
};
eval {
my $data = { %$data };
$data->{NumExplodingSheep} = 1;
ok my $bt = Film->create($data), "Modified accessor - with column name";
isa_ok $bt, "Film";
is $bt->sheep, 1, 'sheep bursting violently';
};
is $@, '', "No errors";
eval {
my $data = { %$data };
$data->{sheep} = 2;
ok my $bt = Film->create($data), "Modified accessor - with accessor";
isa_ok $bt, "Film";
is $bt->sheep, 2, 'sheep bursting violently';
};
is $@, '', "No errors";
eval {
my $data = { %$data };
$data->{NumExplodingSheep} = 1;
ok my $bt = Film->find_or_create($data),
"find_or_create Modified accessor - find with column name";
isa_ok $bt, "Film";
is $bt->sheep, 1, 'sheep bursting violently';
};
is $@, '', "No errors";
eval {
my $data = { %$data };
$data->{sheep} = 1;
ok my $bt = Film->find_or_create($data),
"find_or_create Modified accessor - find with accessor";
isa_ok $bt, "Film";
is $bt->sheep, 1, 'sheep bursting violently';
};
is $@, '', "No errors";
TODO: { local $TODO = 'TODOifying failing tests, waiting for Schwern'; ok (1, 'remove me');
eval {
my $data = { %$data };
$data->{NumExplodingSheep} = 3;
ok my $bt = Film->find_or_create($data),
"find_or_create Modified accessor - create with column name";
isa_ok $bt, "Film";
is $bt->sheep, 3, 'sheep bursting violently';
};
is $@, '', "No errors";
eval {
my $data = { %$data };
$data->{sheep} = 4;
ok my $bt = Film->find_or_create($data),
"find_or_create Modified accessor - create with accessor";
isa_ok $bt, "Film";
is $bt->sheep, 4, 'sheep bursting violently';
};
is $@, '', "No errors";
eval {
my @film = Film->search({ sheep => 1 });
is @film, 2, "Can search with modified accessor";
};
is $@, '', "No errors";
}
{
eval {
local $data->{set_sheep} = 1;
ok my $bt = Film->create($data), "Modified mutator - with mutator";
isa_ok $bt, "Film";
};
is $@, '', "No errors";
eval {
local $data->{NumExplodingSheep} = 1;
ok my $bt = Film->create($data), "Modified mutator - with column name";
isa_ok $bt, "Film";
};
is $@, '', "No errors";
eval {
local $data->{sheep} = 1;
ok my $bt = Film->create($data), "Modified mutator - with accessor";
isa_ok $bt, "Film";
};
is $@, '', "No errors";
}
{
my $p_data = {
name => 'Peter Jackson',
film => 'Bad Taste',
};
my $bt = Film->create($data);
my $ac = Actor->create($p_data);
ok !eval { my $f = $ac->film; 1 };
like $@, qr/film/, "no hasa film";
eval {
ok my $f = $ac->movie, "hasa movie";
isa_ok $f, "Film";
is $f->id, $bt->id, " - Bad Taste";
};
is $@, '', "No errors";
{
local $data->{Title} = "Another film";
my $film = Film->create($data);
eval { $ac->film($film) };
ok $@, $@;
eval { $ac->movie($film) };
ok $@, $@;
eval {
ok $ac->set_film($film), "Set movie through hasa";
$ac->update;
ok my $f = $ac->movie, "hasa movie";
isa_ok $f, "Film";
is $f->id, $film->id, " - Another Film";
};
is $@, '', "No problem";
}
}
# Make sure a class with an accessor_name() method has a similar mutator.
{
my $aki = Director->create({
name => "Aki Kaurismaki",
});
$aki->nutty_as_a_fruitcake(1);
is $aki->nutty_as_a_fruitcake, 1,
"a custom accessor without a custom mutator is setable";
$aki->update;
}
{
Film->columns(TEMP => qw/nonpersistent/);
ok(Film->find_column('nonpersistent'), "nonpersistent is a column");
ok(!Film->has_real_column('nonpersistent'), " - but it's not real");
{
my $film = Film->create({ Title => "Veronique", nonpersistent => 42 });
is $film->title, "Veronique", "Title set OK";
is $film->nonpersistent, 42, "As is non persistent value";
$film->remove_from_object_index;
ok $film = Film->retrieve('Veronique'), "Re-retrieve film";
is $film->title, "Veronique", "Title still OK";
is $film->nonpersistent, undef, "Non persistent value gone";
ok $film->nonpersistent(40), "Can set it";
is $film->nonpersistent, 40, "And it's there again";
ok $film->update, "Commit the film";
is $film->nonpersistent, 40, "And it's still there";
}
}
{
is_deeply(
[Actor->columns('Essential')],
[Actor->columns('Primary')],
"Actor has no specific essential columns"
);
ok(Actor->find_column('nonpersistent'), "nonpersistent is a column");
ok(!Actor->has_real_column('nonpersistent'), " - but it's not real");
my $pj = eval { Actor->search(name => "Peter Jackson")->first };
is $@, '', "no problems retrieving actors";
isa_ok $pj => "Actor";
}
{
Film->autoupdate(1);
my $naked = Film->create({ title => 'Naked' });
my $sandl = Film->create({ title => 'Secrets and Lies' });
my $rating = 1;
my $update_failure = sub {
my $obj = shift;
eval { $obj->rating($rating++) };
return $@ =~ /read only/;
};
ok !$update_failure->($naked), "Can update Naked";
ok $naked->make_read_only, "Make Naked read only";
ok $update_failure->($naked), "Can't update Naked any more";
ok !$update_failure->($sandl), "But can still update Secrets and Lies";
my $july4 = eval { Film->create({ title => "4 Days in July" }) };
isa_ok $july4 => "Film", "And can still create new films";
ok(Film->make_read_only, "Make all Films read only");
ok $update_failure->($naked), "Still can't update Naked";
ok $update_failure->($sandl), "And can't update S&L any more";
eval { $july4->delete };
like $@, qr/read only/, "And can't delete 4 Days in July";
my $abigail = eval { Film->create({ title => "Abigail's Party" }) };
like $@, qr/read only/, "Or create new films";
$_->discard_changes for ($naked, $sandl);
}
done_testing;