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