make _determine_driver more reentrant
[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;
ddc0a6c8 10use Sub::Name ();
329d7385 11use Module::Find();
a02675cd 12
41a6f8c0 13use base qw/DBIx::Class/;
a02675cd 14
0dc79249 15__PACKAGE__->mk_classdata('class_mappings' => {});
16__PACKAGE__->mk_classdata('source_registrations' => {});
1e10a11d 17__PACKAGE__->mk_classdata('storage_type' => '::DBI');
d7156e50 18__PACKAGE__->mk_classdata('storage');
82cc0386 19__PACKAGE__->mk_classdata('exception_action');
4b946902 20__PACKAGE__->mk_classdata('stacktrace' => $ENV{DBIC_TRACE} || 0);
e6c747fd 21__PACKAGE__->mk_classdata('default_resultset_attributes' => {});
a02675cd 22
c2da098a 23=head1 NAME
24
25DBIx::Class::Schema - composable schemas
26
27=head1 SYNOPSIS
28
24d67825 29 package Library::Schema;
c2da098a 30 use base qw/DBIx::Class::Schema/;
bab77431 31
829517d4 32 # load all Result classes in Library/Schema/Result/
33 __PACKAGE__->load_namespaces();
c2da098a 34
829517d4 35 package Library::Schema::Result::CD;
03312470 36 use base qw/DBIx::Class/;
829517d4 37 __PACKAGE__->load_components(qw/Core/); # for example
24d67825 38 __PACKAGE__->table('cd');
c2da098a 39
5d9076f2 40 # Elsewhere in your code:
24d67825 41 my $schema1 = Library::Schema->connect(
a3d93194 42 $dsn,
43 $user,
44 $password,
ef131d82 45 { AutoCommit => 1 },
a3d93194 46 );
bab77431 47
24d67825 48 my $schema2 = Library::Schema->connect($coderef_returning_dbh);
c2da098a 49
829517d4 50 # fetch objects using Library::Schema::Result::DVD
24d67825 51 my $resultset = $schema1->resultset('DVD')->search( ... );
52 my @dvd_objects = $schema2->resultset('DVD')->search( ... );
c2da098a 53
54=head1 DESCRIPTION
55
a3d93194 56Creates database classes based on a schema. This is the recommended way to
57use L<DBIx::Class> and allows you to use more than one concurrent connection
58with your classes.
429bd4f1 59
03312470 60NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
2053ab2a 61carefully, as DBIx::Class does things a little differently. Note in
03312470 62particular which module inherits off which.
63
829517d4 64=head1 SETUP METHODS
c2da098a 65
829517d4 66=head2 load_namespaces
87c4e602 67
27f01d1f 68=over 4
69
829517d4 70=item Arguments: %options?
27f01d1f 71
72=back
076652e8 73
829517d4 74 __PACKAGE__->load_namespaces();
66d9ef6b 75
829517d4 76 __PACKAGE__->load_namespaces(
77 result_namespace => 'Res',
78 resultset_namespace => 'RSet',
79 default_resultset_class => '+MyDB::Othernamespace::RSet',
80 );
076652e8 81
829517d4 82With no arguments, this method uses L<Module::Find> to load all your
83Result classes from a sub-namespace F<Result> under your Schema class'
84namespace. Eg. With a Schema of I<MyDB::Schema> all files in
85I<MyDB::Schema::Result> are assumed to be Result classes.
c2da098a 86
829517d4 87It also finds all ResultSet classes in the namespace F<ResultSet> and
88loads them into the appropriate Result classes using for you. The
89matching is done by assuming the package name of the ResultSet class
90is the same as that of the Result class.
74b92d9a 91
672687db 92You will be warned if ResultSet classes are discovered for which there
829517d4 93are no matching Result classes like this:
87c4e602 94
829517d4 95 load_namespaces found ResultSet class $classname with no corresponding Result class
27f01d1f 96
829517d4 97If a Result class is found to already have a ResultSet class set using
98L</resultset_class> to some other class, you will be warned like this:
27f01d1f 99
829517d4 100 We found ResultSet class '$rs_class' for '$result', but it seems
101 that you had already set '$result' to use '$rs_set' instead
076652e8 102
829517d4 103Both of the sub-namespaces are configurable if you don't like the defaults,
104via the options C<result_namespace> and C<resultset_namespace>.
076652e8 105
829517d4 106If (and only if) you specify the option C<default_resultset_class>, any found
107Result classes for which we do not find a corresponding
108ResultSet class will have their C<resultset_class> set to
109C<default_resultset_class>.
076652e8 110
829517d4 111All of the namespace and classname options to this method are relative to
112the schema classname by default. To specify a fully-qualified name, prefix
113it with a literal C<+>.
2a4d9487 114
829517d4 115Examples:
2a4d9487 116
829517d4 117 # load My::Schema::Result::CD, My::Schema::Result::Artist,
118 # My::Schema::ResultSet::CD, etc...
119 My::Schema->load_namespaces;
2a4d9487 120
829517d4 121 # Override everything to use ugly names.
122 # In this example, if there is a My::Schema::Res::Foo, but no matching
123 # My::Schema::RSets::Foo, then Foo will have its
124 # resultset_class set to My::Schema::RSetBase
125 My::Schema->load_namespaces(
126 result_namespace => 'Res',
127 resultset_namespace => 'RSets',
128 default_resultset_class => 'RSetBase',
129 );
2a4d9487 130
829517d4 131 # Put things in other namespaces
132 My::Schema->load_namespaces(
133 result_namespace => '+Some::Place::Results',
134 resultset_namespace => '+Another::Place::RSets',
135 );
2a4d9487 136
829517d4 137If you'd like to use multiple namespaces of each type, simply use an arrayref
138of namespaces for that option. In the case that the same result
139(or resultset) class exists in multiple namespaces, the latter entries in
140your list of namespaces will override earlier ones.
2a4d9487 141
829517d4 142 My::Schema->load_namespaces(
143 # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo :
144 result_namespace => [ 'Results_A', 'Results_B', 'Results_C' ],
145 resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
146 );
2a4d9487 147
148=cut
149
829517d4 150# Pre-pends our classname to the given relative classname or
151# class namespace, unless there is a '+' prefix, which will
152# be stripped.
153sub _expand_relative_name {
154 my ($class, $name) = @_;
155 return if !$name;
156 $name = $class . '::' . $name if ! ($name =~ s/^\+//);
157 return $name;
2a4d9487 158}
159
f3405058 160# Finds all modules in the supplied namespace, or if omitted in the
161# namespace of $class. Untaints all findings as they can be assumed
162# to be safe
163sub _findallmod {
164 my $proto = shift;
165 my $ns = shift || ref $proto || $proto;
166
167 my @mods = Module::Find::findallmod($ns);
168
169 # try to untaint module names. mods where this fails
170 # are left alone so we don't have to change the old behavior
171 no locale; # localized \w doesn't untaint expression
172 return map { $_ =~ m/^( (?:\w+::)* \w+ )$/x ? $1 : $_ } @mods;
173}
174
829517d4 175# returns a hash of $shortname => $fullname for every package
b488020e 176# found in the given namespaces ($shortname is with the $fullname's
177# namespace stripped off)
829517d4 178sub _map_namespaces {
179 my ($class, @namespaces) = @_;
6eec9003 180
829517d4 181 my @results_hash;
182 foreach my $namespace (@namespaces) {
183 push(
184 @results_hash,
185 map { (substr($_, length "${namespace}::"), $_) }
f3405058 186 $class->_findallmod($namespace)
829517d4 187 );
0dc79249 188 }
27f01d1f 189
829517d4 190 @results_hash;
ea20d0fd 191}
192
b488020e 193# returns the result_source_instance for the passed class/object,
194# or dies with an informative message (used by load_namespaces)
195sub _ns_get_rsrc_instance {
196 my $class = shift;
197 my $rs = ref ($_[0]) || $_[0];
198
199 if ($rs->can ('result_source_instance') ) {
200 return $rs->result_source_instance;
201 }
202 else {
203 $class->throw_exception (
204 "Attempt to load_namespaces() class $rs failed - are you sure this is a real Result Class?"
205 );
206 }
207}
208
829517d4 209sub load_namespaces {
210 my ($class, %args) = @_;
0dc79249 211
829517d4 212 my $result_namespace = delete $args{result_namespace} || 'Result';
213 my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
214 my $default_resultset_class = delete $args{default_resultset_class};
0dc79249 215
829517d4 216 $class->throw_exception('load_namespaces: unknown option(s): '
217 . join(q{,}, map { qq{'$_'} } keys %args))
218 if scalar keys %args;
0dc79249 219
829517d4 220 $default_resultset_class
221 = $class->_expand_relative_name($default_resultset_class);
9b1ba0f2 222
829517d4 223 for my $arg ($result_namespace, $resultset_namespace) {
224 $arg = [ $arg ] if !ref($arg) && $arg;
9b1ba0f2 225
829517d4 226 $class->throw_exception('load_namespaces: namespace arguments must be '
227 . 'a simple string or an arrayref')
228 if ref($arg) ne 'ARRAY';
9b1ba0f2 229
829517d4 230 $_ = $class->_expand_relative_name($_) for (@$arg);
231 }
ea20d0fd 232
829517d4 233 my %results = $class->_map_namespaces(@$result_namespace);
234 my %resultsets = $class->_map_namespaces(@$resultset_namespace);
27f01d1f 235
829517d4 236 my @to_register;
237 {
238 no warnings 'redefine';
239 local *Class::C3::reinitialize = sub { };
240 use warnings 'redefine';
27f01d1f 241
3988ce40 242 # ensure classes are loaded and attached in inheritance order
3d27f771 243 $class->ensure_class_loaded($_) foreach(values %results);
3988ce40 244 my %inh_idx;
245 my @subclass_last = sort {
246
247 ($inh_idx{$a} ||=
248 scalar @{mro::get_linear_isa( $results{$a} )}
249 )
250
251 <=>
252
253 ($inh_idx{$b} ||=
254 scalar @{mro::get_linear_isa( $results{$b} )}
255 )
256
257 } keys(%results);
258
3d27f771 259 foreach my $result (@subclass_last) {
829517d4 260 my $result_class = $results{$result};
82b01c38 261
829517d4 262 my $rs_class = delete $resultsets{$result};
b488020e 263 my $rs_set = $class->_ns_get_rsrc_instance ($result_class)->resultset_class;
3988ce40 264
829517d4 265 if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
3d27f771 266 if($rs_class && $rs_class ne $rs_set) {
341d5ede 267 carp "We found ResultSet class '$rs_class' for '$result', but it seems "
829517d4 268 . "that you had already set '$result' to use '$rs_set' instead";
269 }
270 }
271 elsif($rs_class ||= $default_resultset_class) {
272 $class->ensure_class_loaded($rs_class);
b488020e 273 $class->_ns_get_rsrc_instance ($result_class)->resultset_class($rs_class);
829517d4 274 }
82b01c38 275
b488020e 276 my $source_name = $class->_ns_get_rsrc_instance ($result_class)->source_name || $result;
0e6c5d58 277
278 push(@to_register, [ $source_name, $result_class ]);
829517d4 279 }
280 }
ea20d0fd 281
829517d4 282 foreach (sort keys %resultsets) {
341d5ede 283 carp "load_namespaces found ResultSet class $_ with no "
829517d4 284 . 'corresponding Result class';
285 }
ea20d0fd 286
829517d4 287 Class::C3->reinitialize;
288 $class->register_class(@$_) for (@to_register);
ea20d0fd 289
829517d4 290 return;
ea20d0fd 291}
292
87c4e602 293=head2 load_classes
294
27f01d1f 295=over 4
296
297=item Arguments: @classes?, { $namespace => [ @classes ] }+
298
299=back
076652e8 300
1ab61457 301L</load_classes> is an alternative method to L</load_namespaces>, both of
302which serve similar purposes, each with different advantages and disadvantages.
303In the general case you should use L</load_namespaces>, unless you need to
304be able to specify that only specific classes are loaded at runtime.
829517d4 305
82b01c38 306With no arguments, this method uses L<Module::Find> to find all classes under
307the schema's namespace. Otherwise, this method loads the classes you specify
308(using L<use>), and registers them (using L</"register_class">).
076652e8 309
2053ab2a 310It is possible to comment out classes with a leading C<#>, but note that perl
311will think it's a mistake (trying to use a comment in a qw list), so you'll
312need to add C<no warnings 'qw';> before your load_classes call.
5ce32fc1 313
829517d4 314If any classes found do not appear to be Result class files, you will
315get the following warning:
316
317 Failed to load $comp_class. Can't find source_name method. Is
318 $comp_class really a full DBIC result class? Fix it, move it elsewhere,
319 or make your load_classes call more specific.
320
2053ab2a 321Example:
82b01c38 322
323 My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
75d07914 324 # etc. (anything under the My::Schema namespace)
82b01c38 325
326 # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
327 # not Other::Namespace::LinerNotes nor My::Schema::Track
328 My::Schema->load_classes(qw/ CD Artist #Track /, {
329 Other::Namespace => [qw/ Producer #LinerNotes /],
330 });
331
076652e8 332=cut
333
a02675cd 334sub load_classes {
5ce32fc1 335 my ($class, @params) = @_;
bab77431 336
5ce32fc1 337 my %comps_for;
bab77431 338
5ce32fc1 339 if (@params) {
340 foreach my $param (@params) {
341 if (ref $param eq 'ARRAY') {
342 # filter out commented entries
343 my @modules = grep { $_ !~ /^#/ } @$param;
bab77431 344
5ce32fc1 345 push (@{$comps_for{$class}}, @modules);
346 }
347 elsif (ref $param eq 'HASH') {
348 # more than one namespace possible
349 for my $comp ( keys %$param ) {
350 # filter out commented entries
351 my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
352
353 push (@{$comps_for{$comp}}, @modules);
354 }
355 }
356 else {
357 # filter out commented entries
358 push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
359 }
360 }
361 } else {
bc0c9800 362 my @comp = map { substr $_, length "${class}::" }
f3405058 363 $class->_findallmod;
5ce32fc1 364 $comps_for{$class} = \@comp;
41a6f8c0 365 }
5ce32fc1 366
e6efde04 367 my @to_register;
368 {
369 no warnings qw/redefine/;
370 local *Class::C3::reinitialize = sub { };
371 foreach my $prefix (keys %comps_for) {
372 foreach my $comp (@{$comps_for{$prefix}||[]}) {
373 my $comp_class = "${prefix}::${comp}";
c037c03a 374 $class->ensure_class_loaded($comp_class);
bab77431 375
89271e56 376 my $snsub = $comp_class->can('source_name');
377 if(! $snsub ) {
341d5ede 378 carp "Failed to load $comp_class. Can't find source_name method. Is $comp_class really a full DBIC result class? Fix it, move it elsewhere, or make your load_classes call more specific.";
89271e56 379 next;
380 }
381 $comp = $snsub->($comp_class) || $comp;
382
93405cf0 383 push(@to_register, [ $comp, $comp_class ]);
bfb2bd4f 384 }
5ce32fc1 385 }
a02675cd 386 }
e6efde04 387 Class::C3->reinitialize;
388
389 foreach my $to (@to_register) {
390 $class->register_class(@$to);
391 # if $class->can('result_source_instance');
392 }
a02675cd 393}
394
829517d4 395=head2 storage_type
2374c5ff 396
397=over 4
398
829517d4 399=item Arguments: $storage_type|{$storage_type, \%args}
400
401=item Return value: $storage_type|{$storage_type, \%args}
402
403=item Default value: DBIx::Class::Storage::DBI
2374c5ff 404
405=back
406
829517d4 407Set the storage class that will be instantiated when L</connect> is called.
408If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
409assumed by L</connect>.
2374c5ff 410
829517d4 411You want to use this to set subclasses of L<DBIx::Class::Storage::DBI>
412in cases where the appropriate subclass is not autodetected, such as
413when dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it
414to C<::DBI::Sybase::MSSQL>.
85bd0538 415
829517d4 416If your storage type requires instantiation arguments, those are
417defined as a second argument in the form of a hashref and the entire
418value needs to be wrapped into an arrayref or a hashref. We support
419both types of refs here in order to play nice with your
420Config::[class] or your choice. See
421L<DBIx::Class::Storage::DBI::Replicated> for an example of this.
0f4ec1d2 422
829517d4 423=head2 exception_action
f017c022 424
829517d4 425=over 4
0f4ec1d2 426
829517d4 427=item Arguments: $code_reference
f017c022 428
829517d4 429=item Return value: $code_reference
85bd0538 430
829517d4 431=item Default value: None
2374c5ff 432
829517d4 433=back
f017c022 434
829517d4 435If C<exception_action> is set for this class/object, L</throw_exception>
436will prefer to call this code reference with the exception as an argument,
437rather than L<DBIx::Class::Exception/throw>.
f017c022 438
829517d4 439Your subroutine should probably just wrap the error in the exception
440object/class of your choosing and rethrow. If, against all sage advice,
441you'd like your C<exception_action> to suppress a particular exception
442completely, simply have it return true.
f017c022 443
829517d4 444Example:
f017c022 445
829517d4 446 package My::Schema;
447 use base qw/DBIx::Class::Schema/;
448 use My::ExceptionClass;
449 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
450 __PACKAGE__->load_classes;
2374c5ff 451
829517d4 452 # or:
453 my $schema_obj = My::Schema->connect( .... );
454 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
0f4ec1d2 455
829517d4 456 # suppress all exceptions, like a moron:
457 $schema_obj->exception_action(sub { 1 });
25fb14bd 458
829517d4 459=head2 stacktrace
f017c022 460
829517d4 461=over 4
2374c5ff 462
829517d4 463=item Arguments: boolean
2374c5ff 464
829517d4 465=back
2374c5ff 466
829517d4 467Whether L</throw_exception> should include stack trace information.
468Defaults to false normally, but defaults to true if C<$ENV{DBIC_TRACE}>
469is true.
0f4ec1d2 470
829517d4 471=head2 sqlt_deploy_hook
0f4ec1d2 472
829517d4 473=over
0f4ec1d2 474
829517d4 475=item Arguments: $sqlt_schema
2374c5ff 476
829517d4 477=back
2374c5ff 478
829517d4 479An optional sub which you can declare in your own Schema class that will get
480passed the L<SQL::Translator::Schema> object when you deploy the schema via
481L</create_ddl_dir> or L</deploy>.
0f4ec1d2 482
829517d4 483For an example of what you can do with this, see
484L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>.
fdcd8145 485
2d7d8459 486Note that sqlt_deploy_hook is called by L</deployment_statements>, which in turn
487is called before L</deploy>. Therefore the hook can be used only to manipulate
488the L<SQL::Translator::Schema> object before it is turned into SQL fed to the
489database. If you want to execute post-deploy statements which can not be generated
490by L<SQL::Translator>, the currently suggested method is to overload L</deploy>
491and use L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
492
829517d4 493=head1 METHODS
2374c5ff 494
829517d4 495=head2 connect
87c4e602 496
27f01d1f 497=over 4
498
829517d4 499=item Arguments: @connectinfo
429bd4f1 500
d601dc88 501=item Return Value: $new_schema
27f01d1f 502
503=back
076652e8 504
829517d4 505Creates and returns a new Schema object. The connection info set on it
506is used to create a new instance of the storage backend and set it on
507the Schema object.
1c133e22 508
829517d4 509See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific
5d52945a 510syntax on the C<@connectinfo> argument, or L<DBIx::Class::Storage> in
829517d4 511general.
1c133e22 512
5d52945a 513Note that C<connect_info> expects an arrayref of arguments, but
faaba25f 514C<connect> does not. C<connect> wraps its arguments in an arrayref
5d52945a 515before passing them to C<connect_info>.
516
4c7d99ca 517=head3 Overloading
518
519C<connect> is a convenience method. It is equivalent to calling
520$schema->clone->connection(@connectinfo). To write your own overloaded
521version, overload L</connection> instead.
522
076652e8 523=cut
524
829517d4 525sub connect { shift->clone->connection(@_) }
e678398e 526
829517d4 527=head2 resultset
77254782 528
27f01d1f 529=over 4
530
829517d4 531=item Arguments: $source_name
82b01c38 532
829517d4 533=item Return Value: $resultset
27f01d1f 534
535=back
13765dad 536
829517d4 537 my $rs = $schema->resultset('DVD');
82b01c38 538
829517d4 539Returns the L<DBIx::Class::ResultSet> object for the registered source
540name.
77254782 541
542=cut
543
829517d4 544sub resultset {
545 my ($self, $moniker) = @_;
546 return $self->source($moniker)->resultset;
b7951443 547}
548
829517d4 549=head2 sources
6b43ba5f 550
551=over 4
552
829517d4 553=item Return Value: @source_names
6b43ba5f 554
555=back
556
829517d4 557 my @source_names = $schema->sources;
6b43ba5f 558
829517d4 559Lists names of all the sources registered on this Schema object.
6b43ba5f 560
829517d4 561=cut
161fb223 562
829517d4 563sub sources { return keys %{shift->source_registrations}; }
106d5f3b 564
829517d4 565=head2 source
87c4e602 566
27f01d1f 567=over 4
568
829517d4 569=item Arguments: $source_name
66d9ef6b 570
829517d4 571=item Return Value: $result_source
27f01d1f 572
573=back
82b01c38 574
829517d4 575 my $source = $schema->source('Book');
85f78622 576
829517d4 577Returns the L<DBIx::Class::ResultSource> object for the registered
578source name.
66d9ef6b 579
580=cut
581
829517d4 582sub source {
583 my ($self, $moniker) = @_;
584 my $sreg = $self->source_registrations;
585 return $sreg->{$moniker} if exists $sreg->{$moniker};
586
587 # if we got here, they probably passed a full class name
588 my $mapped = $self->class_mappings->{$moniker};
589 $self->throw_exception("Can't find source for ${moniker}")
590 unless $mapped && exists $sreg->{$mapped};
591 return $sreg->{$mapped};
161fb223 592}
593
829517d4 594=head2 class
87c4e602 595
27f01d1f 596=over 4
597
829517d4 598=item Arguments: $source_name
66d9ef6b 599
829517d4 600=item Return Value: $classname
27f01d1f 601
602=back
82b01c38 603
829517d4 604 my $class = $schema->class('CD');
605
606Retrieves the Result class name for the given source name.
66d9ef6b 607
608=cut
609
829517d4 610sub class {
611 my ($self, $moniker) = @_;
612 return $self->source($moniker)->result_class;
613}
08b515f1 614
4012acd8 615=head2 txn_do
08b515f1 616
4012acd8 617=over 4
08b515f1 618
4012acd8 619=item Arguments: C<$coderef>, @coderef_args?
08b515f1 620
4012acd8 621=item Return Value: The return value of $coderef
08b515f1 622
4012acd8 623=back
08b515f1 624
4012acd8 625Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
626returning its result (if any). Equivalent to calling $schema->storage->txn_do.
627See L<DBIx::Class::Storage/"txn_do"> for more information.
08b515f1 628
4012acd8 629This interface is preferred over using the individual methods L</txn_begin>,
630L</txn_commit>, and L</txn_rollback> below.
08b515f1 631
281719d2 632WARNING: If you are connected with C<AutoCommit => 0> the transaction is
633considered nested, and you will still need to call L</txn_commit> to write your
634changes when appropriate. You will also want to connect with C<auto_savepoint =>
6351> to get partial rollback to work, if the storage driver for your database
636supports it.
637
638Connecting with C<AutoCommit => 1> is recommended.
639
4012acd8 640=cut
08b515f1 641
4012acd8 642sub txn_do {
643 my $self = shift;
08b515f1 644
4012acd8 645 $self->storage or $self->throw_exception
646 ('txn_do called on $schema without storage');
08b515f1 647
4012acd8 648 $self->storage->txn_do(@_);
649}
66d9ef6b 650
6936e902 651=head2 txn_scope_guard
75c8a7ab 652
89028f42 653Runs C<txn_scope_guard> on the schema's storage. See
654L<DBIx::Class::Storage/txn_scope_guard>.
75c8a7ab 655
b85be4c1 656=cut
657
1bc193ac 658sub txn_scope_guard {
659 my $self = shift;
660
661 $self->storage or $self->throw_exception
662 ('txn_scope_guard called on $schema without storage');
663
664 $self->storage->txn_scope_guard(@_);
665}
666
4012acd8 667=head2 txn_begin
a62cf8d4 668
4012acd8 669Begins a transaction (does nothing if AutoCommit is off). Equivalent to
670calling $schema->storage->txn_begin. See
671L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
27f01d1f 672
4012acd8 673=cut
82b01c38 674
4012acd8 675sub txn_begin {
676 my $self = shift;
27f01d1f 677
4012acd8 678 $self->storage or $self->throw_exception
679 ('txn_begin called on $schema without storage');
a62cf8d4 680
4012acd8 681 $self->storage->txn_begin;
682}
a62cf8d4 683
4012acd8 684=head2 txn_commit
a62cf8d4 685
4012acd8 686Commits the current transaction. Equivalent to calling
687$schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
688for more information.
a62cf8d4 689
4012acd8 690=cut
a62cf8d4 691
4012acd8 692sub txn_commit {
693 my $self = shift;
a62cf8d4 694
4012acd8 695 $self->storage or $self->throw_exception
696 ('txn_commit called on $schema without storage');
a62cf8d4 697
4012acd8 698 $self->storage->txn_commit;
699}
70634260 700
4012acd8 701=head2 txn_rollback
a62cf8d4 702
4012acd8 703Rolls back the current transaction. Equivalent to calling
704$schema->storage->txn_rollback. See
705L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
a62cf8d4 706
707=cut
708
4012acd8 709sub txn_rollback {
710 my $self = shift;
a62cf8d4 711
19630353 712 $self->storage or $self->throw_exception
4012acd8 713 ('txn_rollback called on $schema without storage');
a62cf8d4 714
4012acd8 715 $self->storage->txn_rollback;
a62cf8d4 716}
717
829517d4 718=head2 storage
66d9ef6b 719
829517d4 720 my $storage = $schema->storage;
04786a4c 721
829517d4 722Returns the L<DBIx::Class::Storage> object for this Schema. Grab this
723if you want to turn on SQL statement debugging at runtime, or set the
724quote character. For the default storage, the documentation can be
725found in L<DBIx::Class::Storage::DBI>.
66d9ef6b 726
87c4e602 727=head2 populate
728
27f01d1f 729=over 4
730
16c5f7d3 731=item Arguments: $source_name, \@data;
27f01d1f 732
829517d4 733=item Return value: \@$objects | nothing
734
27f01d1f 735=back
a37a4697 736
16c5f7d3 737Pass this method a resultsource name, and an arrayref of
738arrayrefs. The arrayrefs should contain a list of column names,
739followed by one or many sets of matching data for the given columns.
740
744076d8 741In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
742to insert the data, as this is a fast method. However, insert_bulk currently
743assumes that your datasets all contain the same type of values, using scalar
744references in a column in one row, and not in another will probably not work.
745
746Otherwise, each set of data is inserted into the database using
16c5f7d3 747L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
748objects is returned.
82b01c38 749
750i.e.,
a37a4697 751
24d67825 752 $schema->populate('Artist', [
753 [ qw/artistid name/ ],
754 [ 1, 'Popular Band' ],
755 [ 2, 'Indie Band' ],
a62cf8d4 756 ...
757 ]);
d4daee7b 758
5a93e138 759Since wantarray context is basically the same as looping over $rs->create(...)
760you won't see any performance benefits and in this case the method is more for
761convenience. Void context sends the column information directly to storage
762using <DBI>s bulk insert method. So the performance will be much better for
763storages that support this method.
764
765Because of this difference in the way void context inserts rows into your
766database you need to note how this will effect any loaded components that
767override or augment insert. For example if you are using a component such
768as L<DBIx::Class::UUIDColumns> to populate your primary keys you MUST use
769wantarray context if you want the PKs automatically created.
a37a4697 770
771=cut
772
773sub populate {
774 my ($self, $name, $data) = @_;
c4e67d31 775 if(my $rs = $self->resultset($name)) {
776 if(defined wantarray) {
777 return $rs->populate($data);
778 } else {
779 $rs->populate($data);
54e0bd06 780 }
c4e67d31 781 } else {
782 $self->throw_exception("$name is not a resultset");
8b93a938 783 }
a37a4697 784}
785
829517d4 786=head2 connection
787
788=over 4
789
790=item Arguments: @args
791
792=item Return Value: $new_schema
793
794=back
795
796Similar to L</connect> except sets the storage object and connection
797data in-place on the Schema class. You should probably be calling
798L</connect> to get a proper Schema object instead.
799
4c7d99ca 800=head3 Overloading
801
802Overload C<connection> to change the behaviour of C<connect>.
829517d4 803
804=cut
805
806sub connection {
807 my ($self, @info) = @_;
808 return $self if !@info && $self->storage;
d4daee7b 809
829517d4 810 my ($storage_class, $args) = ref $self->storage_type ?
811 ($self->_normalize_storage_type($self->storage_type),{}) : ($self->storage_type, {});
d4daee7b 812
829517d4 813 $storage_class = 'DBIx::Class::Storage'.$storage_class
814 if $storage_class =~ m/^::/;
815 eval "require ${storage_class};";
816 $self->throw_exception(
817 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
818 ) if $@;
819 my $storage = $storage_class->new($self=>$args);
820 $storage->connect_info(\@info);
821 $self->storage($storage);
822 return $self;
823}
824
825sub _normalize_storage_type {
826 my ($self, $storage_type) = @_;
827 if(ref $storage_type eq 'ARRAY') {
828 return @$storage_type;
829 } elsif(ref $storage_type eq 'HASH') {
830 return %$storage_type;
831 } else {
832 $self->throw_exception('Unsupported REFTYPE given: '. ref $storage_type);
833 }
834}
835
836=head2 compose_namespace
82cc0386 837
838=over 4
839
829517d4 840=item Arguments: $target_namespace, $additional_base_class?
841
842=item Retur Value: $new_schema
843
844=back
845
846For each L<DBIx::Class::ResultSource> in the schema, this method creates a
847class in the target namespace (e.g. $target_namespace::CD,
848$target_namespace::Artist) that inherits from the corresponding classes
849attached to the current schema.
850
851It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
852new $schema object. If C<$additional_base_class> is given, the new composed
853classes will inherit from first the corresponding classe from the current
854schema then the base class.
855
856For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
857
858 $schema->compose_namespace('My::DB', 'Base::Class');
859 print join (', ', @My::DB::CD::ISA) . "\n";
860 print join (', ', @My::DB::Artist::ISA) ."\n";
861
862will produce the output
863
864 My::Schema::CD, Base::Class
865 My::Schema::Artist, Base::Class
866
867=cut
868
869# this might be oversimplified
870# sub compose_namespace {
871# my ($self, $target, $base) = @_;
872
873# my $schema = $self->clone;
874# foreach my $moniker ($schema->sources) {
875# my $source = $schema->source($moniker);
876# my $target_class = "${target}::${moniker}";
877# $self->inject_base(
878# $target_class => $source->result_class, ($base ? $base : ())
879# );
880# $source->result_class($target_class);
881# $target_class->result_source_instance($source)
882# if $target_class->can('result_source_instance');
883# $schema->register_source($moniker, $source);
884# }
885# return $schema;
886# }
887
888sub compose_namespace {
889 my ($self, $target, $base) = @_;
890 my $schema = $self->clone;
891 {
892 no warnings qw/redefine/;
893# local *Class::C3::reinitialize = sub { };
894 foreach my $moniker ($schema->sources) {
895 my $source = $schema->source($moniker);
896 my $target_class = "${target}::${moniker}";
897 $self->inject_base(
898 $target_class => $source->result_class, ($base ? $base : ())
899 );
900 $source->result_class($target_class);
901 $target_class->result_source_instance($source)
902 if $target_class->can('result_source_instance');
903 $schema->register_source($moniker, $source);
904 }
905 }
906# Class::C3->reinitialize();
907 {
908 no strict 'refs';
909 no warnings 'redefine';
910 foreach my $meth (qw/class source resultset/) {
911 *{"${target}::${meth}"} =
912 sub { shift->schema->$meth(@_) };
913 }
914 }
915 return $schema;
916}
917
918sub setup_connection_class {
919 my ($class, $target, @info) = @_;
920 $class->inject_base($target => 'DBIx::Class::DB');
921 #$target->load_components('DB');
922 $target->connection(@info);
923}
924
925=head2 svp_begin
926
927Creates a new savepoint (does nothing outside a transaction).
928Equivalent to calling $schema->storage->svp_begin. See
929L<DBIx::Class::Storage::DBI/"svp_begin"> for more information.
930
931=cut
932
933sub svp_begin {
934 my ($self, $name) = @_;
935
936 $self->storage or $self->throw_exception
937 ('svp_begin called on $schema without storage');
938
939 $self->storage->svp_begin($name);
940}
941
942=head2 svp_release
943
944Releases a savepoint (does nothing outside a transaction).
945Equivalent to calling $schema->storage->svp_release. See
946L<DBIx::Class::Storage::DBI/"svp_release"> for more information.
947
948=cut
949
950sub svp_release {
951 my ($self, $name) = @_;
952
953 $self->storage or $self->throw_exception
954 ('svp_release called on $schema without storage');
82cc0386 955
829517d4 956 $self->storage->svp_release($name);
957}
82cc0386 958
829517d4 959=head2 svp_rollback
db5dc233 960
829517d4 961Rollback to a savepoint (does nothing outside a transaction).
962Equivalent to calling $schema->storage->svp_rollback. See
963L<DBIx::Class::Storage::DBI/"svp_rollback"> for more information.
82cc0386 964
829517d4 965=cut
82cc0386 966
829517d4 967sub svp_rollback {
968 my ($self, $name) = @_;
82cc0386 969
829517d4 970 $self->storage or $self->throw_exception
971 ('svp_rollback called on $schema without storage');
82cc0386 972
829517d4 973 $self->storage->svp_rollback($name);
974}
db5dc233 975
829517d4 976=head2 clone
613397e7 977
84c5863b 978=over 4
613397e7 979
829517d4 980=item Return Value: $new_schema
613397e7 981
982=back
983
829517d4 984Clones the schema and its associated result_source objects and returns the
985copy.
986
987=cut
988
989sub clone {
990 my ($self) = @_;
991 my $clone = { (ref $self ? %$self : ()) };
992 bless $clone, (ref $self || $self);
993
994 $clone->class_mappings({ %{$clone->class_mappings} });
995 $clone->source_registrations({ %{$clone->source_registrations} });
996 foreach my $moniker ($self->sources) {
997 my $source = $self->source($moniker);
998 my $new = $source->new($source);
999 # we use extra here as we want to leave the class_mappings as they are
1000 # but overwrite the source_registrations entry with the new source
1001 $clone->register_extra_source($moniker => $new);
1002 }
1003 $clone->storage->set_schema($clone) if $clone->storage;
1004 return $clone;
1005}
613397e7 1006
5160b401 1007=head2 throw_exception
701da8c4 1008
75d07914 1009=over 4
82b01c38 1010
ebc77b53 1011=item Arguments: $message
82b01c38 1012
1013=back
1014
1015Throws an exception. Defaults to using L<Carp::Clan> to report errors from
db5dc233 1016user's perspective. See L</exception_action> for details on overriding
4b946902 1017this method's behavior. If L</stacktrace> is turned on, C<throw_exception>'s
1018default behavior will provide a detailed stack trace.
701da8c4 1019
1020=cut
1021
1022sub throw_exception {
82cc0386 1023 my $self = shift;
4981dc70 1024
1025 DBIx::Class::Exception->throw($_[0], $self->stacktrace)
1026 if !$self->exception_action || !$self->exception_action->(@_);
701da8c4 1027}
1028
dfccde48 1029=head2 deploy
1c339d71 1030
82b01c38 1031=over 4
1032
10976519 1033=item Arguments: \%sqlt_args, $dir
82b01c38 1034
1035=back
1036
1037Attempts to deploy the schema to the current storage using L<SQL::Translator>.
ec6704d4 1038
10976519 1039See L<SQL::Translator/METHODS> for a list of values for C<\%sqlt_args>.
1040The most common value for this would be C<< { add_drop_table => 1 } >>
1041to have the SQL produced include a C<DROP TABLE> statement for each table
1042created. For quoting purposes supply C<quote_table_names> and
3e82fc27 1043C<quote_field_names>.
51bace1c 1044
499adf63 1045Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
1046ref or an array ref, containing a list of source to deploy. If present, then
0e2c6809 1047only the sources listed will get deployed. Furthermore, you can use the
1048C<add_fk_index> parser parameter to prevent the parser from creating an index for each
1049FK.
499adf63 1050
1c339d71 1051=cut
1052
1053sub deploy {
6e73ac25 1054 my ($self, $sqltargs, $dir) = @_;
1c339d71 1055 $self->throw_exception("Can't deploy without storage") unless $self->storage;
6e73ac25 1056 $self->storage->deploy($self, undef, $sqltargs, $dir);
1c339d71 1057}
1058
0e0ce6c1 1059=head2 deployment_statements
1060
1061=over 4
1062
10976519 1063=item Arguments: See L<DBIx::Class::Storage::DBI/deployment_statements>
0e0ce6c1 1064
829517d4 1065=item Return value: $listofstatements
1066
0e0ce6c1 1067=back
1068
10976519 1069A convenient shortcut to
1070C<< $self->storage->deployment_statements($self, @args) >>.
1071Returns the SQL statements used by L</deploy> and
1072L<DBIx::Class::Schema::Storage/deploy>.
0e0ce6c1 1073
1074=cut
1075
1076sub deployment_statements {
7ad93f5a 1077 my $self = shift;
0e0ce6c1 1078
1079 $self->throw_exception("Can't generate deployment statements without a storage")
1080 if not $self->storage;
1081
7ad93f5a 1082 $self->storage->deployment_statements($self, @_);
0e0ce6c1 1083}
1084
c0f61310 1085=head2 create_ddl_dir (EXPERIMENTAL)
1086
1087=over 4
1088
10976519 1089=item Arguments: See L<DBIx::Class::Storage::DBI/create_ddl_dir>
c0f61310 1090
1091=back
1092
10976519 1093A convenient shortcut to
1094C<< $self->storage->create_ddl_dir($self, @args) >>.
c9d2e0a2 1095
10976519 1096Creates an SQL file based on the Schema, for each of the specified
1097database types, in the given directory.
c9d2e0a2 1098
c0f61310 1099=cut
1100
6e73ac25 1101sub create_ddl_dir {
e673f011 1102 my $self = shift;
1103
1104 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1105 $self->storage->create_ddl_dir($self, @_);
1106}
1107
e63a82f7 1108=head2 ddl_filename
9b83fccd 1109
c9d2e0a2 1110=over 4
1111
99a74c4a 1112=item Arguments: $database-type, $version, $directory, $preversion
c9d2e0a2 1113
829517d4 1114=item Return value: $normalised_filename
1115
c9d2e0a2 1116=back
1117
99a74c4a 1118 my $filename = $table->ddl_filename($type, $version, $dir, $preversion)
c9d2e0a2 1119
1120This method is called by C<create_ddl_dir> to compose a file name out of
1121the supplied directory, database type and version number. The default file
1122name format is: C<$dir$schema-$version-$type.sql>.
9b83fccd 1123
c9d2e0a2 1124You may override this method in your schema if you wish to use a different
1125format.
9b83fccd 1126
1acfef8e 1127 WARNING
1128
1129 Prior to DBIx::Class version 0.08100 this method had a different signature:
1130
1131 my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1132
1133 In recent versions variables $dir and $version were reversed in order to
1134 bring the signature in line with other Schema/Storage methods. If you
1135 really need to maintain backward compatibility, you can do the following
1136 in any overriding methods:
1137
1138 ($dir, $version) = ($version, $dir) if ($DBIx::Class::VERSION < 0.08100);
1139
9b83fccd 1140=cut
1141
6e73ac25 1142sub ddl_filename {
99a74c4a 1143 my ($self, $type, $version, $dir, $preversion) = @_;
e673f011 1144
99a74c4a 1145 my $filename = ref($self);
1146 $filename =~ s/::/-/g;
1147 $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
1148 $filename =~ s/$version/$preversion-$version/ if($preversion);
d4daee7b 1149
99a74c4a 1150 return $filename;
e673f011 1151}
1152
4146e3da 1153=head2 thaw
1154
829517d4 1155Provided as the recommended way of thawing schema objects. You can call
4146e3da 1156C<Storable::thaw> directly if you wish, but the thawed objects will not have a
1157reference to any schema, so are rather useless
1158
1159=cut
1160
1161sub thaw {
1162 my ($self, $obj) = @_;
1163 local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1164 return Storable::thaw($obj);
1165}
1166
1167=head2 freeze
1168
1169This doesn't actualy do anything more than call L<Storable/freeze>, it is just
1170provided here for symetry.
1171
d2f3e87b 1172=cut
1173
4146e3da 1174sub freeze {
1175 return Storable::freeze($_[1]);
1176}
1177
1178=head2 dclone
1179
1180Recommeneded way of dcloning objects. This is needed to properly maintain
1181references to the schema object (which itself is B<not> cloned.)
1182
1183=cut
1184
1185sub dclone {
1186 my ($self, $obj) = @_;
1187 local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1188 return Storable::dclone($obj);
1189}
1190
93e4d41a 1191=head2 schema_version
1192
829517d4 1193Returns the current schema class' $VERSION in a normalised way.
93e4d41a 1194
1195=cut
1196
1197sub schema_version {
1198 my ($self) = @_;
1199 my $class = ref($self)||$self;
1200
1201 # does -not- use $schema->VERSION
1202 # since that varies in results depending on if version.pm is installed, and if
1203 # so the perl or XS versions. If you want this to change, bug the version.pm
1204 # author to make vpp and vxs behave the same.
1205
1206 my $version;
1207 {
1208 no strict 'refs';
1209 $version = ${"${class}::VERSION"};
1210 }
1211 return $version;
1212}
1213
829517d4 1214
1215=head2 register_class
1216
1217=over 4
1218
1219=item Arguments: $moniker, $component_class
1220
1221=back
1222
1223This method is called by L</load_namespaces> and L</load_classes> to install the found classes into your Schema. You should be using those instead of this one.
1224
1225You will only need this method if you have your Result classes in
1226files which are not named after the packages (or all in the same
1227file). You may also need it to register classes at runtime.
1228
1229Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
1230calling:
1231
1232 $schema->register_source($moniker, $component_class->result_source_instance);
1233
1234=cut
1235
1236sub register_class {
1237 my ($self, $moniker, $to_register) = @_;
1e36ef62 1238 $self->register_source($moniker => $to_register->result_source_instance);
829517d4 1239}
1240
1241=head2 register_source
1242
1243=over 4
1244
1245=item Arguments: $moniker, $result_source
1246
1247=back
1248
1249This method is called by L</register_class>.
1250
1251Registers the L<DBIx::Class::ResultSource> in the schema with the given
1252moniker.
1253
1254=cut
1255
1256sub register_source {
1257 my $self = shift;
1258
1259 $self->_register_source(@_);
1260}
1261
1262=head2 register_extra_source
1263
1264=over 4
1265
1266=item Arguments: $moniker, $result_source
1267
1268=back
1269
1270As L</register_source> but should be used if the result class already
1271has a source and you want to register an extra one.
1272
1273=cut
1274
1275sub register_extra_source {
1276 my $self = shift;
1277
1278 $self->_register_source(@_, { extra => 1 });
1279}
1280
1281sub _register_source {
1282 my ($self, $moniker, $source, $params) = @_;
1283
6d4f9d94 1284 my $orig_source = $source;
2461ae19 1285
0e6c5d58 1286 $source = $source->new({ %$source, source_name => $moniker });
2461ae19 1287 $source->schema($self);
1288 weaken($source->{schema}) if ref($self);
1289
1290 my $rs_class = $source->result_class;
829517d4 1291
1292 my %reg = %{$self->source_registrations};
1293 $reg{$moniker} = $source;
1294 $self->source_registrations(\%reg);
1295
829517d4 1296 return if ($params->{extra});
5dfe40b8 1297 return unless defined($rs_class) && $rs_class->can('result_source_instance');
829517d4 1298
2461ae19 1299 my %map = %{$self->class_mappings};
f18d2d04 1300 if (
1301 exists $map{$rs_class}
1302 and
1303 $map{$rs_class} ne $moniker
1304 and
1305 $rs_class->result_source_instance ne $orig_source
1306 ) {
2461ae19 1307 carp "$rs_class already has a source, use register_extra_source for additional sources";
829517d4 1308 }
2461ae19 1309 $map{$rs_class} = $moniker;
1310 $self->class_mappings(\%map);
829517d4 1311}
1312
1313sub _unregister_source {
1314 my ($self, $moniker) = @_;
1315 my %reg = %{$self->source_registrations};
1316
1317 my $source = delete $reg{$moniker};
1318 $self->source_registrations(\%reg);
1319 if ($source->result_class) {
1320 my %map = %{$self->class_mappings};
1321 delete $map{$source->result_class};
1322 $self->class_mappings(\%map);
1323 }
1324}
1325
1326
1327=head2 compose_connection (DEPRECATED)
1328
1329=over 4
1330
1331=item Arguments: $target_namespace, @db_info
1332
1333=item Return Value: $new_schema
1334
1335=back
1336
1337DEPRECATED. You probably wanted compose_namespace.
1338
1339Actually, you probably just wanted to call connect.
1340
1341=begin hidden
1342
1343(hidden due to deprecation)
1344
1345Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
1346calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
1347then injects the L<DBix::Class::ResultSetProxy> component and a
1348resultset_instance classdata entry on all the new classes, in order to support
1349$target_namespaces::$class->search(...) method calls.
1350
1351This is primarily useful when you have a specific need for class method access
1352to a connection. In normal usage it is preferred to call
1353L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
1354on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
1355more information.
1356
1357=end hidden
1358
1359=cut
1360
1361{
1362 my $warn;
1363
1364 sub compose_connection {
1365 my ($self, $target, @info) = @_;
1366
341d5ede 1367 carp "compose_connection deprecated as of 0.08000"
829517d4 1368 unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++);
1369
1370 my $base = 'DBIx::Class::ResultSetProxy';
1371 eval "require ${base};";
1372 $self->throw_exception
1373 ("No arguments to load_classes and couldn't load ${base} ($@)")
1374 if $@;
d4daee7b 1375
829517d4 1376 if ($self eq $target) {
1377 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
1378 foreach my $moniker ($self->sources) {
1379 my $source = $self->source($moniker);
1380 my $class = $source->result_class;
1381 $self->inject_base($class, $base);
1382 $class->mk_classdata(resultset_instance => $source->resultset);
1383 $class->mk_classdata(class_resolver => $self);
1384 }
1385 $self->connection(@info);
1386 return $self;
1387 }
d4daee7b 1388
829517d4 1389 my $schema = $self->compose_namespace($target, $base);
1390 {
1391 no strict 'refs';
1392 my $name = join '::', $target, 'schema';
1393 *$name = Sub::Name::subname $name, sub { $schema };
1394 }
d4daee7b 1395
829517d4 1396 $schema->connection(@info);
1397 foreach my $moniker ($schema->sources) {
1398 my $source = $schema->source($moniker);
1399 my $class = $source->result_class;
1400 #warn "$moniker $class $source ".$source->storage;
1401 $class->mk_classdata(result_source_instance => $source);
1402 $class->mk_classdata(resultset_instance => $source->resultset);
1403 $class->mk_classdata(class_resolver => $schema);
1404 }
1405 return $schema;
1406 }
1407}
1408
a02675cd 14091;
c2da098a 1410
c2da098a 1411=head1 AUTHORS
1412
daec44b8 1413Matt S. Trout <mst@shadowcatsystems.co.uk>
c2da098a 1414
1415=head1 LICENSE
1416
1417You may distribute this code under the same terms as Perl itself.
1418
1419=cut