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