Cleaner error message for using source() without required argument
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage.pm
1 package DBIx::Class::Storage;
2
3 use strict;
4 use warnings;
5
6 use base qw/DBIx::Class/;
7 use mro 'c3';
8
9 use DBIx::Class::Exception;
10 use Scalar::Util 'weaken';
11 use IO::File;
12 use DBIx::Class::Storage::TxnScopeGuard;
13 use Try::Tiny;
14 use namespace::clean;
15
16 __PACKAGE__->mk_group_accessors('simple' => qw/debug schema/);
17 __PACKAGE__->mk_group_accessors('inherited' => 'cursor_class');
18
19 __PACKAGE__->cursor_class('DBIx::Class::Cursor');
20
21 sub cursor { shift->cursor_class(@_); }
22
23 package # Hide from PAUSE
24     DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION;
25
26 use overload '"' => sub {
27   'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION'
28 };
29
30 sub new {
31   my $class = shift;
32   my $self = {};
33   return bless $self, $class;
34 }
35
36 package DBIx::Class::Storage;
37
38 =head1 NAME
39
40 DBIx::Class::Storage - Generic Storage Handler
41
42 =head1 DESCRIPTION
43
44 A base implementation of common Storage methods.  For specific
45 information about L<DBI>-based storage, see L<DBIx::Class::Storage::DBI>.
46
47 =head1 METHODS
48
49 =head2 new
50
51 Arguments: $schema
52
53 Instantiates the Storage object.
54
55 =cut
56
57 sub new {
58   my ($self, $schema) = @_;
59
60   $self = ref $self if ref $self;
61
62   my $new = {};
63   bless $new, $self;
64
65   $new->set_schema($schema);
66   $new->debug(1)
67     if $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE};
68
69   $new;
70 }
71
72 =head2 set_schema
73
74 Used to reset the schema class or object which owns this
75 storage object, such as during L<DBIx::Class::Schema/clone>.
76
77 =cut
78
79 sub set_schema {
80   my ($self, $schema) = @_;
81   $self->schema($schema);
82   weaken $self->{schema} if ref $self->{schema};
83 }
84
85 =head2 connected
86
87 Returns true if we have an open storage connection, false
88 if it is not (yet) open.
89
90 =cut
91
92 sub connected { die "Virtual method!" }
93
94 =head2 disconnect
95
96 Closes any open storage connection unconditionally.
97
98 =cut
99
100 sub disconnect { die "Virtual method!" }
101
102 =head2 ensure_connected
103
104 Initiate a connection to the storage if one isn't already open.
105
106 =cut
107
108 sub ensure_connected { die "Virtual method!" }
109
110 =head2 throw_exception
111
112 Throws an exception - croaks.
113
114 =cut
115
116 sub throw_exception {
117   my $self = shift;
118
119   if (ref $self and $self->schema) {
120     $self->schema->throw_exception(@_);
121   }
122   else {
123     DBIx::Class::Exception->throw(@_);
124   }
125 }
126
127 =head2 txn_do
128
129 =over 4
130
131 =item Arguments: C<$coderef>, @coderef_args?
132
133 =item Return Value: The return value of $coderef
134
135 =back
136
137 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
138 returning its result (if any). If an exception is caught, a rollback is issued
139 and the exception is rethrown. If the rollback fails, (i.e. throws an
140 exception) an exception is thrown that includes a "Rollback failed" message.
141
142 For example,
143
144   my $author_rs = $schema->resultset('Author')->find(1);
145   my @titles = qw/Night Day It/;
146
147   my $coderef = sub {
148     # If any one of these fails, the entire transaction fails
149     $author_rs->create_related('books', {
150       title => $_
151     }) foreach (@titles);
152
153     return $author->books;
154   };
155
156   my $rs;
157   try {
158     $rs = $schema->txn_do($coderef);
159   } catch {
160     my $error = shift;
161     # Transaction failed
162     die "something terrible has happened!"   #
163       if ($error =~ /Rollback failed/);          # Rollback failed
164
165     deal_with_failed_transaction();
166   };
167
168 In a nested transaction (calling txn_do() from within a txn_do() coderef) only
169 the outermost transaction will issue a L</txn_commit>, and txn_do() can be
170 called in void, scalar and list context and it will behave as expected.
171
172 Please note that all of the code in your coderef, including non-DBIx::Class
173 code, is part of a transaction.  This transaction may fail out halfway, or
174 it may get partially double-executed (in the case that our DB connection
175 failed halfway through the transaction, in which case we reconnect and
176 restart the txn).  Therefore it is best that any side-effects in your coderef
177 are idempotent (that is, can be re-executed multiple times and get the
178 same result), and that you check up on your side-effects in the case of
179 transaction failure.
180
181 =cut
182
183 sub txn_do {
184   my $self = shift;
185   my $coderef = shift;
186
187   ref $coderef eq 'CODE' or $self->throw_exception
188     ('$coderef must be a CODE reference');
189
190   my (@return_values, $return_value);
191
192   $self->txn_begin; # If this throws an exception, no rollback is needed
193
194   my $wantarray = wantarray; # Need to save this since the context
195                              # inside the try{} block is independent
196                              # of the context that called txn_do()
197   my $args = \@_;
198
199   try {
200
201     # Need to differentiate between scalar/list context to allow for
202     # returning a list in scalar context to get the size of the list
203     if ($wantarray) {
204       # list context
205       @return_values = $coderef->(@$args);
206     } elsif (defined $wantarray) {
207       # scalar context
208       $return_value = $coderef->(@$args);
209     } else {
210       # void context
211       $coderef->(@$args);
212     }
213     $self->txn_commit;
214   }
215   catch {
216     my $error = shift;
217
218     try {
219       $self->txn_rollback;
220     } catch {
221       my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
222       $self->throw_exception($error)  # propagate nested rollback
223         if $_ =~ /$exception_class/;
224
225       $self->throw_exception(
226         "Transaction aborted: $error. Rollback failed: $_"
227       );
228     }
229     $self->throw_exception($error); # txn failed but rollback succeeded
230   };
231
232   return wantarray ? @return_values : $return_value;
233 }
234
235 =head2 txn_begin
236
237 Starts a transaction.
238
239 See the preferred L</txn_do> method, which allows for
240 an entire code block to be executed transactionally.
241
242 =cut
243
244 sub txn_begin { die "Virtual method!" }
245
246 =head2 txn_commit
247
248 Issues a commit of the current transaction.
249
250 It does I<not> perform an actual storage commit unless there's a DBIx::Class
251 transaction currently in effect (i.e. you called L</txn_begin>).
252
253 =cut
254
255 sub txn_commit { die "Virtual method!" }
256
257 =head2 txn_rollback
258
259 Issues a rollback of the current transaction. A nested rollback will
260 throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception,
261 which allows the rollback to propagate to the outermost transaction.
262
263 =cut
264
265 sub txn_rollback { die "Virtual method!" }
266
267 =head2 svp_begin
268
269 Arguments: $savepoint_name?
270
271 Created a new savepoint using the name provided as argument. If no name
272 is provided, a random name will be used.
273
274 =cut
275
276 sub svp_begin { die "Virtual method!" }
277
278 =head2 svp_release
279
280 Arguments: $savepoint_name?
281
282 Release the savepoint provided as argument. If none is provided,
283 release the savepoint created most recently. This will implicitly
284 release all savepoints created after the one explicitly released as well.
285
286 =cut
287
288 sub svp_release { die "Virtual method!" }
289
290 =head2 svp_rollback
291
292 Arguments: $savepoint_name?
293
294 Rollback to the savepoint provided as argument. If none is provided,
295 rollback to the savepoint created most recently. This will implicitly
296 release all savepoints created after the savepoint we rollback to.
297
298 =cut
299
300 sub svp_rollback { die "Virtual method!" }
301
302 =for comment
303
304 =head2 txn_scope_guard
305
306 An alternative way of transaction handling based on
307 L<DBIx::Class::Storage::TxnScopeGuard>:
308
309  my $txn_guard = $storage->txn_scope_guard;
310
311  $row->col1("val1");
312  $row->update;
313
314  $txn_guard->commit;
315
316 If an exception occurs, or the guard object otherwise leaves the scope
317 before C<< $txn_guard->commit >> is called, the transaction will be rolled
318 back by an explicit L</txn_rollback> call. In essence this is akin to
319 using a L</txn_begin>/L</txn_commit> pair, without having to worry
320 about calling L</txn_rollback> at the right places. Note that since there
321 is no defined code closure, there will be no retries and other magic upon
322 database disconnection. If you need such functionality see L</txn_do>.
323
324 =cut
325
326 sub txn_scope_guard {
327   return DBIx::Class::Storage::TxnScopeGuard->new($_[0]);
328 }
329
330 =head2 sql_maker
331
332 Returns a C<sql_maker> object - normally an object of class
333 C<DBIx::Class::SQLMaker>.
334
335 =cut
336
337 sub sql_maker { die "Virtual method!" }
338
339 =head2 debug
340
341 Causes trace information to be emitted on the C<debugobj> object.
342 (or C<STDERR> if C<debugobj> has not specifically been set).
343
344 This is the equivalent to setting L</DBIC_TRACE> in your
345 shell environment.
346
347 =head2 debugfh
348
349 Set or retrieve the filehandle used for trace/debug output.  This should be
350 an IO::Handle compatible object (only the C<print> method is used.  Initially
351 set to be STDERR - although see information on the
352 L<DBIC_TRACE> environment variable.
353
354 =cut
355
356 sub debugfh {
357     my $self = shift;
358
359     if ($self->debugobj->can('debugfh')) {
360         return $self->debugobj->debugfh(@_);
361     }
362 }
363
364 =head2 debugobj
365
366 Sets or retrieves the object used for metric collection. Defaults to an instance
367 of L<DBIx::Class::Storage::Statistics> that is compatible with the original
368 method of using a coderef as a callback.  See the aforementioned Statistics
369 class for more information.
370
371 =cut
372
373 sub debugobj {
374   my $self = shift;
375
376   if (@_) {
377     return $self->{debugobj} = $_[0];
378   }
379
380   $self->{debugobj} ||= do {
381     if (my $profile = $ENV{DBIC_TRACE_PROFILE}) {
382       require DBIx::Class::Storage::Debug::PrettyPrint;
383       if ($profile =~ /^\.?\//) {
384         require Config::Any;
385
386         my $cfg = try {
387           Config::Any->load_files({ files => [$profile], use_ext => 1 });
388         } catch {
389           # sanitize the error message a bit
390           $_ =~ s/at \s+ .+ Storage\.pm \s line \s \d+ $//x;
391           $self->throw_exception("Failure processing \$ENV{DBIC_TRACE_PROFILE}: $_");
392         };
393
394         DBIx::Class::Storage::Debug::PrettyPrint->new(values %{$cfg->[0]});
395       }
396       else {
397         DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile });
398       }
399     }
400     else {
401       require DBIx::Class::Storage::Statistics;
402       DBIx::Class::Storage::Statistics->new
403     }
404   };
405 }
406
407 =head2 debugcb
408
409 Sets a callback to be executed each time a statement is run; takes a sub
410 reference.  Callback is executed as $sub->($op, $info) where $op is
411 SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
412
413 See L<debugobj> for a better way.
414
415 =cut
416
417 sub debugcb {
418     my $self = shift;
419
420     if ($self->debugobj->can('callback')) {
421         return $self->debugobj->callback(@_);
422     }
423 }
424
425 =head2 cursor_class
426
427 The cursor class for this Storage object.
428
429 =cut
430
431 =head2 deploy
432
433 Deploy the tables to storage (CREATE TABLE and friends in a SQL-based
434 Storage class). This would normally be called through
435 L<DBIx::Class::Schema/deploy>.
436
437 =cut
438
439 sub deploy { die "Virtual method!" }
440
441 =head2 connect_info
442
443 The arguments of C<connect_info> are always a single array reference,
444 and are Storage-handler specific.
445
446 This is normally accessed via L<DBIx::Class::Schema/connection>, which
447 encapsulates its argument list in an arrayref before calling
448 C<connect_info> here.
449
450 =cut
451
452 sub connect_info { die "Virtual method!" }
453
454 =head2 select
455
456 Handle a select statement.
457
458 =cut
459
460 sub select { die "Virtual method!" }
461
462 =head2 insert
463
464 Handle an insert statement.
465
466 =cut
467
468 sub insert { die "Virtual method!" }
469
470 =head2 update
471
472 Handle an update statement.
473
474 =cut
475
476 sub update { die "Virtual method!" }
477
478 =head2 delete
479
480 Handle a delete statement.
481
482 =cut
483
484 sub delete { die "Virtual method!" }
485
486 =head2 select_single
487
488 Performs a select, fetch and return of data - handles a single row
489 only.
490
491 =cut
492
493 sub select_single { die "Virtual method!" }
494
495 =head2 columns_info_for
496
497 Returns metadata for the given source's columns.  This
498 is *deprecated*, and will be removed before 1.0.  You should
499 be specifying the metadata yourself if you need it.
500
501 =cut
502
503 sub columns_info_for { die "Virtual method!" }
504
505 =head1 ENVIRONMENT VARIABLES
506
507 =head2 DBIC_TRACE
508
509 If C<DBIC_TRACE> is set then trace information
510 is produced (as when the L<debug> method is set).
511
512 If the value is of the form C<1=/path/name> then the trace output is
513 written to the file C</path/name>.
514
515 This environment variable is checked when the storage object is first
516 created (when you call connect on your schema).  So, run-time changes
517 to this environment variable will not take effect unless you also
518 re-connect on your schema.
519
520 =head2 DBIC_TRACE_PROFILE
521
522 If C<DBIC_TRACE_PROFILE> is set, L<DBIx::Class::Storage::PrettyPrint>
523 will be used to format the output from C<DBIC_TRACE>.  The value it
524 is set to is the C<profile> that it will be used.  If the value is a
525 filename the file is read with L<Config::Any> and the results are
526 used as the configuration for tracing.  See L<SQL::Abstract::Tree/new>
527 for what that structure should look like.
528
529
530 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
531
532 Old name for DBIC_TRACE
533
534 =head1 SEE ALSO
535
536 L<DBIx::Class::Storage::DBI> - reference storage implementation using
537 SQL::Abstract and DBI.
538
539 =head1 AUTHORS
540
541 Matt S. Trout <mst@shadowcatsystems.co.uk>
542
543 Andy Grundman <andy@hybridized.org>
544
545 =head1 LICENSE
546
547 You may distribute this code under the same terms as Perl itself.
548
549 =cut
550
551 1;