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 'refcount';
  12 use Sub::Name 'subname';
  13 use Devel::GlobalDestruction;
  14 use namespace::clean;
  15
  16 __PACKAGE__->mk_classdata('class_mappings' => {});
  17 __PACKAGE__->mk_classdata('source_registrations' => {});
  18 __PACKAGE__->mk_classdata('storage_type' => '::DBI');
  19 __PACKAGE__->mk_classdata('storage');
  20 __PACKAGE__->mk_classdata('exception_action');
  21 __PACKAGE__->mk_classdata('stacktrace' => $ENV{DBIC_TRACE} || 0);
  22 __PACKAGE__->mk_classdata('default_resultset_attributes' => {});
  23
  24 =head1 NAME
  25
  26 DBIx::Class::Schema - composable schemas
  27
  28 =head1 SYNOPSIS
  29
  30   package Library::Schema;
  31   use base qw/DBIx::Class::Schema/;
  32
  33   # load all Result classes in Library/Schema/Result/
  34   __PACKAGE__->load_namespaces();
  35
  36   package Library::Schema::Result::CD;
  37   use base qw/DBIx::Class::Core/;
  38
  39   __PACKAGE__->load_components(qw/InflateColumn::DateTime/); # for example
  40   __PACKAGE__->table('cd');
  41
  42   # Elsewhere in your code:
  43   my $schema1 = Library::Schema->connect(
  44     $dsn,
  45     $user,
  46     $password,
  47     { AutoCommit => 1 },
  48   );
  49
  50   my $schema2 = Library::Schema->connect($coderef_returning_dbh);
  51
  52   # fetch objects using Library::Schema::Result::DVD
  53   my $resultset = $schema1->resultset('DVD')->search( ... );
  54   my @dvd_objects = $schema2->resultset('DVD')->search( ... );
  55
  56 =head1 DESCRIPTION
  57
  58 Creates database classes based on a schema. This is the recommended way to
  59 use L<DBIx::Class> and allows you to use more than one concurrent connection
  60 with your classes.
  61
  62 NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
  63 carefully, as DBIx::Class does things a little differently. Note in
  64 particular which module inherits off which.
  65
  66 =head1 SETUP METHODS
  67
  68 =head2 load_namespaces
  69
  70 =over 4
  71
  72 =item Arguments: %options?
  73
  74 =back
  75
  76   package MyApp::Schema;
  77   __PACKAGE__->load_namespaces();
  78
  79   __PACKAGE__->load_namespaces(
  80      result_namespace => 'Res',
  81      resultset_namespace => 'RSet',
  82      default_resultset_class => '+MyApp::Othernamespace::RSet',
  83   );
  84
  85 With no arguments, this method uses L<Module::Find> to load all of the
  86 Result and ResultSet classes under the namespace of the schema from
  87 which it is called.  For example, C<My::Schema> will by default find
  88 and load Result classes named C<My::Schema::Result::*> and ResultSet
  89 classes named C<My::Schema::ResultSet::*>.
  90
  91 ResultSet classes are associated with Result class of the same name.
  92 For example, C<My::Schema::Result::CD> will get the ResultSet class
  93 C<My::Schema::ResultSet::CD> if it is present.
  94
  95 Both Result and ResultSet namespaces are configurable via the
  96 C<result_namespace> and C<resultset_namespace> options.
  97
  98 Another option, C<default_resultset_class> specifies a custom default
  99 ResultSet class for Result classes with no corresponding ResultSet.
 100
 101 All of the namespace and classname options are by default relative to
 102 the schema classname.  To specify a fully-qualified name, prefix it
 103 with a literal C<+>.  For example, C<+Other::NameSpace::Result>.
 104
 105 =head3 Warnings
 106
 107 You will be warned if ResultSet classes are discovered for which there
 108 are no matching Result classes like this:
 109
 110   load_namespaces found ResultSet class $classname with no corresponding Result class
 111
 112 If a Result class is found to already have a ResultSet class set using
 113 L</resultset_class> to some other class, you will be warned like this:
 114
 115   We found ResultSet class '$rs_class' for '$result', but it seems
 116   that you had already set '$result' 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     no strict qw/refs/;
 901     foreach my $source_name ($self->sources) {
 902       my $orig_source = $self->source($source_name);
 903
 904       my $target_class = "${target}::${source_name}";
 905       $self->inject_base($target_class, $orig_source->result_class, ($base || ()) );
 906
 907       # register_source examines result_class, and then returns us a clone
 908       my $new_source = $schema->register_source($source_name, bless
 909         { %$orig_source, result_class => $target_class },
 910         ref $orig_source,
 911       );
 912
 913       if ($target_class->can('result_source_instance')) {
 914         # give the class a schema-less source copy
 915         $target_class->result_source_instance( bless
 916           { %$new_source, schema => ref $new_source->{schema} || $new_source->{schema} },
 917           ref $new_source,
 918         );
 919       }
 920     }
 921
 922     foreach my $meth (qw/class source resultset/) {
 923       no warnings 'redefine';
 924       *{"${target}::${meth}"} = subname "${target}::${meth}" =>
 925         sub { shift->schema->$meth(@_) };
 926     }
 927   }
 928
 929   Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
 930
 931   return $schema;
 932 }
 933
 934 sub setup_connection_class {
 935   my ($class, $target, @info) = @_;
 936   $class->inject_base($target => 'DBIx::Class::DB');
 937   #$target->load_components('DB');
 938   $target->connection(@info);
 939 }
 940
 941 =head2 svp_begin
 942
 943 Creates a new savepoint (does nothing outside a transaction).
 944 Equivalent to calling $schema->storage->svp_begin.  See
 945 L<DBIx::Class::Storage/"svp_begin"> for more information.
 946
 947 =cut
 948
 949 sub svp_begin {
 950   my ($self, $name) = @_;
 951
 952   $self->storage or $self->throw_exception
 953     ('svp_begin called on $schema without storage');
 954
 955   $self->storage->svp_begin($name);
 956 }
 957
 958 =head2 svp_release
 959
 960 Releases a savepoint (does nothing outside a transaction).
 961 Equivalent to calling $schema->storage->svp_release.  See
 962 L<DBIx::Class::Storage/"svp_release"> for more information.
 963
 964 =cut
 965
 966 sub svp_release {
 967   my ($self, $name) = @_;
 968
 969   $self->storage or $self->throw_exception
 970     ('svp_release called on $schema without storage');
 971
 972   $self->storage->svp_release($name);
 973 }
 974
 975 =head2 svp_rollback
 976
 977 Rollback to a savepoint (does nothing outside a transaction).
 978 Equivalent to calling $schema->storage->svp_rollback.  See
 979 L<DBIx::Class::Storage/"svp_rollback"> for more information.
 980
 981 =cut
 982
 983 sub svp_rollback {
 984   my ($self, $name) = @_;
 985
 986   $self->storage or $self->throw_exception
 987     ('svp_rollback called on $schema without storage');
 988
 989   $self->storage->svp_rollback($name);
 990 }
 991
 992 =head2 clone
 993
 994 =over 4
 995
 996 =item Arguments: %attrs?
 997
 998 =item Return Value: $new_schema
 999
