Reduce the number of times $self->_dbh is called inside dbh_do() to speed
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Schema.pm
CommitLineData
a02675cd 1package DBIx::Class::Schema;
2
3use strict;
4use warnings;
aa562407 5
4981dc70 6use DBIx::Class::Exception;
701da8c4 7use Carp::Clan qw/^DBIx::Class/;
a917fb06 8use Scalar::Util qw/weaken/;
c9d2e0a2 9use File::Spec;
7cb86b38 10require Module::Find;
a02675cd 11
41a6f8c0 12use base qw/DBIx::Class/;
a02675cd 13
0dc79249 14__PACKAGE__->mk_classdata('class_mappings' => {});
15__PACKAGE__->mk_classdata('source_registrations' => {});
1e10a11d 16__PACKAGE__->mk_classdata('storage_type' => '::DBI');
d7156e50 17__PACKAGE__->mk_classdata('storage');
82cc0386 18__PACKAGE__->mk_classdata('exception_action');
4b946902 19__PACKAGE__->mk_classdata('stacktrace' => $ENV{DBIC_TRACE} || 0);
e6c747fd 20__PACKAGE__->mk_classdata('default_resultset_attributes' => {});
a02675cd 21
c2da098a 22=head1 NAME
23
24DBIx::Class::Schema - composable schemas
25
26=head1 SYNOPSIS
27
24d67825 28 package Library::Schema;
c2da098a 29 use base qw/DBIx::Class::Schema/;
bab77431 30
24d67825 31 # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
32 __PACKAGE__->load_classes(qw/CD Book DVD/);
c2da098a 33
24d67825 34 package Library::Schema::CD;
03312470 35 use base qw/DBIx::Class/;
77254782 36 __PACKAGE__->load_components(qw/PK::Auto Core/); # for example
24d67825 37 __PACKAGE__->table('cd');
c2da098a 38
5d9076f2 39 # Elsewhere in your code:
24d67825 40 my $schema1 = Library::Schema->connect(
a3d93194 41 $dsn,
42 $user,
43 $password,
24d67825 44 { AutoCommit => 0 },
a3d93194 45 );
bab77431 46
24d67825 47 my $schema2 = Library::Schema->connect($coderef_returning_dbh);
c2da098a 48
24d67825 49 # fetch objects using Library::Schema::DVD
50 my $resultset = $schema1->resultset('DVD')->search( ... );
51 my @dvd_objects = $schema2->resultset('DVD')->search( ... );
c2da098a 52
53=head1 DESCRIPTION
54
a3d93194 55Creates database classes based on a schema. This is the recommended way to
56use L<DBIx::Class> and allows you to use more than one concurrent connection
57with your classes.
429bd4f1 58
03312470 59NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
2053ab2a 60carefully, as DBIx::Class does things a little differently. Note in
03312470 61particular which module inherits off which.
62
c2da098a 63=head1 METHODS
64
87c4e602 65=head2 register_class
66
27f01d1f 67=over 4
68
ebc77b53 69=item Arguments: $moniker, $component_class
27f01d1f 70
71=back
076652e8 72
71f9df37 73Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
2053ab2a 74calling:
66d9ef6b 75
181a28f4 76 $schema->register_source($moniker, $component_class->result_source_instance);
076652e8 77
c2da098a 78=cut
79
a02675cd 80sub register_class {
0dc79249 81 my ($self, $moniker, $to_register) = @_;
82 $self->register_source($moniker => $to_register->result_source_instance);
74b92d9a 83}
84
87c4e602 85=head2 register_source
86
27f01d1f 87=over 4
88
ebc77b53 89=item Arguments: $moniker, $result_source
27f01d1f 90
91=back
076652e8 92
82b01c38 93Registers the L<DBIx::Class::ResultSource> in the schema with the given
94moniker.
076652e8 95
96=cut
97
0dc79249 98sub register_source {
99 my ($self, $moniker, $source) = @_;
93405cf0 100
101 %$source = %{ $source->new( { %$source, source_name => $moniker }) };
102
96c95414 103 my %reg = %{$self->source_registrations};
104 $reg{$moniker} = $source;
105 $self->source_registrations(\%reg);
93405cf0 106
0dc79249 107 $source->schema($self);
93405cf0 108
a917fb06 109 weaken($source->{schema}) if ref($self);
0dc79249 110 if ($source->result_class) {
96c95414 111 my %map = %{$self->class_mappings};
112 $map{$source->result_class} = $moniker;
113 $self->class_mappings(\%map);
0dc79249 114 }
75d07914 115}
a02675cd 116
93405cf0 117sub _unregister_source {
118 my ($self, $moniker) = @_;
119 my %reg = %{$self->source_registrations};
120
121 my $source = delete $reg{$moniker};
122 $self->source_registrations(\%reg);
123 if ($source->result_class) {
124 my %map = %{$self->class_mappings};
125 delete $map{$source->result_class};
126 $self->class_mappings(\%map);
127 }
128}
129
bfb2bd4f 130=head2 class
131
27f01d1f 132=over 4
82b01c38 133
ebc77b53 134=item Arguments: $moniker
27f01d1f 135
d601dc88 136=item Return Value: $classname
27f01d1f 137
138=back
82b01c38 139
2053ab2a 140Retrieves the result class name for the given moniker. For example:
82b01c38 141
142 my $class = $schema->class('CD');
bfb2bd4f 143
144=cut
145
146sub class {
0dc79249 147 my ($self, $moniker) = @_;
148 return $self->source($moniker)->result_class;
bfb2bd4f 149}
150
ea20d0fd 151=head2 source
152
27f01d1f 153=over 4
154
ebc77b53 155=item Arguments: $moniker
27f01d1f 156
d601dc88 157=item Return Value: $result_source
82b01c38 158
27f01d1f 159=back
82b01c38 160
24d67825 161 my $source = $schema->source('Book');
ea20d0fd 162
82b01c38 163Returns the L<DBIx::Class::ResultSource> object for the registered moniker.
ea20d0fd 164
165=cut
166
167sub source {
0dc79249 168 my ($self, $moniker) = @_;
169 my $sreg = $self->source_registrations;
170 return $sreg->{$moniker} if exists $sreg->{$moniker};
171
172 # if we got here, they probably passed a full class name
173 my $mapped = $self->class_mappings->{$moniker};
701da8c4 174 $self->throw_exception("Can't find source for ${moniker}")
0dc79249 175 unless $mapped && exists $sreg->{$mapped};
176 return $sreg->{$mapped};
ea20d0fd 177}
178
0dc79249 179=head2 sources
180
27f01d1f 181=over 4
182
d601dc88 183=item Return Value: @source_monikers
27f01d1f 184
185=back
82b01c38 186
187Returns the source monikers of all source registrations on this schema.
2053ab2a 188For example:
82b01c38 189
190 my @source_monikers = $schema->sources;
0dc79249 191
192=cut
193
194sub sources { return keys %{shift->source_registrations}; }
195
9b1ba0f2 196=head2 storage
197
198 my $storage = $schema->storage;
199
200Returns the L<DBIx::Class::Storage> object for this Schema.
201
ea20d0fd 202=head2 resultset
203
27f01d1f 204=over 4
205
ebc77b53 206=item Arguments: $moniker
27f01d1f 207
d601dc88 208=item Return Value: $result_set
82b01c38 209
27f01d1f 210=back
82b01c38 211
24d67825 212 my $rs = $schema->resultset('DVD');
ea20d0fd 213
82b01c38 214Returns the L<DBIx::Class::ResultSet> object for the registered moniker.
ea20d0fd 215
216=cut
217
218sub resultset {
0dc79249 219 my ($self, $moniker) = @_;
220 return $self->source($moniker)->resultset;
ea20d0fd 221}
222
87c4e602 223=head2 load_classes
224
27f01d1f 225=over 4
226
227=item Arguments: @classes?, { $namespace => [ @classes ] }+
228
229=back
076652e8 230
82b01c38 231With no arguments, this method uses L<Module::Find> to find all classes under
232the schema's namespace. Otherwise, this method loads the classes you specify
233(using L<use>), and registers them (using L</"register_class">).
076652e8 234
2053ab2a 235It is possible to comment out classes with a leading C<#>, but note that perl
236will think it's a mistake (trying to use a comment in a qw list), so you'll
237need to add C<no warnings 'qw';> before your load_classes call.
5ce32fc1 238
2053ab2a 239Example:
82b01c38 240
241 My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
75d07914 242 # etc. (anything under the My::Schema namespace)
82b01c38 243
244 # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
245 # not Other::Namespace::LinerNotes nor My::Schema::Track
246 My::Schema->load_classes(qw/ CD Artist #Track /, {
247 Other::Namespace => [qw/ Producer #LinerNotes /],
248 });
249
076652e8 250=cut
251
a02675cd 252sub load_classes {
5ce32fc1 253 my ($class, @params) = @_;
bab77431 254
5ce32fc1 255 my %comps_for;
bab77431 256
5ce32fc1 257 if (@params) {
258 foreach my $param (@params) {
259 if (ref $param eq 'ARRAY') {
260 # filter out commented entries
261 my @modules = grep { $_ !~ /^#/ } @$param;
bab77431 262
5ce32fc1 263 push (@{$comps_for{$class}}, @modules);
264 }
265 elsif (ref $param eq 'HASH') {
266 # more than one namespace possible
267 for my $comp ( keys %$param ) {
268 # filter out commented entries
269 my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
270
271 push (@{$comps_for{$comp}}, @modules);
272 }
273 }
274 else {
275 # filter out commented entries
276 push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
277 }
278 }
279 } else {
bc0c9800 280 my @comp = map { substr $_, length "${class}::" }
281 Module::Find::findallmod($class);
5ce32fc1 282 $comps_for{$class} = \@comp;
41a6f8c0 283 }
5ce32fc1 284
e6efde04 285 my @to_register;
286 {
287 no warnings qw/redefine/;
288 local *Class::C3::reinitialize = sub { };
289 foreach my $prefix (keys %comps_for) {
290 foreach my $comp (@{$comps_for{$prefix}||[]}) {
291 my $comp_class = "${prefix}::${comp}";
83542a7d 292 { # try to untaint module name. mods where this fails
293 # are left alone so we don't have to change the old behavior
294 no locale; # localized \w doesn't untaint expression
295 if ( $comp_class =~ m/^( (?:\w+::)* \w+ )$/x ) {
296 $comp_class = $1;
297 }
298 }
c037c03a 299 $class->ensure_class_loaded($comp_class);
bab77431 300
93405cf0 301 $comp = $comp_class->source_name || $comp;
302# $DB::single = 1;
303 push(@to_register, [ $comp, $comp_class ]);
bfb2bd4f 304 }
5ce32fc1 305 }
a02675cd 306 }
e6efde04 307 Class::C3->reinitialize;
308
309 foreach my $to (@to_register) {
310 $class->register_class(@$to);
311 # if $class->can('result_source_instance');
312 }
a02675cd 313}
314
2374c5ff 315=head2 load_namespaces
316
317=over 4
318
85bd0538 319=item Arguments: %options?
2374c5ff 320
321=back
322
323This is an alternative to L</load_classes> above which assumes an alternative
c87014e8 324layout for automatic class loading. It assumes that all result
325classes are underneath a sub-namespace of the schema called C<Result>, any
7a58f051 326corresponding ResultSet classes are underneath a sub-namespace of the schema
46a05fd4 327called C<ResultSet>.
2374c5ff 328
46a05fd4 329Both of the sub-namespaces are configurable if you don't like the defaults,
c87014e8 330via the options C<result_namespace> and C<resultset_namespace>.
85bd0538 331
25fb14bd 332If (and only if) you specify the option C<default_resultset_class>, any found
c87014e8 333Result classes for which we do not find a corresponding
25fb14bd 334ResultSet class will have their C<resultset_class> set to
335C<default_resultset_class>.
0f4ec1d2 336
46a05fd4 337C<load_namespaces> takes care of calling C<resultset_class> for you where
338neccessary if you didn't do it for yourself.
f017c022 339
0f4ec1d2 340All of the namespace and classname options to this method are relative to
341the schema classname by default. To specify a fully-qualified name, prefix
342it with a literal C<+>.
2374c5ff 343
f017c022 344Examples:
2374c5ff 345
c87014e8 346 # load My::Schema::Result::CD, My::Schema::Result::Artist,
2374c5ff 347 # My::Schema::ResultSet::CD, etc...
0f4ec1d2 348 My::Schema->load_namespaces;
349
c87014e8 350 # Override everything to use ugly names.
351 # In this example, if there is a My::Schema::Res::Foo, but no matching
352 # My::Schema::RSets::Foo, then Foo will have its
353 # resultset_class set to My::Schema::RSetBase
0f4ec1d2 354 My::Schema->load_namespaces(
c87014e8 355 result_namespace => 'Res',
0f4ec1d2 356 resultset_namespace => 'RSets',
25fb14bd 357 default_resultset_class => 'RSetBase',
0f4ec1d2 358 );
2374c5ff 359
0f4ec1d2 360 # Put things in other namespaces
85bd0538 361 My::Schema->load_namespaces(
c87014e8 362 result_namespace => '+Some::Place::Results',
0f4ec1d2 363 resultset_namespace => '+Another::Place::RSets',
85bd0538 364 );
0f4ec1d2 365
f017c022 366If you'd like to use multiple namespaces of each type, simply use an arrayref
c87014e8 367of namespaces for that option. In the case that the same result
46a05fd4 368(or resultset) class exists in multiple namespaces, the latter entries in
369your list of namespaces will override earlier ones.
f017c022 370
371 My::Schema->load_namespaces(
c87014e8 372 # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo :
373 result_namespace => [ 'Results_A', 'Results_B', 'Results_C' ],
f017c022 374 resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
375 );
85bd0538 376
2374c5ff 377=cut
378
f017c022 379# Pre-pends our classname to the given relative classname or
380# class namespace, unless there is a '+' prefix, which will
7a58f051 381# be stripped.
f017c022 382sub _expand_relative_name {
7a58f051 383 my ($class, $name) = @_;
384 return if !$name;
385 $name = $class . '::' . $name if ! ($name =~ s/^\+//);
386 return $name;
f017c022 387}
388
389# returns a hash of $shortname => $fullname for every package
390# found in the given namespaces ($shortname is with the $fullname's
391# namespace stripped off)
392sub _map_namespaces {
393 my ($class, @namespaces) = @_;
394
395 my @results_hash;
396 foreach my $namespace (@namespaces) {
397 push(
398 @results_hash,
399 map { (substr($_, length "${namespace}::"), $_) }
400 Module::Find::findallmod($namespace)
401 );
402 }
403
404 @results_hash;
405}
406
2374c5ff 407sub load_namespaces {
85bd0538 408 my ($class, %args) = @_;
2374c5ff 409
c87014e8 410 my $result_namespace = delete $args{result_namespace} || 'Result';
25fb14bd 411 my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
25fb14bd 412 my $default_resultset_class = delete $args{default_resultset_class};
0f4ec1d2 413
25fb14bd 414 $class->throw_exception('load_namespaces: unknown option(s): '
415 . join(q{,}, map { qq{'$_'} } keys %args))
416 if scalar keys %args;
417
7a58f051 418 $default_resultset_class
419 = $class->_expand_relative_name($default_resultset_class);
f017c022 420
c87014e8 421 for my $arg ($result_namespace, $resultset_namespace) {
f017c022 422 $arg = [ $arg ] if !ref($arg) && $arg;
2374c5ff 423
f017c022 424 $class->throw_exception('load_namespaces: namespace arguments must be '
425 . 'a simple string or an arrayref')
426 if ref($arg) ne 'ARRAY';
2374c5ff 427
7a58f051 428 $_ = $class->_expand_relative_name($_) for (@$arg);
f017c022 429 }
2374c5ff 430
c87014e8 431 my %results = $class->_map_namespaces(@$result_namespace);
f017c022 432 my %resultsets = $class->_map_namespaces(@$resultset_namespace);
0f4ec1d2 433
2374c5ff 434 my @to_register;
435 {
25fb14bd 436 no warnings 'redefine';
2374c5ff 437 local *Class::C3::reinitialize = sub { };
25fb14bd 438 use warnings 'redefine';
0f4ec1d2 439
c87014e8 440 foreach my $result (keys %results) {
441 my $result_class = $results{$result};
442 $class->ensure_class_loaded($result_class);
443 $result_class->source_name($result) unless $result_class->source_name;
0f4ec1d2 444
c87014e8 445 my $rs_class = delete $resultsets{$result};
446 my $rs_set = $result_class->resultset_class;
25fb14bd 447 if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
f017c022 448 if($rs_class && $rs_class ne $rs_set) {
c87014e8 449 warn "We found ResultSet class '$rs_class' for '$result', but it seems "
450 . "that you had already set '$result' to use '$rs_set' instead";
2374c5ff 451 }
452 }
25fb14bd 453 elsif($rs_class ||= $default_resultset_class) {
454 $class->ensure_class_loaded($rs_class);
c87014e8 455 $result_class->resultset_class($rs_class);
0f4ec1d2 456 }
2374c5ff 457
c87014e8 458 push(@to_register, [ $result_class->source_name, $result_class ]);
2374c5ff 459 }
460 }
461
0f4ec1d2 462 foreach (sort keys %resultsets) {
463 warn "load_namespaces found ResultSet class $_ with no "
c87014e8 464 . 'corresponding Result class';
2374c5ff 465 }
0f4ec1d2 466
fdcd8145 467 Class::C3->reinitialize;
468 $class->register_class(@$_) for (@to_register);
469
0f4ec1d2 470 return;
2374c5ff 471}
472
c216324a 473=head2 compose_connection (DEPRECATED)
87c4e602 474
27f01d1f 475=over 4
476
ebc77b53 477=item Arguments: $target_namespace, @db_info
429bd4f1 478
d601dc88 479=item Return Value: $new_schema
27f01d1f 480
481=back
076652e8 482
c216324a 483DEPRECATED. You probably wanted compose_namespace.
484
485Actually, you probably just wanted to call connect.
486
1c133e22 487=begin hidden
488
489(hidden due to deprecation)
c216324a 490
2053ab2a 491Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
492calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
493then injects the L<DBix::Class::ResultSetProxy> component and a
494resultset_instance classdata entry on all the new classes, in order to support
82b01c38 495$target_namespaces::$class->search(...) method calls.
496
497This is primarily useful when you have a specific need for class method access
498to a connection. In normal usage it is preferred to call
499L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
500on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
501more information.
54540863 502
1c133e22 503=end hidden
504
076652e8 505=cut
506
c216324a 507{
508 my $warn;
509
510 sub compose_connection {
511 my ($self, $target, @info) = @_;
512
3943fd63 513 warn "compose_connection deprecated as of 0.08000"
514 unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++);
c216324a 515
516 my $base = 'DBIx::Class::ResultSetProxy';
517 eval "require ${base};";
518 $self->throw_exception
519 ("No arguments to load_classes and couldn't load ${base} ($@)")
520 if $@;
521
522 if ($self eq $target) {
523 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
524 foreach my $moniker ($self->sources) {
525 my $source = $self->source($moniker);
526 my $class = $source->result_class;
527 $self->inject_base($class, $base);
528 $class->mk_classdata(resultset_instance => $source->resultset);
529 $class->mk_classdata(class_resolver => $self);
530 }
531 $self->connection(@info);
532 return $self;
533 }
534
535 my $schema = $self->compose_namespace($target, $base);
536 {
537 no strict 'refs';
538 *{"${target}::schema"} = sub { $schema };
539 }
540
541 $schema->connection(@info);
542 foreach my $moniker ($schema->sources) {
543 my $source = $schema->source($moniker);
be381829 544 my $class = $source->result_class;
c216324a 545 #warn "$moniker $class $source ".$source->storage;
546 $class->mk_classdata(result_source_instance => $source);
be381829 547 $class->mk_classdata(resultset_instance => $source->resultset);
c216324a 548 $class->mk_classdata(class_resolver => $schema);
be381829 549 }
c216324a 550 return $schema;
bfb2bd4f 551 }
e678398e 552}
553
77254782 554=head2 compose_namespace
555
27f01d1f 556=over 4
557
558=item Arguments: $target_namespace, $additional_base_class?
82b01c38 559
d601dc88 560=item Return Value: $new_schema
27f01d1f 561
562=back
13765dad 563
82b01c38 564For each L<DBIx::Class::ResultSource> in the schema, this method creates a
565class in the target namespace (e.g. $target_namespace::CD,
566$target_namespace::Artist) that inherits from the corresponding classes
567attached to the current schema.
77254782 568
82b01c38 569It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
570new $schema object. If C<$additional_base_class> is given, the new composed
571classes will inherit from first the corresponding classe from the current
572schema then the base class.
573
2053ab2a 574For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
82b01c38 575
576 $schema->compose_namespace('My::DB', 'Base::Class');
577 print join (', ', @My::DB::CD::ISA) . "\n";
578 print join (', ', @My::DB::Artist::ISA) ."\n";
579
2053ab2a 580will produce the output
82b01c38 581
582 My::Schema::CD, Base::Class
583 My::Schema::Artist, Base::Class
77254782 584
585=cut
586
e678398e 587sub compose_namespace {
66d9ef6b 588 my ($self, $target, $base) = @_;
66d9ef6b 589 my $schema = $self->clone;
e9100ff7 590 {
591 no warnings qw/redefine/;
592 local *Class::C3::reinitialize = sub { };
593 foreach my $moniker ($schema->sources) {
594 my $source = $schema->source($moniker);
595 my $target_class = "${target}::${moniker}";
596 $self->inject_base(
597 $target_class => $source->result_class, ($base ? $base : ())
598 );
599 $source->result_class($target_class);
9d3d5af3 600 $target_class->result_source_instance($source)
601 if $target_class->can('result_source_instance');
e9100ff7 602 }
b7951443 603 }
e9100ff7 604 Class::C3->reinitialize();
11b78bd6 605 {
606 no strict 'refs';
978b42af 607 no warnings 'redefine';
1edaf6fe 608 foreach my $meth (qw/class source resultset/) {
609 *{"${target}::${meth}"} =
610 sub { shift->schema->$meth(@_) };
611 }
11b78bd6 612 }
bfb2bd4f 613 return $schema;
b7951443 614}
615
87c4e602 616=head2 setup_connection_class
617
27f01d1f 618=over 4
619
ebc77b53 620=item Arguments: $target, @info
27f01d1f 621
622=back
076652e8 623
82b01c38 624Sets up a database connection class to inject between the schema and the
625subclasses that the schema creates.
429bd4f1 626
076652e8 627=cut
628
b7951443 629sub setup_connection_class {
630 my ($class, $target, @info) = @_;
63e9583a 631 $class->inject_base($target => 'DBIx::Class::DB');
632 #$target->load_components('DB');
b7951443 633 $target->connection(@info);
634}
635
6b43ba5f 636=head2 storage_type
637
638=over 4
639
640=item Arguments: $storage_type
641
642=item Return Value: $storage_type
643
644=back
645
646Set the storage class that will be instantiated when L</connect> is called.
647If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
648assumed by L</connect>. Defaults to C<::DBI>,
649which is L<DBIx::Class::Storage::DBI>.
650
651You want to use this to hardcoded subclasses of L<DBIx::Class::Storage::DBI>
652in cases where the appropriate subclass is not autodetected, such as when
653dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it to
654C<::DBI::Sybase::MSSQL>.
655
87c4e602 656=head2 connection
657
27f01d1f 658=over 4
659
ebc77b53 660=item Arguments: @args
66d9ef6b 661
d601dc88 662=item Return Value: $new_schema
27f01d1f 663
664=back
82b01c38 665
666Instantiates a new Storage object of type
667L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
85f78622 668$storage->connect_info. Sets the connection in-place on the schema.
669
670See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific syntax,
671or L<DBIx::Class::Storage> in general.
66d9ef6b 672
673=cut
674
675sub connection {
676 my ($self, @info) = @_;
e59d3e5b 677 return $self if !@info && $self->storage;
1e10a11d 678 my $storage_class = $self->storage_type;
679 $storage_class = 'DBIx::Class::Storage'.$storage_class
680 if $storage_class =~ m/^::/;
8ef144ff 681 eval "require ${storage_class};";
bc0c9800 682 $self->throw_exception(
683 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
684 ) if $@;
82cc0386 685 my $storage = $storage_class->new($self);
66d9ef6b 686 $storage->connect_info(\@info);
687 $self->storage($storage);
688 return $self;
689}
690
87c4e602 691=head2 connect
692
27f01d1f 693=over 4
694
ebc77b53 695=item Arguments: @info
66d9ef6b 696
d601dc88 697=item Return Value: $new_schema
27f01d1f 698
699=back
82b01c38 700
701This is a convenience method. It is equivalent to calling
702$schema->clone->connection(@info). See L</connection> and L</clone> for more
703information.
66d9ef6b 704
705=cut
706
08b515f1 707sub connect { shift->clone->connection(@_) }
708
4012acd8 709=head2 txn_do
08b515f1 710
4012acd8 711=over 4
08b515f1 712
4012acd8 713=item Arguments: C<$coderef>, @coderef_args?
08b515f1 714
4012acd8 715=item Return Value: The return value of $coderef
08b515f1 716
4012acd8 717=back
08b515f1 718
4012acd8 719Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
720returning its result (if any). Equivalent to calling $schema->storage->txn_do.
721See L<DBIx::Class::Storage/"txn_do"> for more information.
08b515f1 722
4012acd8 723This interface is preferred over using the individual methods L</txn_begin>,
724L</txn_commit>, and L</txn_rollback> below.
08b515f1 725
4012acd8 726=cut
08b515f1 727
4012acd8 728sub txn_do {
729 my $self = shift;
08b515f1 730
4012acd8 731 $self->storage or $self->throw_exception
732 ('txn_do called on $schema without storage');
08b515f1 733
4012acd8 734 $self->storage->txn_do(@_);
735}
66d9ef6b 736
75c8a7ab 737=head2 txn_scope_guard
738
739Runs C<txn_scope_guard> on the schema's storage.
740
b85be4c1 741=cut
742
1bc193ac 743sub txn_scope_guard {
744 my $self = shift;
745
746 $self->storage or $self->throw_exception
747 ('txn_scope_guard called on $schema without storage');
748
749 $self->storage->txn_scope_guard(@_);
750}
751
4012acd8 752=head2 txn_begin
a62cf8d4 753
4012acd8 754Begins a transaction (does nothing if AutoCommit is off). Equivalent to
755calling $schema->storage->txn_begin. See
756L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
27f01d1f 757
4012acd8 758=cut
82b01c38 759
4012acd8 760sub txn_begin {
761 my $self = shift;
27f01d1f 762
4012acd8 763 $self->storage or $self->throw_exception
764 ('txn_begin called on $schema without storage');
a62cf8d4 765
4012acd8 766 $self->storage->txn_begin;
767}
a62cf8d4 768
4012acd8 769=head2 txn_commit
a62cf8d4 770
4012acd8 771Commits the current transaction. Equivalent to calling
772$schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
773for more information.
a62cf8d4 774
4012acd8 775=cut
a62cf8d4 776
4012acd8 777sub txn_commit {
778 my $self = shift;
a62cf8d4 779
4012acd8 780 $self->storage or $self->throw_exception
781 ('txn_commit called on $schema without storage');
a62cf8d4 782
4012acd8 783 $self->storage->txn_commit;
784}
70634260 785
4012acd8 786=head2 txn_rollback
a62cf8d4 787
4012acd8 788Rolls back the current transaction. Equivalent to calling
789$schema->storage->txn_rollback. See
790L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
a62cf8d4 791
792=cut
793
4012acd8 794sub txn_rollback {
795 my $self = shift;
a62cf8d4 796
19630353 797 $self->storage or $self->throw_exception
4012acd8 798 ('txn_rollback called on $schema without storage');
a62cf8d4 799
4012acd8 800 $self->storage->txn_rollback;
a62cf8d4 801}
802
66d9ef6b 803=head2 clone
804
27f01d1f 805=over 4
806
d601dc88 807=item Return Value: $new_schema
27f01d1f 808
809=back
82b01c38 810
66d9ef6b 811Clones the schema and its associated result_source objects and returns the
812copy.
813
814=cut
815
816sub clone {
817 my ($self) = @_;
04786a4c 818 my $clone = { (ref $self ? %$self : ()) };
819 bless $clone, (ref $self || $self);
820
66d9ef6b 821 foreach my $moniker ($self->sources) {
822 my $source = $self->source($moniker);
823 my $new = $source->new($source);
824 $clone->register_source($moniker => $new);
825 }
82cc0386 826 $clone->storage->set_schema($clone) if $clone->storage;
66d9ef6b 827 return $clone;
828}
829
87c4e602 830=head2 populate
831
27f01d1f 832=over 4
833
16c5f7d3 834=item Arguments: $source_name, \@data;
27f01d1f 835
836=back
a37a4697 837
16c5f7d3 838Pass this method a resultsource name, and an arrayref of
839arrayrefs. The arrayrefs should contain a list of column names,
840followed by one or many sets of matching data for the given columns.
841
744076d8 842In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
843to insert the data, as this is a fast method. However, insert_bulk currently
844assumes that your datasets all contain the same type of values, using scalar
845references in a column in one row, and not in another will probably not work.
846
847Otherwise, each set of data is inserted into the database using
16c5f7d3 848L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
849objects is returned.
82b01c38 850
851i.e.,
a37a4697 852
24d67825 853 $schema->populate('Artist', [
854 [ qw/artistid name/ ],
855 [ 1, 'Popular Band' ],
856 [ 2, 'Indie Band' ],
a62cf8d4 857 ...
858 ]);
5a93e138 859
860Since wantarray context is basically the same as looping over $rs->create(...)
861you won't see any performance benefits and in this case the method is more for
862convenience. Void context sends the column information directly to storage
863using <DBI>s bulk insert method. So the performance will be much better for
864storages that support this method.
865
866Because of this difference in the way void context inserts rows into your
867database you need to note how this will effect any loaded components that
868override or augment insert. For example if you are using a component such
869as L<DBIx::Class::UUIDColumns> to populate your primary keys you MUST use
870wantarray context if you want the PKs automatically created.
a37a4697 871
872=cut
873
874sub populate {
875 my ($self, $name, $data) = @_;
876 my $rs = $self->resultset($name);
877 my @names = @{shift(@$data)};
54e0bd06 878 if(defined wantarray) {
879 my @created;
880 foreach my $item (@$data) {
881 my %create;
882 @create{@names} = @$item;
883 push(@created, $rs->create(\%create));
884 }
885 return @created;
a37a4697 886 }
8b93a938 887 my @results_to_create;
888 foreach my $datum (@$data) {
889 my %result_to_create;
890 foreach my $index (0..$#names) {
891 $result_to_create{$names[$index]} = $$datum[$index];
892 }
893 push @results_to_create, \%result_to_create;
894 }
895 $rs->populate(\@results_to_create);
a37a4697 896}
897
82cc0386 898=head2 exception_action
899
900=over 4
901
902=item Arguments: $code_reference
903
904=back
905
db5dc233 906If C<exception_action> is set for this class/object, L</throw_exception>
907will prefer to call this code reference with the exception as an argument,
613397e7 908rather than its normal C<croak> or C<confess> action.
db5dc233 909
910Your subroutine should probably just wrap the error in the exception
911object/class of your choosing and rethrow. If, against all sage advice,
912you'd like your C<exception_action> to suppress a particular exception
913completely, simply have it return true.
82cc0386 914
915Example:
916
917 package My::Schema;
918 use base qw/DBIx::Class::Schema/;
919 use My::ExceptionClass;
920 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
921 __PACKAGE__->load_classes;
922
db5dc233 923 # or:
82cc0386 924 my $schema_obj = My::Schema->connect( .... );
925 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
926
db5dc233 927 # suppress all exceptions, like a moron:
928 $schema_obj->exception_action(sub { 1 });
929
613397e7 930=head2 stacktrace
931
84c5863b 932=over 4
613397e7 933
934=item Arguments: boolean
935
936=back
937
4981dc70 938Whether L</throw_exception> should include stack trace information.
4b946902 939Defaults to false normally, but defaults to true if C<$ENV{DBIC_TRACE}>
940is true.
613397e7 941
5160b401 942=head2 throw_exception
701da8c4 943
75d07914 944=over 4
82b01c38 945
ebc77b53 946=item Arguments: $message
82b01c38 947
948=back
949
950Throws an exception. Defaults to using L<Carp::Clan> to report errors from
db5dc233 951user's perspective. See L</exception_action> for details on overriding
4b946902 952this method's behavior. If L</stacktrace> is turned on, C<throw_exception>'s
953default behavior will provide a detailed stack trace.
701da8c4 954
955=cut
956
957sub throw_exception {
82cc0386 958 my $self = shift;
4981dc70 959
960 DBIx::Class::Exception->throw($_[0], $self->stacktrace)
961 if !$self->exception_action || !$self->exception_action->(@_);
701da8c4 962}
963
dfccde48 964=head2 deploy
1c339d71 965
82b01c38 966=over 4
967
6e73ac25 968=item Arguments: $sqlt_args, $dir
82b01c38 969
970=back
971
972Attempts to deploy the schema to the current storage using L<SQL::Translator>.
ec6704d4 973
51bace1c 974See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
975common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
976produced include a DROP TABLE statement for each table created.
977
499adf63 978Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
979ref or an array ref, containing a list of source to deploy. If present, then
980only the sources listed will get deployed.
981
1c339d71 982=cut
983
984sub deploy {
6e73ac25 985 my ($self, $sqltargs, $dir) = @_;
1c339d71 986 $self->throw_exception("Can't deploy without storage") unless $self->storage;
6e73ac25 987 $self->storage->deploy($self, undef, $sqltargs, $dir);
1c339d71 988}
989
c0f61310 990=head2 create_ddl_dir (EXPERIMENTAL)
991
992=over 4
993
c9d2e0a2 994=item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args
c0f61310 995
996=back
997
998Creates an SQL file based on the Schema, for each of the specified
c9d2e0a2 999database types, in the given directory. Given a previous version number,
1000this will also create a file containing the ALTER TABLE statements to
1001transform the previous schema into the current one. Note that these
1002statements may contain DROP TABLE or DROP COLUMN statements that can
1003potentially destroy data.
1004
1005The file names are created using the C<ddl_filename> method below, please
1006override this method in your schema if you would like a different file
1007name format. For the ALTER file, the same format is used, replacing
1008$version in the name with "$preversion-$version".
1009
1010If no arguments are passed, then the following default values are used:
1011
1012=over 4
1013
1014=item databases - ['MySQL', 'SQLite', 'PostgreSQL']
1015
1016=item version - $schema->VERSION
1017
1018=item directory - './'
1019
1020=item preversion - <none>
1021
1022=back
c0f61310 1023
1024Note that this feature is currently EXPERIMENTAL and may not work correctly
1025across all databases, or fully handle complex relationships.
1026
c9d2e0a2 1027WARNING: Please check all SQL files created, before applying them.
1028
c0f61310 1029=cut
1030
6e73ac25 1031sub create_ddl_dir {
e673f011 1032 my $self = shift;
1033
1034 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1035 $self->storage->create_ddl_dir($self, @_);
1036}
1037
9b83fccd 1038=head2 ddl_filename (EXPERIMENTAL)
1039
c9d2e0a2 1040=over 4
1041
1042=item Arguments: $directory, $database-type, $version, $preversion
1043
1044=back
1045
1046 my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1047
1048This method is called by C<create_ddl_dir> to compose a file name out of
1049the supplied directory, database type and version number. The default file
1050name format is: C<$dir$schema-$version-$type.sql>.
9b83fccd 1051
c9d2e0a2 1052You may override this method in your schema if you wish to use a different
1053format.
9b83fccd 1054
1055=cut
1056
6e73ac25 1057sub ddl_filename {
c9d2e0a2 1058 my ($self, $type, $dir, $version, $pversion) = @_;
e673f011 1059
1060 my $filename = ref($self);
32be057c 1061 $filename =~ s/::/-/g;
c9d2e0a2 1062 $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
1063 $filename =~ s/$version/$pversion-$version/ if($pversion);
e673f011 1064
1065 return $filename;
1066}
1067
d2f3e87b 1068=head2 sqlt_deploy_hook($sqlt_schema)
1069
1070An optional sub which you can declare in your own Schema class that will get
1071passed the L<SQL::Translator::Schema> object when you deploy the schema via
1072L</create_ddl_dir> or L</deploy>.
1073
1074For an example of what you can do with this, see
1075L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>.
1076
4146e3da 1077=head2 thaw
1078
1079Provided as the recommened way of thawing schema objects. You can call
1080C<Storable::thaw> directly if you wish, but the thawed objects will not have a
1081reference to any schema, so are rather useless
1082
1083=cut
1084
1085sub thaw {
1086 my ($self, $obj) = @_;
1087 local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1088 return Storable::thaw($obj);
1089}
1090
1091=head2 freeze
1092
1093This doesn't actualy do anything more than call L<Storable/freeze>, it is just
1094provided here for symetry.
1095
d2f3e87b 1096=cut
1097
4146e3da 1098sub freeze {
1099 return Storable::freeze($_[1]);
1100}
1101
1102=head2 dclone
1103
1104Recommeneded way of dcloning objects. This is needed to properly maintain
1105references to the schema object (which itself is B<not> cloned.)
1106
1107=cut
1108
1109sub dclone {
1110 my ($self, $obj) = @_;
1111 local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1112 return Storable::dclone($obj);
1113}
1114
a02675cd 11151;
c2da098a 1116
c2da098a 1117=head1 AUTHORS
1118
daec44b8 1119Matt S. Trout <mst@shadowcatsystems.co.uk>
c2da098a 1120
1121=head1 LICENSE
1122
1123You may distribute this code under the same terms as Perl itself.
1124
1125=cut