The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

LSAUNDERS / DBIx-Class-0.08099_04 / t / lib / DBICNGTest / Schema.pm 

            

              
1
2
3
4
5
6
7
—
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
—
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
—
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
—
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
—
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
—
138
139
140
141
142
143
144
145
146
147
148
149
—
150
151
152
153
154
155
156
157
158
159
160
161
162

              
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<Moose>
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<DBIx::Class> for more information regarding authors.
=head1 LICENSE
You may distribute this code under the same terms as Perl itself.
=cut
1;