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