Commit | Line | Data |
4012acd8 |
1 | package DBIx::Class::Storage; |
a62cf8d4 |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
046ad905 |
6 | use base qw/DBIx::Class/; |
7 | |
8 | use Scalar::Util qw/weaken/; |
aaba9524 |
9 | use Carp::Clan qw/^DBIx::Class/; |
942cd0c1 |
10 | use IO::File; |
046ad905 |
11 | |
046ad905 |
12 | __PACKAGE__->mk_group_accessors('simple' => qw/debug debugobj schema/); |
13 | |
4012acd8 |
14 | package # Hide from PAUSE |
15 | DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION; |
16 | |
17 | use overload '"' => sub { |
18 | 'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION' |
19 | }; |
20 | |
21 | sub new { |
22 | my $class = shift; |
23 | my $self = {}; |
24 | return bless $self, $class; |
25 | } |
26 | |
27 | package DBIx::Class::Storage; |
28 | |
046ad905 |
29 | =head1 NAME |
30 | |
31 | DBIx::Class::Storage - Generic Storage Handler |
32 | |
33 | =head1 DESCRIPTION |
34 | |
35 | A base implementation of common Storage methods. For specific |
36 | information about L<DBI>-based storage, see L<DBIx::Class::Storage::DBI>. |
37 | |
38 | =head1 METHODS |
39 | |
40 | =head2 new |
41 | |
42 | Arguments: $schema |
43 | |
44 | Instantiates the Storage object. |
45 | |
46 | =cut |
47 | |
48 | sub new { |
49 | my ($self, $schema) = @_; |
50 | |
51 | $self = ref $self if ref $self; |
52 | |
53 | my $new = {}; |
54 | bless $new, $self; |
55 | |
56 | $new->set_schema($schema); |
57 | $new->debugobj(new DBIx::Class::Storage::Statistics()); |
58 | |
59 | my $fh; |
60 | |
61 | my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} |
62 | || $ENV{DBIC_TRACE}; |
63 | |
64 | if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) { |
65 | $fh = IO::File->new($1, 'w') |
66 | or $new->throw_exception("Cannot open trace file $1"); |
67 | } else { |
68 | $fh = IO::File->new('>&STDERR'); |
69 | } |
70 | |
942cd0c1 |
71 | $fh->autoflush(1); |
046ad905 |
72 | $new->debugfh($fh); |
73 | $new->debug(1) if $debug_env; |
74 | |
75 | $new; |
76 | } |
77 | |
78 | =head2 set_schema |
79 | |
80 | Used to reset the schema class or object which owns this |
81 | storage object, such as during L<DBIx::Class::Schema/clone>. |
82 | |
83 | =cut |
84 | |
85 | sub set_schema { |
86 | my ($self, $schema) = @_; |
87 | $self->schema($schema); |
88 | weaken($self->{schema}) if ref $self->{schema}; |
89 | } |
90 | |
91 | =head2 connected |
92 | |
93 | Returns true if we have an open storage connection, false |
94 | if it is not (yet) open. |
95 | |
96 | =cut |
97 | |
a62cf8d4 |
98 | sub connected { die "Virtual method!" } |
046ad905 |
99 | |
100 | =head2 disconnect |
101 | |
102 | Closes any open storage connection unconditionally. |
103 | |
104 | =cut |
105 | |
106 | sub disconnect { die "Virtual method!" } |
107 | |
108 | =head2 ensure_connected |
109 | |
110 | Initiate a connection to the storage if one isn't already open. |
111 | |
112 | =cut |
113 | |
a62cf8d4 |
114 | sub ensure_connected { die "Virtual method!" } |
046ad905 |
115 | |
116 | =head2 throw_exception |
117 | |
118 | Throws an exception - croaks. |
119 | |
120 | =cut |
121 | |
122 | sub throw_exception { |
123 | my $self = shift; |
124 | |
125 | $self->schema->throw_exception(@_) if $self->schema; |
126 | croak @_; |
127 | } |
a62cf8d4 |
128 | |
4012acd8 |
129 | =head2 txn_do |
a62cf8d4 |
130 | |
4012acd8 |
131 | =over 4 |
a62cf8d4 |
132 | |
4012acd8 |
133 | =item Arguments: C<$coderef>, @coderef_args? |
a62cf8d4 |
134 | |
4012acd8 |
135 | =item Return Value: The return value of $coderef |
136 | |
137 | =back |
138 | |
139 | Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically, |
140 | returning its result (if any). If an exception is caught, a rollback is issued |
141 | and the exception is rethrown. If the rollback fails, (i.e. throws an |
142 | exception) an exception is thrown that includes a "Rollback failed" message. |
143 | |
144 | For example, |
145 | |
146 | my $author_rs = $schema->resultset('Author')->find(1); |
147 | my @titles = qw/Night Day It/; |
148 | |
149 | my $coderef = sub { |
150 | # If any one of these fails, the entire transaction fails |
151 | $author_rs->create_related('books', { |
152 | title => $_ |
153 | }) foreach (@titles); |
154 | |
155 | return $author->books; |
156 | }; |
157 | |
158 | my $rs; |
159 | eval { |
160 | $rs = $schema->txn_do($coderef); |
161 | }; |
162 | |
163 | if ($@) { # Transaction failed |
164 | die "something terrible has happened!" # |
165 | if ($@ =~ /Rollback failed/); # Rollback failed |
166 | |
167 | deal_with_failed_transaction(); |
168 | } |
169 | |
170 | In a nested transaction (calling txn_do() from within a txn_do() coderef) only |
171 | the outermost transaction will issue a L</txn_commit>, and txn_do() can be |
172 | called in void, scalar and list context and it will behave as expected. |
173 | |
6500d50f |
174 | Please note that all of the code in your coderef, including non-DBIx::Class |
175 | code, is part of a transaction. This transaction may fail out halfway, or |
176 | it may get partially double-executed (in the case that our DB connection |
177 | failed halfway through the transaction, in which case we reconnect and |
178 | restart the txn). Therefore it is best that any side-effects in your coderef |
179 | are idempotent (that is, can be re-executed multiple times and get the |
180 | same result), and that you check up on your side-effects in the case of |
181 | transaction failure. |
182 | |
4012acd8 |
183 | =cut |
184 | |
185 | sub txn_do { |
186 | my ($self, $coderef, @args) = @_; |
187 | |
188 | ref $coderef eq 'CODE' or $self->throw_exception |
189 | ('$coderef must be a CODE reference'); |
190 | |
191 | my (@return_values, $return_value); |
192 | |
193 | $self->txn_begin; # If this throws an exception, no rollback is needed |
194 | |
195 | my $wantarray = wantarray; # Need to save this since the context |
196 | # inside the eval{} block is independent |
197 | # of the context that called txn_do() |
198 | eval { |
199 | |
200 | # Need to differentiate between scalar/list context to allow for |
201 | # returning a list in scalar context to get the size of the list |
202 | if ($wantarray) { |
203 | # list context |
204 | @return_values = $coderef->(@args); |
205 | } elsif (defined $wantarray) { |
206 | # scalar context |
207 | $return_value = $coderef->(@args); |
208 | } else { |
209 | # void context |
210 | $coderef->(@args); |
211 | } |
212 | $self->txn_commit; |
213 | }; |
214 | |
215 | if ($@) { |
216 | my $error = $@; |
217 | |
218 | eval { |
219 | $self->txn_rollback; |
220 | }; |
221 | |
222 | if ($@) { |
223 | my $rollback_error = $@; |
224 | my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION"; |
225 | $self->throw_exception($error) # propagate nested rollback |
226 | if $rollback_error =~ /$exception_class/; |
227 | |
228 | $self->throw_exception( |
229 | "Transaction aborted: $error. Rollback failed: ${rollback_error}" |
230 | ); |
231 | } else { |
232 | $self->throw_exception($error); # txn failed but rollback succeeded |
233 | } |
234 | } |
235 | |
236 | return $wantarray ? @return_values : $return_value; |
a62cf8d4 |
237 | } |
238 | |
046ad905 |
239 | =head2 txn_begin |
240 | |
241 | Starts a transaction. |
242 | |
243 | See the preferred L</txn_do> method, which allows for |
244 | an entire code block to be executed transactionally. |
245 | |
246 | =cut |
247 | |
248 | sub txn_begin { die "Virtual method!" } |
249 | |
250 | =head2 txn_commit |
251 | |
252 | Issues a commit of the current transaction. |
253 | |
254 | =cut |
255 | |
256 | sub txn_commit { die "Virtual method!" } |
257 | |
258 | =head2 txn_rollback |
259 | |
260 | Issues a rollback of the current transaction. A nested rollback will |
261 | throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception, |
262 | which allows the rollback to propagate to the outermost transaction. |
263 | |
264 | =cut |
265 | |
266 | sub txn_rollback { die "Virtual method!" } |
267 | |
268 | =head2 sql_maker |
269 | |
270 | Returns a C<sql_maker> object - normally an object of class |
271 | C<DBIC::SQL::Abstract>. |
272 | |
273 | =cut |
274 | |
275 | sub sql_maker { die "Virtual method!" } |
276 | |
277 | =head2 debug |
278 | |
279 | Causes trace information to be emitted on the C<debugobj> object. |
280 | (or C<STDERR> if C<debugobj> has not specifically been set). |
281 | |
282 | This is the equivalent to setting L</DBIC_TRACE> in your |
283 | shell environment. |
284 | |
285 | =head2 debugfh |
286 | |
287 | Set or retrieve the filehandle used for trace/debug output. This should be |
288 | an IO::Handle compatible ojbect (only the C<print> method is used. Initially |
289 | set to be STDERR - although see information on the |
290 | L<DBIC_TRACE> environment variable. |
291 | |
292 | =cut |
293 | |
294 | sub debugfh { |
295 | my $self = shift; |
296 | |
297 | if ($self->debugobj->can('debugfh')) { |
298 | return $self->debugobj->debugfh(@_); |
299 | } |
300 | } |
301 | |
302 | =head2 debugobj |
303 | |
304 | Sets or retrieves the object used for metric collection. Defaults to an instance |
305 | of L<DBIx::Class::Storage::Statistics> that is compatible with the original |
306 | method of using a coderef as a callback. See the aforementioned Statistics |
307 | class for more information. |
308 | |
309 | =head2 debugcb |
310 | |
311 | Sets a callback to be executed each time a statement is run; takes a sub |
312 | reference. Callback is executed as $sub->($op, $info) where $op is |
313 | SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed. |
314 | |
315 | See L<debugobj> for a better way. |
316 | |
317 | =cut |
318 | |
319 | sub debugcb { |
320 | my $self = shift; |
321 | |
322 | if ($self->debugobj->can('callback')) { |
323 | return $self->debugobj->callback(@_); |
324 | } |
325 | } |
326 | |
327 | =head2 cursor |
328 | |
329 | The cursor class for this Storage object. |
330 | |
331 | =cut |
332 | |
333 | sub cursor { die "Virtual method!" } |
334 | |
335 | =head2 deploy |
336 | |
337 | Deploy the tables to storage (CREATE TABLE and friends in a SQL-based |
338 | Storage class). This would normally be called through |
339 | L<DBIx::Class::Schema/deploy>. |
340 | |
341 | =cut |
342 | |
343 | sub deploy { die "Virtual method!" } |
344 | |
a3eaff0e |
345 | =head2 connect_info |
346 | |
347 | The arguments of C<connect_info> are always a single array reference, |
348 | and are Storage-handler specific. |
349 | |
350 | This is normally accessed via L<DBIx::Class::Schema/connection>, which |
351 | encapsulates its argument list in an arrayref before calling |
352 | C<connect_info> here. |
353 | |
354 | =cut |
355 | |
046ad905 |
356 | sub connect_info { die "Virtual method!" } |
a3eaff0e |
357 | |
358 | =head2 select |
359 | |
360 | Handle a select statement. |
361 | |
362 | =cut |
363 | |
364 | sub select { die "Virtual method!" } |
365 | |
366 | =head2 insert |
367 | |
368 | Handle an insert statement. |
369 | |
370 | =cut |
371 | |
046ad905 |
372 | sub insert { die "Virtual method!" } |
a3eaff0e |
373 | |
374 | =head2 update |
375 | |
376 | Handle an update statement. |
377 | |
378 | =cut |
379 | |
046ad905 |
380 | sub update { die "Virtual method!" } |
a3eaff0e |
381 | |
382 | =head2 delete |
383 | |
384 | Handle a delete statement. |
385 | |
386 | =cut |
387 | |
046ad905 |
388 | sub delete { die "Virtual method!" } |
a3eaff0e |
389 | |
390 | =head2 select_single |
391 | |
392 | Performs a select, fetch and return of data - handles a single row |
393 | only. |
394 | |
395 | =cut |
396 | |
046ad905 |
397 | sub select_single { die "Virtual method!" } |
a3eaff0e |
398 | |
399 | =head2 columns_info_for |
400 | |
c22c7625 |
401 | Returns metadata for the given source's columns. This |
402 | is *deprecated*, and will be removed before 1.0. You should |
403 | be specifying the metadata yourself if you need it. |
a3eaff0e |
404 | |
405 | =cut |
406 | |
046ad905 |
407 | sub columns_info_for { die "Virtual method!" } |
408 | |
409 | =head1 ENVIRONMENT VARIABLES |
410 | |
411 | =head2 DBIC_TRACE |
412 | |
413 | If C<DBIC_TRACE> is set then trace information |
414 | is produced (as when the L<debug> method is set). |
415 | |
416 | If the value is of the form C<1=/path/name> then the trace output is |
417 | written to the file C</path/name>. |
418 | |
419 | This environment variable is checked when the storage object is first |
420 | created (when you call connect on your schema). So, run-time changes |
421 | to this environment variable will not take effect unless you also |
422 | re-connect on your schema. |
423 | |
424 | =head2 DBIX_CLASS_STORAGE_DBI_DEBUG |
425 | |
426 | Old name for DBIC_TRACE |
427 | |
428 | =head1 AUTHORS |
429 | |
430 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
431 | |
432 | Andy Grundman <andy@hybridized.org> |
433 | |
434 | =head1 LICENSE |
435 | |
436 | You may distribute this code under the same terms as Perl itself. |
437 | |
438 | =cut |
439 | |
a62cf8d4 |
440 | 1; |