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 # this might be oversimplified
 869 # sub compose_namespace {
 870 #   my ($self, $target, $base) = @_;
 871
 872 #   my $schema = $self->clone;
 873 #   foreach my $source_name ($schema->sources) {
 874 #     my $source = $schema->source($source_name);
 875 #     my $target_class = "${target}::${source_name}";
 876 #     $self->inject_base(
 877 #       $target_class => $source->result_class, ($base ? $base : ())
 878 #     );
 879 #     $source->result_class($target_class);
 880 #     $target_class->result_source_instance($source)
 881 #       if $target_class->can('result_source_instance');
 882 #     $schema->register_source($source_name, $source);
 883 #   }
 884 #   return $schema;
 885 # }
 886
 887 sub compose_namespace {
 888   my ($self, $target, $base) = @_;
 889
 890   my $schema = $self->clone;
 891
 892   $schema->source_registrations({});
 893
 894   # the original class-mappings must remain - otherwise
 895   # reverse_relationship_info will not work
 896   #$schema->class_mappings({});
 897
 898   {
 899     no warnings qw/redefine/;
 900     local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO;
 901     use warnings qw/redefine/;
 902
 903     foreach my $source_name ($self->sources) {
 904       my $orig_source = $self->source($source_name);
 905
 906       my $target_class = "${target}::${source_name}";
 907       $self->inject_base($target_class, $orig_source->result_class, ($base || ()) );
 908
 909       # register_source examines result_class, and then returns us a clone
 910       my $new_source = $schema->register_source($source_name, bless
 911         { %$orig_source, result_class => $target_class },
 912         ref $orig_source,
 913       );
 914
 915       if ($target_class->can('result_source_instance')) {
 916         # give the class a schema-less source copy
 917         $target_class->result_source_instance( bless
 918           { %$new_source, schema => ref $new_source->{schema} || $new_source->{schema} },
 919           ref $new_source,
 920         );
 921       }
 922     }
 923
 924     quote_sub "${target}::${_}" => "shift->schema->$_(\@_)"
 925       for qw(class source resultset);
 926   }
 927
 928   Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
 929
 930   return $schema;
 931 }
 932
 933 sub setup_connection_class {
 934   my ($class, $target, @info) = @_;
 935   $class->inject_base($target => 'DBIx::Class::DB');
 936   #$target->load_components('DB');
 937   $target->connection(@info);
 938 }
 939
 940 =head2 svp_begin
 941
 942 Creates a new savepoint (does nothing outside a transaction).
 943 Equivalent to calling $schema->storage->svp_begin.  See
 944 L<DBIx::Class::Storage/"svp_begin"> for more information.
 945
 946 =cut
 947
 948 sub svp_begin {
 949   my ($self, $name) = @_;
 950
 951   $self->storage or $self->throw_exception
 952     ('svp_begin called on $schema without storage');
 953
 954   $self->storage->svp_begin($name);
 955 }
 956
 957 =head2 svp_release
 958
 959 Releases a savepoint (does nothing outside a transaction).
 960 Equivalent to calling $schema->storage->svp_release.  See
 961 L<DBIx::Class::Storage/"svp_release"> for more information.
 962
 963 =cut
 964
 965 sub svp_release {
 966   my ($self, $name) = @_;
 967
 968   $self->storage or $self->throw_exception
 969     ('svp_release called on $schema without storage');
 970
 971   $self->storage->svp_release($name);
 972 }
 973
 974 =head2 svp_rollback
 975
 976 Rollback to a savepoint (does nothing outside a transaction).
 977 Equivalent to calling $schema->storage->svp_rollback.  See
 978 L<DBIx::Class::Storage/"svp_rollback"> for more information.
 979
 980 =cut
 981
 982 sub svp_rollback {
 983   my ($self, $name) = @_;
 984
 985   $self->storage or $self->throw_exception
 986     ('svp_rollback called on $schema without storage');
 987
 988   $self->storage->svp_rollback($name);
 989 }
 990
 991 =head2 clone
 992
 993 =over 4
 994
 995 =item Arguments: %attrs?
 996
 997 =item Return Value: $new_schema
 998
 999 =back
