line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Class::Wrapper; |
2
|
|
|
|
|
|
|
$DBIx::Class::Wrapper::VERSION = '0.009'; |
3
|
5
|
|
|
5
|
|
1161954
|
use Moose::Role; |
|
5
|
|
|
|
|
1136250
|
|
|
5
|
|
|
|
|
22
|
|
4
|
5
|
|
|
5
|
|
23420
|
use Moose::Meta::Class; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
130
|
|
5
|
5
|
|
|
5
|
|
1890
|
use Module::Pluggable::Object; |
|
5
|
|
|
|
|
25093
|
|
|
5
|
|
|
|
|
149
|
|
6
|
5
|
|
|
5
|
|
35
|
use Class::Load; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
1867
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
DBIx::Class::Wrapper - A Moose role to allow your business model to wrap business code around a dbic model. |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 BUILD STATUS |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=begin html |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
<a href="https://travis-ci.org/jeteve/DBIx-Class-Wrapper"><img src="https://travis-ci.org/jeteve/DBIx-Class-Wrapper.svg?branch=master"></a> |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=end html |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 SYNOPSIS |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
This package allows you to easily extend your DBIC Schema by Optionally wrapping its resultsets and result objects |
23
|
|
|
|
|
|
|
in your own business classes. |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head2 Basic usage with no specific wrapping at all |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
package My::Model; |
28
|
|
|
|
|
|
|
use Moose; |
29
|
|
|
|
|
|
|
with qw/DBIx::Class::Wrapper/; |
30
|
|
|
|
|
|
|
1 |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Later |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
my $schema = instance of DBIx schema |
35
|
|
|
|
|
|
|
my $app = My::Model->new( { dbic_schema => $schema } ); |
36
|
|
|
|
|
|
|
## And use the dbic resultsets-ish methods. |
37
|
|
|
|
|
|
|
my $products = $app->dbic_factory('Product'); ## Get a new instance of the Product resultset. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
## Use classic DBIC methods as usual. |
40
|
|
|
|
|
|
|
my $p = $products->find(2); |
41
|
|
|
|
|
|
|
my $blue_ps = $products->search({ colour => blue }); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=head2 Implement your own product class with business methods. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
First you need a DBIC factory that will wrap the raw dbic object into your own class of product |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
package My::Model::Wrapper::Factory::Product; |
49
|
|
|
|
|
|
|
use Moose; extends qw/DBIx::Class::Wrapper::Factory/ ; |
50
|
|
|
|
|
|
|
sub wrap{ |
51
|
|
|
|
|
|
|
my ($self , $o) = @_; |
52
|
|
|
|
|
|
|
return My::Model::O::Product->new({o => $o , factory => $self }); |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
1; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
Then your Product business object class |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
package My::Model::O::Product; |
59
|
|
|
|
|
|
|
use Moose; |
60
|
|
|
|
|
|
|
has 'o' => ( isa => 'My::Schema::Product', ## The raw DBIC object class. |
61
|
|
|
|
|
|
|
is => 'ro' , required => 1, |
62
|
|
|
|
|
|
|
handles => [ 'id' , 'name', 'active' ] ## handles standard properties |
63
|
|
|
|
|
|
|
); |
64
|
|
|
|
|
|
|
## A business method |
65
|
|
|
|
|
|
|
sub activate{ |
66
|
|
|
|
|
|
|
my ($self) = @_; |
67
|
|
|
|
|
|
|
$self->o->update({ active => 1 }); |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
Then from your main code, continue using the Product resultset as normal. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
my $product = $app->dbic_factory('Product')->find(1); |
73
|
|
|
|
|
|
|
## But you can do |
74
|
|
|
|
|
|
|
$product->activate(); |
75
|
|
|
|
|
|
|
## so now |
76
|
|
|
|
|
|
|
$product->active() == 1; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=head2 Your own specialised resultset |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Let's say you decide that from now, the bulk of your application should access only active products, |
82
|
|
|
|
|
|
|
leaving unlimited access to all product to a limited set of places. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
package My::Model::Wrapper::Factory::Product; |
85
|
|
|
|
|
|
|
use Moose; |
86
|
|
|
|
|
|
|
extends qw/DBIx::Class::Wrapper::Factory/; |
87
|
|
|
|
|
|
|
sub build_dbic_rs{ |
88
|
|
|
|
|
|
|
my ($self) = @_; |
89
|
|
|
|
|
|
|
## Note that you can always access your original business model |
90
|
|
|
|
|
|
|
## from a factory (method bm). |
91
|
|
|
|
|
|
|
return $self->bm->dbic_schema->resultset('Product')->search_rs({ active => 1}); |
92
|
|
|
|
|
|
|
## This is a simple example. You can restrict your products set |
93
|
|
|
|
|
|
|
## according to any current property of your business model for instance. |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
sub wrap{ .. same .. } |
96
|
|
|
|
|
|
|
1; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Everywhere your application uses $app->dbic_factory('Product') is now |
99
|
|
|
|
|
|
|
restricted to active products only. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Surely you want admin parts of your application to access all products. |
102
|
|
|
|
|
|
|
So here's a very basic AllProducts: |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
package My::Model::Wrapper::Factory::AllProduct; |
105
|
|
|
|
|
|
|
use Moose; extends qw/My::Model::Wrapper::Factory::Product/; |
106
|
|
|
|
|
|
|
sub build_dbic_rs{ |
107
|
|
|
|
|
|
|
my ($self) = @_; |
108
|
|
|
|
|
|
|
## Some extra security. |
109
|
|
|
|
|
|
|
unless( $self->bm->current_user()->is_admin() ){ confess "Sorry you cant access that"; } |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
return $self->bm()->dbic_schema->resultset('Product')->search_rs(); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head2 Changing the factory base class. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
Until now, all your custom factories were named My::Model::Wrapper::Factory::<something>. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
If you want to customise the base class of those custom factories, you can do so by overriding |
120
|
|
|
|
|
|
|
the method _build_dbic_factory_baseclass in your model: |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
package My::Model; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
use Moose; |
125
|
|
|
|
|
|
|
with qw/DBIx::Class::Wrapper/; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub _build_dbic_factory_baseclass{ |
128
|
|
|
|
|
|
|
return 'My::Model::DBICFactory'; # for instance. |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
Then implement your factories as subpackages of My::Model::DBICFactory |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=cut |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
has 'dbic_schema' => ( is => 'rw' , isa => 'DBIx::Class::Schema' , required => 1 ); |
136
|
|
|
|
|
|
|
has 'dbic_factory_baseclass' => ( is => 'ro' , isa => 'Str' , lazy_build => 1); |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
has '_dbic_dbic_fact_classes' => ( is => 'ro' , isa => 'HashRef[Bool]' , lazy_build => 1); |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub _build_dbic_factory_baseclass{ |
141
|
2
|
|
|
2
|
|
7
|
my ($self) = @_; |
142
|
2
|
|
|
|
|
76
|
return ref ($self).'::Wrapper::Factory'; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub _build__dbic_dbic_fact_classes{ |
146
|
3
|
|
|
3
|
|
9
|
my ($self) = @_; |
147
|
3
|
|
|
|
|
78
|
my $baseclass = $self->dbic_factory_baseclass(); |
148
|
3
|
|
|
|
|
9
|
my $res = {}; |
149
|
3
|
|
|
|
|
36
|
my $mp = Module::Pluggable::Object->new( search_path => [ $baseclass ]); |
150
|
3
|
|
|
|
|
38
|
foreach my $candidate_class ( $mp->plugins() ){ |
151
|
9
|
|
|
|
|
3793
|
Class::Load::load_class( $candidate_class ); |
152
|
|
|
|
|
|
|
# Code is loaded |
153
|
9
|
50
|
|
|
|
21636
|
unless( $candidate_class->isa('DBIx::Class::Wrapper::Factory') ){ |
154
|
0
|
|
|
|
|
0
|
warn "Class $candidate_class does not extend DBIx::Class::Wrapper::Factory."; |
155
|
0
|
|
|
|
|
0
|
next; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
# And inherit from the right class. |
158
|
9
|
|
|
|
|
31
|
$res->{$candidate_class} = 1; |
159
|
|
|
|
|
|
|
} |
160
|
3
|
|
|
|
|
144
|
return $res; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=head1 METHODS |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head2 dbic_factory |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
Returns a new instance of L<DBIx::Class::Wrapper::Factory> that wraps around the given DBIC ResultSet name |
168
|
|
|
|
|
|
|
if such a resultset exists. Dies otherwise. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Additionaly, you can set a ad-hoc resulset if you want to locally restrict your original resultset. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
usage: |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
my $f = $this->dbic_factory('Article'); |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
my $f = $this->dbic_factory('Article' , { dbic_rs => $schema->resultset('Article')->search_rs({ is_active => 1 }) }); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=cut |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub dbic_factory{ |
181
|
22
|
|
|
22
|
1
|
38626
|
my ($self , $name , $init_args ) = @_; |
182
|
22
|
100
|
|
|
|
77
|
unless( defined $init_args ){ |
183
|
20
|
|
|
|
|
43
|
$init_args = {}; |
184
|
|
|
|
|
|
|
} |
185
|
22
|
50
|
|
|
|
67
|
unless( $name ){ |
186
|
0
|
|
|
|
|
0
|
confess("Missing name in call to dbic_factory"); |
187
|
|
|
|
|
|
|
} |
188
|
22
|
|
|
|
|
676
|
my $class_name = $self->dbic_factory_baseclass().'::'.$name; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
## Build a class dynamically if necessary |
191
|
22
|
100
|
|
|
|
548
|
unless( $self->_dbic_dbic_fact_classes->{$class_name} ){ |
192
|
|
|
|
|
|
|
## We need to build such a class. |
193
|
6
|
|
|
|
|
51
|
Moose::Meta::Class->create($class_name => ( superclasses => [ 'DBIx::Class::Wrapper::Factory' ] )); |
194
|
6
|
|
|
|
|
16246
|
$self->_dbic_dbic_fact_classes->{$class_name} = 1; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
## Ok, $class_name is now there |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
## Note that the factory will built its own resultset from this model and the name |
199
|
22
|
|
|
|
|
749
|
my $instance = $class_name->new({ bm => $self , name => $name , %$init_args }); |
200
|
|
|
|
|
|
|
## This will die instantly if cannot find a dbic_rs |
201
|
22
|
|
|
|
|
30111
|
my $dbic_rs = $instance->dbic_rs(); |
202
|
20
|
|
|
|
|
146
|
return $instance; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
1; |