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