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