[dbsrgits/DBIx-Class.git] / t / cdbi-t / 15-accessor.t

use strict;
use Test::More;

BEGIN {
    eval "use DBIx::Class::CDBICompat;";
    if ($@) {
        plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
        next;
    }
    eval "use DBD::SQLite";
    plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 75);
}

INIT {
    #local $SIG{__WARN__} =
        #sub { like $_[0], qr/clashes with built-in method/, $_[0] };
    use lib 't/testlib';
    require Film;
    require Actor;
    require Director;

    Actor->has_a(film => 'Film');
    Film->has_a(director => 'Director');

    sub Class::DBI::sheep { ok 0; }
}

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 {
        local $SIG{__WARN__} = sub {
            warn @_ unless $_[0] =~ /Query returned more than one row/;
        };
        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";

    $sandl->discard_changes;
}
Commit	Line	Data
9bc6db13	1	use strict;
	2	use Test::More;
	3
	4	BEGIN {
134ea846	5	eval "use DBIx::Class::CDBICompat;";
	6	if ($@) {
	7	plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
	8	next;
	9	}
	10	eval "use DBD::SQLite";
c73f755d	11	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 75);
9bc6db13	12	}
	13
	14	INIT {
d4519f23	15	#local $SIG{__WARN__} =
	16	#sub { like $_[0], qr/clashes with built-in method/, $_[0] };
	17	use lib 't/testlib';
	18	require Film;
	19	require Actor;
48cb8be4	20	require Director;
48cb8be4	21
d4519f23	22	Actor->has_a(film => 'Film');
48cb8be4	23	Film->has_a(director => 'Director');
48cb8be4	24
d4519f23	25	sub Class::DBI::sheep { ok 0; }
9bc6db13	26	}
	27
	28	sub Film::mutator_name {
d4519f23	29	my ($class, $col) = @_;
	30	return "set_sheep" if lc $col eq "numexplodingsheep";
	31	return $col;
9bc6db13	32	}
	33
	34	sub Film::accessor_name {
d4519f23	35	my ($class, $col) = @_;
	36	return "sheep" if lc $col eq "numexplodingsheep";
	37	return $col;
9bc6db13	38	}
9bc6db13	39
e60dc79f	40	sub Actor::accessor_name_for {
d4519f23	41	my ($class, $col) = @_;
	42	return "movie" if lc $col eq "film";
	43	return $col;
9bc6db13	44	}
9bc6db13	45
5e85c671	46	# This is a class with accessor_name_for() but no corresponding mutator_name_for()
e60dc79f	47	sub Director::accessor_name_for {
	48	my($class, $col) = @_;
	49	return "nutty_as_a_fruitcake" if lc $col eq "isinsane";
	50	return $col;
	51	}
	52
9bc6db13	53	my $data = {
d4519f23	54	Title => 'Bad Taste',
	55	Director => 'Peter Jackson',
	56	Rating => 'R',
9bc6db13	57	};
	58
	59	eval {
c73f755d	60	my $data = { %$data };
d4519f23	61	$data->{NumExplodingSheep} = 1;
	62	ok my $bt = Film->create($data), "Modified accessor - with column name";
	63	isa_ok $bt, "Film";
c73f755d	64	is $bt->sheep, 1, 'sheep bursting violently';
9bc6db13	65	};
	66	is $@, '', "No errors";
	67
	68	eval {
c73f755d	69	my $data = { %$data };
c73f755d	70	$data->{sheep} = 2;
d4519f23	71	ok my $bt = Film->create($data), "Modified accessor - with accessor";
d4519f23	72	isa_ok $bt, "Film";
c73f755d	73	is $bt->sheep, 2, 'sheep bursting violently';
	74	};
	75	is $@, '', "No errors";
	76
	77	eval {
	78	my $data = { %$data };
	79	$data->{NumExplodingSheep} = 1;
	80	ok my $bt = Film->find_or_create($data),
	81	"find_or_create Modified accessor - find with column name";
	82	isa_ok $bt, "Film";
	83	is $bt->sheep, 1, 'sheep bursting violently';
	84	};
	85	is $@, '', "No errors";
	86
	87	eval {
	88	my $data = { %$data };
	89	$data->{sheep} = 1;
	90	ok my $bt = Film->find_or_create($data),
	91	"find_or_create Modified accessor - find with accessor";
	92	isa_ok $bt, "Film";
	93	is $bt->sheep, 1, 'sheep bursting violently';
	94	};
	95	is $@, '', "No errors";
	96
