lib/DBIx/Class/Schema.pm

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