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     dbic_internal_try {
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     catch {
1113       # We call this to get the necessary warnings emitted and disregard the RV
1114       # as it's definitely an exception if we got as far as this catch{} block
1115       is_exception(
1116         $args[0] = $_
1117       );
1118     };
1119
1120     # Done guarding against https://github.com/PerlDancer/Dancer2/issues/1125
1121     $guard_disarmed = 1;
1122   }
1123
1124   DBIx::Class::Exception->throw( $args[0], $self->stacktrace );
1125 }
1126
1127 =head2 deploy
1128
1129 =over 4
1130
1131 =item Arguments: \%sqlt_args, $dir
1132
1133 =back
1134
1135 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
1136
1137 See L<SQL::Translator/METHODS> for a list of values for C<\%sqlt_args>.
1138 The most common value for this would be C<< { add_drop_table => 1 } >>
1139 to have the SQL produced include a C<DROP TABLE> statement for each table
1140 created. For quoting purposes supply C<quote_identifiers>.
1141
1142 Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
1143 ref or an array ref, containing a list of source to deploy. If present, then
1144 only the sources listed will get deployed. Furthermore, you can use the
1145 C<add_fk_index> parser parameter to prevent the parser from creating an index for each
1146 FK.
1147
1148 =cut
1149
1150 sub deploy {
1151   my ($self, $sqltargs, $dir) = @_;
1152   $self->throw_exception("Can't deploy without storage") unless $self->storage;
1153   $self->storage->deploy($self, undef, $sqltargs, $dir);
1154 }
1155
1156 =head2 deployment_statements
1157
1158 =over 4
1159
1160 =item Arguments: See L<DBIx::Class::Storage::DBI/deployment_statements>
1161
1162 =item Return Value: $listofstatements
1163
1164 =back
1165
1166 A convenient shortcut to
1167 C<< $self->storage->deployment_statements($self, @args) >>.
1168 Returns the statements used by L</deploy> and
1169 L<DBIx::Class::Storage/deploy>.
1170
1171 =cut
1172
1173 sub deployment_statements {
1174   my $self = shift;
1175
1176   $self->throw_exception("Can't generate deployment statements without a storage")
1177     if not $self->storage;
1178
1179   $self->storage->deployment_statements($self, @_);
1180 }
1181
1182 =head2 create_ddl_dir
1183
1184 =over 4
1185
1186 =item Arguments: See L<DBIx::Class::Storage::DBI/create_ddl_dir>
1187
1188 =back
1189
1190 A convenient shortcut to
1191 C<< $self->storage->create_ddl_dir($self, @args) >>.
1192
1193 Creates an SQL file based on the Schema, for each of the specified
1194 database types, in the given directory.
1195
1196 =cut
1197
1198 sub create_ddl_dir {
1199   my $self = shift;
1200
1201   $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1202   $self->storage->create_ddl_dir($self, @_);
1203 }
1204
1205 =head2 ddl_filename
1206
1207 =over 4
1208
1209 =item Arguments: $database-type, $version, $directory, $preversion
1210
1211 =item Return Value: $normalised_filename
1212
1213 =back
1214
1215   my $filename = $table->ddl_filename($type, $version, $dir, $preversion)
1216
1217 This method is called by C<create_ddl_dir> to compose a file name out of
1218 the supplied directory, database type and version number. The default file
1219 name format is: C<$dir$schema-$version-$type.sql>.
1220
1221 You may override this method in your schema if you wish to use a different
1222 format.
1223
1224  WARNING
1225
1226  Prior to DBIx::Class version 0.08100 this method had a different signature:
1227
1228     my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1229
1230  In recent versions variables $dir and $version were reversed in order to
1231  bring the signature in line with other Schema/Storage methods. If you
1232  really need to maintain backward compatibility, you can do the following
1233  in any overriding methods:
1234
1235     ($dir, $version) = ($version, $dir) if ($DBIx::Class::VERSION < 0.08100);
1236
1237 =cut
1238
1239 sub ddl_filename {
1240   my ($self, $type, $version, $dir, $preversion) = @_;
1241
1242   $version = "$preversion-$version" if $preversion;
1243
1244   my $class = blessed($self) || $self;
1245   $class =~ s/::/-/g;
1246
1247   return "$dir/$class-$version-$type.sql";
1248 }
1249
1250 =head2 thaw
1251
1252 Provided as the recommended way of thawing schema objects. You can call
1253 C<Storable::thaw> directly if you wish, but the thawed objects will not have a
1254 reference to any schema, so are rather useless.
1255
1256 =cut
1257
1258 sub thaw {
1259   my ($self, $obj) = @_;
1260   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1261   return Storable::thaw($obj);
1262 }
1263
1264 =head2 freeze
1265
1266 This doesn't actually do anything beyond calling L<nfreeze|Storable/SYNOPSIS>,
1267 it is just provided here for symmetry.
1268
1269 =cut
1270
1271 sub freeze {
1272   return Storable::nfreeze($_[1]);
1273 }
1274
1275 =head2 dclone
1276
1277 =over 4
1278
1279 =item Arguments: $object
1280
1281 =item Return Value: dcloned $object
1282
1283 =back
1284
1285 Recommended way of dcloning L<DBIx::Class::Row> and L<DBIx::Class::ResultSet>
1286 objects so their references to the schema object
1287 (which itself is B<not> cloned) are properly maintained.
1288
1289 =cut
1290
1291 sub dclone {
1292   my ($self, $obj) = @_;
1293   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1294   return Storable::dclone($obj);
1295 }
1296
1297 =head2 schema_version
1298
1299 Returns the current schema class' $VERSION in a normalised way.
1300
1301 =cut
1302
1303 sub schema_version {
1304   my ($self) = @_;
1305   my $class = ref($self)||$self;
1306
1307   # does -not- use $schema->VERSION
1308   # since that varies in results depending on if version.pm is installed, and if
1309   # so the perl or XS versions. If you want this to change, bug the version.pm
1310   # author to make vpp and vxs behave the same.
1311
1312   my $version;
1313   {
1314     no strict 'refs';
1315     $version = ${"${class}::VERSION"};
1316   }
1317   return $version;
1318 }
1319
1320
1321 =head2 register_class
1322
1323 =over 4
1324
1325 =item Arguments: $source_name, $component_class
1326
1327 =back
1328
1329 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.
1330
1331 You will only need this method if you have your Result classes in
1332 files which are not named after the packages (or all in the same
1333 file). You may also need it to register classes at runtime.
1334
1335 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
1336 calling:
1337
1338   $schema->register_source($source_name, $component_class->result_source_instance);
1339
1340 =cut
1341
1342 sub register_class {
1343   my ($self, $source_name, $to_register) = @_;
1344   $self->register_source($source_name => $to_register->result_source_instance);
1345 }
1346
1347 =head2 register_source
1348
1349 =over 4
1350
1351 =item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>
1352
1353 =back
1354
1355 This method is called by L</register_class>.
1356
1357 Registers the L<DBIx::Class::ResultSource> in the schema with the given
1358 source name.
1359
1360 =cut
1361
1362 sub register_source { shift->_register_source(@_) }
1363
1364 =head2 unregister_source
1365
1366 =over 4
1367
1368 =item Arguments: $source_name
1369
1370 =back
1371
1372 Removes the L<DBIx::Class::ResultSource> from the schema for the given source name.
1373
1374 =cut
1375
1376 sub unregister_source { shift->_unregister_source(@_) }
1377
1378 =head2 register_extra_source
1379
1380 =over 4
1381
1382 =item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>
1383
1384 =back
1385
1386 As L</register_source> but should be used if the result class already
1387 has a source and you want to register an extra one.
1388
1389 =cut
1390
1391 sub register_extra_source { shift->_register_source(@_, { extra => 1 }) }
1392
1393 sub _register_source {
1394   my ($self, $source_name, $source, $params) = @_;
1395
1396   $source = $source->new({ %$source, source_name => $source_name });
1397
1398   $source->schema($self);
1399   weaken $source->{schema} if ref($self);
1400
1401   my %reg = %{$self->source_registrations};
1402   $reg{$source_name} = $source;
1403   $self->source_registrations(\%reg);
1404
1405   return $source if $params->{extra};
1406
1407   my $rs_class = $source->result_class;
1408   if ($rs_class and my $rsrc = dbic_internal_try { $rs_class->result_source_instance } ) {
1409     my %map = %{$self->class_mappings};
1410     if (
1411       exists $map{$rs_class}
1412         and
1413       $map{$rs_class} ne $source_name
1414         and
1415       $rsrc ne $_[2]  # orig_source
1416     ) {
1417       carp
1418         "$rs_class already had a registered source which was replaced by this call. "
1419       . 'Perhaps you wanted register_extra_source(), though it is more likely you did '
1420       . 'something wrong.'
1421       ;
1422     }
1423
1424     $map{$rs_class} = $source_name;
1425     $self->class_mappings(\%map);
1426   }
1427
1428   return $source;
1429 }
1430
1431 my $global_phase_destroy;
1432 sub DESTROY {
1433   ### NO detected_reinvoked_destructor check
1434   ### This code very much relies on being called multuple times
1435
1436   return if $global_phase_destroy ||= in_global_destruction;
1437
1438   my $self = shift;
1439   my $srcs = $self->source_registrations;
1440
1441   for my $source_name (keys %$srcs) {
1442     # find first source that is not about to be GCed (someone other than $self
1443     # holds a reference to it) and reattach to it, weakening our own link
1444     #
1445     # during global destruction (if we have not yet bailed out) this should throw
1446     # which will serve as a signal to not try doing anything else
1447     # however beware - on older perls the exception seems randomly untrappable
1448     # due to some weird race condition during thread joining :(((
1449     if (length ref $srcs->{$source_name} and refcount($srcs->{$source_name}) > 1) {
1450       local $SIG{__DIE__} if $SIG{__DIE__};
1451       local $@;
1452       eval {
1453         $srcs->{$source_name}->schema($self);
1454         weaken $srcs->{$source_name};
1455         1;
1456       } or do {
1457         $global_phase_destroy = 1;
1458       };
1459
1460       last;
1461     }
1462   }
1463
1464   # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
1465   # collected before leaving this scope. Depending on the code above, this
1466   # may very well be just a preventive measure guarding future modifications
1467   undef;
1468 }
1469
1470 sub _unregister_source {
1471     my ($self, $source_name) = @_;
1472     my %reg = %{$self->source_registrations};
1473
1474     my $source = delete $reg{$source_name};
1475     $self->source_registrations(\%reg);
1476     if ($source->result_class) {
1477         my %map = %{$self->class_mappings};
1478         delete $map{$source->result_class};
1479         $self->class_mappings(\%map);
1480     }
1481 }
1482
1483
1484 =head2 compose_connection (DEPRECATED)
1485
1486 =over 4
1487
1488 =item Arguments: $target_namespace, @db_info
1489
1490 =item Return Value: $new_schema
1491
1492 =back
1493
1494 DEPRECATED. You probably wanted compose_namespace.
1495
1496 Actually, you probably just wanted to call connect.
1497
1498 =begin hidden
1499
1500 (hidden due to deprecation)
1501
1502 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
1503 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
1504 then injects the L<DBix::Class::ResultSetProxy> component and a
1505 resultset_instance classdata entry on all the new classes, in order to support
1506 $target_namespaces::$class->search(...) method calls.
1507
1508 This is primarily useful when you have a specific need for class method access
1509 to a connection. In normal usage it is preferred to call
1510 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
1511 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
1512 more information.
1513
1514 =end hidden
1515
1516 =cut
1517
1518 sub compose_connection {
1519   my ($self, $target, @info) = @_;
1520
1521   carp_once "compose_connection deprecated as of 0.08000"
1522     unless $INC{"DBIx/Class/CDBICompat.pm"};
1523
1524   dbic_internal_try {
1525     require DBIx::Class::ResultSetProxy;
1526   }
1527   catch {
1528     $self->throw_exception
1529       ("No arguments to load_classes and couldn't load DBIx::Class::ResultSetProxy ($_)")
1530   };
1531
1532   if ($self eq $target) {
1533     # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
1534     foreach my $source_name ($self->sources) {
1535       my $source = $self->source($source_name);
1536       my $class = $source->result_class;
1537       $self->inject_base($class, 'DBIx::Class::ResultSetProxy');
1538       $class->mk_classdata(resultset_instance => $source->resultset);
1539       $class->mk_classdata(class_resolver => $self);
1540     }
1541     $self->connection(@info);
1542     return $self;
1543   }
1544
1545   my $schema = $self->compose_namespace($target, 'DBIx::Class::ResultSetProxy');
1546   quote_sub "${target}::schema", '$s', { '$s' => \$schema };
1547
1548   $schema->connection(@info);
1549   foreach my $source_name ($schema->sources) {
1550     my $source = $schema->source($source_name);
1551     my $class = $source->result_class;
1552     #warn "$source_name $class $source ".$source->storage;
1553     $class->mk_classdata(result_source_instance => $source);
1554     $class->mk_classdata(resultset_instance => $source->resultset);
1555     $class->mk_classdata(class_resolver => $schema);
1556   }
1557   return $schema;
1558 }
1559
1560 =head1 FURTHER QUESTIONS?
1561
1562 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
1563
1564 =head1 COPYRIGHT AND LICENSE
1565
1566 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
1567 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
1568 redistribute it and/or modify it under the same terms as the
1569 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
1570
1571 =cut
1572
1573 1;