1fecf835	97	TODO: { local $TODO = 'TODOifying failing tests, waiting for Schwern'; ok (1, 'remove me');
c73f755d	98	eval {
	99	my $data = { %$data };
	100	$data->{NumExplodingSheep} = 3;
	101	ok my $bt = Film->find_or_create($data),
	102	"find_or_create Modified accessor - create with column name";
	103	isa_ok $bt, "Film";
	104	is $bt->sheep, 3, 'sheep bursting violently';
	105	};
	106	is $@, '', "No errors";
	107
	108	eval {
	109	my $data = { %$data };
	110	$data->{sheep} = 4;
	111	ok my $bt = Film->find_or_create($data),
	112	"find_or_create Modified accessor - create with accessor";
	113	isa_ok $bt, "Film";
	114	is $bt->sheep, 4, 'sheep bursting violently';
9bc6db13	115	};
	116	is $@, '', "No errors";
	117
	118	eval {
d4519f23	119	my @film = Film->search({ sheep => 1 });
d4519f23	120	is @film, 2, "Can search with modified accessor";
9bc6db13	121	};
c73f755d	122	is $@, '', "No errors";
9bc6db13	123
1fecf835	124	}
1fecf835	125
9bc6db13	126	{
9bc6db13	127
d4519f23	128	eval {
	129	local $data->{set_sheep} = 1;
	130	ok my $bt = Film->create($data), "Modified mutator - with mutator";
	131	isa_ok $bt, "Film";
	132	};
	133	is $@, '', "No errors";
	134
	135	eval {
	136	local $data->{NumExplodingSheep} = 1;
	137	ok my $bt = Film->create($data), "Modified mutator - with column name";
	138	isa_ok $bt, "Film";
	139	};
	140	is $@, '', "No errors";
	141
	142	eval {
	143	local $data->{sheep} = 1;
	144	ok my $bt = Film->create($data), "Modified mutator - with accessor";
	145	isa_ok $bt, "Film";
	146	};
	147	is $@, '', "No errors";
9bc6db13	148
	149	}
	150
	151	{
d4519f23	152	my $p_data = {
	153	name => 'Peter Jackson',
	154	film => 'Bad Taste',
	155	};
	156	my $bt = Film->create($data);
	157	my $ac = Actor->create($p_data);
	158
48cb8be4	159	ok !eval { my $f = $ac->film; 1 };
d4519f23	160	like $@, qr/film/, "no hasa film";
	161
	162	eval {
dec1bfe0	163	local $SIG{__WARN__} = sub {
	164	warn @_ unless $_[0] =~ /Query returned more than one row/;
	165	};
d4519f23	166	ok my $f = $ac->movie, "hasa movie";
	167	isa_ok $f, "Film";
	168	is $f->id, $bt->id, " - Bad Taste";
	169	};
	170	is $@, '', "No errors";
	171
	172	{
	173	local $data->{Title} = "Another film";
	174	my $film = Film->create($data);
	175
	176	eval { $ac->film($film) };
	177	ok $@, $@;
	178
	179	eval { $ac->movie($film) };
	180	ok $@, $@;
	181
	182	eval {
	183	ok $ac->set_film($film), "Set movie through hasa";
	184	$ac->update;
	185	ok my $f = $ac->movie, "hasa movie";
	186	isa_ok $f, "Film";
	187	is $f->id, $film->id, " - Another Film";
	188	};
	189	is $@, '', "No problem";
	190	}
9bc6db13	191
	192	}
	193
e60dc79f	194
	195	# Make sure a class with an accessor_name() method has a similar mutator.
	196	{
	197	my $aki = Director->create({
	198	name => "Aki Kaurismaki",
	199	});
	200
	201	$aki->nutty_as_a_fruitcake(1);
	202	is $aki->nutty_as_a_fruitcake, 1,
	203	"a custom accessor without a custom mutator is setable";
	204	$aki->update;
	205	}
	206
	207	{
d4519f23	208	Film->columns(TEMP => qw/nonpersistent/);
	209	ok(Film->find_column('nonpersistent'), "nonpersistent is a column");
	210	ok(!Film->has_real_column('nonpersistent'), " - but it's not real");
	211
	212	{
	213	my $film = Film->create({ Title => "Veronique", nonpersistent => 42 });
	214	is $film->title, "Veronique", "Title set OK";
	215	is $film->nonpersistent, 42, "As is non persistent value";
	216	$film->remove_from_object_index;
	217	ok $film = Film->retrieve('Veronique'), "Re-retrieve film";
	218	is $film->title, "Veronique", "Title still OK";
	219	is $film->nonpersistent, undef, "Non persistent value gone";
	220	ok $film->nonpersistent(40), "Can set it";
	221	is $film->nonpersistent, 40, "And it's there again";
	222	ok $film->update, "Commit the film";
	223	is $film->nonpersistent, 40, "And it's still there";
	224	}
9bc6db13	225	}
9bc6db13	226
e60dc79f	227	{
d4519f23	228	is_deeply(
	229	[Actor->columns('Essential')],
	230	[Actor->columns('Primary')],
	231	"Actor has no specific essential columns"
	232	);
	233	ok(Actor->find_column('nonpersistent'), "nonpersistent is a column");
	234	ok(!Actor->has_real_column('nonpersistent'), " - but it's not real");
	235	my $pj = eval { Actor->search(name => "Peter Jackson")->first };
	236	is $@, '', "no problems retrieving actors";
	237	isa_ok $pj => "Actor";
9bc6db13	238	}
9bc6db13	239
e60dc79f	240	{
d4519f23	241	Film->autoupdate(1);
	242	my $naked = Film->create({ title => 'Naked' });
	243	my $sandl = Film->create({ title => 'Secrets and Lies' });
	244
	245	my $rating = 1;
	246	my $update_failure = sub {
	247	my $obj = shift;
	248	eval { $obj->rating($rating++) };
	249	return $@ =~ /read only/;
	250	};
	251
	252	ok !$update_failure->($naked), "Can update Naked";
	253	ok $naked->make_read_only, "Make Naked read only";
	254	ok $update_failure->($naked), "Can't update Naked any more";
	255	ok !$update_failure->($sandl), "But can still update Secrets and Lies";
	256	my $july4 = eval { Film->create({ title => "4 Days in July" }) };
	257	isa_ok $july4 => "Film", "And can still create new films";
	258
	259	ok(Film->make_read_only, "Make all Films read only");
	260	ok $update_failure->($naked), "Still can't update Naked";
	261	ok $update_failure->($sandl), "And can't update S&L any more";
	262	eval { $july4->delete };
	263	like $@, qr/read only/, "And can't delete 4 Days in July";
	264	my $abigail = eval { Film->create({ title => "Abigail's Party" }) };
	265	like $@, qr/read only/, "Or create new films";
48cb8be4	266
48cb8be4	267	$sandl->discard_changes;
9bc6db13	268	}