From: Peter Rabbitson Date: Wed, 11 Mar 2009 06:57:05 +0000 (+0000) Subject: Moose-related test hierarchy not removed at r4326 X-Git-Tag: v0.08100~50 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6fe5a3d40d7fa2318b62ff28281dbb58274cc105;p=dbsrgits%2FDBIx-Class.git Moose-related test hierarchy not removed at r4326 --- diff --git a/t/lib/DBICNGTest/Schema.pm b/t/lib/DBICNGTest/Schema.pm deleted file mode 100644 index 57d2d50..0000000 --- a/t/lib/DBICNGTest/Schema.pm +++ /dev/null @@ -1,162 +0,0 @@ -package # hide from PAUSE - DBICNGTest::Schema; - - use Moose; - use Path::Class::File; - extends 'DBIx::Class::Schema', 'Moose::Object'; - - -=head1 NAME - -DBICNGTest::Schema; Schema Base For Testing Moose Roles, Traits, etc. - -=head1 SYNOPSIS - - my $schema = DBICNGTest::Schema->connect($dsn); - - ## Do anything you would as with a normal $schema object. - -=head1 DESCRIPTION - -Defines the base case for loading DBIC Schemas. We add in some additional -helpful functions for administering you schemas. This namespace is dedicated -to integration of Moose based development practices. - -=head1 PACKAGE METHODS - -The following is a list of package methods declared with this class. - -=head2 load_namespaces - -Automatically load the classes and resultsets from their default namespaces. - -=cut - -__PACKAGE__->load_namespaces( - default_resultset_class => 'ResultSet', -); - - -=head1 ATTRIBUTES - -This class defines the following attributes. - -=head1 METHODS - -This module declares the following methods - -=head2 new - -overload new to make sure we get a good meta object and that the attributes all -get properly setup. This is done so that our instances properly get a L -meta class. - -=cut - -sub new -{ - my $class = shift @_; - my $obj = $class->SUPER::new(@_); - - return $class->meta->new_object( - __INSTANCE__ => $obj, @_ - ); -} - - -=head2 connect_and_setup - -Creates a schema, deploys a database and sets the testing data. - -=cut - -sub connect_and_setup { - my $class = shift @_; - my $db_file = shift @_; - - my ($dsn, $user, $pass) = ( - $ENV{DBICNG_DSN} || "dbi:SQLite:${db_file}", - $ENV{DBICNG_USER} || '', - $ENV{DBICNG_PASS} || '', - ); - - return $class - ->connect($dsn, $user, $pass, { AutoCommit => 1 }) - ->setup; -} - - -=head2 setup - -deploy a database and populate it with the initial data - -=cut - -sub setup { - my $self = shift @_; - $self->deploy(); - $self->initial_populate(@_); - - return $self; -} - - -=head2 initial_populate - -initializing the startup database information - -=cut - -sub initial_populate { - my $self = shift @_; - - my @genders = $self->populate('Gender' => [ - [qw(gender_id label)], - [qw(1 female)], - [qw(2 male)], - [qw(3 transgender)], - ]); - - my @persons = $self->populate('Person' => [ - [ qw(person_id fk_gender_id name age) ], - [ qw(1 1 john 25) ], - [ qw(2 1 dan 35) ], - [ qw(3 2 mary 15) ], - [ qw(4 2 jane 95) ], - [ qw(5 3 steve 40) ], - ]); - - my @friends = $self->populate('FriendList' => [ - [ qw(fk_person_id fk_friend_id) ], - [ qw(1 2) ], - [ qw(1 3) ], - [ qw(2 3) ], - [ qw(3 2) ], - ]); -} - - -=head2 job_handler_echo - -This is a method to test the job handler role. - -=cut - -sub job_handler_echo { - my ($schema, $job, $alert) = @_; - return $alert; -} - - -=head1 AUTHORS - -See L for more information regarding authors. - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. - -=cut - - -1; diff --git a/t/lib/DBICNGTest/Schema/Result.pm b/t/lib/DBICNGTest/Schema/Result.pm deleted file mode 100644 index 9d13c4a..0000000 --- a/t/lib/DBICNGTest/Schema/Result.pm +++ /dev/null @@ -1,83 +0,0 @@ -package # hide from PAUSE - DBICNGTest::Schema::Result; - - use Moose; - extends 'DBIx::Class', 'Moose::Object'; - -=head1 NAME - -DBICNGTest::Schema::Result; Base Class for result and class objects - -=head1 SYNOPSIS - - package DBICNGTest::Schema::Result::Member; - - use Moose; - extends 'DBICNGTest::Schema::Result'; - - ## Rest of the class definition. - -=head1 DESCRIPTION - -Defines the base case for loading DBIC Schemas. We add in some additional -helpful functions for administering you schemas. This namespace is dedicated -to integration of Moose based development practices - -=head1 PACKAGE METHODS - -The following is a list of package methods declared with this class. - -=head2 load_components - -Components to preload. - -=cut - -__PACKAGE__->load_components(qw/ - PK::Auto - InflateColumn::DateTime - Core -/); - - -=head1 ATTRIBUTES - -This class defines the following attributes. - -=head1 METHODS - -This module declares the following methods - -=head2 new - -overload new to make sure we get a good meta object and that the attributes all -get properly setup. This is done so that our instances properly get a L -meta class. - -=cut - -sub new -{ - my $class = shift @_; - my $attrs = shift @_; - - my $obj = $class->SUPER::new($attrs); - - return $class->meta->new_object( - __INSTANCE__ => $obj, %$attrs - ); -} - - -=head1 AUTHORS - -See L for more information regarding authors. - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. - -=cut - - -1; \ No newline at end of file diff --git a/t/lib/DBICNGTest/Schema/Result/FriendList.pm b/t/lib/DBICNGTest/Schema/Result/FriendList.pm deleted file mode 100644 index 8c87003..0000000 --- a/t/lib/DBICNGTest/Schema/Result/FriendList.pm +++ /dev/null @@ -1,118 +0,0 @@ -package #hide from pause - DBICNGTest::Schema::Result::FriendList; - - use Moose; - extends 'DBICNGTest::Schema::Result'; - - -=head1 NAME - -Zoomwit::tlib::DBIC::Schema::Result::FriendList; An example Friends Class; - -=head1 VERSION - -0.01 - -=cut - -our $VERSION = '0.01'; - - -=head1 DESCRIPTION - -A Person can have zero or more friends -A Person can't be their own friend -A Person over 18 can't be friends with Persons under 18 and vis versa. -A Person can have friendships that are not mutual. - -=head1 ATTRIBUTES - -This class defines the following attributes. - -=head1 PACKAGE METHODS - -This module defines the following package methods - -=head2 table - -Name of the Physical table in the database - -=cut - -__PACKAGE__ - ->table('friend_list'); - - -=head2 add_columns - -Add columns and meta information - -=head3 fk_person_id - -ID of the person with friends - -=head3 fk_friend_id - -Who is the friend? - -=cut - -__PACKAGE__ - ->add_columns( - fk_person_id => { - data_type=>'integer', - }, - fk_friend_id => { - data_type=>'integer', - }, -); - - -=head2 primary_key - -Sets the Primary keys for this table - -=cut - -__PACKAGE__ - ->set_primary_key(qw/fk_person_id fk_friend_id/); - - -=head2 befriender - -The person that 'owns' the friendship (list) - -=cut - -__PACKAGE__ - ->belongs_to( befriender => 'DBICNGTest::Schema::Result::Person', { - 'foreign.person_id' => 'self.fk_person_id' }); - - -=head2 friendee - -The actual friend that befriender is listing - -=cut - -__PACKAGE__ - ->belongs_to( friendee => 'DBICNGTest::Schema::Result::Person', { - 'foreign.person_id' => 'self.fk_friend_id' }); - - -=head1 METHODS - -This module defines the following methods. - -=head1 AUTHORS - -See L for more information regarding authors. - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. - -=cut - - -1; diff --git a/t/lib/DBICNGTest/Schema/Result/Gender.pm b/t/lib/DBICNGTest/Schema/Result/Gender.pm deleted file mode 100644 index a47e5dd..0000000 --- a/t/lib/DBICNGTest/Schema/Result/Gender.pm +++ /dev/null @@ -1,117 +0,0 @@ -package #hide from pause - DBICNGTest::Schema::Result::Gender; - - use Moose; - extends 'DBICNGTest::Schema::Result'; - - -=head1 NAME - -DBICNGTest::Schema::Result::Gender; An example Gender Class; - -=head1 DESCRIPTION - -Tests for this type of FK relationship - -=head1 ATTRIBUTES - -This class defines the following attributes. - -=head2 label - -example of using an attribute to add constraints on a table insert - -=cut - -has 'label' =>(is=>'rw', required=>1, isa=>'Str'); - - -=head1 PACKAGE METHODS - -This module defines the following package methods - -=head2 table - -Name of the Physical table in the database - -=cut - -__PACKAGE__ - ->table('gender'); - - -=head2 add_columns - -Add columns and meta information - -=head3 gender_id - -Primary Key which is an auto generated UUID - -=head3 label - -Text label of the gender (ie, 'male', 'female', 'transgender', etc.). - -=cut - -__PACKAGE__ - ->add_columns( - gender_id => { - data_type=>'integer', - }, - label => { - data_type=>'varchar', - size=>12, - }, - ); - - -=head2 primary_key - -Sets the Primary keys for this table - -=cut - -__PACKAGE__ - ->set_primary_key(qw/gender_id/); - - -=head2 - -Marks the unique columns - -=cut - -__PACKAGE__ - ->add_unique_constraint('gender_label_unique' => [ qw/label/ ]); - - -=head2 people - -A resultset of people with this gender - -=cut - -__PACKAGE__ - ->has_many( - people => 'DBICNGTest::Schema::Result::Person', - {'foreign.fk_gender_id' => 'self.gender_id'} - ); - - -=head1 METHODS - -This module defines the following methods. - -=head1 AUTHORS - -See L for more information regarding authors. - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. - -=cut - - -1; diff --git a/t/lib/DBICNGTest/Schema/Result/Person.pm b/t/lib/DBICNGTest/Schema/Result/Person.pm deleted file mode 100644 index 9547cc4..0000000 --- a/t/lib/DBICNGTest/Schema/Result/Person.pm +++ /dev/null @@ -1,178 +0,0 @@ -package #hide from pause - DBICNGTest::Schema::Result::Person; - - use Moose; - use DateTime; - extends 'DBICNGTest::Schema::Result'; - - -=head1 NAME - -DBICNGTest::Schema::Result::Person; An example Person Class; - -=head1 DESCRIPTION - -Tests for this type of FK relationship - -=head1 ATTRIBUTES - -This class defines the following attributes. - -=head2 created - -attribute for the created column - -=cut - -has 'created' => ( - is=>'ro', - isa=>'DateTime', - required=>1, - default=>sub { - DateTime->now; - }, -); - - -=head1 PACKAGE METHODS - -This module defines the following package methods - -=head2 table - -Name of the Physical table in the database - -=cut - -__PACKAGE__ - ->table('person'); - - -=head2 add_columns - -Add columns and meta information - -=head3 person_id - -Primary Key which is an auto generated autoinc - -=head3 fk_gender_id - -foreign key to the Gender table - -=head3 name - -Just an ordinary name - -=head3 age - -The person's age - -head3 created - -When the person was added to the database - -=cut - -__PACKAGE__ - ->add_columns( - person_id => { - data_type=>'integer', - }, - fk_gender_id => { - data_type=>'integer', - }, - name => { - data_type=>'varchar', - size=>32, - }, - age => { - data_type=>'integer', - default_value=>25, - }, - created => { - data_type=>'datetime', - default_value=>'date("now")', - }); - - -=head2 primary_key - -Sets the Primary keys for this table - -=cut - -__PACKAGE__ - ->set_primary_key(qw/person_id/); - - -=head2 friendlist - -Each Person might have a resultset of friendlist - -=cut - -__PACKAGE__ - ->has_many( - friendlist => 'DBICNGTest::Schema::Result::FriendList', - {'foreign.fk_person_id' => 'self.person_id'}); - - -=head2 gender - -This person's gender - -=cut - -__PACKAGE__ - ->belongs_to( gender => 'DBICNGTest::Schema::Result::Gender', { - 'foreign.gender_id' => 'self.fk_gender_id' }); - - -=head2 fanlist - -A resultset of the people listing me as a friend (if any) - -=cut - -__PACKAGE__ - ->belongs_to( fanlist => 'DBICNGTest::Schema::Result::FriendList', { - 'foreign.fk_friend_id' => 'self.person_id' }); - - -=head2 friends - -A resultset of Persons who are in my FriendList - -=cut - -__PACKAGE__ - ->many_to_many( friends => 'friendlist', 'friend' ); - - -=head2 fans - -A resultset of people that have me in their friendlist - -=cut - -__PACKAGE__ - ->many_to_many( fans => 'fanlist', 'befriender' ); - - -=head1 METHODS - -This module defines the following methods. - -=head1 AUTHORS - -See L for more information regarding authors. - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. - -=cut - - -1; diff --git a/t/lib/DBICNGTest/Schema/ResultSet.pm b/t/lib/DBICNGTest/Schema/ResultSet.pm deleted file mode 100644 index 7bb83c6..0000000 --- a/t/lib/DBICNGTest/Schema/ResultSet.pm +++ /dev/null @@ -1,68 +0,0 @@ -package # hide from PAUSE - DBICNGTest::Schema::ResultSet; - - use Moose; - extends 'DBIx::Class::ResultSet', 'Moose::Object'; - -=head1 NAME - -DBICNGTest::Schema::ResultSet; A base ResultSet Class - -=head1 SYNOPSIS - - package DBICNGTest::Schema::ResultSet::Member; - - use Moose; - extends 'DBICNGTest::Schema::ResultSet'; - - ## Rest of the class definition. - -=head1 DESCRIPTION - -All ResultSet classes will inherit from this. This provides some base function -for all your resultsets and it is also the default resultset if you don't -bother to declare a custom resultset in the resultset namespace - -=head1 PACKAGE METHODS - -The following is a list of package methods declared with this class. - -=head1 ATTRIBUTES - -This class defines the following attributes. - -=head1 METHODS - -This module declares the following methods - -=head2 new - -overload new to make sure we get a good meta object and that the attributes all -get properly setup. This is done so that our instances properly get a L -meta class. - -=cut - -sub new -{ - my $class = shift @_; - my $obj = $class->SUPER::new(@_); - - return $class->meta->new_object( - __INSTANCE__ => $obj, @_ - ); -} - - -=head1 AUTHORS - -See L for more information regarding authors. - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. - -=cut - - -1; \ No newline at end of file diff --git a/t/lib/DBICNGTest/Schema/ResultSet/Person.pm b/t/lib/DBICNGTest/Schema/ResultSet/Person.pm deleted file mode 100644 index 86b4dbb..0000000 --- a/t/lib/DBICNGTest/Schema/ResultSet/Person.pm +++ /dev/null @@ -1,95 +0,0 @@ -package # hide from pause - DBICNGTest::Schema::ResultSet::Person; - - use Moose; - extends 'DBICNGTest::Schema::ResultSet'; - - -=head1 NAME - -DBICNGTest::Schema::ResultSet:Person; Example Resultset - -=head1 VERSION - -0.01 - -=cut - -our $VERSION = '0.01'; - - -=head1 SYNOPSIS - - ##Example Usage - -See Tests for more example usage. - -=head1 DESCRIPTION - -Resultset Methods for the Person Source - -=head1 ATTRIBUTES - -This class defines the following attributes. - -=head2 literal - -a literal attribute for testing - -=cut - -has 'literal' => (is=>'ro', isa=>'Str', required=>1, lazy=>1, default=>'hi'); - - -=head2 available_genders - -A resultset of the genders people can have. Keep in mind this get's run once -only at the first compile, so it's only good for stuff that doesn't change -between reboots. - -=cut - -has 'available_genders' => ( - is=>'ro', - isa=>'DBICNGTest::Schema::ResultSet', - required=>1, - lazy=>1, - default=> sub { - shift - ->result_source - ->schema - ->resultset('Gender'); - } -); - - -=head1 METHODS - -This module defines the following methods. - -=head2 older_than($int) - -Only people over a given age - -=cut - -sub older_than -{ - my ($self, $age) = @_; - - return $self->search({age=>{'>'=>$age}}); -} - - -=head1 AUTHORS - -See L for more information regarding authors. - -=head1 LICENSE - -You may distribute this code under the same terms as Perl itself. - -=cut - - -1;