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
  16 );
  17 use Devel::GlobalDestruction;
  18 use namespace::clean;
  19
  20 __PACKAGE__->mk_group_accessors( inherited => qw( storage exception_action ) );
  21 __PACKAGE__->mk_classaccessor('class_mappings' => {});
  22 __PACKAGE__->mk_classaccessor('source_registrations' => {});
  23 __PACKAGE__->mk_classaccessor('storage_type' => '::DBI');
  24 __PACKAGE__->mk_classaccessor('stacktrace' => $ENV{DBIC_TRACE} || 0);
  25 __PACKAGE__->mk_classaccessor('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 {
 529   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
 530   shift->clone->connection(@_);
 531 }
 532
 533 =head2 resultset
 534
 535 =over 4
 536
 537 =item Arguments: L<$source_name|DBIx::Class::ResultSource/source_name>
 538
 539 =item Return Value: L<$resultset|DBIx::Class::ResultSet>
 540
 541 =back
 542
 543   my $rs = $schema->resultset('DVD');
 544
 545 Returns the L<DBIx::Class::ResultSet> object for the registered source
 546 name.
 547
 548 =cut
 549
 550 sub resultset {
 551   my ($self, $source_name) = @_;
 552   $self->throw_exception('resultset() expects a source name')
 553     unless defined $source_name;
 554   return $self->source($source_name)->resultset;
 555 }
 556
 557 =head2 sources
 558
 559 =over 4
 560
 561 =item Return Value: L<@source_names|DBIx::Class::ResultSource/source_name>
 562
 563 =back
 564
 565   my @source_names = $schema->sources;
 566
 567 Lists names of all the sources registered on this Schema object.
 568
 569 =cut
 570
 571 sub sources { keys %{shift->source_registrations} }
 572
 573 =head2 source
 574
 575 =over 4
 576
 577 =item Arguments: L<$source_name|DBIx::Class::ResultSource/source_name>
 578
 579 =item Return Value: L<$result_source|DBIx::Class::ResultSource>
 580
 581 =back
 582
 583   my $source = $schema->source('Book');
 584
 585 Returns the L<DBIx::Class::ResultSource> object for the registered
 586 source name.
 587
 588 =cut
 589
 590 sub source {
 591   my $self = shift;
 592
 593   $self->throw_exception("source() expects a source name")
 594     unless @_;
 595
 596   my $source_name = shift;
 597
 598   my $sreg = $self->source_registrations;
 599   return $sreg->{$source_name} if exists $sreg->{$source_name};
 600
 601   # if we got here, they probably passed a full class name
 602   my $mapped = $self->class_mappings->{$source_name};
 603   $self->throw_exception("Can't find source for ${source_name}")
 604     unless $mapped && exists $sreg->{$mapped};
 605   return $sreg->{$mapped};
 606 }
 607
 608 =head2 class
 609
 610 =over 4
 611
 612 =item Arguments: L<$source_name|DBIx::Class::ResultSource/source_name>
 613
 614 =item Return Value: $classname
 615
 616 =back
 617
 618   my $class = $schema->class('CD');
 619
 620 Retrieves the Result class name for the given source name.
 621
 622 =cut
 623
 624 sub class {
 625   return shift->source(shift)->result_class;
 626 }
 627
 628 =head2 txn_do
 629
 630 =over 4
 631
 632 =item Arguments: C<$coderef>, @coderef_args?
 633
 634 =item Return Value: The return value of $coderef
 635
 636 =back
 637
 638 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
 639 returning its result (if any). Equivalent to calling $schema->storage->txn_do.
 640 See L<DBIx::Class::Storage/"txn_do"> for more information.
 641
 642 This interface is preferred over using the individual methods L</txn_begin>,
 643 L</txn_commit>, and L</txn_rollback> below.
 644
 645 WARNING: If you are connected with C<< AutoCommit => 0 >> the transaction is
 646 considered nested, and you will still need to call L</txn_commit> to write your
 647 changes when appropriate. You will also want to connect with C<< auto_savepoint =>
 648 1 >> to get partial rollback to work, if the storage driver for your database
 649 supports it.
 650
 651 Connecting with C<< AutoCommit => 1 >> is recommended.
 652
 653 =cut
 654
 655 sub txn_do {
 656   my $self = shift;
 657
 658   $self->storage or $self->throw_exception
 659     ('txn_do called on $schema without storage');
 660
 661   $self->storage->txn_do(@_);
 662 }
 663
 664 =head2 txn_scope_guard
 665
 666 Runs C<txn_scope_guard> on the schema's storage. See
 667 L<DBIx::Class::Storage/txn_scope_guard>.
 668
 669 =cut
 670
 671 sub txn_scope_guard {
 672   my $self = shift;
 673
 674   $self->storage or $self->throw_exception
 675     ('txn_scope_guard called on $schema without storage');
 676
 677   $self->storage->txn_scope_guard(@_);
 678 }
 679
 680 =head2 txn_begin
 681
 682 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
 683 calling $schema->storage->txn_begin. See
 684 L<DBIx::Class::Storage/"txn_begin"> for more information.
 685
 686 =cut
 687
 688 sub txn_begin {
 689   my $self = shift;
 690
 691   $self->storage or $self->throw_exception
 692     ('txn_begin called on $schema without storage');
 693
 694   $self->storage->txn_begin;
 695 }
 696
 697 =head2 txn_commit
 698
 699 Commits the current transaction. Equivalent to calling
 700 $schema->storage->txn_commit. See L<DBIx::Class::Storage/"txn_commit">
 701 for more information.
 702
 703 =cut
 704
 705 sub txn_commit {
 706   my $self = shift;
 707
 708   $self->storage or $self->throw_exception
 709     ('txn_commit called on $schema without storage');
 710
 711   $self->storage->txn_commit;
 712 }
 713
 714 =head2 txn_rollback
 715
 716 Rolls back the current transaction. Equivalent to calling
 717 $schema->storage->txn_rollback. See
 718 L<DBIx::Class::Storage/"txn_rollback"> for more information.
 719
 720 =cut
 721
 722 sub txn_rollback {
 723   my $self = shift;
 724
 725   $self->storage or $self->throw_exception
 726     ('txn_rollback called on $schema without storage');
 727
 728   $self->storage->txn_rollback;
 729 }
 730
 731 =head2 storage
 732
 733   my $storage = $schema->storage;
 734
 735 Returns the L<DBIx::Class::Storage> object for this Schema. Grab this
 736 if you want to turn on SQL statement debugging at runtime, or set the
 737 quote character. For the default storage, the documentation can be
 738 found in L<DBIx::Class::Storage::DBI>.
 739
 740 =head2 populate
 741
 742 =over 4
 743
 744 =item Arguments: L<$source_name|DBIx::Class::ResultSource/source_name>, [ \@column_list, \@row_values+ ] | [ \%col_data+ ]
 745
 746 =item Return Value: L<\@result_objects|DBIx::Class::Manual::ResultClass> (scalar context) | L<@result_objects|DBIx::Class::Manual::ResultClass> (list context)
 747
 748 =back
 749
 750 A convenience shortcut to L<DBIx::Class::ResultSet/populate>. Equivalent to:
 751
 752  $schema->resultset($source_name)->populate([...]);
 753
 754 =over 4
 755
 756 =item NOTE
 757
 758 The context of this method call has an important effect on what is
 759 submitted to storage. In void context data is fed directly to fastpath
 760 insertion routines provided by the underlying storage (most often
 761 L<DBI/execute_for_fetch>), bypassing the L<new|DBIx::Class::Row/new> and
 762 L<insert|DBIx::Class::Row/insert> calls on the
 763 L<Result|DBIx::Class::Manual::ResultClass> class, including any
 764 augmentation of these methods provided by components. For example if you
 765 are using something like L<DBIx::Class::UUIDColumns> to create primary
 766 keys for you, you will find that your PKs are empty.  In this case you
 767 will have to explicitly force scalar or list context in order to create
 768 those values.
 769
 770 =back
 771
 772 =cut
 773
 774 sub populate {
 775   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
 776
 777   my ($self, $name, $data) = @_;
 778   my $rs = $self->resultset($name)
 779     or $self->throw_exception("'$name' is not a resultset");
 780
 781   return $rs->populate($data);
 782 }
 783
 784 =head2 connection
 785
 786 =over 4
 787
 788 =item Arguments: @args
 789
 790 =item Return Value: $new_schema
 791
 792 =back
 793
 794 Similar to L</connect> except sets the storage object and connection
 795 data in-place on the Schema class. You should probably be calling
 796 L</connect> to get a proper Schema object instead.
 797
 798 =head3 Overloading
 799
 800 Overload C<connection> to change the behaviour of C<connect>.
 801
 802 =cut
 803
 804 sub connection {
 805   my ($self, @info) = @_;
 806   return $self if !@info && $self->storage;
 807
 808   my ($storage_class, $args) = ref $self->storage_type
 809     ? $self->_normalize_storage_type($self->storage_type)
 810     : $self->storage_type
 811   ;
 812
 813   $storage_class =~ s/^::/DBIx::Class::Storage::/;
 814
 815   dbic_internal_try {
 816     $self->ensure_class_loaded ($storage_class);
 817   }
 818   catch {
 819     $self->throw_exception(
 820       "Unable to load storage class ${storage_class}: $_"
 821     );
 822   };
 823
 824   my $storage = $storage_class->new( $self => $args||{} );
 825   $storage->connect_info(\@info);
 826   $self->storage($storage);
 827   return $self;
 828 }
 829
 830 sub _normalize_storage_type {
 831   my ($self, $storage_type) = @_;
 832   if(ref $storage_type eq 'ARRAY') {
 833     return @$storage_type;
 834   } elsif(ref $storage_type eq 'HASH') {
 835     return %$storage_type;
 836   } else {
 837     $self->throw_exception('Unsupported REFTYPE given: '. ref $storage_type);
 838   }
 839 }
 840
 841 =head2 compose_namespace
 842
 843 =over 4
 844
 845 =item Arguments: $target_namespace, $additional_base_class?
 846
 847 =item Return Value: $new_schema
 848
 849 =back
 850
 851 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
 852 class in the target namespace (e.g. $target_namespace::CD,
 853 $target_namespace::Artist) that inherits from the corresponding classes
 854 attached to the current schema.
 855
 856 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
 857 new $schema object. If C<$additional_base_class> is given, the new composed
 858 classes will inherit from first the corresponding class from the current
 859 schema then the base class.
 860
 861 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
 862
 863   $schema->compose_namespace('My::DB', 'Base::Class');
 864   print join (', ', @My::DB::CD::ISA) . "\n";
 865   print join (', ', @My::DB::Artist::ISA) ."\n";
 866
 867 will produce the output
 868
 869   My::Schema::CD, Base::Class
 870   My::Schema::Artist, Base::Class
 871
 872 =cut
 873
 874 sub compose_namespace {
 875   my ($self, $target, $base) = @_;
 876
 877   my $schema = $self->clone;
 878
 879   $schema->source_registrations({});
 880
 881   # the original class-mappings must remain - otherwise
 882   # reverse_relationship_info will not work
 883   #$schema->class_mappings({});
 884
 885   {
 886     no warnings qw/redefine/;
 887     local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO;
 888     use warnings qw/redefine/;
 889
 890     foreach my $source_name ($self->sources) {
 891       my $orig_source = $self->source($source_name);
 892
 893       my $target_class = "${target}::${source_name}";
 894       $self->inject_base($target_class, $orig_source->result_class, ($base || ()) );
 895
 896       # register_source examines result_class, and then returns us a clone
 897       my $new_source = $schema->register_source($source_name, bless
 898         { %$orig_source, result_class => $target_class },
 899         ref $orig_source,
 900       );
 901
 902       if ($target_class->can('result_source_instance')) {
 903         # give the class a schema-less source copy
 904         $target_class->result_source_instance( bless
 905           { %$new_source, schema => ref $new_source->{schema} || $new_source->{schema} },
 906           ref $new_source,
 907         );
 908       }
 909     }
 910
 911     quote_sub "${target}::${_}" => "shift->schema->$_(\@_)"
 912       for qw(class source resultset);
 913   }
 914
 915   Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
 916
 917   return $schema;
 918 }
 919
 920 sub setup_connection_class {
 921   my ($class, $target, @info) = @_;
 922   $class->inject_base($target => 'DBIx::Class::DB');
 923   #$target->load_components('DB');
 924   $target->connection(@info);
 925 }
 926
 927 =head2 svp_begin
 928
 929 Creates a new savepoint (does nothing outside a transaction).
 930 Equivalent to calling $schema->storage->svp_begin.  See
 931 L<DBIx::Class::Storage/"svp_begin"> for more information.
 932
 933 =cut
 934
 935 sub svp_begin {
 936   my ($self, $name) = @_;
 937
 938   $self->storage or $self->throw_exception
 939     ('svp_begin called on $schema without storage');
 940
 941   $self->storage->svp_begin($name);
 942 }
 943
 944 =head2 svp_release
 945
 946 Releases a savepoint (does nothing outside a transaction).
 947 Equivalent to calling $schema->storage->svp_release.  See
 948 L<DBIx::Class::Storage/"svp_release"> for more information.
 949
 950 =cut
 951
 952 sub svp_release {
 953   my ($self, $name) = @_;
 954
 955   $self->storage or $self->throw_exception
 956     ('svp_release called on $schema without storage');
 957
 958   $self->storage->svp_release($name);
 959 }
 960
 961 =head2 svp_rollback
 962
 963 Rollback to a savepoint (does nothing outside a transaction).
 964 Equivalent to calling $schema->storage->svp_rollback.  See
 965 L<DBIx::Class::Storage/"svp_rollback"> for more information.
 966
 967 =cut
 968
 969 sub svp_rollback {
 970   my ($self, $name) = @_;
 971
 972   $self->storage or $self->throw_exception
 973     ('svp_rollback called on $schema without storage');
 974
 975   $self->storage->svp_rollback($name);
 976 }
 977
 978 =head2 clone
 979
 980 =over 4
 981
 982 =item Arguments: %attrs?
 983
 984 =item Return Value: $new_schema
 985
 986 =back
 987
 988 Clones the schema and its associated result_source objects and returns the
 989 copy. The resulting copy will have the same attributes as the source schema,
 990 except for those attributes explicitly overridden by the provided C<%attrs>.
 991
 992 =cut
 993
 994 sub clone {
 995   my $self = shift;
 996
 997   my $clone = {
 998       (ref $self ? %$self : ()),
 999       (@_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_),
1000   };
1001   bless $clone, (ref $self || $self);
1002
1003   $clone->$_(undef) for qw/class_mappings source_registrations storage/;
1004
1005   $clone->_copy_state_from($self);
1006
1007   return $clone;
1008 }
1009
1010 # Needed in Schema::Loader - if you refactor, please make a compatibility shim
1011 # -- Caelum
1012 sub _copy_state_from {
1013   my ($self, $from) = @_;
1014
1015   $self->class_mappings({ %{$from->class_mappings} });
1016   $self->source_registrations({ %{$from->source_registrations} });
1017
1018   foreach my $source_name ($from->sources) {
1019     my $source = $from->source($source_name);
1020     my $new = $source->new($source);
1021     # we use extra here as we want to leave the class_mappings as they are
1022     # but overwrite the source_registrations entry with the new source
1023     $self->register_extra_source($source_name => $new);
1024   }
1025
1026   if ($from->storage) {
1027     $self->storage($from->storage);
1028     $self->storage->set_schema($self);
1029   }
1030 }
1031
1032 =head2 throw_exception
1033
1034 =over 4
1035
1036 =item Arguments: $message
1037
1038 =back
1039
1040 Throws an exception. Obeys the exemption rules of L<DBIx::Class::Carp> to report
1041 errors from outer-user's perspective. See L</exception_action> for details on overriding
1042 this method's behavior.  If L</stacktrace> is turned on, C<throw_exception>'s
1043 default behavior will provide a detailed stack trace.
1044
1045 =cut
1046
1047 sub throw_exception {
1048   my ($self, @args) = @_;
1049
1050   if (
1051     ! DBIx::Class::_Util::in_internal_try()
1052       and
1053     my $act = $self->exception_action
1054   ) {
1055
1056     my $guard_disarmed;
1057
1058     my $guard = scope_guard {
1059       return if $guard_disarmed;
1060       local $SIG{__WARN__};
1061       Carp::cluck("
1062                     !!! DBIx::Class INTERNAL PANIC !!!
1063
1064 The exception_action() handler installed on '$self'
1065 aborted the stacktrace below via a longjmp (either via Return::Multilevel or
1066 plain goto, or Scope::Upper or something equally nefarious). There currently
1067 is nothing safe DBIx::Class can do, aside from displaying this error. A future
1068 version ( 0.082900, when available ) will reduce the cases in which the
1069 handler is invoked, but this is neither a complete solution, nor can it do
1070 anything for other software that might be affected by a similar problem.
1071
1072                       !!! FIX YOUR ERROR HANDLING !!!
1073
1074 This guard was activated beginning"
1075       );
1076     };
1077
1078     dbic_internal_try {
1079       # if it throws - good, we'll assign to @args in the end
1080       # if it doesn't - do different things depending on RV truthiness
1081       if( $act->(@args) ) {
1082         $args[0] = (
1083           "Invocation of the exception_action handler installed on $self did *not*"
1084         .' result in an exception. DBIx::Class is unable to function without a reliable'
1085         .' exception mechanism, ensure your exception_action does not hide exceptions'
1086         ." (original error: $args[0])"
1087         );
1088       }
1089       else {
1090         carp_unique (
1091           "The exception_action handler installed on $self returned false instead"
1092         .' of throwing an exception. This behavior has been deprecated, adjust your'
1093         .' handler to always rethrow the supplied error'
1094         );
1095       }
1096
1097       1;
1098     }
1099     catch {
1100       # We call this to get the necessary warnings emitted and disregard the RV
1101       # as it's definitely an exception if we got as far as this catch{} block
1102       is_exception(
1103         $args[0] = $_
1104       );
1105     };
1106
1107     # Done guarding against https://github.com/PerlDancer/Dancer2/issues/1125
1108     $guard_disarmed = 1;
1109   }
1110
1111   DBIx::Class::Exception->throw( $args[0], $self->stacktrace );
1112 }
1113
1114 =head2 deploy
1115
1116 =over 4
1117
1118 =item Arguments: \%sqlt_args, $dir
1119
1120 =back
1121
1122 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
1123
1124 See L<SQL::Translator/METHODS> for a list of values for C<\%sqlt_args>.
1125 The most common value for this would be C<< { add_drop_table => 1 } >>
1126 to have the SQL produced include a C<DROP TABLE> statement for each table
1127 created. For quoting purposes supply C<quote_identifiers>.
1128
1129 Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
1130 ref or an array ref, containing a list of source to deploy. If present, then
1131 only the sources listed will get deployed. Furthermore, you can use the
1132 C<add_fk_index> parser parameter to prevent the parser from creating an index for each
1133 FK.
1134
1135 =cut
1136
1137 sub deploy {
1138   my ($self, $sqltargs, $dir) = @_;
1139   $self->throw_exception("Can't deploy without storage") unless $self->storage;
1140   $self->storage->deploy($self, undef, $sqltargs, $dir);
1141 }
1142
1143 =head2 deployment_statements
1144
1145 =over 4
1146
1147 =item Arguments: See L<DBIx::Class::Storage::DBI/deployment_statements>
1148
1149 =item Return Value: $listofstatements
1150
1151 =back
1152
1153 A convenient shortcut to
1154 C<< $self->storage->deployment_statements($self, @args) >>.
1155 Returns the statements used by L</deploy> and
1156 L<DBIx::Class::Storage/deploy>.
1157
1158 =cut
1159
1160 sub deployment_statements {
1161   my $self = shift;
1162
1163   $self->throw_exception("Can't generate deployment statements without a storage")
1164     if not $self->storage;
1165
1166   $self->storage->deployment_statements($self, @_);
1167 }
1168
1169 =head2 create_ddl_dir
1170
1171 =over 4
1172
1173 =item Arguments: See L<DBIx::Class::Storage::DBI/create_ddl_dir>
1174
1175 =back
1176
1177 A convenient shortcut to
1178 C<< $self->storage->create_ddl_dir($self, @args) >>.
1179
1180 Creates an SQL file based on the Schema, for each of the specified
1181 database types, in the given directory.
1182
1183 =cut
1184
1185 sub create_ddl_dir {
1186   my $self = shift;
1187
1188   $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1189   $self->storage->create_ddl_dir($self, @_);
1190 }
1191
1192 =head2 ddl_filename
1193
1194 =over 4
1195
1196 =item Arguments: $database-type, $version, $directory, $preversion
1197
1198 =item Return Value: $normalised_filename
1199
1200 =back
1201
1202   my $filename = $table->ddl_filename($type, $version, $dir, $preversion)
1203
1204 This method is called by C<create_ddl_dir> to compose a file name out of
1205 the supplied directory, database type and version number. The default file
1206 name format is: C<$dir$schema-$version-$type.sql>.
1207
1208 You may override this method in your schema if you wish to use a different
1209 format.
1210
1211  WARNING
1212
1213  Prior to DBIx::Class version 0.08100 this method had a different signature:
1214
1215     my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1216
1217  In recent versions variables $dir and $version were reversed in order to
1218  bring the signature in line with other Schema/Storage methods. If you
1219  really need to maintain backward compatibility, you can do the following
1220  in any overriding methods:
1221
1222     ($dir, $version) = ($version, $dir) if ($DBIx::Class::VERSION < 0.08100);
1223
1224 =cut
1225
1226 sub ddl_filename {
1227   my ($self, $type, $version, $dir, $preversion) = @_;
1228
1229   $version = "$preversion-$version" if $preversion;
1230
1231   my $class = blessed($self) || $self;
1232   $class =~ s/::/-/g;
1233
1234   return "$dir/$class-$version-$type.sql";
1235 }
1236
1237 =head2 thaw
1238
1239 Provided as the recommended way of thawing schema objects. You can call
1240 C<Storable::thaw> directly if you wish, but the thawed objects will not have a
1241 reference to any schema, so are rather useless.
1242
1243 =cut
1244
1245 sub thaw {
1246   my ($self, $obj) = @_;
1247   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1248   return Storable::thaw($obj);
1249 }
1250
1251 =head2 freeze
1252
1253 This doesn't actually do anything beyond calling L<nfreeze|Storable/SYNOPSIS>,
1254 it is just provided here for symmetry.
1255
1256 =cut
1257
1258 sub freeze {
1259   return Storable::nfreeze($_[1]);
1260 }
1261
1262 =head2 dclone
1263
1264 =over 4
1265
1266 =item Arguments: $object
1267
1268 =item Return Value: dcloned $object
1269
1270 =back
1271
1272 Recommended way of dcloning L<DBIx::Class::Row> and L<DBIx::Class::ResultSet>
1273 objects so their references to the schema object
1274 (which itself is B<not> cloned) are properly maintained.
1275
1276 =cut
1277
1278 sub dclone {
1279   my ($self, $obj) = @_;
1280   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1281   return Storable::dclone($obj);
1282 }
1283
1284 =head2 schema_version
1285
1286 Returns the current schema class' $VERSION in a normalised way.
1287
1288 =cut
1289
1290 sub schema_version {
1291   my ($self) = @_;
1292   my $class = ref($self)||$self;
1293
1294   # does -not- use $schema->VERSION
1295   # since that varies in results depending on if version.pm is installed, and if
1296   # so the perl or XS versions. If you want this to change, bug the version.pm
1297   # author to make vpp and vxs behave the same.
1298
1299   my $version;
1300   {
1301     no strict 'refs';
1302     $version = ${"${class}::VERSION"};
1303   }
1304   return $version;
1305 }
1306
1307
1308 =head2 register_class
1309
1310 =over 4
1311
1312 =item Arguments: $source_name, $component_class
1313
1314 =back
1315
1316 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.
1317
1318 You will only need this method if you have your Result classes in
1319 files which are not named after the packages (or all in the same
1320 file). You may also need it to register classes at runtime.
1321
1322 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
1323 calling:
1324
1325   $schema->register_source($source_name, $component_class->result_source_instance);
1326
1327 =cut
1328
1329 sub register_class {
1330   my ($self, $source_name, $to_register) = @_;
1331   $self->register_source($source_name => $to_register->result_source_instance);
1332 }
1333
1334 =head2 register_source
1335
1336 =over 4
1337
1338 =item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>
1339
1340 =back
1341
1342 This method is called by L</register_class>.
1343
1344 Registers the L<DBIx::Class::ResultSource> in the schema with the given
1345 source name.
1346
1347 =cut
1348
1349 sub register_source { shift->_register_source(@_) }
1350
1351 =head2 unregister_source
1352
1353 =over 4
1354
1355 =item Arguments: $source_name
1356
1357 =back
1358
1359 Removes the L<DBIx::Class::ResultSource> from the schema for the given source name.
1360
1361 =cut
1362
1363 sub unregister_source { shift->_unregister_source(@_) }
1364
1365 =head2 register_extra_source
1366
1367 =over 4
1368
1369 =item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>
1370
1371 =back
1372
1373 As L</register_source> but should be used if the result class already
1374 has a source and you want to register an extra one.
1375
1376 =cut
1377
1378 sub register_extra_source { shift->_register_source(@_, { extra => 1 }) }
1379
1380 sub _register_source {
1381   my ($self, $source_name, $source, $params) = @_;
1382
1383   $source = $source->new({ %$source, source_name => $source_name });
1384
1385   $source->schema($self);
1386   weaken $source->{schema} if ref($self);
1387
1388   my %reg = %{$self->source_registrations};
1389   $reg{$source_name} = $source;
1390   $self->source_registrations(\%reg);
1391
1392   return $source if $params->{extra};
1393
1394   my $rs_class = $source->result_class;
1395   if ($rs_class and my $rsrc = dbic_internal_try { $rs_class->result_source_instance } ) {
1396     my %map = %{$self->class_mappings};
1397     if (
1398       exists $map{$rs_class}
1399         and
1400       $map{$rs_class} ne $source_name
1401         and
1402       $rsrc ne $_[2]  # orig_source
1403     ) {
1404       carp
1405         "$rs_class already had a registered source which was replaced by this call. "
1406       . 'Perhaps you wanted register_extra_source(), though it is more likely you did '
1407       . 'something wrong.'
1408       ;
1409     }
1410
1411     $map{$rs_class} = $source_name;
1412     $self->class_mappings(\%map);
1413   }
1414
1415   return $source;
1416 }
1417
1418 my $global_phase_destroy;
1419 sub DESTROY {
1420   ### NO detected_reinvoked_destructor check
1421   ### This code very much relies on being called multuple times
1422
1423   return if $global_phase_destroy ||= in_global_destruction;
1424
1425   my $self = shift;
1426   my $srcs = $self->source_registrations;
1427
1428   for my $source_name (keys %$srcs) {
1429     # find first source that is not about to be GCed (someone other than $self
1430     # holds a reference to it) and reattach to it, weakening our own link
1431     #
1432     # during global destruction (if we have not yet bailed out) this should throw
1433     # which will serve as a signal to not try doing anything else
1434     # however beware - on older perls the exception seems randomly untrappable
1435     # due to some weird race condition during thread joining :(((
1436     if (length ref $srcs->{$source_name} and refcount($srcs->{$source_name}) > 1) {
1437       local $SIG{__DIE__} if $SIG{__DIE__};
1438       local $@;
1439       eval {
1440         $srcs->{$source_name}->schema($self);
1441         weaken $srcs->{$source_name};
1442         1;
1443       } or do {
1444         $global_phase_destroy = 1;
1445       };
1446
1447       last;
1448     }
1449   }
1450
1451   # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
1452   # collected before leaving this scope. Depending on the code above, this
1453   # may very well be just a preventive measure guarding future modifications
1454   undef;
1455 }
1456
1457 sub _unregister_source {
1458     my ($self, $source_name) = @_;
1459     my %reg = %{$self->source_registrations};
1460
1461     my $source = delete $reg{$source_name};
1462     $self->source_registrations(\%reg);
1463     if ($source->result_class) {
1464         my %map = %{$self->class_mappings};
1465         delete $map{$source->result_class};
1466         $self->class_mappings(\%map);
1467     }
1468 }
1469
1470
1471 =head2 compose_connection (DEPRECATED)
1472
1473 =over 4
1474
1475 =item Arguments: $target_namespace, @db_info
1476
1477 =item Return Value: $new_schema
1478
1479 =back
1480
1481 DEPRECATED. You probably wanted compose_namespace.
1482
1483 Actually, you probably just wanted to call connect.
1484
1485 =begin hidden
1486
1487 (hidden due to deprecation)
1488
1489 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
1490 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
1491 then injects the L<DBix::Class::ResultSetProxy> component and a
1492 resultset_instance classdata entry on all the new classes, in order to support
1493 $target_namespaces::$class->search(...) method calls.
1494
1495 This is primarily useful when you have a specific need for class method access
1496 to a connection. In normal usage it is preferred to call
1497 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
1498 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
1499 more information.
1500
1501 =end hidden
1502
1503 =cut
1504
1505 sub compose_connection {
1506   my ($self, $target, @info) = @_;
1507
1508   carp_once "compose_connection deprecated as of 0.08000"
1509     unless $INC{"DBIx/Class/CDBICompat.pm"};
1510
1511   dbic_internal_try {
1512     require DBIx::Class::ResultSetProxy;
1513   }
1514   catch {
1515     $self->throw_exception
1516       ("No arguments to load_classes and couldn't load DBIx::Class::ResultSetProxy ($_)")
1517   };
1518
1519   if ($self eq $target) {
1520     # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
1521     foreach my $source_name ($self->sources) {
1522       my $source = $self->source($source_name);
1523       my $class = $source->result_class;
1524       $self->inject_base($class, 'DBIx::Class::ResultSetProxy');
1525       $class->mk_classaccessor(resultset_instance => $source->resultset);
1526       $class->mk_classaccessor(class_resolver => $self);
1527     }
1528     $self->connection(@info);
1529     return $self;
1530   }
1531
1532   my $schema = $self->compose_namespace($target, 'DBIx::Class::ResultSetProxy');
1533   quote_sub "${target}::schema", '$s', { '$s' => \$schema };
1534
1535   $schema->connection(@info);
1536   foreach my $source_name ($schema->sources) {
1537     my $source = $schema->source($source_name);
1538     my $class = $source->result_class;
1539     #warn "$source_name $class $source ".$source->storage;
1540     $class->mk_classaccessor(result_source_instance => $source);
1541     $class->mk_classaccessor(resultset_instance => $source->resultset);
1542     $class->mk_classaccessor(class_resolver => $schema);
1543   }
1544   return $schema;
1545 }
1546
1547 =head1 FURTHER QUESTIONS?
1548
1549 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
1550
1551 =head1 COPYRIGHT AND LICENSE
1552
1553 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
1554 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
1555 redistribute it and/or modify it under the same terms as the
1556 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
1557
1558 =cut
1559
1560 1;