Add optdep on CPAN::Uploader to get an effortless `make upload`
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / DB.pm
1 package DBIx::Class::DB;
2
3 use strict;
4 use warnings;
5
6 use base qw/DBIx::Class/;
7 use DBIx::Class::Schema;
8 use DBIx::Class::Storage::DBI;
9 use DBIx::Class::ClassResolver::PassThrough;
10 use DBI;
11 use Scalar::Util 'blessed';
12 use namespace::clean;
13
14 unless ($INC{"DBIx/Class/CDBICompat.pm"}) {
15   warn "IMPORTANT: DBIx::Class::DB is DEPRECATED AND *WILL* BE REMOVED. DO NOT USE.\n";
16 }
17
18 __PACKAGE__->load_components(qw/ResultSetProxy/);
19
20 sub storage { shift->schema_instance(@_)->storage; }
21 sub dbi_commit { shift->txn_commit(@_) }
22 sub dbi_rollback { shift->txn_rollback(@_) }
23
24 =head1 NAME
25
26 DBIx::Class::DB - (DEPRECATED) classdata schema component
27
28 =head1 DESCRIPTION
29
30 This class is designed to support the Class::DBI connection-as-classdata style
31 for DBIx::Class. You are *strongly* recommended to use a DBIx::Class::Schema
32 instead; DBIx::Class::DB will not undergo new development and will be moved
33 to being a CDBICompat-only component before 1.0. In order to discourage further
34 use, documentation has been removed as of 0.08000
35
36 =head1 METHODS
37
38 Hidden.
39
40 =begin hidden
41
42 =head2 storage
43
44 Sets or gets the storage backend. Defaults to L<DBIx::Class::Storage::DBI>.
45
46 =end hidden
47
48 =cut
49
50 =begin hidden
51
52 =head2 class_resolver
53
54 ****DEPRECATED****
55
56 Sets or gets the class to use for resolving a class. Defaults to
57 L<DBIx::Class::ClassResolver::Passthrough>, which returns whatever you give
58 it. See resolve_class below.
59
60 =end hidden
61
62 =cut
63
64 __PACKAGE__->mk_classdata('class_resolver' =>
65                           'DBIx::Class::ClassResolver::PassThrough');
66
67 =begin hidden
68
69 =head2 connection
70
71   __PACKAGE__->connection($dsn, $user, $pass, $attrs);
72
73 Specifies the arguments that will be passed to DBI->connect(...) to
74 instantiate the class dbh when required.
75
76 =end hidden
77
78 =cut
79
80 sub connection {
81   my ($class, @info) = @_;
82   $class->setup_schema_instance unless $class->can('schema_instance');
83   $class->schema_instance->connection(@info);
84 }
85
86 =begin hidden
87
88 =head2 setup_schema_instance
89
90 Creates a class method ->schema_instance which contains a DBIx::Class::Schema;
91 all class-method operations are proxies through to this object. If you don't
92 call ->connection in your DBIx::Class::DB subclass at load time you *must*
93 call ->setup_schema_instance in order for subclasses to find the schema and
94 register themselves with it.
95
96 =end hidden
97
98 =cut
99
100 sub setup_schema_instance {
101   my $class = shift;
102   my $schema = {};
103   bless $schema, 'DBIx::Class::Schema';
104   $class->mk_classdata('schema_instance' => $schema);
105 }
106
107 =begin hidden
108
109 =head2 txn_begin
110
111 Begins a transaction (does nothing if AutoCommit is off).
112
113 =end hidden
114
115 =cut
116
117 sub txn_begin { shift->schema_instance->txn_begin(@_); }
118
119 =begin hidden
120
121 =head2 txn_commit
122
123 Commits the current transaction.
124
125 =end hidden
126
127 =cut
128
129 sub txn_commit { shift->schema_instance->txn_commit(@_); }
130
131 =begin hidden
132
133 =head2 txn_rollback
134
135 Rolls back the current transaction.
136
137 =end hidden
138
139 =cut
140
141 sub txn_rollback { shift->schema_instance->txn_rollback(@_); }
142
143 =begin hidden
144
145 =head2 txn_do
146
147 Executes a block of code transactionally. If this code reference
148 throws an exception, the transaction is rolled back and the exception
149 is rethrown. See L<DBIx::Class::Schema/"txn_do"> for more details.
150
151 =end hidden
152
153 =cut
154
155 sub txn_do { shift->schema_instance->txn_do(@_); }
156
157 {
158   my $warn;
159
160   sub resolve_class {
161     warn "resolve_class deprecated as of 0.04999_02" unless $warn++;
162     return shift->class_resolver->class(@_);
163   }
164 }
165
166 =begin hidden
167
168 =head2 resultset_instance
169
170 Returns an instance of a resultset for this class - effectively
171 mapping the L<Class::DBI> connection-as-classdata paradigm into the
172 native L<DBIx::Class::ResultSet> system.
173
174 =end hidden
175
176 =cut
177
178 sub resultset_instance {
179   $_[0]->result_source_instance->resultset
180 }
181
182 =begin hidden
183
184 =head2 result_source_instance
185
186 Returns an instance of the result source for this class
187
188 =end hidden
189
190 =cut
191
192 __PACKAGE__->mk_classdata('_result_source_instance' => []);
193
194 # Yep. this is horrific. Basically what's happening here is that
195 # (with good reason) DBIx::Class::Schema copies the result source for
196 # registration. Because we have a retarded setup order forced on us we need
197 # to actually make our ->result_source_instance -be- the source used, and we
198 # need to get the source name and schema into ourselves. So this makes it
199 # happen.
200
201 sub _maybe_attach_source_to_schema {
202   my ($class, $source) = @_;
203   if (my $meth = $class->can('schema_instance')) {
204     if (my $schema = $class->$meth) {
205       $schema->register_class($class, $class);
206       my $new_source = $schema->source($class);
207       %$source = %$new_source;
208       $schema->source_registrations->{$class} = $source;
209     }
210   }
211 }
212
213 sub result_source_instance {
214   my $class = shift;
215   $class = ref $class || $class;
216
217   if (@_) {
218     my $source = $_[0];
219     $class->_result_source_instance([$source, $class]);
220     $class->_maybe_attach_source_to_schema($source);
221     return $source;
222   }
223
224   my($source, $result_class) = @{$class->_result_source_instance};
225   return unless blessed $source;
226
227   if ($result_class ne $class) {  # new class
228     # Give this new class its own source and register it.
229     $source = $source->new({
230         %$source,
231         source_name  => $class,
232         result_class => $class
233     } );
234     $class->_result_source_instance([$source, $class]);
235     $class->_maybe_attach_source_to_schema($source);
236   }
237   return $source;
238 }
239
240 =begin hidden
241
242 =head2 resolve_class
243
244 ****DEPRECATED****
245
246 See L</class_resolver>
247
248 =end hidden
249
250 =begin hidden
251
252 =head2 dbi_commit
253
254 ****DEPRECATED****
255
256 Alias for L</txn_commit>
257
258 =end hidden
259
260 =begin hidden
261
262 =head2 dbi_rollback
263
264 ****DEPRECATED****
265
266 Alias for L</txn_rollback>
267
268 =end hidden
269
270 =head1 AUTHOR AND CONTRIBUTORS
271
272 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
273
274 =head1 LICENSE
275
276 You may distribute this code under the same terms as Perl itself
277
278 =cut
279
280 1;