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