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