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