lib/DBIx/Class/Schema.pm

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