1000
1001 Clones the schema and its associated result_source objects and returns the
1002 copy. The resulting copy will have the same attributes as the source schema,
1003 except for those attributes explicitly overridden by the provided C<%attrs>.
1004
1005 =cut
1006
1007 sub clone {
1008   my $self = shift;
1009
1010   my $clone = {
1011       (ref $self ? %$self : ()),
1012       (@_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_),
1013   };
1014   bless $clone, (ref $self || $self);
1015
1016   $clone->$_(undef) for qw/class_mappings source_registrations storage/;
1017
1018   $clone->_copy_state_from($self);
1019
1020   return $clone;
1021 }
1022
1023 # Needed in Schema::Loader - if you refactor, please make a compatibility shim
1024 # -- Caelum
1025 sub _copy_state_from {
1026   my ($self, $from) = @_;
1027
1028   $self->class_mappings({ %{$from->class_mappings} });
1029   $self->source_registrations({ %{$from->source_registrations} });
1030
1031   foreach my $source_name ($from->sources) {
1032     my $source = $from->source($source_name);
1033     my $new = $source->new($source);
1034     # we use extra here as we want to leave the class_mappings as they are
1035     # but overwrite the source_registrations entry with the new source
1036     $self->register_extra_source($source_name => $new);
1037   }
1038
1039   if ($from->storage) {
1040     $self->storage($from->storage);
1041     $self->storage->set_schema($self);
1042   }
1043 }
1044
1045 =head2 throw_exception
1046
1047 =over 4
1048
1049 =item Arguments: $message
1050
1051 =back
1052
1053 Throws an exception. Obeys the exemption rules of L<DBIx::Class::Carp> to report
1054 errors from outer-user's perspective. See L</exception_action> for details on overriding
1055 this method's behavior.  If L</stacktrace> is turned on, C<throw_exception>'s
1056 default behavior will provide a detailed stack trace.
1057
1058 =cut
1059
1060 sub throw_exception {
1061   my ($self, @args) = @_;
1062
1063   if (
1064     ! DBIx::Class::_Util::in_internal_try()
1065       and
1066     my $act = $self->exception_action
1067   ) {
1068
1069     my $guard_disarmed;
1070
1071     my $guard = scope_guard {
1072       return if $guard_disarmed;
1073       local $SIG{__WARN__};
1074       Carp::cluck("
1075                     !!! DBIx::Class INTERNAL PANIC !!!
1076
1077 The exception_action() handler installed on '$self'
1078 aborted the stacktrace below via a longjmp (either via Return::Multilevel or
1079 plain goto, or Scope::Upper or something equally nefarious). There currently
1080 is nothing safe DBIx::Class can do, aside from displaying this error. A future
1081 version ( 0.082900, when available ) will reduce the cases in which the
1082 handler is invoked, but this is neither a complete solution, nor can it do
1083 anything for other software that might be affected by a similar problem.
1084
1085                       !!! FIX YOUR ERROR HANDLING !!!
1086
1087 This guard was activated beginning"
1088       );
1089     };
1090
1091     eval {
1092       # if it throws - good, we'll assign to @args in the end
1093       # if it doesn't - do different things depending on RV truthiness
1094       if( $act->(@args) ) {
1095         $args[0] = (
1096           "Invocation of the exception_action handler installed on $self did *not*"
1097         .' result in an exception. DBIx::Class is unable to function without a reliable'
1098         .' exception mechanism, ensure your exception_action does not hide exceptions'
1099         ." (original error: $args[0])"
1100         );
1101       }
1102       else {
1103         carp_unique (
1104           "The exception_action handler installed on $self returned false instead"
1105         .' of throwing an exception. This behavior has been deprecated, adjust your'
1106         .' handler to always rethrow the supplied error'
1107         );
1108       }
1109
1110       1;
1111     }
1112
1113       or
1114
1115     # We call this to get the necessary warnings emitted and disregard the RV
1116     # as it's definitely an exception if we got as far as this do{} block
1117     is_exception(
1118       $args[0] = $@
1119     );
1120
1121     # Done guarding against https://github.com/PerlDancer/Dancer2/issues/1125
1122     $guard_disarmed = 1;
1123   }
1124
1125   DBIx::Class::Exception->throw( $args[0], $self->stacktrace );
1126 }
1127
1128 =head2 deploy
1129
1130 =over 4
1131
1132 =item Arguments: \%sqlt_args, $dir
1133
1134 =back
1135
1136 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
1137
1138 See L<SQL::Translator/METHODS> for a list of values for C<\%sqlt_args>.
1139 The most common value for this would be C<< { add_drop_table => 1 } >>
1140 to have the SQL produced include a C<DROP TABLE> statement for each table
1141 created. For quoting purposes supply C<quote_identifiers>.
1142
1143 Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
1144 ref or an array ref, containing a list of source to deploy. If present, then
1145 only the sources listed will get deployed. Furthermore, you can use the
1146 C<add_fk_index> parser parameter to prevent the parser from creating an index for each
1147 FK.
1148
1149 =cut
1150
1151 sub deploy {
1152   my ($self, $sqltargs, $dir) = @_;
1153   $self->throw_exception("Can't deploy without storage") unless $self->storage;
1154   $self->storage->deploy($self, undef, $sqltargs, $dir);
1155 }
1156
1157 =head2 deployment_statements
1158
1159 =over 4
1160
1161 =item Arguments: See L<DBIx::Class::Storage::DBI/deployment_statements>
1162
1163 =item Return Value: $listofstatements
1164
1165 =back
1166
1167 A convenient shortcut to
1168 C<< $self->storage->deployment_statements($self, @args) >>.
1169 Returns the statements used by L</deploy> and
1170 L<DBIx::Class::Storage/deploy>.
1171
1172 =cut
1173
1174 sub deployment_statements {
1175   my $self = shift;
1176
1177   $self->throw_exception("Can't generate deployment statements without a storage")
1178     if not $self->storage;
1179
1180   $self->storage->deployment_statements($self, @_);
1181 }
1182
1183 =head2 create_ddl_dir
1184
1185 =over 4
1186
1187 =item Arguments: See L<DBIx::Class::Storage::DBI/create_ddl_dir>
1188
1189 =back
1190
1191 A convenient shortcut to
1192 C<< $self->storage->create_ddl_dir($self, @args) >>.
1193
1194 Creates an SQL file based on the Schema, for each of the specified
1195 database types, in the given directory.
1196
1197 =cut
1198
1199 sub create_ddl_dir {
1200   my $self = shift;
1201
1202   $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1203   $self->storage->create_ddl_dir($self, @_);
1204 }
1205
1206 =head2 ddl_filename
1207
1208 =over 4
1209
1210 =item Arguments: $database-type, $version, $directory, $preversion
1211
1212 =item Return Value: $normalised_filename
1213
1214 =back
1215
1216   my $filename = $table->ddl_filename($type, $version, $dir, $preversion)
1217
1218 This method is called by C<create_ddl_dir> to compose a file name out of
1219 the supplied directory, database type and version number. The default file
1220 name format is: C<$dir$schema-$version-$type.sql>.
1221
1222 You may override this method in your schema if you wish to use a different
1223 format.
1224
1225  WARNING
1226
1227  Prior to DBIx::Class version 0.08100 this method had a different signature:
1228
1229     my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1230
1231  In recent versions variables $dir and $version were reversed in order to
1232  bring the signature in line with other Schema/Storage methods. If you
1233  really need to maintain backward compatibility, you can do the following
1234  in any overriding methods:
1235
1236     ($dir, $version) = ($version, $dir) if ($DBIx::Class::VERSION < 0.08100);
1237
1238 =cut
1239
1240 sub ddl_filename {
1241   my ($self, $type, $version, $dir, $preversion) = @_;
1242
1243   require File::Spec;
1244
1245   $version = "$preversion-$version" if $preversion;
1246
1247   my $class = blessed($self) || $self;
1248   $class =~ s/::/-/g;
1249
1250   return File::Spec->catfile($dir, "$class-$version-$type.sql");
1251 }
1252
1253 =head2 thaw
1254
1255 Provided as the recommended way of thawing schema objects. You can call
1256 C<Storable::thaw> directly if you wish, but the thawed objects will not have a
1257 reference to any schema, so are rather useless.
1258
1259 =cut
1260
1261 sub thaw {
1262   my ($self, $obj) = @_;
1263   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1264   return Storable::thaw($obj);
1265 }
1266
1267 =head2 freeze
1268
1269 This doesn't actually do anything beyond calling L<nfreeze|Storable/SYNOPSIS>,
1270 it is just provided here for symmetry.
1271
1272 =cut
1273
1274 sub freeze {
1275   return Storable::nfreeze($_[1]);
1276 }
1277
1278 =head2 dclone
1279
1280 =over 4
1281
1282 =item Arguments: $object
1283
1284 =item Return Value: dcloned $object
1285
1286 =back
1287
1288 Recommended way of dcloning L<DBIx::Class::Row> and L<DBIx::Class::ResultSet>
1289 objects so their references to the schema object
1290 (which itself is B<not> cloned) are properly maintained.
1291
1292 =cut
1293
1294 sub dclone {
1295   my ($self, $obj) = @_;
1296   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1297   return Storable::dclone($obj);
1298 }
1299
1300 =head2 schema_version
1301
1302 Returns the current schema class' $VERSION in a normalised way.
1303
1304 =cut
1305
1306 sub schema_version {
1307   my ($self) = @_;
1308   my $class = ref($self)||$self;
1309
1310   # does -not- use $schema->VERSION
1311   # since that varies in results depending on if version.pm is installed, and if
1312   # so the perl or XS versions. If you want this to change, bug the version.pm
1313   # author to make vpp and vxs behave the same.
1314
1315   my $version;
1316   {
1317     no strict 'refs';
1318     $version = ${"${class}::VERSION"};
1319   }
1320   return $version;
1321 }
1322
1323
1324 =head2 register_class
1325
1326 =over 4
1327
1328 =item Arguments: $source_name, $component_class
1329
1330 =back
1331
1332 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.
1333
1334 You will only need this method if you have your Result classes in
1335 files which are not named after the packages (or all in the same
1336 file). You may also need it to register classes at runtime.
1337
1338 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
1339 calling:
1340
1341   $schema->register_source($source_name, $component_class->result_source_instance);
1342
1343 =cut
1344
1345 sub register_class {
1346   my ($self, $source_name, $to_register) = @_;
1347   $self->register_source($source_name => $to_register->result_source_instance);
1348 }
1349
1350 =head2 register_source
1351
1352 =over 4
1353
1354 =item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>
1355
1356 =back
1357
1358 This method is called by L</register_class>.
1359
1360 Registers the L<DBIx::Class::ResultSource> in the schema with the given
1361 source name.
1362
1363 =cut
1364
1365 sub register_source { shift->_register_source(@_) }
1366
1367 =head2 unregister_source
1368
1369 =over 4
1370
1371 =item Arguments: $source_name
1372
1373 =back
1374
1375 Removes the L<DBIx::Class::ResultSource> from the schema for the given source name.
1376
1377 =cut
1378
1379 sub unregister_source { shift->_unregister_source(@_) }
1380
1381 =head2 register_extra_source
1382
1383 =over 4
1384
1385 =item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>
1386
1387 =back
1388
1389 As L</register_source> but should be used if the result class already
1390 has a source and you want to register an extra one.
1391
1392 =cut
1393
1394 sub register_extra_source { shift->_register_source(@_, { extra => 1 }) }
1395
1396 sub _register_source {
1397   my ($self, $source_name, $source, $params) = @_;
1398
1399   $source = $source->new({ %$source, source_name => $source_name });
1400
1401   $source->schema($self);
1402   weaken $source->{schema} if ref($self);
1403
1404   my %reg = %{$self->source_registrations};
1405   $reg{$source_name} = $source;
1406   $self->source_registrations(\%reg);
1407
1408   return $source if $params->{extra};
1409
1410   my $rs_class = $source->result_class;
1411   if ($rs_class and my $rsrc = dbic_internal_try { $rs_class->result_source_instance } ) {
1412     my %map = %{$self->class_mappings};
1413     if (
1414       exists $map{$rs_class}
1415         and
1416       $map{$rs_class} ne $source_name
1417         and
1418       $rsrc ne $_[2]  # orig_source
1419     ) {
1420       carp
1421         "$rs_class already had a registered source which was replaced by this call. "
1422       . 'Perhaps you wanted register_extra_source(), though it is more likely you did '
1423       . 'something wrong.'
1424       ;
1425     }
1426
1427     $map{$rs_class} = $source_name;
1428     $self->class_mappings(\%map);
1429   }
1430
1431   return $source;
1432 }
1433
1434 my $global_phase_destroy;
1435 sub DESTROY {
1436   ### NO detected_reinvoked_destructor check
1437   ### This code very much relies on being called multuple times
1438
1439   return if $global_phase_destroy ||= in_global_destruction;
1440
1441   my $self = shift;
1442   my $srcs = $self->source_registrations;
1443
1444   for my $source_name (keys %$srcs) {
1445     # find first source that is not about to be GCed (someone other than $self
1446     # holds a reference to it) and reattach to it, weakening our own link
1447     #
1448     # during global destruction (if we have not yet bailed out) this should throw
1449     # which will serve as a signal to not try doing anything else
1450     # however beware - on older perls the exception seems randomly untrappable
1451     # due to some weird race condition during thread joining :(((
1452     if (length ref $srcs->{$source_name} and refcount($srcs->{$source_name}) > 1) {
1453       local $@;
1454       eval {
1455         $srcs->{$source_name}->schema($self);
1456         weaken $srcs->{$source_name};
1457         1;
1458       } or do {
1459         $global_phase_destroy = 1;
1460       };
1461
1462       last;
1463     }
1464   }
1465
1466   # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
1467   # collected before leaving this scope. Depending on the code above, this
1468   # may very well be just a preventive measure guarding future modifications
1469   undef;
1470 }
1471
1472 sub _unregister_source {
1473     my ($self, $source_name) = @_;
1474     my %reg = %{$self->source_registrations};
1475
1476     my $source = delete $reg{$source_name};
1477     $self->source_registrations(\%reg);
1478     if ($source->result_class) {
1479         my %map = %{$self->class_mappings};
1480         delete $map{$source->result_class};
1481         $self->class_mappings(\%map);
1482     }
1483 }
1484
1485
1486 =head2 compose_connection (DEPRECATED)
1487
1488 =over 4
1489
1490 =item Arguments: $target_namespace, @db_info
1491
1492 =item Return Value: $new_schema
1493
1494 =back
1495
1496 DEPRECATED. You probably wanted compose_namespace.
1497
1498 Actually, you probably just wanted to call connect.
1499
1500 =begin hidden
1501
1502 (hidden due to deprecation)
1503
1504 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
1505 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
1506 then injects the L<DBix::Class::ResultSetProxy> component and a
1507 resultset_instance classdata entry on all the new classes, in order to support
1508 $target_namespaces::$class->search(...) method calls.
1509
1510 This is primarily useful when you have a specific need for class method access
1511 to a connection. In normal usage it is preferred to call
1512 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
1513 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
1514 more information.
1515
1516 =end hidden
1517
1518 =cut
1519
1520 sub compose_connection {
1521   my ($self, $target, @info) = @_;
1522
1523   carp_once "compose_connection deprecated as of 0.08000"
1524     unless $INC{"DBIx/Class/CDBICompat.pm"};
1525
1526   dbic_internal_try {
1527     require DBIx::Class::ResultSetProxy;
1528   }
1529   catch {
1530     $self->throw_exception
1531       ("No arguments to load_classes and couldn't load DBIx::Class::ResultSetProxy ($_)")
1532   };
1533
1534   if ($self eq $target) {
1535     # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
1536     foreach my $source_name ($self->sources) {
1537       my $source = $self->source($source_name);
1538       my $class = $source->result_class;
1539       $self->inject_base($class, 'DBIx::Class::ResultSetProxy');
1540       $class->mk_classdata(resultset_instance => $source->resultset);
1541       $class->mk_classdata(class_resolver => $self);
1542     }
1543     $self->connection(@info);
1544     return $self;
1545   }
1546
1547   my $schema = $self->compose_namespace($target, 'DBIx::Class::ResultSetProxy');
1548   quote_sub "${target}::schema", '$s', { '$s' => \$schema };
1549
1550   $schema->connection(@info);
1551   foreach my $source_name ($schema->sources) {
1552     my $source = $schema->source($source_name);
1553     my $class = $source->result_class;
1554     #warn "$source_name $class $source ".$source->storage;
1555     $class->mk_classdata(result_source_instance => $source);
1556     $class->mk_classdata(resultset_instance => $source->resultset);
1557     $class->mk_classdata(class_resolver => $schema);
1558   }
1559   return $schema;
1560 }
1561
1562 =head1 FURTHER QUESTIONS?
1563
1564 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
1565
1566 =head1 COPYRIGHT AND LICENSE
1567
1568 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
1569 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
1570 redistribute it and/or modify it under the same terms as the
1571 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
1572
1573 =cut
1574
1575 1;