[Bast-commits] r5348 - in DBIx-Class/0.08/trunk: . examples t
t/cdbi t/cdbi/DeepAbstractSearch t/cdbi/abstract t/cdbi/sweet
t/cdbi/testlib
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Sun Jan 25 10:09:41 GMT 2009
Author: ribasushi
Date: 2009-01-25 10:09:41 +0000 (Sun, 25 Jan 2009)
New Revision: 5348
Added:
DBIx-Class/0.08/trunk/examples/
DBIx-Class/0.08/trunk/t/cdbi/
DBIx-Class/0.08/trunk/t/cdbi/01-columns.t
DBIx-Class/0.08/trunk/t/cdbi/02-Film.t
DBIx-Class/0.08/trunk/t/cdbi/03-subclassing.t
DBIx-Class/0.08/trunk/t/cdbi/04-lazy.t
DBIx-Class/0.08/trunk/t/cdbi/06-hasa.t
DBIx-Class/0.08/trunk/t/cdbi/08-inheritcols.t
DBIx-Class/0.08/trunk/t/cdbi/09-has_many.t
DBIx-Class/0.08/trunk/t/cdbi/11-triggers.t
DBIx-Class/0.08/trunk/t/cdbi/12-filter.t
DBIx-Class/0.08/trunk/t/cdbi/13-constraint.t
DBIx-Class/0.08/trunk/t/cdbi/14-might_have.t
DBIx-Class/0.08/trunk/t/cdbi/15-accessor.t
DBIx-Class/0.08/trunk/t/cdbi/16-reserved.t
DBIx-Class/0.08/trunk/t/cdbi/18-has_a.t
DBIx-Class/0.08/trunk/t/cdbi/19-set_sql.t
DBIx-Class/0.08/trunk/t/cdbi/21-iterator.t
DBIx-Class/0.08/trunk/t/cdbi/22-deflate_order.t
DBIx-Class/0.08/trunk/t/cdbi/22-self_referential.t
DBIx-Class/0.08/trunk/t/cdbi/23-cascade.t
DBIx-Class/0.08/trunk/t/cdbi/24-meta_info.t
DBIx-Class/0.08/trunk/t/cdbi/26-mutator.t
DBIx-Class/0.08/trunk/t/cdbi/30-pager.t
DBIx-Class/0.08/trunk/t/cdbi/68-inflate_has_a.t
DBIx-Class/0.08/trunk/t/cdbi/98-failure.t
DBIx-Class/0.08/trunk/t/cdbi/DeepAbstractSearch/
DBIx-Class/0.08/trunk/t/cdbi/abstract/
DBIx-Class/0.08/trunk/t/cdbi/columns_as_hashes.t
DBIx-Class/0.08/trunk/t/cdbi/columns_dont_override_custom_accessors.t
DBIx-Class/0.08/trunk/t/cdbi/construct.t
DBIx-Class/0.08/trunk/t/cdbi/copy.t
DBIx-Class/0.08/trunk/t/cdbi/early_column_heisenbug.t
DBIx-Class/0.08/trunk/t/cdbi/has_many_loads_foreign_class.t
DBIx-Class/0.08/trunk/t/cdbi/hasa_without_loading.t
DBIx-Class/0.08/trunk/t/cdbi/max_min_value_of.t
DBIx-Class/0.08/trunk/t/cdbi/mk_group_accessors.t
DBIx-Class/0.08/trunk/t/cdbi/multi_column_set.t
DBIx-Class/0.08/trunk/t/cdbi/object_cache.t
DBIx-Class/0.08/trunk/t/cdbi/retrieve_from_sql_with_limit.t
DBIx-Class/0.08/trunk/t/cdbi/set_to_undef.t
DBIx-Class/0.08/trunk/t/cdbi/set_vs_DateTime.t
DBIx-Class/0.08/trunk/t/cdbi/sweet/
DBIx-Class/0.08/trunk/t/cdbi/testlib/
Removed:
DBIx-Class/0.08/trunk/t/cdbi-DeepAbstractSearch/
DBIx-Class/0.08/trunk/t/cdbi-abstract/
DBIx-Class/0.08/trunk/t/cdbi-sweet-t/
DBIx-Class/0.08/trunk/t/cdbi-t/
DBIx-Class/0.08/trunk/t/examples/
DBIx-Class/0.08/trunk/t/testlib/
Modified:
DBIx-Class/0.08/trunk/Makefile.PL
DBIx-Class/0.08/trunk/t/cdbi/DeepAbstractSearch/01_search.t
DBIx-Class/0.08/trunk/t/cdbi/abstract/search_where.t
DBIx-Class/0.08/trunk/t/cdbi/testlib/Actor.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/ActorAlias.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/Binary.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/Blurb.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/Director.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/Film.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/Lazy.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/Log.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/MyFilm.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/MyFoo.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/MyStar.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/MyStarLink.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/MyStarLinkMCPK.pm
DBIx-Class/0.08/trunk/t/cdbi/testlib/Order.pm
Log:
First stab at restructuring with tests_recursive() - no functional changes
Modified: DBIx-Class/0.08/trunk/Makefile.PL
===================================================================
--- DBIx-Class/0.08/trunk/Makefile.PL 2009-01-25 09:54:03 UTC (rev 5347)
+++ DBIx-Class/0.08/trunk/Makefile.PL 2009-01-25 10:09:41 UTC (rev 5348)
@@ -37,7 +37,7 @@
install_script 'script/dbicadmin';
-tests "t/*.t t/*/*.t";
+tests_recursive 't';
# re-build README and require CDBI modules for testing if we're in a checkout
Copied: DBIx-Class/0.08/trunk/examples (from rev 5346, DBIx-Class/0.08/trunk/t/examples)
Property changes on: DBIx-Class/0.08/trunk/examples
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/01-columns.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/01-columns.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/01-columns.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/01-columns.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,153 @@
+use strict;
+
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@") : (tests=> 24);
+}
+
+
+#-----------------------------------------------------------------------
+# Make sure that we can set up columns properly
+#-----------------------------------------------------------------------
+package State;
+
+use base 'DBIx::Class::Test::SQLite';
+
+State->table('State');
+State->columns(Essential => qw/Abbreviation Name/);
+State->columns(Primary => 'Name');
+State->columns(Weather => qw/Rain Snowfall/);
+State->columns(Other => qw/Capital Population/);
+#State->has_many(cities => "City");
+
+sub accessor_name_for {
+ 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;
+}
+
+sub Snowfall { 1 }
+
+
+package City;
+
+use base 'DBIx::Class::Test::SQLite';
+
+City->table('City');
+City->columns(All => qw/Name State Population/);
+
+{
+ # Disable the `no such table' warning
+ local $SIG{__WARN__} = sub {
+ my $warning = shift;
+ warn $warning unless ($warning =~ /\Qno such table: City(1)\E/);
+ };
+
+ City->has_a(State => 'State');
+}
+
+#-------------------------------------------------------------------------
+package CD;
+use base 'DBIx::Class::Test::SQLite';
+
+CD->table('CD');
+CD->columns('All' => qw/artist title length/);
+
+#-------------------------------------------------------------------------
+
+package main;
+
+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');
+is_deeply [ sort State->columns('Essential') ] => [qw/abbreviation name/],
+ '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');
+
+is(CD->primary_column, 'artist', 'CD primary()');
+is_deeply [ CD->columns('Primary') ] => [qw/artist/],
+ 'CD primary:' . join ", ", CD->columns('Primary');
+is_deeply [ sort CD->columns('All') ] => [qw/artist length title/],
+ 'CD all:' . join ", ", CD->columns('All');
+is_deeply [ sort CD->columns('Essential') ] => [qw/artist/],
+ '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";
+ }
+
+}
+
+{
+ SKIP: {
+ skip "No column objects", 1;
+
+ 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";
+ @grps = sort @grps; # Because the underlying API is hash-based
+ 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";
+#}
+
+#-----------------------------------------------------------------------
+# Make sure that columns inherit properly
+#-----------------------------------------------------------------------
+package State;
+
+package A;
+ at A::ISA = qw(DBIx::Class);
+__PACKAGE__->load_components(qw/CDBICompat Core/);
+__PACKAGE__->table('dummy');
+__PACKAGE__->columns(Primary => 'id');
+
+package A::B;
+ at A::B::ISA = 'A';
+__PACKAGE__->table('dummy2');
+__PACKAGE__->columns(All => qw(id b1));
+
+package A::C;
+ at A::C::ISA = 'A';
+__PACKAGE__->table('dummy3');
+__PACKAGE__->columns(All => qw(id c1 c2 c3));
+
+package main;
+is join (' ', sort A->columns), 'id', "A columns";
+is join (' ', sort A::B->columns), 'b1 id', "A::B columns";
+is join (' ', sort A::C->columns), 'c1 c2 c3 id', "A::C columns";
+
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/01-columns.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/02-Film.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/02-Film.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/02-Film.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/02-Film.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,417 @@
+use strict;
+use Test::More;
+$| = 1;
+
+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 => 98);
+}
+
+INIT {
+ 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...
+}
+
+{
+ 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 $duh = Film->insert; };
+like $@, qr/create needs a hashref/, "needs a hashref";
+
+ok +Film->create_test_film;
+
+my $btaste = Film->retrieve('Bad Taste');
+isa_ok $btaste, 'Film';
+is($btaste->Title, 'Bad Taste', 'Title() get');
+is($btaste->Director, 'Peter Jackson', 'Director() get');
+is($btaste->Rating, 'R', 'Rating() get');
+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";
+}
+
+ok my $gone = Film->find_or_create(
+ {
+ 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";
+isa_ok $gone, 'Film';
+
+# Shocking new footage found reveals bizarre Scarlet/sheep scene!
+is($gone->NumExplodingSheep, 0, 'NumExplodingSheep() get again');
+$gone->NumExplodingSheep(5);
+is($gone->NumExplodingSheep, 5, 'NumExplodingSheep() set');
+is($gone->numexplodingsheep, 5, 'numexplodingsheep() set');
+
+is($gone->Rating, 'PG', 'Rating() get again');
+$gone->Rating('NC-17');
+is($gone->Rating, 'NC-17', 'Rating() set');
+$gone->update;
+
+{
+ 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
+cmp_ok(Film->count_all, '==', 2, "count_all confirms 2 films");
+
+my $gone_copy = Film->retrieve('Gone With The Wind');
+ok($gone->NumExplodingSheep == 5, 'update()');
+ok($gone->Rating eq 'NC-17', 'update() again');
+
+# Grab the 'Bladerunner' entry.
+Film->create(
+ {
+ Title => 'Bladerunner',
+ Director => 'Bob Ridley Scott',
+ Rating => 'R'
+ }
+);
+
+my $blrunner = Film->retrieve('Bladerunner');
+is(ref $blrunner, 'Film', 'retrieve() again');
+is $blrunner->Title, 'Bladerunner', "Correct title";
+is $blrunner->Director, 'Bob Ridley Scott', " and Director";
+is $blrunner->Rating, 'R', " and Rating";
+is $blrunner->NumExplodingSheep, undef, " and sheep";
+
+# 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",
+ }
+);
+is(ref $blrunner_dc, 'Film', "copy() produces a film");
+is($blrunner_dc->Title, "Bladerunner: Director's Cut", 'Title correct');
+is($blrunner_dc->Director, 'Bob Ridley Scott', 'Director correct');
+is($blrunner_dc->Rating, '15', 'Rating correct');
+is($blrunner_dc->NumExplodingSheep, undef, 'Sheep 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_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";
+ }
+}
+
+# Multi-column search
+{
+ my @films = $blrunner->search_like(title => "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";
+}
+
+# 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";
+}
+
+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' });
+
+#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");
+ SKIP: {
+ skip "No deprecated warnings from compat layer", 1;
+ is $deprecated, 1, "Got a deprecated warning";
+ }
+ }
+};
+is $@, '', "No problems with deletes";
+
+# Find all films which have a rating of NC-17.
+my @films = Film->search('Rating', 'NC-17');
+is(scalar @films, 1, ' search returns one film');
+is($films[0]->id, $gone->id, ' ... the correct one');
+
+# Find all films which were directed by Bob
+ at films = Film->search_like('Director', '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'
+);
+
+# Find Ridley Scott films which don't have vomit
+ at films =
+ 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'
+);
+
+# Test that a disconnect doesnt harm anything.
+{
+ # SQLite is loud on disconnect/reconnect.
+ # This is solved in DBIC but not in ContextualFetch
+ local $SIG{__WARN__} = sub {
+ warn @_ unless $_[0] =~
+ /active statement handles|inactive database handle/;
+ };
+
+ Film->db_Main->disconnect;
+ @films = Film->search({ Rating => 'NC-17' });
+ ok(@films == 1 && $films[0]->id eq $gone->id, 'auto reconnection');
+
+ # Test discard_changes().
+ my $orig_director = $btaste->Director;
+ $btaste->Director('Lenny Bruce');
+ is($btaste->Director, 'Lenny Bruce', 'set new Director');
+ $btaste->discard_changes;
+ is($btaste->Director, $orig_director, 'discard_changes()');
+}
+
+SKIP: {
+ 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);
+}
+
+{ # update 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;
+}
+
+{
+ $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";
+}
+
+# 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";
+}
+
+# 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");
+}
+
+# overloading
+{
+ is "$blrunner", "Bladerunner", "stringify";
+
+ 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";
+
+ 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";
+}
+
+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";
+
+ $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";
+
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/02-Film.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/03-subclassing.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/03-subclassing.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/03-subclassing.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/03-subclassing.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,31 @@
+use strict;
+use Test::More;
+
+#----------------------------------------------------------------------
+# Make sure subclasses can be themselves subclassed
+#----------------------------------------------------------------------
+
+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 => 6);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+INIT { @Film::Threat::ISA = qw/Film/; }
+
+ok(Film::Threat->db_Main->ping, 'subclass db_Main()');
+is_deeply [ sort Film::Threat->columns ], [ sort Film->columns ],
+ 'has the same columns';
+
+my $bt = Film->create_test_film;
+ok my $btaste = Film::Threat->retrieve('Bad Taste'), "subclass retrieve";
+isa_ok $btaste => "Film::Threat";
+isa_ok $btaste => "Film";
+is $btaste->Title, 'Bad Taste', 'subclass get()';
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/03-subclassing.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/04-lazy.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/04-lazy.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/04-lazy.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/04-lazy.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,184 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+use Test::Warn;
+
+#----------------------------------------------------------------------
+# Test lazy loading
+#----------------------------------------------------------------------
+
+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 => 36);
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Lazy;
+}
+
+is_deeply [ Lazy->columns('Primary') ], [qw/this/], "Pri";
+is_deeply [ sort Lazy->columns('Essential') ], [qw/opop this/], "Essential";
+is_deeply [ sort Lazy->columns('things') ], [qw/that this/], "things";
+is_deeply [ sort Lazy->columns('horizon') ], [qw/eep orp/], "horizon";
+is_deeply [ sort Lazy->columns('vertical') ], [qw/oop opop/], "vertical";
+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('that'));
+ is_deeply \@groups, [qw/things/], "that (@groups)";
+}
+
+Lazy->create({ this => 1, that => 2, oop => 3, opop => 4, eep => 5 });
+
+ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
+ok($obj->_attribute_exists('this'), "Gets primary");
+ok($obj->_attribute_exists('opop'), "Gets other essential");
+ok(!$obj->_attribute_exists('that'), "But other things");
+ok(!$obj->_attribute_exists('eep'), " nor eep");
+ok(!$obj->_attribute_exists('orp'), " nor orp");
+ok(!$obj->_attribute_exists('oop'), " nor oop");
+
+ok(my $val = $obj->eep, 'Fetch eep');
+ok($obj->_attribute_exists('orp'), 'Gets orp too');
+ok(!$obj->_attribute_exists('oop'), 'But still not oop');
+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";
+}
+
+# Test contructor breaking.
+
+eval { # Need a hashref
+ Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50);
+};
+ok($@, $@);
+
+eval { # False column
+ Lazy->create({ this => 10, that => 20, theother => 30 });
+};
+ok($@, $@);
+
+eval { # Multiple false columns
+ Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 });
+};
+ok($@, $@);
+
+
+warning_is {
+ Lazy->columns( TEMP => qw(that) );
+} "Declaring column that as TEMP but it already exists";
+
+# Test that create() and update() throws out columns that changed
+{
+ my $l = Lazy->create({
+ this => 99,
+ that => 2,
+ oop => 3,
+ opop => 4,
+ });
+
+ ok $l->db_Main->do(qq{
+ UPDATE @{[ $l->table ]}
+ SET oop = ?
+ WHERE this = ?
+ }, undef, 87, $l->this);
+
+ is $l->oop, 87;
+
+ $l->oop(32);
+ $l->update;
+
+ ok $l->db_Main->do(qq{
+ UPDATE @{[ $l->table ]}
+ SET oop = ?
+ WHERE this = ?
+ }, undef, 23, $l->this);
+
+ is $l->oop, 23;
+
+ $l->delete;
+}
+
+
+# Now again for inflated values
+SKIP: {
+ skip "Requires Date::Simple", 5 unless eval "use Date::Simple; 1; ";
+ Lazy->has_a(
+ orp => 'Date::Simple',
+ inflate => sub { Date::Simple->new($_[0] . '-01-01') },
+ deflate => 'format'
+ );
+
+ my $l = Lazy->create({
+ this => 89,
+ that => 2,
+ orp => 1998,
+ });
+
+ ok $l->db_Main->do(qq{
+ UPDATE @{[ $l->table ]}
+ SET orp = ?
+ WHERE this = ?
+ }, undef, 1987, $l->this);
+
+ is $l->orp, '1987-01-01';
+
+ $l->orp(2007);
+ is $l->orp, '2007-01-01'; # make sure it's inflated
+ $l->update;
+
+ ok $l->db_Main->do(qq{
+ UPDATE @{[ $l->table ]}
+ SET orp = ?
+ WHERE this = ?
+ }, undef, 1942, $l->this);
+
+ is $l->orp, '1942-01-01';
+
+ $l->delete;
+}
+
+
+# Test that a deleted object works
+{
+ Lazy->search()->delete_all;
+ my $l = Lazy->create({
+ this => 99,
+ that => 2,
+ oop => 3,
+ opop => 4,
+ });
+
+ # Delete the object without it knowing.
+ Lazy->db_Main->do(qq[
+ DELETE
+ FROM @{[ Lazy->table ]}
+ WHERE this = 99
+ ]);
+
+ $l->eep;
+
+ # The problem was when an object had an inflated object
+ # loaded. _flesh() would set _column_data to undef and
+ # get_column() would think nothing was there.
+ # I'm too lazy to set up the proper inflation test.
+ ok !exists $l->{_column_data}{orp};
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/04-lazy.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/06-hasa.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/06-hasa.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/06-hasa.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/06-hasa.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,170 @@
+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 => 24);
+}
+
+ at YA::Film::ISA = 'Film';
+
+#local $SIG{__WARN__} = sub { };
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Film;
+ use Director;
+}
+
+Film->create_test_film;
+ok(my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste");
+ok(my $pj = $btaste->Director, "Bad taste has_a() director");
+ok(!ref($pj), ' ... which is not an object');
+
+ok(Film->has_a('Director' => 'Director'), "Link Director table");
+ok(
+ Director->create(
+ {
+ Name => 'Peter Jackson',
+ Birthday => -300000000,
+ IsInsane => 1
+ }
+ ),
+ 'create Director'
+);
+
+$btaste = Film->retrieve('Bad Taste');
+
+ok($pj = $btaste->Director, "Bad taste now has_a() director");
+isa_ok($pj => 'Director');
+is($pj->id, 'Peter Jackson', ' ... and is the correct director');
+
+# 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,
+ }
+);
+
+is($sj->id, 'Skippy Jackson', 'We have a new director');
+
+Film->has_a(CoDirector => 'Director');
+
+$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"
+);
+
+{ # 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";
+}
+
+inheriting_hasa();
+
+{
+
+ # 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);
+}
+
+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');
+}
+
+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'
+ );
+}
+
+sub fail_with_bad_object {
+ my ($dir, $codir) = @_;
+ eval {
+ YA::Film->create(
+ {
+ Title => 'Tastes Bad',
+ Director => $dir,
+ CoDirector => $codir,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ }
+ );
+ };
+ ok $@, $@;
+}
+
+package Foo;
+use base 'CDBase';
+__PACKAGE__->table('foo');
+__PACKAGE__->columns('All' => qw/ id fav /);
+# fav is a film
+__PACKAGE__->db_Main->do( qq{
+ CREATE TABLE foo (
+ id INTEGER,
+ fav VARCHAR(255)
+ )
+});
+
+
+package Bar;
+use base 'CDBase';
+__PACKAGE__->table('bar');
+__PACKAGE__->columns('All' => qw/ id fav /);
+# fav is a foo
+__PACKAGE__->db_Main->do( qq{
+ CREATE TABLE bar (
+ id INTEGER,
+ fav INTEGER
+ )
+});
+
+package main;
+Foo->has_a("fav" => "Film");
+Bar->has_a("fav" => "Foo");
+my $foo = Foo->create({ id => 6, fav => 'Bad Taste' });
+my $bar = Bar->create({ id => 2, fav => 6 });
+isa_ok($bar->fav, "Foo");
+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";
+}
+
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/06-hasa.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/08-inheritcols.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/08-inheritcols.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/08-inheritcols.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/08-inheritcols.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,25 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => 'Class::Trigger and DBIx::ContextualFetch required')
+ : (tests=> 3);
+}
+
+package A;
+ at A::ISA = qw(DBIx::Class::CDBICompat);
+__PACKAGE__->columns(Primary => 'id');
+
+package A::B;
+ at A::B::ISA = 'A';
+__PACKAGE__->columns(All => qw(id b1));
+
+package A::C;
+ at A::C::ISA = 'A';
+__PACKAGE__->columns(All => qw(id c1 c2 c3));
+
+package main;
+is join (' ', sort A->columns), 'id', "A columns";
+is join (' ', sort A::B->columns), 'b1 id', "A::B columns";
+is join (' ', sort A::C->columns), 'c1 c2 c3 id', "A::C columns";
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/08-inheritcols.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/09-has_many.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/09-has_many.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/09-has_many.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/09-has_many.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,127 @@
+use strict;
+use Test::More;
+
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => 'Class::Trigger and DBIx::ContextualFetch required' if $@;
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 31);
+}
+
+
+use lib 't/cdbi/testlib';
+use Film;
+use Actor;
+Actor->has_a(Film => 'Film');
+Film->has_many(actors => 'Actor', { order_by => 'name' });
+is(Actor->primary_column, 'id', "Actor primary OK");
+
+ok(Actor->can('Salary'), "Actor table set-up OK");
+ok(Film->can('actors'), " and have a suitable method in Film");
+
+Film->create_test_film;
+
+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'
+);
+is $pvj->Name, "Peter Vere-Jones", "PVJ name ok";
+is $pvj->Film, undef, "No film";
+ok $pvj->set_Film($btaste), "Set 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 %pj_data = (
+ Name => 'Peter Jackson',
+ Salary => '0', # it's a labour of love
+);
+
+eval { my $pj = Film->add_to_actors(\%pj_data) };
+like $@, qr/class/, "add_to_actors must be object method";
+
+eval { my $pj = $btaste->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'
+);
+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";
+}
+
+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";
+};
+is $@, '', "No errors";
+
+my $as = Actor->create(
+ {
+ Name => 'Arnold Schwarzenegger',
+ Film => 'Terminator 2',
+ Salary => '15_000_000'
+ }
+);
+
+eval { $btaste->actors($pj, $pvj, $as) };
+ok $@, $@;
+is($btaste->actors, 2, " - so we still only have 2 actors");
+
+my @bta_before = Actor->search(Film => 'Bad Taste');
+is(@bta_before, 2, "We have 2 actors in bad taste");
+ok($btaste->delete, "Delete bad taste");
+my @bta_after = Actor->search(Film => 'Bad Taste');
+is(@bta_after, 0, " - after deleting there are no actors");
+
+# While we're here, make sure Actors have unreadable mutators and
+# unwritable accessors
+
+eval { $as->Name("Paul Reubens") };
+ok $@, $@;
+eval { my $name = $as->set_Name };
+ok $@, $@;
+
+is($as->Name, 'Arnold Schwarzenegger', "Arnie's still Arnie");
+
+
+# Test infering of the foreign key of a has_many from an existing has_a
+{
+ use Thing;
+ use OtherThing;
+
+ Thing->has_a(that_thing => "OtherThing");
+ OtherThing->has_many(things => "Thing");
+
+ my $other_thing = OtherThing->create({ id => 1 });
+ Thing->create({ id => 1, that_thing => $other_thing });
+ Thing->create({ id => 2, that_thing => $other_thing });
+
+ is_deeply [sort map { $_->id } $other_thing->things], [1,2];
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/09-has_many.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/11-triggers.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/11-triggers.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/11-triggers.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/11-triggers.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,66 @@
+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 => 13);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+sub create_trigger2 { ::ok(1, "Running create trigger 2"); }
+sub delete_trigger { ::ok(1, "Deleting " . shift->Title) }
+
+sub pre_up_trigger {
+ $_[0]->_attribute_set(numexplodingsheep => 1);
+ ::ok(1, "Running pre-update trigger");
+}
+sub pst_up_trigger { ::ok(1, "Running post-update trigger"); }
+
+sub default_rating { $_[0]->Rating(15); }
+
+Film->add_trigger(before_create => \&default_rating);
+Film->add_trigger(after_create => \&create_trigger2);
+Film->add_trigger(after_delete => \&delete_trigger);
+Film->add_trigger(before_update => \&pre_up_trigger);
+Film->add_trigger(after_update => \&pst_up_trigger);
+
+ok(
+ my $ver = Film->create({
+ title => 'La Double Vie De Veronique',
+ director => 'Kryzstof Kieslowski',
+
+ # rating => '15',
+ numexplodingsheep => 0,
+ }
+ ),
+ "Create Veronique"
+);
+
+is $ver->Rating, 15, "Default rating";
+is $ver->NumExplodingSheep, 0, "Original sheep count";
+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))
+)->[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"});
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/11-triggers.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/12-filter.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/12-filter.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/12-filter.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/12-filter.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,181 @@
+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 => 50);
+}
+
+use lib 't/cdbi/testlib';
+use Actor;
+use Film;
+Film->has_many(actors => 'Actor');
+Actor->has_a('film' => 'Film');
+Actor->add_constructor(double_search => 'name = ? AND salary = ?');
+
+my $film = Film->create({ Title => 'MY Film' });
+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,
+ }
+ ),
+);
+
+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";
+};
+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";
+}
+
+{
+ 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";
+}
+
+{
+ 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->search(Film => $film), "Search by object";
+ is @actors, 3, "3 actors in film 1";
+}
+
+#----------------------------------------------------------------------
+# Iterators
+#----------------------------------------------------------------------
+
+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";
+}
+
+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";
+}
+
+# make sure nothing gets clobbered;
+test_normal_iterator;
+
+SKIP: {
+ #skip "dbic iterators don't support slice yet", 12;
+
+
+{
+ 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(2, 8);
+ is @acts, 1, "Slice off the end";
+ is $acts[0]->name, "Actor 3", "Gets last actor only";
+}
+
+package Class::DBI::My::Iterator;
+
+use vars qw/@ISA/;
+
+ at ISA = ($it_class);
+
+sub slice { qw/fred barney/ }
+
+package main;
+
+Actor->iterator_class('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";
+
+ 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";
+}
+
+} # end SKIP block
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/12-filter.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/13-constraint.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/13-constraint.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/13-constraint.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/13-constraint.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,121 @@
+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 => 23);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+sub valid_rating {
+ my $value = shift;
+ my $ok = grep $value eq $_, qw/U Uc PG 12 15 18/;
+ return $ok;
+}
+
+Film->add_constraint('valid rating', Rating => \&valid_rating);
+
+my %info = (
+ Title => 'La Double Vie De Veronique',
+ Director => 'Kryzstof Kieslowski',
+ Rating => '18',
+);
+
+{
+ local $info{Title} = "nonsense";
+ local $info{Rating} = 19;
+ eval { Film->create({%info}) };
+ ok $@, $@;
+ ok !Film->retrieve($info{Title}), "No film created";
+ is(Film->retrieve_all, 0, "So no films");
+}
+
+ok(my $ver = Film->create({%info}), "Can create with valid rating");
+is $ver->Rating, 18, "Rating 18";
+
+ok $ver->Rating(12), "Change to 12";
+ok $ver->update, "And update";
+is $ver->Rating, 12, "Rating now 12";
+
+eval {
+ $ver->Rating(13);
+ $ver->update;
+};
+ok $@, $@;
+is $ver->Rating, 12, "Rating still 12";
+ok $ver->delete, "Delete";
+
+# this threw an infinite loop in old versions
+Film->add_constraint('valid director', Director => sub { 1 });
+my $fred = Film->create({ Rating => '12' });
+
+# this test is a bit problematical because we don't supply a primary key
+# to the create() and the table doesn't use auto_increment or a sequence.
+ok $fred, "Got fred";
+
+{
+ ok +Film->constrain_column(rating => [qw/U PG 12 15 19/]),
+ "constraint_column";
+ my $narrower = eval { Film->create({ Rating => 'Uc' }) };
+ like $@, qr/fails.*constraint/, "Fails listref constraint";
+ my $ok = eval { Film->create({ Rating => 'U' }) };
+ is $@, '', "Can create with rating U";
+ SKIP: {
+ skip "No column objects", 2;
+ ok +Film->find_column('rating')->is_constrained, "Rating is constrained";
+ ok +Film->find_column('director')->is_constrained, "Director is not";
+ }
+}
+
+{
+ ok +Film->constrain_column(title => qr/The/), "constraint_column";
+ my $inferno = eval { Film->create({ Title => 'Towering Infero' }) };
+ like $@, qr/fails.*constraint/, "Can't create towering inferno";
+ my $the_inferno = eval { Film->create({ Title => 'The Towering Infero' }) };
+ is $@, '', "But can create THE towering inferno";
+}
+
+{
+
+ sub Film::_constrain_by_untaint {
+ my ($class, $col, $string, $type) = @_;
+ $class->add_constraint(
+ untaint => $col => sub {
+ my ($value, $self, $column_name, $changing) = @_;
+ $value eq "today" ? $changing->{$column_name} = "2001-03-03" : 0;
+ }
+ );
+ }
+ eval { Film->constrain_column(codirector => Untaint => 'date') };
+ is $@, '', 'Can constrain with untaint';
+ my $freeaa =
+ eval { Film->create({ title => "The Freaa", codirector => 'today' }) };
+ TODO: {
+ local $TODO = "no idea what this is supposed to do";
+ is $@, '', "Can create codirector";
+ is $freeaa && $freeaa->codirector, '2001-03-03', "Set the codirector";
+ }
+}
+
+__DATA__
+
+use CGI::Untaint;
+
+sub _constrain_by_untaint {
+ my ($class, $col, $string, $type) = @_;
+ $class->add_constraint(untaint => $col => sub {
+ my ($value, $self, $column_name, $changing) = @_;
+ my $h = CGI::Untaint->new({ %$changing });
+ return unless my $val = $h->extract("-as_$type" => $column_name);
+ $changing->{$column_name} = $val;
+ return 1;
+ });
+}
+
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/13-constraint.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/14-might_have.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/14-might_have.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/14-might_have.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/14-might_have.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,83 @@
+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 => 22);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+use Blurb;
+
+is(Blurb->primary_column, "title", "Primary key of Blurb = title");
+is_deeply [ Blurb->columns('Essential') ], [ Blurb->primary_column ], "Essential = Primary";
+
+eval { Blurb->retrieve(10) };
+is $@, "", "No problem retrieving non-existent Blurb";
+
+Film->might_have(info => Blurb => qw/blurb/);
+
+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";
+
+ 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';
+
+ 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";
+
+ # 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 $host = Film->create({ title => "Gwoemul" });
+ $host->blurb("Monsters are real.");
+ my $info = $host->info;
+ is $info->blurb, "Monsters are real.";
+
+ $host->discard_changes;
+ is $host->info->id, $info->id,
+ 'relationships still valid after discard_changes';
+
+ ok $host->info->delete;
+ $host->discard_changes;
+ ok !$host->info, 'relationships rechecked after discard_changes';
+}
\ No newline at end of file
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/14-might_have.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/15-accessor.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/15-accessor.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/15-accessor.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/15-accessor.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,268 @@
+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/cdbi/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;
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/15-accessor.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/16-reserved.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/16-reserved.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/16-reserved.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/16-reserved.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,36 @@
+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 => 5);
+}
+
+use lib 't/cdbi/testlib';
+require Film;
+require Order;
+
+Film->has_many(orders => 'Order');
+Order->has_a(film => 'Film');
+
+Film->create_test_film;
+
+my $film = Film->retrieve('Bad Taste');
+isa_ok $film => 'Film';
+
+$film->add_to_orders({ orders => 10 });
+
+my $bto = (Order->search(film => 'Bad Taste'))[0];
+isa_ok $bto => 'Order';
+is $bto->orders, 10, "Correct number of orders";
+
+
+my $infilm = $bto->film;
+isa_ok $infilm, "Film";
+
+is $infilm->id, $film->id, "Orders hasa Film";
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/16-reserved.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/18-has_a.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/18-has_a.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/18-has_a.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/18-has_a.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,240 @@
+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 => 41);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+use Director;
+ at YA::Film::ISA = 'Film';
+
+Film->create_test_film;
+
+ok my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste";
+ok my $pj = $btaste->Director, "Bad taste has a director";
+ok !ref($pj), ' ... which is not an object';
+
+ok(Film->has_a('Director' => 'Director'), "Link Director table");
+ok(
+ 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";
+}
+
+# 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,
+ });
+
+{
+ 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;
+}
+
+{ # 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";
+}
+
+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";
+}
+
+$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"
+);
+
+{ # 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');
+}
+
+{
+ $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';
+}
+
+{ # Broken has_a declaration
+ eval { Film->has_a(driector => "Director") };
+ like $@, qr/driector/, "Sensible error from has_a with incorrect column: $@";
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/18-has_a.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/19-set_sql.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/19-set_sql.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/19-set_sql.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/19-set_sql.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,132 @@
+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 => 20);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+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 $f1 = Film->create({ title => 'A', director => 'AA', rating => 'PG' });
+my $f2 = Film->create({ title => 'B', director => 'BA', rating => 'PG' });
+my $f3 = Film->create({ title => 'C', director => 'AA', rating => '15' });
+my $f4 = Film->create({ title => 'D', director => 'BA', rating => '18' });
+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
+}
+);
+
+{
+ (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";
+};
+
+Film->set_sql(
+ 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";
+};
+
+{
+ Film->set_sql(
+ by_id => qq{
+ SELECT __ESSENTIAL__
+ FROM __TABLE__
+ WHERE __IDENTIFIER__
+ }
+ );
+
+ my $film = Film->retrieve_all->first;
+ my @found = Film->search_by_id($film->id);
+ is @found, 1;
+ is $found[0]->id, $film->id;
+}
+
+
+{
+ 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";
+}
+
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/19-set_sql.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/21-iterator.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/21-iterator.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/21-iterator.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/21-iterator.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,96 @@
+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 => 37);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+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' }),
+);
+
+{
+ my $it1 = Film->retrieve_all;
+ isa_ok $it1, $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";
+ }
+}
+
+{
+ 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);
+ 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";
+}
+
+{
+ my $it = Film->retrieve_all;
+ is $it, $it->count, "iterator returns count as a scalar";
+ ok $it, "iterator returns true when there are results";
+}
+
+{
+ my $it = Film->search( Title => "something which does not exist" );
+ is $it, 0;
+ ok !$it, "iterator returns false when no results";
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/21-iterator.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/22-deflate_order.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/22-deflate_order.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/22-deflate_order.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/22-deflate_order.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,30 @@
+$| = 1;
+use strict;
+
+use Test::More;
+
+eval "use DBIx::Class::CDBICompat;";
+if ($@) {
+ plan (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@");
+ next;
+}
+
+eval { require Time::Piece::MySQL };
+plan skip_all => "Need Time::Piece::MySQL for this test" if $@;
+
+eval { require 't/cdbi/testlib/Log.pm' };
+plan skip_all => "Need MySQL for this test" if $@;
+
+plan tests => 2;
+
+package main;
+
+my $log = Log->insert( { message => 'initial message' } );
+ok eval { $log->datetime_stamp }, "Have datetime";
+diag $@ if $@;
+
+$log->message( 'a revised message' );
+$log->update;
+ok eval { $log->datetime_stamp }, "Have datetime after update";
+diag $@ if $@;
+
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/22-deflate_order.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/22-self_referential.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/22-self_referential.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/22-self_referential.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/22-self_referential.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,25 @@
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => 'Class::Trigger and DBIx::ContextualFetch required') : (tests=> 2);
+}
+
+use strict;
+
+use lib 't/cdbi/testlib';
+use Actor;
+use ActorAlias;
+Actor->has_many( aliases => [ 'ActorAlias' => 'alias' ] );
+
+my $first = Actor->create( { Name => 'First' } );
+my $second = Actor->create( { Name => 'Second' } );
+
+ActorAlias->create( { actor => $first, alias => $second } );
+
+my @aliases = $first->aliases;
+
+is( scalar @aliases, 1, 'proper number of aliases' );
+is( $aliases[ 0 ]->name, 'Second', 'proper alias' );
+
+
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/22-self_referential.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/23-cascade.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/23-cascade.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/23-cascade.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/23-cascade.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,78 @@
+use strict;
+use Test::More;
+use Data::Dumper;
+
+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 => 12);
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Film;
+ use Director;
+}
+
+{ # Cascade on delete
+ Director->has_many(nasties => 'Film');
+
+ my $dir = Director->insert({
+ name => "Lewis Teague",
+ });
+ my $kk = $dir->add_to_nasties({
+ Title => 'Alligator'
+ });
+ is $kk->director, $dir, "Director set OK";
+ is $dir->nasties, 1, "We have one nasty";
+
+ ok $dir->delete;
+ ok !Film->retrieve("Alligator"), "has_many cascade deletes by default";
+}
+
+
+# Two ways of saying not to cascade
+for my $args ({ no_cascade_delete => 1 }, { cascade => "None" }) {
+ Director->has_many(nasties => 'Film', $args);
+
+ my $dir = Director->insert({
+ name => "Lewis Teague",
+ });
+ my $kk = $dir->add_to_nasties({
+ Title => 'Alligator'
+ });
+ is $kk->director, $dir, "Director set OK";
+ is $dir->nasties, 1, "We have one nasty";
+
+ ok $dir->delete;
+ local $Data::Dumper::Terse = 1;
+ ok +Film->retrieve("Alligator"), 'has_many with ' . Dumper ($args);;
+ $kk->delete;
+}
+
+
+#{ # Fail on cascade
+# local $TODO = 'cascade => "Fail" unimplemented';
+#
+# Director->has_many(nasties => Film => { cascade => 'Fail' });
+#
+# my $dir = Director->insert({ name => "Nasty Noddy" });
+# my $kk = $dir->add_to_nasties({ Title => 'Killer Killers' });
+# is $kk->director, $dir, "Director set OK";
+# is $dir->nasties, 1, "We have one nasty";
+#
+# ok !eval { $dir->delete };
+# like $@, qr/1/, "Can't delete while films exist";
+#
+# my $rr = $dir->add_to_nasties({ Title => 'Revenge of the Revengers' });
+# ok !eval { $dir->delete };
+# like $@, qr/2/, "Still can't delete";
+#
+# $dir->nasties->delete_all;
+# ok eval { $dir->delete };
+# is $@, '', "Can delete once films are gone";
+#}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/23-cascade.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/24-meta_info.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/24-meta_info.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/24-meta_info.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/24-meta_info.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,78 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@"
+ if $@;
+
+ plan skip_all => "Time::Piece required for this test"
+ unless eval { require Time::Piece };
+
+ plan tests => 12;
+}
+
+use Test::Warn;
+
+package Temp::DBI;
+use base qw(DBIx::Class::CDBICompat);
+Temp::DBI->columns(All => qw(id date));
+
+my $strptime_inflate = sub {
+ Time::Piece->strptime(shift, "%Y-%m-%d")
+};
+Temp::DBI->has_a(
+ date => 'Time::Piece',
+ inflate => $strptime_inflate
+);
+
+
+package Temp::Person;
+use base 'Temp::DBI';
+Temp::Person->table('people');
+Temp::Person->columns(Info => qw(name pet));
+Temp::Person->has_a( pet => 'Temp::Pet' );
+
+package Temp::Pet;
+use base 'Temp::DBI';
+Temp::Pet->table('pets');
+Temp::Pet->columns(Info => qw(name));
+Temp::Pet->has_many(owners => 'Temp::Person');
+
+package main;
+
+{
+ my $pn_meta = Temp::Person->meta_info('has_a');
+ is_deeply [sort keys %$pn_meta], [qw/date pet/], "Person has Date and Pet";
+}
+
+{
+ my $pt_meta = Temp::Pet->meta_info;
+ is_deeply [keys %{$pt_meta->{has_a}}], [qw/date/], "Pet has Date";
+ is_deeply [keys %{$pt_meta->{has_many}}], [qw/owners/], "And owners";
+}
+
+{
+ my $pet = Temp::Person->meta_info( has_a => 'pet' );
+ is $pet->class, 'Temp::Person';
+ is $pet->foreign_class, 'Temp::Pet';
+ is $pet->accessor, 'pet';
+ is $pet->name, 'has_a';
+}
+
+{
+ my $owners = Temp::Pet->meta_info( has_many => 'owners' );
+
+ is_deeply $owners->args, {
+ foreign_key => 'pet',
+ mapping => [],
+ };
+}
+
+{
+ my $date = Temp::Pet->meta_info( has_a => 'date' );
+ is $date->class, 'Temp::DBI';
+ is $date->foreign_class, 'Time::Piece';
+ is $date->accessor, 'date';
+ is $date->args->{inflate}, $strptime_inflate;
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/24-meta_info.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/26-mutator.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/26-mutator.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/26-mutator.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/26-mutator.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,47 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@"
+ if $@;
+}
+
+BEGIN {
+ 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 $data = {
+ 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
+accessor";
+ isa_ok $bt, "Film";
+};
+is $@, '', "No errors";
+
+eval {
+ ok $bt->sheep(2), 'Modified accessor, set';
+ ok $bt->update, 'Update';
+};
+is $@, '', "No errors";
+
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/26-mutator.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/30-pager.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/30-pager.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/30-pager.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/30-pager.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,52 @@
+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 => 6);
+}
+
+use lib 't/cdbi/testlib';
+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' }),
+);
+
+# first page
+my ( $pager, $it ) = Film->page(
+ {},
+ { rows => 3,
+ page => 1 }
+);
+
+is( $pager->entries_on_this_page, 3, "entries_on_this_page ok" );
+
+is( $pager->next_page, 2, "next_page ok" );
+
+is( $it->next->title, "Film 1", "iterator->next ok" );
+
+$it->next;
+$it->next;
+
+is( $it->next, undef, "next past end of page ok" );
+
+# second page
+( $pager, $it ) = Film->page(
+ {},
+ { rows => 3,
+ page => 2 }
+);
+
+is( $pager->entries_on_this_page, 2, "entries on second page ok" );
+
+is( $it->next->title, "Film 4", "second page first title ok" );
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/30-pager.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/68-inflate_has_a.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/68-inflate_has_a.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/68-inflate_has_a.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/68-inflate_has_a.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,67 @@
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => "Class::Trigger and DBIx::ContextualFetch required"
+ if $@;
+
+ eval { require DateTime };
+ plan skip_all => "Need DateTime for inflation tests" if $@;
+
+ eval { require Clone };
+ plan skip_all => "Need Clone for CDBICompat inflation tests" if $@;
+}
+
+plan tests => 6;
+
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+DBICTest::Schema::CD->load_components(qw/CDBICompat::Relationships/);
+
+DBICTest::Schema::CD->has_a( 'year', 'DateTime',
+ inflate => sub { DateTime->new( year => shift ) },
+ deflate => sub { shift->year }
+);
+Class::C3->reinitialize;
+
+# inflation test
+my $cd = $schema->resultset("CD")->find(3);
+
+is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' );
+
+is( $cd->year->month, 1, 'inflated month ok' );
+
+# deflate test
+my $now = DateTime->now;
+$cd->year( $now );
+$cd->update;
+
+($cd) = $schema->resultset("CD")->search( year => $now->year );
+is( $cd->year->year, $now->year, 'deflate ok' );
+
+# re-test using alternate deflate syntax
+$schema->class("CD")->has_a( 'year', 'DateTime',
+ inflate => sub { DateTime->new( year => shift ) },
+ deflate => 'year'
+);
+
+# inflation test
+$cd = $schema->resultset("CD")->find(3);
+
+is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' );
+
+is( $cd->year->month, 1, 'inflated month ok' );
+
+# deflate test
+$now = DateTime->now;
+$cd->year( $now );
+$cd->update;
+
+($cd) = $schema->resultset("CD")->search( year => $now->year );
+is( $cd->year->year, $now->year, 'deflate ok' );
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/98-failure.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/98-failure.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/98-failure.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/98-failure.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,62 @@
+use strict;
+use Test::More;
+
+#----------------------------------------------------------------------
+# Test database failures
+#----------------------------------------------------------------------
+
+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 => 7);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+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";
+ $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";
+ }
+}
+
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/98-failure.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/DeepAbstractSearch (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-DeepAbstractSearch)
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/DeepAbstractSearch
___________________________________________________________________
Name: svn:mergeinfo
+
Modified: DBIx-Class/0.08/trunk/t/cdbi/DeepAbstractSearch/01_search.t
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi-DeepAbstractSearch/01_search.t 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/DeepAbstractSearch/01_search.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -17,7 +17,7 @@
plan tests => 19;
}
-my $DB = "t/testdb";
+my $DB = "t/var/cdbi_testdb";
unlink $DB if -e $DB;
my @DSN = ("dbi:SQLite:dbname=$DB", '', '', { AutoCommit => 0 });
Copied: DBIx-Class/0.08/trunk/t/cdbi/abstract (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-abstract)
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/abstract
___________________________________________________________________
Name: svn:mergeinfo
+
Modified: DBIx-Class/0.08/trunk/t/cdbi/abstract/search_where.t
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi-abstract/search_where.t 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/abstract/search_where.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,5 +1,3 @@
-#!/usr/bin/perl -w
-
use Test::More;
use strict;
@@ -16,7 +14,7 @@
}
INIT {
- use lib 't/testlib';
+ use lib 't/cdbi/testlib';
use Film;
}
Copied: DBIx-Class/0.08/trunk/t/cdbi/columns_as_hashes.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/columns_as_hashes.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/columns_as_hashes.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/columns_as_hashes.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,104 @@
+use strict;
+use Test::More;
+use Test::Warn;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : ('no_plan');
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+my $waves = Film->insert({
+ Title => "Breaking the Waves",
+ Director => 'Lars von Trier',
+ Rating => 'R'
+});
+
+local $ENV{DBIC_CDBICOMPAT_HASH_WARN} = 0;
+
+{
+ local $ENV{DBIC_CDBICOMPAT_HASH_WARN} = 1;
+
+ warnings_like {
+ my $rating = $waves->{rating};
+ $waves->Rating("PG");
+ is $rating, "R", 'evaluation of column value is not deferred';
+ } qr{^Column 'rating' of 'Film/$waves' was fetched as a hash at \Q$0};
+
+ warnings_like {
+ is $waves->{title}, $waves->Title, "columns can be accessed as hashes";
+ } qr{^Column 'title' of 'Film/$waves' was fetched as a hash at\b};
+
+ $waves->Rating("G");
+
+ warnings_like {
+ is $waves->{rating}, "G", "updating via the accessor updates the hash";
+ } qr{^Column 'rating' of 'Film/$waves' was fetched as a hash at\b};
+
+
+ warnings_like {
+ $waves->{rating} = "PG";
+ } qr{^Column 'rating' of 'Film/$waves' was stored as a hash at\b};
+
+ $waves->update;
+ my @films = Film->search( Rating => "PG", Title => "Breaking the Waves" );
+ is @films, 1, "column updated as hash was saved";
+}
+
+warning_is {
+ $waves->{rating}
+} '', 'DBIC_CDBICOMPAT_HASH_WARN controls warnings';
+
+
+{
+ $waves->rating("R");
+ $waves->update;
+
+ no warnings 'redefine';
+ local *Film::rating = sub {
+ return "wibble";
+ };
+
+ is $waves->{rating}, "R";
+}
+
+
+{
+ no warnings 'redefine';
+ no warnings 'once';
+ local *Actor::accessor_name_for = sub {
+ my($class, $col) = @_;
+ return "movie" if lc $col eq "film";
+ return $col;
+ };
+
+ require Actor;
+ Actor->has_a( film => "Film" );
+
+ my $actor = Actor->insert({
+ name => 'Emily Watson',
+ film => $waves,
+ });
+
+ ok !eval { $actor->film };
+ is $actor->{film}->id, $waves->id,
+ 'hash access still works despite lack of accessor';
+}
+
+
+# Emulate that Class::DBI inflates immediately
+SKIP: {
+ skip "Need MySQL to run this test", 3 unless eval { require MyFoo };
+
+ my $foo = MyFoo->insert({
+ name => 'Whatever',
+ tdate => '1949-02-01',
+ });
+ isa_ok $foo, 'MyFoo';
+
+ isa_ok $foo->{tdate}, 'Date::Simple';
+ is $foo->{tdate}->year, 1949;
+}
\ No newline at end of file
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/columns_as_hashes.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/columns_dont_override_custom_accessors.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/columns_dont_override_custom_accessors.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/columns_dont_override_custom_accessors.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/columns_dont_override_custom_accessors.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,32 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : (tests=> 5);
+}
+
+{
+ package Thing;
+
+ use base 'DBIx::Class::Test::SQLite';
+
+ Thing->columns(TEMP => qw[foo bar]);
+ Thing->columns(All => qw[thing_id yarrow flower]);
+ sub foo { 42 }
+ sub yarrow { "hock" }
+}
+
+is_deeply( [sort Thing->columns("TEMP")],
+ [sort qw(foo bar)],
+ "TEMP columns set"
+);
+my $thing = Thing->construct(
+ { thing_id => 23, foo => "this", bar => "that" }
+);
+
+is( $thing->id, 23 );
+is( $thing->yarrow, "hock", 'custom accessor not overwritten by column' );
+is( $thing->foo, 42, 'custom routine not overwritten by temp column' );
+is( $thing->bar, "that", 'temp column accessor generated' );
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/columns_dont_override_custom_accessors.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/construct.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/construct.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/construct.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/construct.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,43 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : (tests=> 5);
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Film;
+}
+
+{
+ Film->insert({
+ Title => "Breaking the Waves",
+ Director => 'Lars von Trier',
+ Rating => 'R'
+ });
+
+ my $film = Film->construct({
+ Title => "Breaking the Waves",
+ Director => 'Lars von Trier',
+ });
+
+ isa_ok $film, "Film";
+ is $film->title, "Breaking the Waves";
+ is $film->director, "Lars von Trier";
+ is $film->rating, "R",
+ "constructed objects can get missing data from the db";
+}
+
+{
+ package Foo;
+ use base qw(Film);
+ Foo->columns( TEMP => qw(temp_thing) );
+ my $film = Foo->construct({
+ temp_thing => 23
+ });
+
+ ::is $film->temp_thing, 23, "construct sets temp columns";
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/construct.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/copy.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/copy.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/copy.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/copy.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,41 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : (tests=> 4);
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+}
+
+{
+ package # hide from PAUSE
+ MyFilm;
+
+ use base 'DBIx::Class::Test::SQLite';
+ use strict;
+
+ __PACKAGE__->set_table('Movies');
+ __PACKAGE__->columns(All => qw(id title));
+
+ sub create_sql {
+ return qq{
+ id INTEGER PRIMARY KEY AUTOINCREMENT,
+ title VARCHAR(255)
+ }
+ }
+}
+
+my $film = MyFilm->create({ title => "For Your Eyes Only" });
+ok $film->id;
+
+my $new_film = $film->copy;
+ok $new_film->id;
+isnt $new_film->id, $film->id, "copy() gets new primary key";
+
+$new_film = $film->copy(42);
+is $new_film->id, 42, "copy() with new id";
+
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/copy.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/early_column_heisenbug.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/early_column_heisenbug.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/early_column_heisenbug.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/early_column_heisenbug.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,28 @@
+use strict;
+
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : ('no_plan');
+}
+
+
+{
+ package Thing;
+ use base qw(DBIx::Class::CDBICompat);
+}
+
+{
+ package Stuff;
+ use base qw(DBIx::Class::CDBICompat);
+}
+
+# There was a bug where looking at a column group before any were
+# set would cause them to be shared across classes.
+is_deeply [Stuff->columns("Essential")], [];
+Thing->columns(Essential => qw(foo bar baz));
+is_deeply [Stuff->columns("Essential")], [];
+
+1;
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/early_column_heisenbug.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/has_many_loads_foreign_class.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/has_many_loads_foreign_class.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/has_many_loads_foreign_class.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/has_many_loads_foreign_class.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,37 @@
+use strict;
+use Test::More;
+
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => 'Class::Trigger and DBIx::ContextualFetch required' if $@;
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 3);
+}
+
+
+use lib 't/cdbi/testlib';
+use Director;
+
+# Test that has_many() will load the foreign class.
+ok !Class::Inspector->loaded( 'Film' );
+ok eval { Director->has_many( films => 'Film' ); 1; } || diag $@;
+
+my $shan_hua = Director->create({
+ Name => "Shan Hua",
+});
+
+my $inframan = Film->create({
+ Title => "Inframan",
+ Director => "Shan Hua",
+});
+my $guillotine2 = Film->create({
+ Title => "Flying Guillotine 2",
+ Director => "Shan Hua",
+});
+my $guillotine = Film->create({
+ Title => "Master of the Flying Guillotine",
+ Director => "Yu Wang",
+});
+
+is_deeply [sort $shan_hua->films], [sort $inframan, $guillotine2];
\ No newline at end of file
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/has_many_loads_foreign_class.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/hasa_without_loading.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/hasa_without_loading.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/hasa_without_loading.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/hasa_without_loading.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,21 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => 'Class::Trigger and DBIx::ContextualFetch required')
+ : (tests=> 2);
+}
+
+package Foo;
+
+use base qw(DBIx::Class::CDBICompat);
+
+eval {
+ Foo->table("foo");
+ Foo->columns(Essential => qw(foo bar));
+ #Foo->has_a( bar => "This::Does::Not::Exist::Yet" );
+};
+#::is $@, '';
+::is(Foo->table, "foo");
+::is_deeply [sort map lc, Foo->columns], [sort map lc, qw(foo bar)];
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/hasa_without_loading.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/max_min_value_of.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/max_min_value_of.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/max_min_value_of.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/max_min_value_of.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,32 @@
+use strict;
+use Test::More;
+
+#----------------------------------------------------------------------
+# Test database failures
+#----------------------------------------------------------------------
+
+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 => 2);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+Film->create({
+ title => "Bad Taste",
+ numexplodingsheep => 10,
+});
+
+Film->create({
+ title => "Evil Alien Conquerers",
+ numexplodingsheep => 2,
+});
+
+is( Film->maximum_value_of("numexplodingsheep"), 10 );
+is( Film->minimum_value_of("numexplodingsheep"), 2 );
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/max_min_value_of.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/mk_group_accessors.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/mk_group_accessors.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/mk_group_accessors.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/mk_group_accessors.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,69 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => 'Class::Trigger and DBIx::ContextualFetch required' if $@;
+
+ eval "use DBD::SQLite";
+ plan skip_all => 'needs DBD::SQLite for testing' if $@;
+
+ plan 'no_plan';
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ require Film;
+}
+
+sub Film::get_test {
+ my $self = shift;
+ my $key = shift;
+ $self->{get_test}++;
+ return $self->{$key};
+}
+
+sub Film::set_test {
+ my($self, $key, $val) = @_;
+ $self->{set_test}++;
+ return $self->{$key} = $val;
+}
+
+
+my $film = Film->create({ Title => "No Wolf McQuade" });
+
+# Test mk_group_accessors() with a list of fields.
+{
+ Film->mk_group_accessors(test => qw(foo bar));
+ $film->foo(42);
+ is $film->foo, 42;
+
+ $film->bar(23);
+ is $film->bar, 23;
+}
+
+
+# An explicit accessor passed to mk_group_accessors should
+# ignore accessor/mutator_name_for.
+sub Film::accessor_name_for {
+ my($class, $col) = @_;
+ return "hlaglagh" if $col eq "wibble";
+ return $col;
+}
+
+sub Film::mutator_name_for {
+ my($class, $col) = @_;
+ return "hlaglagh" if $col eq "wibble";
+ return $col;
+}
+
+
+# Test with a mix of fields and field specs
+{
+ Film->mk_group_accessors(test => ("baz", [wibble_thing => "wibble"]));
+ $film->baz(42);
+ is $film->baz, 42;
+
+ $film->wibble_thing(23);
+ is $film->wibble_thing, 23;
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/mk_group_accessors.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/multi_column_set.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/multi_column_set.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/multi_column_set.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/multi_column_set.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,25 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : (tests=> 3);
+}
+
+{
+ package Thing;
+
+ use base 'DBIx::Class::Test::SQLite';
+
+ Thing->columns(TEMP => qw[foo bar baz]);
+ Thing->columns(All => qw[some real stuff]);
+}
+
+my $thing = Thing->construct({ foo => 23, some => 42, baz => 99 });
+$thing->set( foo => "wibble", some => "woosh" );
+is $thing->foo, "wibble";
+is $thing->some, "woosh";
+is $thing->baz, 99;
+
+$thing->discard_changes;
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/multi_column_set.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/object_cache.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/object_cache.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/object_cache.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/object_cache.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,82 @@
+use strict;
+use Test::More;
+$| = 1;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ }
+
+ eval "use DBD::SQLite";
+ plan skip_all => 'needs DBD::SQLite for testing' if $@;
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Film;
+}
+
+plan skip_all => "Object cache is turned off"
+ if Film->isa("DBIx::Class::CDBICompat::NoObjectIndex");
+
+plan tests => 5;
+
+
+ok +Film->create({
+ Title => 'This Is Spinal Tap',
+ Director => 'Rob Reiner',
+ Rating => 'R',
+});
+
+{
+ my $film1 = Film->retrieve( "This Is Spinal Tap" );
+ my $film2 = Film->retrieve( "This Is Spinal Tap" );
+
+ $film1->Director("Marty DiBergi");
+ is $film2->Director, "Marty DiBergi", 'retrieve returns the same object';
+
+ $film1->discard_changes;
+}
+
+{
+ Film->nocache(1);
+
+ my $film1 = Film->retrieve( "This Is Spinal Tap" );
+ my $film2 = Film->retrieve( "This Is Spinal Tap" );
+
+ $film1->Director("Marty DiBergi");
+ is $film2->Director, "Rob Reiner",
+ 'caching turned off';
+
+ $film1->discard_changes;
+}
+
+{
+ Film->nocache(0);
+
+ my $film1 = Film->retrieve( "This Is Spinal Tap" );
+ my $film2 = Film->retrieve( "This Is Spinal Tap" );
+
+ $film1->Director("Marty DiBergi");
+ is $film2->Director, "Marty DiBergi",
+ 'caching back on';
+
+ $film1->discard_changes;
+}
+
+
+{
+ Film->nocache(1);
+
+ local $Class::DBI::Weaken_Is_Available = 0;
+
+ my $film1 = Film->retrieve( "This Is Spinal Tap" );
+ my $film2 = Film->retrieve( "This Is Spinal Tap" );
+
+ $film1->Director("Marty DiBergi");
+ is $film2->Director, "Rob Reiner",
+ 'CDBI::Weaken_Is_Available turns off all caching';
+
+ $film1->discard_changes;
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/object_cache.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/retrieve_from_sql_with_limit.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/retrieve_from_sql_with_limit.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/retrieve_from_sql_with_limit.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/retrieve_from_sql_with_limit.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,25 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : (tests=> 3);
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Film;
+}
+
+for my $title ("Bad Taste", "Braindead", "Forgotten Silver") {
+ Film->insert({ Title => $title, Director => 'Peter Jackson' });
+}
+
+Film->insert({ Title => "Transformers", Director => "Michael Bay"});
+
+{
+ my @films = Film->retrieve_from_sql(qq[director = "Peter Jackson" LIMIT 2]);
+ is @films, 2, "retrieve_from_sql with LIMIT";
+ is( $_->director, "Peter Jackson" ) for @films;
+}
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/retrieve_from_sql_with_limit.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/set_to_undef.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/set_to_undef.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/set_to_undef.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/set_to_undef.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,32 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@"
+ if $@;
+ plan skip_all => "DateTime required" unless eval { require DateTime };
+ plan tests => 2;
+}
+
+
+# Don't use Test::NoWarnings because of an unrelated DBD::SQLite warning.
+my @warnings;
+local $SIG{__WARN__} = sub {
+ push @warnings, @_;
+};
+
+{
+ package Thing;
+
+ use base 'DBIx::Class::Test::SQLite';
+
+ Thing->columns(All => qw[thing_id this that date]);
+}
+
+my $thing = Thing->construct({ thing_id => 23, this => 42 });
+$thing->set( this => undef );
+is $thing->get( "this" ), undef, 'undef set';
+$thing->discard_changes;
+
+is @warnings, 0, 'no warnings';
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/set_to_undef.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/set_vs_DateTime.t (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-t/set_vs_DateTime.t)
===================================================================
--- DBIx-Class/0.08/trunk/t/cdbi/set_vs_DateTime.t (rev 0)
+++ DBIx-Class/0.08/trunk/t/cdbi/set_vs_DateTime.t 2009-01-25 10:09:41 UTC (rev 5348)
@@ -0,0 +1,30 @@
+use strict;
+use Test::More;
+use Test::Exception;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@"
+ if $@;
+ plan skip_all => "DateTime required" unless eval { require DateTime };
+ plan tests => 1;
+}
+
+{
+ package Thing;
+
+ use base 'DBIx::Class::Test::SQLite';
+
+ Thing->columns(All => qw[thing_id this that date]);
+}
+
+my $thing = Thing->construct({ thing_id => 23, date => "01-02-1994" });
+my $date = DateTime->now;
+lives_ok {
+ $thing->set( date => $date );
+ $thing->set( date => $date );
+};
+
+
+
+$thing->discard_changes;
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/set_vs_DateTime.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/sweet (from rev 5346, DBIx-Class/0.08/trunk/t/cdbi-sweet-t)
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/sweet
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/trunk/t/cdbi/testlib (from rev 5346, DBIx-Class/0.08/trunk/t/testlib)
Property changes on: DBIx-Class/0.08/trunk/t/cdbi/testlib
___________________________________________________________________
Name: svn:mergeinfo
+
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/Actor.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/Actor.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/Actor.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,8 +1,6 @@
package # hide from PAUSE
Actor;
-BEGIN { unshift @INC, './t/testlib'; }
-
use strict;
use warnings;
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/ActorAlias.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/ActorAlias.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/ActorAlias.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,27 +1,25 @@
-package # hide from PAUSE
- ActorAlias;
-
-BEGIN { unshift @INC, './t/testlib'; }
-
-use strict;
-use warnings;
-
-use base 'DBIx::Class::Test::SQLite';
-
-__PACKAGE__->set_table( 'ActorAlias' );
-
-__PACKAGE__->columns( Primary => 'id' );
-__PACKAGE__->columns( All => qw/ actor alias / );
-__PACKAGE__->has_a( actor => 'Actor' );
-__PACKAGE__->has_a( alias => 'Actor' );
-
-sub create_sql {
- return qq{
- id INTEGER PRIMARY KEY,
- actor INTEGER,
- alias INTEGER
- }
-}
-
-1;
-
+package # hide from PAUSE
+ ActorAlias;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Test::SQLite';
+
+__PACKAGE__->set_table( 'ActorAlias' );
+
+__PACKAGE__->columns( Primary => 'id' );
+__PACKAGE__->columns( All => qw/ actor alias / );
+__PACKAGE__->has_a( actor => 'Actor' );
+__PACKAGE__->has_a( alias => 'Actor' );
+
+sub create_sql {
+ return qq{
+ id INTEGER PRIMARY KEY,
+ actor INTEGER,
+ alias INTEGER
+ }
+}
+
+1;
+
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/Binary.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/Binary.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/Binary.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,8 +1,6 @@
package # hide from PAUSE
Binary;
-BEGIN { unshift @INC, './t/testlib'; }
-
use strict;
use base 'PgBase';
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/Blurb.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/Blurb.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/Blurb.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,8 +1,6 @@
package # hide from PAUSE
Blurb;
-BEGIN { unshift @INC, './t/testlib'; }
-
use strict;
use base 'DBIx::Class::Test::SQLite';
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/Director.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/Director.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/Director.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,8 +1,6 @@
package # hide from PAUSE
Director;
-BEGIN { unshift @INC, './t/testlib'; }
-
use strict;
use base 'DBIx::Class::Test::SQLite';
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/Film.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/Film.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/Film.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,7 +1,6 @@
package # hide from PAUSE
Film;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'DBIx::Class::Test::SQLite';
use strict;
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/Lazy.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/Lazy.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/Lazy.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,7 +1,6 @@
package # hide from PAUSE
Lazy;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'DBIx::Class::Test::SQLite';
use strict;
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/Log.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/Log.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/Log.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,7 +1,6 @@
package # hide from PAUSE
Log;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use strict;
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/MyFilm.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/MyFilm.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/MyFilm.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,7 +1,6 @@
package # hide from PAUSE
MyFilm;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use MyStarLink;
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/MyFoo.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/MyFoo.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/MyFoo.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,7 +1,6 @@
package # hide from PAUSE
MyFoo;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use strict;
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/MyStar.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/MyStar.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/MyStar.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,7 +1,6 @@
package # hide from PAUSE
MyStar;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use strict;
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/MyStarLink.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/MyStarLink.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/MyStarLink.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,7 +1,6 @@
package # hide from PAUSE
MyStarLink;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use strict;
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/MyStarLinkMCPK.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/MyStarLinkMCPK.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/MyStarLinkMCPK.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,7 +1,6 @@
package # hide from PAUSE
MyStarLinkMCPK;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use MyStar;
Modified: DBIx-Class/0.08/trunk/t/cdbi/testlib/Order.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/testlib/Order.pm 2009-01-25 00:58:55 UTC (rev 5346)
+++ DBIx-Class/0.08/trunk/t/cdbi/testlib/Order.pm 2009-01-25 10:09:41 UTC (rev 5348)
@@ -1,8 +1,6 @@
package # hide from PAUSE
Order;
-BEGIN { unshift @INC, './t/testlib'; }
-
use strict;
use base 'DBIx::Class::Test::SQLite';
More information about the Bast-commits
mailing list