1000 =back
1001
1002 Clones the schema and its associated result_source objects and returns the
1003 copy. The resulting copy will have the same attributes as the source schema,
1004 except for those attributes explicitly overridden by the provided C<%attrs>.
1005
1006 =cut
1007
1008 sub clone {
1009   my $self = shift;
1010
1011   my $clone = {
1012       (ref $self ? %$self : ()),
1013       (@_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_),
1014   };
1015   bless $clone, (ref $self || $self);
1016
1017   $clone->$_(undef) for qw/class_mappings source_registrations storage/;
1018
1019   $clone->_copy_state_from($self);
1020
1021   return $clone;
1022 }
1023
1024 # Needed in Schema::Loader - if you refactor, please make a compatibility shim
1025 # -- Caelum
1026 sub _copy_state_from {
1027   my ($self, $from) = @_;
1028
1029   $self->class_mappings({ %{$from->class_mappings} });
1030   $self->source_registrations({ %{$from->source_registrations} });
1031
1032   foreach my $source_name ($from->sources) {
1033     my $source = $from->source($source_name);
1034     my $new = $source->new($source);
1035     # we use extra here as we want to leave the class_mappings as they are
1036     # but overwrite the source_registrations entry with the new source
1037     $self->register_extra_source($source_name => $new);
1038   }
1039
1040   if ($from->storage) {
1041     $self->storage($from->storage);
1042     $self->storage->set_schema($self);
1043   }
1044 }
1045
1046 =head2 throw_exception
1047
1048 =over 4
1049
1050 =item Arguments: $message
1051
1052 =back
1053
1054 Throws an exception. Obeys the exemption rules of L<DBIx::Class::Carp> to report
1055 errors from outer-user's perspective. See L</exception_action> for details on overriding
1056 this method's behavior.  If L</stacktrace> is turned on, C<throw_exception>'s
1057 default behavior will provide a detailed stack trace.
1058
1059 =cut
1060
1061 sub throw_exception {
1062   my $self = shift;
1063
1064   if (my $act = $self->exception_action) {
1065     if ($act->(@_)) {
1066       DBIx::Class::Exception->throw(
1067           "Invocation of the exception_action handler installed on $self did *not*"
1068         .' result in an exception. DBIx::Class is unable to function without a reliable'
1069         .' exception mechanism, ensure that exception_action does not hide exceptions'
1070         ." (original error: $_[0])"
1071       );
1072     }
1073
1074     carp_unique (
1075       "The exception_action handler installed on $self returned false instead"
1076     .' of throwing an exception. This behavior has been deprecated, adjust your'
1077     .' handler to always rethrow the supplied error.'
1078     );
1079   }
1080
1081   DBIx::Class::Exception->throw($_[0], $self->stacktrace);
1082 }
1083
1084 =head2 deploy
1085
1086 =over 4
1087
1088 =item Arguments: \%sqlt_args, $dir
1089
1090 =back
1091
1092 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
1093
1094 See L<SQL::Translator/METHODS> for a list of values for C<\%sqlt_args>.
1095 The most common value for this would be C<< { add_drop_table => 1 } >>
1096 to have the SQL produced include a C<DROP TABLE> statement for each table
1097 created. For quoting purposes supply C<quote_identifiers>.
1098
1099 Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
1100 ref or an array ref, containing a list of source to deploy. If present, then
1101 only the sources listed will get deployed. Furthermore, you can use the
1102 C<add_fk_index> parser parameter to prevent the parser from creating an index for each
1103 FK.
1104
1105 =cut
1106
1107 sub deploy {
1108   my ($self, $sqltargs, $dir) = @_;
1109   $self->throw_exception("Can't deploy without storage") unless $self->storage;
1110   $self->storage->deploy($self, undef, $sqltargs, $dir);
1111 }
1112
1113 =head2 deployment_statements
1114
1115 =over 4
1116
1117 =item Arguments: See L<DBIx::Class::Storage::DBI/deployment_statements>
1118
1119 =item Return Value: $listofstatements
1120
1121 =back
1122
1123 A convenient shortcut to
1124 C<< $self->storage->deployment_statements($self, @args) >>.
1125 Returns the SQL statements used by L</deploy> and
1126 L<DBIx::Class::Schema::Storage/deploy>.
1127
1128 =cut
1129
1130 sub deployment_statements {
1131   my $self = shift;
1132
1133   $self->throw_exception("Can't generate deployment statements without a storage")
1134     if not $self->storage;
1135
1136   $self->storage->deployment_statements($self, @_);
1137 }
1138
1139 =head2 create_ddl_dir
1140
1141 =over 4
1142
1143 =item Arguments: See L<DBIx::Class::Storage::DBI/create_ddl_dir>
1144
1145 =back
1146
1147 A convenient shortcut to
1148 C<< $self->storage->create_ddl_dir($self, @args) >>.
1149
1150 Creates an SQL file based on the Schema, for each of the specified
1151 database types, in the given directory.
1152
1153 =cut
1154
1155 sub create_ddl_dir {
1156   my $self = shift;
1157
1158   $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1159   $self->storage->create_ddl_dir($self, @_);
1160 }
1161
1162 =head2 ddl_filename
1163
1164 =over 4
1165
1166 =item Arguments: $database-type, $version, $directory, $preversion
1167
1168 =item Return Value: $normalised_filename
1169
1170 =back
1171
1172   my $filename = $table->ddl_filename($type, $version, $dir, $preversion)
1173
1174 This method is called by C<create_ddl_dir> to compose a file name out of
1175 the supplied directory, database type and version number. The default file
1176 name format is: C<$dir$schema-$version-$type.sql>.
1177
1178 You may override this method in your schema if you wish to use a different
1179 format.
1180
1181  WARNING
1182
1183  Prior to DBIx::Class version 0.08100 this method had a different signature:
1184
1185     my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1186
1187  In recent versions variables $dir and $version were reversed in order to
1188  bring the signature in line with other Schema/Storage methods. If you
1189  really need to maintain backward compatibility, you can do the following
1190  in any overriding methods:
1191
1192     ($dir, $version) = ($version, $dir) if ($DBIx::Class::VERSION < 0.08100);
1193
1194 =cut
1195
1196 sub ddl_filename {
1197   my ($self, $type, $version, $dir, $preversion) = @_;
1198
1199   require File::Spec;
1200
1201   $version = "$preversion-$version" if $preversion;
1202
1203   my $class = blessed($self) || $self;
1204   $class =~ s/::/-/g;
1205
1206   return File::Spec->catfile($dir, "$class-$version-$type.sql");
1207 }
1208
1209 =head2 thaw
1210
1211 Provided as the recommended way of thawing schema objects. You can call
1212 C<Storable::thaw> directly if you wish, but the thawed objects will not have a
1213 reference to any schema, so are rather useless.
1214
1215 =cut
1216
1217 sub thaw {
1218   my ($self, $obj) = @_;
1219   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1220   require Storable;
1221   return Storable::thaw($obj);
1222 }
1223
1224 =head2 freeze
1225
1226 This doesn't actually do anything more than call L<Storable/nfreeze>, it is just
1227 provided here for symmetry.
1228
1229 =cut
1230
1231 sub freeze {
1232   require Storable;
1233   return Storable::nfreeze($_[1]);
1234 }
1235
1236 =head2 dclone
1237
1238 =over 4
1239
1240 =item Arguments: $object
1241
1242 =item Return Value: dcloned $object
1243
1244 =back
1245
1246 Recommended way of dcloning L<DBIx::Class::Row> and L<DBIx::Class::ResultSet>
1247 objects so their references to the schema object
1248 (which itself is B<not> cloned) are properly maintained.
1249
1250 =cut
1251
1252 sub dclone {
1253   my ($self, $obj) = @_;
1254   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1255   require Storable;
1256   return Storable::dclone($obj);
1257 }
1258
1259 =head2 schema_version
1260
1261 Returns the current schema class' $VERSION in a normalised way.
1262
1263 =cut
1264
1265 sub schema_version {
1266   my ($self) = @_;
1267   my $class = ref($self)||$self;
1268
1269   # does -not- use $schema->VERSION
1270   # since that varies in results depending on if version.pm is installed, and if
1271   # so the perl or XS versions. If you want this to change, bug the version.pm
1272   # author to make vpp and vxs behave the same.
1273
1274   my $version;
1275   {
1276     no strict 'refs';
1277     $version = ${"${class}::VERSION"};
1278   }
1279   return $version;
1280 }
1281
1282
1283 =head2 register_class
1284
1285 =over 4
1286
1287 =item Arguments: $source_name, $component_class
1288
1289 =back
1290
1291 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.
1292
1293 You will only need this method if you have your Result classes in
1294 files which are not named after the packages (or all in the same
1295 file). You may also need it to register classes at runtime.
1296
1297 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
1298 calling:
1299
1300   $schema->register_source($source_name, $component_class->result_source_instance);
1301
1302 =cut
1303
1304 sub register_class {
1305   my ($self, $source_name, $to_register) = @_;
1306   $self->register_source($source_name => $to_register->result_source_instance);
1307 }
1308
1309 =head2 register_source
1310
1311 =over 4
1312
1313 =item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>
1314
1315 =back
1316
1317 This method is called by L</register_class>.
1318
1319 Registers the L<DBIx::Class::ResultSource> in the schema with the given
1320 source name.
1321
1322 =cut
1323
1324 sub register_source { shift->_register_source(@_) }
1325
1326 =head2 unregister_source
1327
1328 =over 4
1329
1330 =item Arguments: $source_name
1331
1332 =back
1333
1334 Removes the L<DBIx::Class::ResultSource> from the schema for the given source name.
1335
1336 =cut
1337
1338 sub unregister_source { shift->_unregister_source(@_) }
1339
1340 =head2 register_extra_source
1341
1342 =over 4
1343
1344 =item Arguments: $source_name, L<$result_source|DBIx::Class::ResultSource>
1345
1346 =back
1347
1348 As L</register_source> but should be used if the result class already
1349 has a source and you want to register an extra one.
1350
1351 =cut
1352
1353 sub register_extra_source { shift->_register_source(@_, { extra => 1 }) }
1354
1355 sub _register_source {
1356   my ($self, $source_name, $source, $params) = @_;
1357
1358   $source = $source->new({ %$source, source_name => $source_name });
1359
1360   $source->schema($self);
1361   weaken $source->{schema} if ref($self);
1362
1363   my %reg = %{$self->source_registrations};
1364   $reg{$source_name} = $source;
1365   $self->source_registrations(\%reg);
1366
1367   return $source if $params->{extra};
1368
1369   my $rs_class = $source->result_class;
1370   if ($rs_class and my $rsrc = try { $rs_class->result_source_instance } ) {
1371     my %map = %{$self->class_mappings};
1372     if (
1373       exists $map{$rs_class}
1374         and
1375       $map{$rs_class} ne $source_name
1376         and
1377       $rsrc ne $_[2]  # orig_source
1378     ) {
1379       carp
1380         "$rs_class already had a registered source which was replaced by this call. "
1381       . 'Perhaps you wanted register_extra_source(), though it is more likely you did '
1382       . 'something wrong.'
1383       ;
1384     }
1385
1386     $map{$rs_class} = $source_name;
1387     $self->class_mappings(\%map);
1388   }
1389
1390   return $source;
1391 }
1392
1393 my $global_phase_destroy;
1394 sub DESTROY {
1395   return if $global_phase_destroy ||= in_global_destruction;
1396
1397   my $self = shift;
1398   my $srcs = $self->source_registrations;
1399
1400   for my $source_name (keys %$srcs) {
1401     # find first source that is not about to be GCed (someone other than $self
1402     # holds a reference to it) and reattach to it, weakening our own link
1403     #
1404     # during global destruction (if we have not yet bailed out) this should throw
1405     # which will serve as a signal to not try doing anything else
1406     # however beware - on older perls the exception seems randomly untrappable
1407     # due to some weird race condition during thread joining :(((
1408     if (length ref $srcs->{$source_name} and refcount($srcs->{$source_name}) > 1) {
1409       local $@;
1410       eval {
1411         $srcs->{$source_name}->schema($self);
1412         weaken $srcs->{$source_name};
1413         1;
1414       } or do {
1415         $global_phase_destroy = 1;
1416       };
1417
1418       last;
1419     }
1420   }
1421 }
1422
1423 sub _unregister_source {
1424     my ($self, $source_name) = @_;
1425     my %reg = %{$self->source_registrations};
1426
1427     my $source = delete $reg{$source_name};
1428     $self->source_registrations(\%reg);
1429     if ($source->result_class) {
1430         my %map = %{$self->class_mappings};
1431         delete $map{$source->result_class};
1432         $self->class_mappings(\%map);
1433     }
1434 }
1435
1436
1437 =head2 compose_connection (DEPRECATED)
1438
1439 =over 4
1440
1441 =item Arguments: $target_namespace, @db_info
1442
1443 =item Return Value: $new_schema
1444
1445 =back
1446
1447 DEPRECATED. You probably wanted compose_namespace.
1448
1449 Actually, you probably just wanted to call connect.
1450
1451 =begin hidden
1452
1453 (hidden due to deprecation)
1454
1455 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
1456 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
1457 then injects the L<DBix::Class::ResultSetProxy> component and a
1458 resultset_instance classdata entry on all the new classes, in order to support
1459 $target_namespaces::$class->search(...) method calls.
1460
1461 This is primarily useful when you have a specific need for class method access
1462 to a connection. In normal usage it is preferred to call
1463 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
1464 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
1465 more information.
1466
1467 =end hidden
1468
1469 =cut
1470
1471 sub compose_connection {
1472   my ($self, $target, @info) = @_;
1473
1474   carp_once "compose_connection deprecated as of 0.08000"
1475     unless $INC{"DBIx/Class/CDBICompat.pm"};
1476
1477   my $base = 'DBIx::Class::ResultSetProxy';
1478   try {
1479     eval "require ${base};"
1480   }
1481   catch {
1482     $self->throw_exception
1483       ("No arguments to load_classes and couldn't load ${base} ($_)")
1484   };
1485
1486   if ($self eq $target) {
1487     # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
1488     foreach my $source_name ($self->sources) {
1489       my $source = $self->source($source_name);
1490       my $class = $source->result_class;
1491       $self->inject_base($class, $base);
1492       $class->mk_classdata(resultset_instance => $source->resultset);
1493       $class->mk_classdata(class_resolver => $self);
1494     }
1495     $self->connection(@info);
1496     return $self;
1497   }
1498
1499   my $schema = $self->compose_namespace($target, $base);
1500   {
1501     no strict 'refs';
1502     my $name = join '::', $target, 'schema';
1503     *$name = subname $name, sub { $schema };
1504   }
1505
1506   $schema->connection(@info);
1507   foreach my $source_name ($schema->sources) {
1508     my $source = $schema->source($source_name);
1509     my $class = $source->result_class;
1510     #warn "$source_name $class $source ".$source->storage;
1511     $class->mk_classdata(result_source_instance => $source);
1512     $class->mk_classdata(resultset_instance => $source->resultset);
1513     $class->mk_classdata(class_resolver => $schema);
1514   }
1515   return $schema;
1516 }
1517
1518 1;
1519
1520 =head1 AUTHOR AND CONTRIBUTORS
1521
1522 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
1523
1524 =head1 LICENSE
1525
1526 You may distribute this code under the same terms as Perl itself.
1527
1528 =cut