Commit | Line | Data |
62fa8aec |
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; |