t/lib/DBICNGTest/Schema.pm

   1 package # hide from PAUSE
   2  DBICNGTest::Schema;
   3
   4         use Moose;
   5         use Path::Class::File;
   6     extends 'DBIx::Class::Schema',  'Moose::Object';
   7
   8
   9 =head1 NAME
  10
  11 DBICNGTest::Schema; Schema Base For Testing Moose Roles, Traits, etc.
  12
  13 =head1 SYNOPSIS
  14
  15     my $schema = DBICNGTest::Schema->connect($dsn);
  16
  17     ## Do anything you would as with a normal $schema object.
  18
  19 =head1 DESCRIPTION
  20
  21 Defines the base case for loading DBIC Schemas.  We add in some additional
  22 helpful functions for administering you schemas.  This namespace is dedicated
  23 to integration of Moose based development practices.
  24
  25 =head1 PACKAGE METHODS
  26
  27 The following is a list of package methods declared with this class.
  28
  29 =head2 load_namespaces
  30
  31 Automatically load the classes and resultsets from their default namespaces.
  32
  33 =cut
  34
  35 __PACKAGE__->load_namespaces(
  36     default_resultset_class => 'ResultSet',
  37 );
  38
  39
  40 =head1 ATTRIBUTES
  41
  42 This class defines the following attributes.
  43
  44 =head1 METHODS
  45
  46 This module declares the following methods
  47
  48 =head2 new
  49
  50 overload new to make sure we get a good meta object and that the attributes all
  51 get properly setup.  This is done so that our instances properly get a L<Moose>
  52 meta class.
  53
  54 =cut
  55
  56 sub new
  57 {
  58     my $class = shift @_;
  59     my $obj = $class->SUPER::new(@_);
  60
  61     return $class->meta->new_object(
  62         __INSTANCE__ => $obj, @_
  63     );
  64 }
  65
  66
  67 =head2 connect_and_setup
  68
  69 Creates a schema, deploys a database and sets the testing data.
  70
  71 =cut
  72
  73 sub connect_and_setup {
  74     my $class = shift @_;
  75     my $db_file = shift @_;
  76
  77     my ($dsn, $user, $pass) = (
  78       $ENV{DBICNG_DSN} || "dbi:SQLite:${db_file}",
  79       $ENV{DBICNG_USER} || '',
  80       $ENV{DBICNG_PASS} || '',
  81     );
  82
  83     return $class
  84         ->connect($dsn, $user, $pass, { AutoCommit => 1 })
  85         ->setup;
  86 }
  87
  88
  89 =head2 setup
  90
  91 deploy a database and populate it with the initial data
  92
  93 =cut
  94
  95 sub setup {
  96     my $self = shift @_;
  97     $self->deploy();
  98     $self->initial_populate(@_);
  99
 100     return $self;
 101 }
 102
 103
 104 =head2 initial_populate
 105
 106 initializing the startup database information
 107
 108 =cut
 109
 110 sub initial_populate {
 111     my $self = shift @_;
 112
 113     my @genders = $self->populate('Gender' => [
 114         [qw(gender_id label)],
 115         [qw(1 female)],
 116         [qw(2 male)],
 117         [qw(3 transgender)],
 118     ]);
 119
 120     my @persons = $self->populate('Person' => [
 121         [ qw(person_id fk_gender_id name age) ],
 122         [ qw(1 1 john 25) ],
 123         [ qw(2 1 dan 35) ],
 124         [ qw(3 2 mary 15) ],
 125         [ qw(4 2 jane 95) ],
 126         [ qw(5 3 steve 40) ],
 127     ]);
 128
 129     my @friends = $self->populate('FriendList' => [
 130         [ qw(fk_person_id fk_friend_id) ],
 131         [ qw(1 2) ],
 132         [ qw(1 3) ],
 133         [ qw(2 3) ],
 134         [ qw(3 2) ],
 135     ]);
 136 }
 137
 138
 139 =head1 AUTHORS
 140
 141 See L<DBIx::Class> for more information regarding authors.
 142
 143 =head1 LICENSE
 144
 145 You may distribute this code under the same terms as Perl itself.
 146
 147 =cut
 148
 149
 150 1;