resultset_class/result_class now (again) auto loads the specified class; requires...
[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
506 warn "compose_connection deprecated as of 0.08000" unless $warn++;
507
508 my $base = 'DBIx::Class::ResultSetProxy';
509 eval "require ${base};";
510 $self->throw_exception
511 ("No arguments to load_classes and couldn't load ${base} ($@)")
512 if $@;
513
514 if ($self eq $target) {
515 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
516 foreach my $moniker ($self->sources) {
517 my $source = $self->source($moniker);
518 my $class = $source->result_class;
519 $self->inject_base($class, $base);
520 $class->mk_classdata(resultset_instance => $source->resultset);
521 $class->mk_classdata(class_resolver => $self);
522 }
523 $self->connection(@info);
524 return $self;
525 }
526
527 my $schema = $self->compose_namespace($target, $base);
528 {
529 no strict 'refs';
530 *{"${target}::schema"} = sub { $schema };
531 }
532
533 $schema->connection(@info);
534 foreach my $moniker ($schema->sources) {
535 my $source = $schema->source($moniker);
be381829 536 my $class = $source->result_class;
c216324a 537 #warn "$moniker $class $source ".$source->storage;
538 $class->mk_classdata(result_source_instance => $source);
be381829 539 $class->mk_classdata(resultset_instance => $source->resultset);
c216324a 540 $class->mk_classdata(class_resolver => $schema);
be381829 541 }
c216324a 542 return $schema;
bfb2bd4f 543 }
e678398e 544}
545
77254782 546=head2 compose_namespace
547
27f01d1f 548=over 4
549
550=item Arguments: $target_namespace, $additional_base_class?
82b01c38 551
d601dc88 552=item Return Value: $new_schema
27f01d1f 553
554=back
13765dad 555
82b01c38 556For each L<DBIx::Class::ResultSource> in the schema, this method creates a
557class in the target namespace (e.g. $target_namespace::CD,
558$target_namespace::Artist) that inherits from the corresponding classes
559attached to the current schema.
77254782 560
82b01c38 561It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
562new $schema object. If C<$additional_base_class> is given, the new composed
563classes will inherit from first the corresponding classe from the current
564schema then the base class.
565
2053ab2a 566For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
82b01c38 567
568 $schema->compose_namespace('My::DB', 'Base::Class');
569 print join (', ', @My::DB::CD::ISA) . "\n";
570 print join (', ', @My::DB::Artist::ISA) ."\n";
571
2053ab2a 572will produce the output
82b01c38 573
574 My::Schema::CD, Base::Class
575 My::Schema::Artist, Base::Class
77254782 576
577=cut
578
e678398e 579sub compose_namespace {
66d9ef6b 580 my ($self, $target, $base) = @_;
66d9ef6b 581 my $schema = $self->clone;
e9100ff7 582 {
583 no warnings qw/redefine/;
584 local *Class::C3::reinitialize = sub { };
585 foreach my $moniker ($schema->sources) {
586 my $source = $schema->source($moniker);
587 my $target_class = "${target}::${moniker}";
588 $self->inject_base(
589 $target_class => $source->result_class, ($base ? $base : ())
590 );
591 $source->result_class($target_class);
9d3d5af3 592 $target_class->result_source_instance($source)
593 if $target_class->can('result_source_instance');
e9100ff7 594 }
b7951443 595 }
e9100ff7 596 Class::C3->reinitialize();
11b78bd6 597 {
598 no strict 'refs';
1edaf6fe 599 foreach my $meth (qw/class source resultset/) {
600 *{"${target}::${meth}"} =
601 sub { shift->schema->$meth(@_) };
602 }
11b78bd6 603 }
bfb2bd4f 604 return $schema;
b7951443 605}
606
87c4e602 607=head2 setup_connection_class
608
27f01d1f 609=over 4
610
ebc77b53 611=item Arguments: $target, @info
27f01d1f 612
613=back
076652e8 614
82b01c38 615Sets up a database connection class to inject between the schema and the
616subclasses that the schema creates.
429bd4f1 617
076652e8 618=cut
619
b7951443 620sub setup_connection_class {
621 my ($class, $target, @info) = @_;
63e9583a 622 $class->inject_base($target => 'DBIx::Class::DB');
623 #$target->load_components('DB');
b7951443 624 $target->connection(@info);
625}
626
6b43ba5f 627=head2 storage_type
628
629=over 4
630
631=item Arguments: $storage_type
632
633=item Return Value: $storage_type
634
635=back
636
637Set the storage class that will be instantiated when L</connect> is called.
638If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
639assumed by L</connect>. Defaults to C<::DBI>,
640which is L<DBIx::Class::Storage::DBI>.
641
642You want to use this to hardcoded subclasses of L<DBIx::Class::Storage::DBI>
643in cases where the appropriate subclass is not autodetected, such as when
644dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it to
645C<::DBI::Sybase::MSSQL>.
646
87c4e602 647=head2 connection
648
27f01d1f 649=over 4
650
ebc77b53 651=item Arguments: @args
66d9ef6b 652
d601dc88 653=item Return Value: $new_schema
27f01d1f 654
655=back
82b01c38 656
657Instantiates a new Storage object of type
658L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
85f78622 659$storage->connect_info. Sets the connection in-place on the schema.
660
661See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific syntax,
662or L<DBIx::Class::Storage> in general.
66d9ef6b 663
664=cut
665
666sub connection {
667 my ($self, @info) = @_;
e59d3e5b 668 return $self if !@info && $self->storage;
1e10a11d 669 my $storage_class = $self->storage_type;
670 $storage_class = 'DBIx::Class::Storage'.$storage_class
671 if $storage_class =~ m/^::/;
8ef144ff 672 eval "require ${storage_class};";
bc0c9800 673 $self->throw_exception(
674 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
675 ) if $@;
82cc0386 676 my $storage = $storage_class->new($self);
66d9ef6b 677 $storage->connect_info(\@info);
678 $self->storage($storage);
c9d2e0a2 679 $self->on_connect() if($self->can('on_connect'));
66d9ef6b 680 return $self;
681}
682
87c4e602 683=head2 connect
684
27f01d1f 685=over 4
686
ebc77b53 687=item Arguments: @info
66d9ef6b 688
d601dc88 689=item Return Value: $new_schema
27f01d1f 690
691=back
82b01c38 692
693This is a convenience method. It is equivalent to calling
694$schema->clone->connection(@info). See L</connection> and L</clone> for more
695information.
66d9ef6b 696
697=cut
698
08b515f1 699sub connect { shift->clone->connection(@_) }
700
4012acd8 701=head2 txn_do
08b515f1 702
4012acd8 703=over 4
08b515f1 704
4012acd8 705=item Arguments: C<$coderef>, @coderef_args?
08b515f1 706
4012acd8 707=item Return Value: The return value of $coderef
08b515f1 708
4012acd8 709=back
08b515f1 710
4012acd8 711Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
712returning its result (if any). Equivalent to calling $schema->storage->txn_do.
713See L<DBIx::Class::Storage/"txn_do"> for more information.
08b515f1 714
4012acd8 715This interface is preferred over using the individual methods L</txn_begin>,
716L</txn_commit>, and L</txn_rollback> below.
08b515f1 717
4012acd8 718=cut
08b515f1 719
4012acd8 720sub txn_do {
721 my $self = shift;
08b515f1 722
4012acd8 723 $self->storage or $self->throw_exception
724 ('txn_do called on $schema without storage');
08b515f1 725
4012acd8 726 $self->storage->txn_do(@_);
727}
08b515f1 728
4012acd8 729=head2 txn_begin
a62cf8d4 730
4012acd8 731Begins a transaction (does nothing if AutoCommit is off). Equivalent to
732calling $schema->storage->txn_begin. See
733L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
27f01d1f 734
4012acd8 735=cut
82b01c38 736
4012acd8 737sub txn_begin {
738 my $self = shift;
27f01d1f 739
4012acd8 740 $self->storage or $self->throw_exception
741 ('txn_begin called on $schema without storage');
a62cf8d4 742
4012acd8 743 $self->storage->txn_begin;
744}
a62cf8d4 745
4012acd8 746=head2 txn_commit
a62cf8d4 747
4012acd8 748Commits the current transaction. Equivalent to calling
749$schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
750for more information.
a62cf8d4 751
4012acd8 752=cut
a62cf8d4 753
4012acd8 754sub txn_commit {
755 my $self = shift;
a62cf8d4 756
4012acd8 757 $self->storage or $self->throw_exception
758 ('txn_commit called on $schema without storage');
a62cf8d4 759
4012acd8 760 $self->storage->txn_commit;
761}
70634260 762
4012acd8 763=head2 txn_rollback
a62cf8d4 764
4012acd8 765Rolls back the current transaction. Equivalent to calling
766$schema->storage->txn_rollback. See
767L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
a62cf8d4 768
769=cut
770
4012acd8 771sub txn_rollback {
772 my $self = shift;
a62cf8d4 773
19630353 774 $self->storage or $self->throw_exception
4012acd8 775 ('txn_rollback called on $schema without storage');
a62cf8d4 776
4012acd8 777 $self->storage->txn_rollback;
a62cf8d4 778}
779
66d9ef6b 780=head2 clone
781
27f01d1f 782=over 4
783
d601dc88 784=item Return Value: $new_schema
27f01d1f 785
786=back
82b01c38 787
66d9ef6b 788Clones the schema and its associated result_source objects and returns the
789copy.
790
791=cut
792
793sub clone {
794 my ($self) = @_;
04786a4c 795 my $clone = { (ref $self ? %$self : ()) };
796 bless $clone, (ref $self || $self);
797
66d9ef6b 798 foreach my $moniker ($self->sources) {
799 my $source = $self->source($moniker);
800 my $new = $source->new($source);
801 $clone->register_source($moniker => $new);
802 }
82cc0386 803 $clone->storage->set_schema($clone) if $clone->storage;
66d9ef6b 804 return $clone;
805}
806
87c4e602 807=head2 populate
808
27f01d1f 809=over 4
810
16c5f7d3 811=item Arguments: $source_name, \@data;
27f01d1f 812
813=back
a37a4697 814
16c5f7d3 815Pass this method a resultsource name, and an arrayref of
816arrayrefs. The arrayrefs should contain a list of column names,
817followed by one or many sets of matching data for the given columns.
818
744076d8 819In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
820to insert the data, as this is a fast method. However, insert_bulk currently
821assumes that your datasets all contain the same type of values, using scalar
822references in a column in one row, and not in another will probably not work.
823
824Otherwise, each set of data is inserted into the database using
16c5f7d3 825L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
826objects is returned.
82b01c38 827
828i.e.,
a37a4697 829
24d67825 830 $schema->populate('Artist', [
831 [ qw/artistid name/ ],
832 [ 1, 'Popular Band' ],
833 [ 2, 'Indie Band' ],
a62cf8d4 834 ...
835 ]);
a37a4697 836
837=cut
838
839sub populate {
840 my ($self, $name, $data) = @_;
841 my $rs = $self->resultset($name);
842 my @names = @{shift(@$data)};
54e0bd06 843 if(defined wantarray) {
844 my @created;
845 foreach my $item (@$data) {
846 my %create;
847 @create{@names} = @$item;
848 push(@created, $rs->create(\%create));
849 }
850 return @created;
a37a4697 851 }
9fdf90df 852 $self->storage->insert_bulk($self->source($name), \@names, $data);
a37a4697 853}
854
82cc0386 855=head2 exception_action
856
857=over 4
858
859=item Arguments: $code_reference
860
861=back
862
db5dc233 863If C<exception_action> is set for this class/object, L</throw_exception>
864will prefer to call this code reference with the exception as an argument,
865rather than its normal <croak> action.
866
867Your subroutine should probably just wrap the error in the exception
868object/class of your choosing and rethrow. If, against all sage advice,
869you'd like your C<exception_action> to suppress a particular exception
870completely, simply have it return true.
82cc0386 871
872Example:
873
874 package My::Schema;
875 use base qw/DBIx::Class::Schema/;
876 use My::ExceptionClass;
877 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
878 __PACKAGE__->load_classes;
879
db5dc233 880 # or:
82cc0386 881 my $schema_obj = My::Schema->connect( .... );
882 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
883
db5dc233 884 # suppress all exceptions, like a moron:
885 $schema_obj->exception_action(sub { 1 });
886
5160b401 887=head2 throw_exception
701da8c4 888
75d07914 889=over 4
82b01c38 890
ebc77b53 891=item Arguments: $message
82b01c38 892
893=back
894
895Throws an exception. Defaults to using L<Carp::Clan> to report errors from
db5dc233 896user's perspective. See L</exception_action> for details on overriding
897this method's behavior.
701da8c4 898
899=cut
900
901sub throw_exception {
82cc0386 902 my $self = shift;
db5dc233 903 croak @_ if !$self->exception_action || !$self->exception_action->(@_);
701da8c4 904}
905
ec6704d4 906=head2 deploy (EXPERIMENTAL)
1c339d71 907
82b01c38 908=over 4
909
6e73ac25 910=item Arguments: $sqlt_args, $dir
82b01c38 911
912=back
913
914Attempts to deploy the schema to the current storage using L<SQL::Translator>.
ec6704d4 915
916Note that this feature is currently EXPERIMENTAL and may not work correctly
499adf63 917across all databases, or fully handle complex relationships. Saying that, it
918has been used successfully by many people, including the core dev team.
1c339d71 919
51bace1c 920See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
921common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
922produced include a DROP TABLE statement for each table created.
923
499adf63 924Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
925ref or an array ref, containing a list of source to deploy. If present, then
926only the sources listed will get deployed.
927
1c339d71 928=cut
929
930sub deploy {
6e73ac25 931 my ($self, $sqltargs, $dir) = @_;
1c339d71 932 $self->throw_exception("Can't deploy without storage") unless $self->storage;
6e73ac25 933 $self->storage->deploy($self, undef, $sqltargs, $dir);
1c339d71 934}
935
c0f61310 936=head2 create_ddl_dir (EXPERIMENTAL)
937
938=over 4
939
c9d2e0a2 940=item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args
c0f61310 941
942=back
943
944Creates an SQL file based on the Schema, for each of the specified
c9d2e0a2 945database types, in the given directory. Given a previous version number,
946this will also create a file containing the ALTER TABLE statements to
947transform the previous schema into the current one. Note that these
948statements may contain DROP TABLE or DROP COLUMN statements that can
949potentially destroy data.
950
951The file names are created using the C<ddl_filename> method below, please
952override this method in your schema if you would like a different file
953name format. For the ALTER file, the same format is used, replacing
954$version in the name with "$preversion-$version".
955
956If no arguments are passed, then the following default values are used:
957
958=over 4
959
960=item databases - ['MySQL', 'SQLite', 'PostgreSQL']
961
962=item version - $schema->VERSION
963
964=item directory - './'
965
966=item preversion - <none>
967
968=back
c0f61310 969
970Note that this feature is currently EXPERIMENTAL and may not work correctly
971across all databases, or fully handle complex relationships.
972
c9d2e0a2 973WARNING: Please check all SQL files created, before applying them.
974
c0f61310 975=cut
976
6e73ac25 977sub create_ddl_dir {
e673f011 978 my $self = shift;
979
980 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
981 $self->storage->create_ddl_dir($self, @_);
982}
983
9b83fccd 984=head2 ddl_filename (EXPERIMENTAL)
985
c9d2e0a2 986=over 4
987
988=item Arguments: $directory, $database-type, $version, $preversion
989
990=back
991
992 my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
993
994This method is called by C<create_ddl_dir> to compose a file name out of
995the supplied directory, database type and version number. The default file
996name format is: C<$dir$schema-$version-$type.sql>.
9b83fccd 997
c9d2e0a2 998You may override this method in your schema if you wish to use a different
999format.
9b83fccd 1000
1001=cut
1002
6e73ac25 1003sub ddl_filename {
c9d2e0a2 1004 my ($self, $type, $dir, $version, $pversion) = @_;
e673f011 1005
1006 my $filename = ref($self);
32be057c 1007 $filename =~ s/::/-/g;
c9d2e0a2 1008 $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
1009 $filename =~ s/$version/$pversion-$version/ if($pversion);
e673f011 1010
1011 return $filename;
1012}
1013
a02675cd 10141;
c2da098a 1015
c2da098a 1016=head1 AUTHORS
1017
daec44b8 1018Matt S. Trout <mst@shadowcatsystems.co.uk>
c2da098a 1019
1020=head1 LICENSE
1021
1022You may distribute this code under the same terms as Perl itself.
1023
1024=cut