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 'weaken';
  10 use Sub::Name 'subname';
  11 use B 'svref_2object';
  12 use namespace::clean;
  13
  14 use base qw/DBIx::Class/;
  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__->load_namespaces();
  77
  78   __PACKAGE__->load_namespaces(
  79      result_namespace => 'Res',
  80      resultset_namespace => 'RSet',
  81      default_resultset_class => '+MyDB::Othernamespace::RSet',
  82   );
  83
  84 With no arguments, this method uses L<Module::Find> to load all of the
  85 Result and ResultSet classes under the namespace of the schema from
  86 which it is called.  For example, C<My::Schema> will by default find
  87 and load Result classes named C<My::Schema::Result::*> and ResultSet
  88 classes named C<My::Schema::ResultSet::*>.
  89
  90 ResultSet classes are associated with Result class of the same name.
  91 For example, C<My::Schema::Result::CD> will get the ResultSet class
  92 C<My::Schema::ResultSet::CD> if it is present.
  93
  94 Both Result and ResultSet namespaces are configurable via the
  95 C<result_namespace> and C<resultset_namespace> options.
  96
  97 Another option, C<default_resultset_class> specifies a custom default
  98 ResultSet class for Result classes with no corresponding ResultSet.
  99
 100 All of the namespace and classname options are by default relative to
 101 the schema classname.  To specify a fully-qualified name, prefix it
 102 with a literal C<+>.  For example, C<+Other::NameSpace::Result>.
 103
 104 =head3 Warnings
 105
 106 You will be warned if ResultSet classes are discovered for which there
 107 are no matching Result classes like this:
 108
 109   load_namespaces found ResultSet class $classname with no corresponding Result class
 110
 111 If a Result class is found to already have a ResultSet class set using
 112 L</resultset_class> to some other class, you will be warned like this:
 113
 114   We found ResultSet class '$rs_class' for '$result', but it seems
 115   that you had already set '$result' to use '$rs_set' instead
 116
 117 =head3 Examples
 118
 119   # load My::Schema::Result::CD, My::Schema::Result::Artist,
 120   #    My::Schema::ResultSet::CD, etc...
 121   My::Schema->load_namespaces;
 122
 123   # Override everything to use ugly names.
 124   # In this example, if there is a My::Schema::Res::Foo, but no matching
 125   #   My::Schema::RSets::Foo, then Foo will have its
 126   #   resultset_class set to My::Schema::RSetBase
 127   My::Schema->load_namespaces(
 128     result_namespace => 'Res',
 129     resultset_namespace => 'RSets',
 130     default_resultset_class => 'RSetBase',
 131   );
 132
 133   # Put things in other namespaces
 134   My::Schema->load_namespaces(
 135     result_namespace => '+Some::Place::Results',
 136     resultset_namespace => '+Another::Place::RSets',
 137   );
 138
 139 To search multiple namespaces for either Result or ResultSet classes,
 140 use an arrayref of namespaces for that option.  In the case that the
 141 same result (or resultset) class exists in multiple namespaces, later
 142 entries in the list of namespaces will override earlier ones.
 143
 144   My::Schema->load_namespaces(
 145     # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo :
 146     result_namespace => [ 'Results_A', 'Results_B', 'Results_C' ],
 147     resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
 148   );
 149
 150 =cut
 151
 152 # Pre-pends our classname to the given relative classname or
 153 #   class namespace, unless there is a '+' prefix, which will
 154 #   be stripped.
 155 sub _expand_relative_name {
 156   my ($class, $name) = @_;
 157   return if !$name;
 158   $name = $class . '::' . $name if ! ($name =~ s/^\+//);
 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   my $proto = shift;
 167   my $ns = shift || ref $proto || $proto;
 168
 169   require Module::Find;
 170   my @mods = Module::Find::findallmod($ns);
 171
 172   # try to untaint module names. mods where this fails
 173   # are left alone so we don't have to change the old behavior
 174   no locale; # localized \w doesn't untaint expression
 175   return map { $_ =~ m/^( (?:\w+::)* \w+ )$/x ? $1 : $_ } @mods;
 176 }
 177
 178 # returns a hash of $shortname => $fullname for every package
 179 # found in the given namespaces ($shortname is with the $fullname's
 180 # namespace stripped off)
 181 sub _map_namespaces {
 182   my ($class, @namespaces) = @_;
 183
 184   my @results_hash;
 185   foreach my $namespace (@namespaces) {
 186     push(
 187       @results_hash,
 188       map { (substr($_, length "${namespace}::"), $_) }
 189       $class->_findallmod($namespace)
 190     );
 191   }
 192
 193   @results_hash;
 194 }
 195
 196 # returns the result_source_instance for the passed class/object,
 197 # or dies with an informative message (used by load_namespaces)
 198 sub _ns_get_rsrc_instance {
 199   my $class = shift;
 200   my $rs = ref ($_[0]) || $_[0];
 201
 202   if ($rs->can ('result_source_instance') ) {
 203     return $rs->result_source_instance;
 204   }
 205   else {
 206     $class->throw_exception (
 207       "Attempt to load_namespaces() class $rs 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     #  if $class->can('result_source_instance');
 404   }
 405 }
 406
 407 =head2 storage_type
 408
 409 =over 4
 410
 411 =item Arguments: $storage_type|{$storage_type, \%args}
 412
 413 =item Return value: $storage_type|{$storage_type, \%args}
 414
 415 =item Default value: DBIx::Class::Storage::DBI
 416
 417 =back
 418
 419 Set the storage class that will be instantiated when L</connect> is called.
 420 If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
 421 assumed by L</connect>.
 422
 423 You want to use this to set subclasses of L<DBIx::Class::Storage::DBI>
 424 in cases where the appropriate subclass is not autodetected.
 425
 426 If your storage type requires instantiation arguments, those are
 427 defined as a second argument in the form of a hashref and the entire
 428 value needs to be wrapped into an arrayref or a hashref.  We support
 429 both types of refs here in order to play nice with your
 430 Config::[class] or your choice. See
 431 L<DBIx::Class::Storage::DBI::Replicated> for an example of this.
 432
 433 =head2 exception_action
 434
 435 =over 4
 436
 437 =item Arguments: $code_reference
 438
 439 =item Return value: $code_reference
 440
 441 =item Default value: None
 442
 443 =back
 444
 445 When L</throw_exception> is invoked and L</exception_action> is set to a code
 446 reference, this reference will be called instead of
 447 L<DBIx::Class::Exception/throw>, with the exception message passed as the only
 448 argument.
 449
 450 Your custom throw code B<must> rethrow the exception, as L</throw_exception> is
 451 an integral part of DBIC's internal execution control flow.
 452
 453 Example:
 454
 455    package My::Schema;
 456    use base qw/DBIx::Class::Schema/;
 457    use My::ExceptionClass;
 458    __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
 459    __PACKAGE__->load_classes;
 460
 461    # or:
 462    my $schema_obj = My::Schema->connect( .... );
 463    $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
 464
 465 =head2 stacktrace
 466
 467 =over 4
 468
 469 =item Arguments: boolean
 470
 471 =back
 472
 473 Whether L</throw_exception> should include stack trace information.
 474 Defaults to false normally, but defaults to true if C<$ENV{DBIC_TRACE}>
 475 is true.
 476
 477 =head2 sqlt_deploy_hook
 478
 479 =over
 480
 481 =item Arguments: $sqlt_schema
 482
 483 =back
 484
 485 An optional sub which you can declare in your own Schema class that will get
 486 passed the L<SQL::Translator::Schema> object when you deploy the schema via
 487 L</create_ddl_dir> or L</deploy>.
 488
 489 For an example of what you can do with this, see
 490 L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>.
 491
 492 Note that sqlt_deploy_hook is called by L</deployment_statements>, which in turn
 493 is called before L</deploy>. Therefore the hook can be used only to manipulate
 494 the L<SQL::Translator::Schema> object before it is turned into SQL fed to the
 495 database. If you want to execute post-deploy statements which can not be generated
 496 by L<SQL::Translator>, the currently suggested method is to overload L</deploy>
 497 and use L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
 498
 499 =head1 METHODS
 500
 501 =head2 connect
 502
 503 =over 4
 504
 505 =item Arguments: @connectinfo
 506
 507 =item Return Value: $new_schema
 508
 509 =back
 510
 511 Creates and returns a new Schema object. The connection info set on it
 512 is used to create a new instance of the storage backend and set it on
 513 the Schema object.
 514
 515 See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific
 516 syntax on the C<@connectinfo> argument, or L<DBIx::Class::Storage> in
 517 general.
 518
 519 Note that C<connect_info> expects an arrayref of arguments, but
 520 C<connect> does not. C<connect> wraps its arguments in an arrayref
 521 before passing them to C<connect_info>.
 522
 523 =head3 Overloading
 524
 525 C<connect> is a convenience method. It is equivalent to calling
 526 $schema->clone->connection(@connectinfo). To write your own overloaded
 527 version, overload L</connection> instead.
 528
 529 =cut
 530
 531 sub connect { shift->clone->connection(@_) }
 532
 533 =head2 resultset
 534
 535 =over 4
 536
 537 =item Arguments: $source_name
 538
 539 =item Return Value: $resultset
 540
 541 =back
 542
 543   my $rs = $schema->resultset('DVD');
 544
 545 Returns the L<DBIx::Class::ResultSet> object for the registered source
 546 name.
 547
 548 =cut
 549
 550 sub resultset {
 551   my ($self, $moniker) = @_;
 552   $self->throw_exception('resultset() expects a source name')
 553     unless defined $moniker;
 554   return $self->source($moniker)->resultset;
 555 }
 556
 557 =head2 sources
 558
 559 =over 4
 560
 561 =item Return Value: @source_names
 562
 563 =back
 564
 565   my @source_names = $schema->sources;
 566
 567 Lists names of all the sources registered on this Schema object.
 568
 569 =cut
 570
 571 sub sources { return keys %{shift->source_registrations}; }
 572
 573 =head2 source
 574
 575 =over 4
 576
 577 =item Arguments: $source_name
 578
 579 =item Return Value: $result_source
 580
 581 =back
 582
 583   my $source = $schema->source('Book');
 584
 585 Returns the L<DBIx::Class::ResultSource> object for the registered
 586 source name.
 587
 588 =cut
 589
 590 sub source {
 591   my $self = shift;
 592
 593   $self->throw_exception("source() expects a source name")
 594     unless @_;
 595
 596   my $moniker = shift;
 597
 598   my $sreg = $self->source_registrations;
 599   return $sreg->{$moniker} if exists $sreg->{$moniker};
 600
 601   # if we got here, they probably passed a full class name
 602   my $mapped = $self->class_mappings->{$moniker};
 603   $self->throw_exception("Can't find source for ${moniker}")
 604     unless $mapped && exists $sreg->{$mapped};
 605   return $sreg->{$mapped};
 606 }
 607
 608 =head2 class
 609
 610 =over 4
 611
 612 =item Arguments: $source_name
 613
 614 =item Return Value: $classname
 615
 616 =back
 617
 618   my $class = $schema->class('CD');
 619
 620 Retrieves the Result class name for the given source name.
 621
 622 =cut
 623
 624 sub class {
 625   my ($self, $moniker) = @_;
 626   return $self->source($moniker)->result_class;
 627 }
 628
 629 =head2 txn_do
 630
 631 =over 4
 632
 633 =item Arguments: C<$coderef>, @coderef_args?
 634
 635 =item Return Value: The return value of $coderef
 636
 637 =back
 638
 639 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
 640 returning its result (if any). Equivalent to calling $schema->storage->txn_do.
 641 See L<DBIx::Class::Storage/"txn_do"> for more information.
 642
 643 This interface is preferred over using the individual methods L</txn_begin>,
 644 L</txn_commit>, and L</txn_rollback> below.
 645
 646 WARNING: If you are connected with C<< AutoCommit => 0 >> the transaction is
 647 considered nested, and you will still need to call L</txn_commit> to write your
 648 changes when appropriate. You will also want to connect with C<< auto_savepoint =>
 649 1 >> to get partial rollback to work, if the storage driver for your database
 650 supports it.
 651
 652 Connecting with C<< AutoCommit => 1 >> is recommended.
 653
 654 =cut
 655
 656 sub txn_do {
 657   my $self = shift;
 658
 659   $self->storage or $self->throw_exception
 660     ('txn_do called on $schema without storage');
 661
 662   $self->storage->txn_do(@_);
 663 }
 664
 665 =head2 txn_scope_guard
 666
 667 Runs C<txn_scope_guard> on the schema's storage. See
 668 L<DBIx::Class::Storage/txn_scope_guard>.
 669
 670 =cut
 671
 672 sub txn_scope_guard {
 673   my $self = shift;
 674
 675   $self->storage or $self->throw_exception
 676     ('txn_scope_guard called on $schema without storage');
 677
 678   $self->storage->txn_scope_guard(@_);
 679 }
 680
 681 =head2 txn_begin
 682
 683 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
 684 calling $schema->storage->txn_begin. See
 685 L<DBIx::Class::Storage/"txn_begin"> for more information.
 686
 687 =cut
 688
 689 sub txn_begin {
 690   my $self = shift;
 691
 692   $self->storage or $self->throw_exception
 693     ('txn_begin called on $schema without storage');
 694
 695   $self->storage->txn_begin;
 696 }
 697
 698 =head2 txn_commit
 699
 700 Commits the current transaction. Equivalent to calling
 701 $schema->storage->txn_commit. See L<DBIx::Class::Storage/"txn_commit">
 702 for more information.
 703
 704 =cut
 705
 706 sub txn_commit {
 707   my $self = shift;
 708
 709   $self->storage or $self->throw_exception
 710     ('txn_commit called on $schema without storage');
 711
 712   $self->storage->txn_commit;
 713 }
 714
 715 =head2 txn_rollback
 716
 717 Rolls back the current transaction. Equivalent to calling
 718 $schema->storage->txn_rollback. See
 719 L<DBIx::Class::Storage/"txn_rollback"> for more information.
 720
 721 =cut
 722
 723 sub txn_rollback {
 724   my $self = shift;
 725
 726   $self->storage or $self->throw_exception
 727     ('txn_rollback called on $schema without storage');
 728
 729   $self->storage->txn_rollback;
 730 }
 731
 732 =head2 storage
 733
 734   my $storage = $schema->storage;
 735
 736 Returns the L<DBIx::Class::Storage> object for this Schema. Grab this
 737 if you want to turn on SQL statement debugging at runtime, or set the
 738 quote character. For the default storage, the documentation can be
 739 found in L<DBIx::Class::Storage::DBI>.
 740
 741 =head2 populate
 742
 743 =over 4
 744
 745 =item Arguments: $source_name, \@data;
 746
 747 =item Return value: \@$objects | nothing
 748
 749 =back
 750
 751 Pass this method a resultsource name, and an arrayref of
 752 arrayrefs. The arrayrefs should contain a list of column names,
 753 followed by one or many sets of matching data for the given columns.
 754
 755 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
 756 to insert the data, as this is a fast method. However, insert_bulk currently
 757 assumes that your datasets all contain the same type of values, using scalar
 758 references in a column in one row, and not in another will probably not work.
 759
 760 Otherwise, each set of data is inserted into the database using
 761 L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
 762 objects is returned.
 763
 764 e.g.
 765
 766   $schema->populate('Artist', [
 767     [ qw/artistid name/ ],
 768     [ 1, 'Popular Band' ],
 769     [ 2, 'Indie Band' ],
 770     ...
 771   ]);
 772
 773 Since wantarray context is basically the same as looping over $rs->create(...)
 774 you won't see any performance benefits and in this case the method is more for
 775 convenience. Void context sends the column information directly to storage
 776 using <DBI>s bulk insert method. So the performance will be much better for
 777 storages that support this method.
 778
 779 Because of this difference in the way void context inserts rows into your
 780 database you need to note how this will effect any loaded components that
 781 override or augment insert.  For example if you are using a component such
 782 as L<DBIx::Class::UUIDColumns> to populate your primary keys you MUST use
 783 wantarray context if you want the PKs automatically created.
 784
 785 =cut
 786
 787 sub populate {
 788   my ($self, $name, $data) = @_;
 789   if(my $rs = $self->resultset($name)) {
 790     if(defined wantarray) {
 791         return $rs->populate($data);
 792     } else {
 793         $rs->populate($data);
 794     }
 795   } else {
 796       $self->throw_exception("$name is not a resultset");
 797   }
 798 }
 799
 800 =head2 connection
 801
 802 =over 4
 803
 804 =item Arguments: @args
 805
 806 =item Return Value: $new_schema
 807
 808 =back
 809
 810 Similar to L</connect> except sets the storage object and connection
 811 data in-place on the Schema class. You should probably be calling
 812 L</connect> to get a proper Schema object instead.
 813
 814 =head3 Overloading
 815
 816 Overload C<connection> to change the behaviour of C<connect>.
 817
 818 =cut
 819
 820 sub connection {
 821   my ($self, @info) = @_;
 822   return $self if !@info && $self->storage;
 823
 824   my ($storage_class, $args) = ref $self->storage_type ?
 825     ($self->_normalize_storage_type($self->storage_type),{}) : ($self->storage_type, {});
 826
 827   $storage_class = 'DBIx::Class::Storage'.$storage_class
 828     if $storage_class =~ m/^::/;
 829   try {
 830     $self->ensure_class_loaded ($storage_class);
 831   }
 832   catch {
 833     $self->throw_exception(
 834       "No arguments to load_classes and couldn't load ${storage_class} ($_)"
 835     );
 836   };
 837   my $storage = $storage_class->new($self=>$args);
 838   $storage->connect_info(\@info);
 839   $self->storage($storage);
 840   return $self;
 841 }
 842
 843 sub _normalize_storage_type {
 844   my ($self, $storage_type) = @_;
 845   if(ref $storage_type eq 'ARRAY') {
 846     return @$storage_type;
 847   } elsif(ref $storage_type eq 'HASH') {
 848     return %$storage_type;
 849   } else {
 850     $self->throw_exception('Unsupported REFTYPE given: '. ref $storage_type);
 851   }
 852 }
 853
 854 =head2 compose_namespace
 855
 856 =over 4
 857
 858 =item Arguments: $target_namespace, $additional_base_class?
 859
 860 =item Retur Value: $new_schema
 861
 862 =back
 863
 864 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
 865 class in the target namespace (e.g. $target_namespace::CD,
 866 $target_namespace::Artist) that inherits from the corresponding classes
 867 attached to the current schema.
 868
 869 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
 870 new $schema object. If C<$additional_base_class> is given, the new composed
 871 classes will inherit from first the corresponding class from the current
 872 schema then the base class.
 873
 874 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
 875
 876   $schema->compose_namespace('My::DB', 'Base::Class');
 877   print join (', ', @My::DB::CD::ISA) . "\n";
 878   print join (', ', @My::DB::Artist::ISA) ."\n";
 879
 880 will produce the output
 881
 882   My::Schema::CD, Base::Class
 883   My::Schema::Artist, Base::Class
 884
 885 =cut
 886
 887 # this might be oversimplified
 888 # sub compose_namespace {
 889 #   my ($self, $target, $base) = @_;
 890
 891 #   my $schema = $self->clone;
 892 #   foreach my $moniker ($schema->sources) {
 893 #     my $source = $schema->source($moniker);
 894 #     my $target_class = "${target}::${moniker}";
 895 #     $self->inject_base(
 896 #       $target_class => $source->result_class, ($base ? $base : ())
 897 #     );
 898 #     $source->result_class($target_class);
 899 #     $target_class->result_source_instance($source)
 900 #       if $target_class->can('result_source_instance');
 901 #     $schema->register_source($moniker, $source);
 902 #   }
 903 #   return $schema;
 904 # }
 905
 906 sub compose_namespace {
 907   my ($self, $target, $base) = @_;
 908   my $schema = $self->clone;
 909   {
 910     no warnings qw/redefine/;
 911     local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO;
 912     use warnings qw/redefine/;
 913
 914     no strict qw/refs/;
 915     foreach my $moniker ($schema->sources) {
 916       my $source = $schema->source($moniker);
 917       my $target_class = "${target}::${moniker}";
 918       $self->inject_base(
 919         $target_class => $source->result_class, ($base ? $base : ())
 920       );
 921       $source->result_class($target_class);
 922       if ($target_class->can('result_source_instance')) {
 923
 924         # since the newly created classes are registered only with
 925         # the instance of $schema, it should be safe to weaken
 926         # the ref (it will GC when $schema is destroyed)
 927         $target_class->result_source_instance($source);
 928         weaken ${"${target_class}::__cag_result_source_instance"};
 929       }
 930      $schema->register_source($moniker, $source);
 931     }
 932   }
 933   Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
 934   {
 935     no strict 'refs';
 936     no warnings 'redefine';
 937     foreach my $meth (qw/class source resultset/) {
 938       *{"${target}::${meth}"} = subname "${target}::${meth}" =>
 939         sub { shift->schema->$meth(@_) };
 940     }
 941   }
 942   return $schema;
 943 }
 944
 945 sub setup_connection_class {
 946   my ($class, $target, @info) = @_;
 947   $class->inject_base($target => 'DBIx::Class::DB');
 948   #$target->load_components('DB');
 949   $target->connection(@info);
 950 }
 951
 952 =head2 svp_begin
 953
 954 Creates a new savepoint (does nothing outside a transaction).
 955 Equivalent to calling $schema->storage->svp_begin.  See
 956 L<DBIx::Class::Storage/"svp_begin"> for more information.
 957
 958 =cut
 959
 960 sub svp_begin {
 961   my ($self, $name) = @_;
 962
 963   $self->storage or $self->throw_exception
 964     ('svp_begin called on $schema without storage');
 965
 966   $self->storage->svp_begin($name);
 967 }
 968
 969 =head2 svp_release
 970
 971 Releases a savepoint (does nothing outside a transaction).
 972 Equivalent to calling $schema->storage->svp_release.  See
 973 L<DBIx::Class::Storage/"svp_release"> for more information.
 974
 975 =cut
 976
 977 sub svp_release {
 978   my ($self, $name) = @_;
 979
 980   $self->storage or $self->throw_exception
 981     ('svp_release called on $schema without storage');
 982
 983   $self->storage->svp_release($name);
 984 }
 985
 986 =head2 svp_rollback
 987
 988 Rollback to a savepoint (does nothing outside a transaction).
 989 Equivalent to calling $schema->storage->svp_rollback.  See
 990 L<DBIx::Class::Storage/"svp_rollback"> for more information.
 991
 992 =cut
 993
 994 sub svp_rollback {
 995   my ($self, $name) = @_;
 996
 997   $self->storage or $self->throw_exception
 998     ('svp_rollback called on $schema without storage');
 999
1000   $self->storage->svp_rollback($name);
1001 }
1002
1003 =head2 clone
1004
1005 =over 4
1006
1007 =item Arguments: %attrs?
1008
1009 =item Return Value: $new_schema
1010
1011 =back
1012
1013 Clones the schema and its associated result_source objects and returns the
1014 copy. The resulting copy will have the same attributes as the source schema,
1015 except for those attributes explicitly overriden by the provided C<%attrs>.
1016
1017 =cut
1018
1019 sub clone {
1020   my $self = shift;
1021
1022   my $clone = {
1023       (ref $self ? %$self : ()),
1024       (@_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_),
1025   };
1026   bless $clone, (ref $self || $self);
1027
1028   $clone->class_mappings({ %{$clone->class_mappings} });
1029   $clone->source_registrations({ %{$clone->source_registrations} });
1030   foreach my $moniker ($self->sources) {
1031     my $source = $self->source($moniker);
1032     my $new = $source->new($source);
1033     # we use extra here as we want to leave the class_mappings as they are
1034     # but overwrite the source_registrations entry with the new source
1035     $clone->register_extra_source($moniker => $new);
1036   }
1037   $clone->storage->set_schema($clone) if $clone->storage;
1038   return $clone;
1039 }
1040
1041 =head2 throw_exception
1042
1043 =over 4
1044
1045 =item Arguments: $message
1046
1047 =back
1048
1049 Throws an exception. Obeys the exemption rules of L<DBIx::Class::Carp> to report
1050 errors from outer-user's perspective. See L</exception_action> for details on overriding
1051 this method's behavior.  If L</stacktrace> is turned on, C<throw_exception>'s
1052 default behavior will provide a detailed stack trace.
1053
1054 =cut
1055
1056 my $false_exception_action_warned;
1057 sub throw_exception {
1058   my $self = shift;
1059
1060   if (my $act = $self->exception_action) {
1061     if ($act->(@_)) {
1062       DBIx::Class::Exception->throw(
1063           "Invocation of the exception_action handler installed on $self did *not*"
1064         .' result in an exception. DBIx::Class is unable to function without a reliable'
1065         .' exception mechanism, ensure that exception_action does not hide exceptions'
1066         ." (original error: $_[0])"
1067       );
1068     }
1069     elsif(! $false_exception_action_warned++) {
1070       carp (
1071           "The exception_action handler installed on $self returned false instead"
1072         .' of throwing an exception. This behavior has been deprecated, adjust your'
1073         .' handler to always rethrow the supplied error.'
1074       );
1075     }
1076   }
1077
1078   DBIx::Class::Exception->throw($_[0], $self->stacktrace);
1079 }
1080
1081 =head2 deploy
1082
1083 =over 4
1084
1085 =item Arguments: \%sqlt_args, $dir
1086
1087 =back
1088
1089 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
1090
1091 See L<SQL::Translator/METHODS> for a list of values for C<\%sqlt_args>.
1092 The most common value for this would be C<< { add_drop_table => 1 } >>
1093 to have the SQL produced include a C<DROP TABLE> statement for each table
1094 created. For quoting purposes supply C<quote_table_names> and
1095 C<quote_field_names>.
1096
1097 Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
1098 ref or an array ref, containing a list of source to deploy. If present, then
1099 only the sources listed will get deployed. Furthermore, you can use the
1100 C<add_fk_index> parser parameter to prevent the parser from creating an index for each
1101 FK.
1102
1103 =cut
1104
1105 sub deploy {
1106   my ($self, $sqltargs, $dir) = @_;
1107   $self->throw_exception("Can't deploy without storage") unless $self->storage;
1108   $self->storage->deploy($self, undef, $sqltargs, $dir);
1109 }
1110
1111 =head2 deployment_statements
1112
1113 =over 4
1114
1115 =item Arguments: See L<DBIx::Class::Storage::DBI/deployment_statements>
1116
1117 =item Return value: $listofstatements
1118
1119 =back
1120
1121 A convenient shortcut to
1122 C<< $self->storage->deployment_statements($self, @args) >>.
1123 Returns the SQL statements used by L</deploy> and
1124 L<DBIx::Class::Schema::Storage/deploy>.
1125
1126 =cut
1127
1128 sub deployment_statements {
1129   my $self = shift;
1130
1131   $self->throw_exception("Can't generate deployment statements without a storage")
1132     if not $self->storage;
1133
1134   $self->storage->deployment_statements($self, @_);
1135 }
1136
1137 =head2 create_ddl_dir
1138
1139 =over 4
1140
1141 =item Arguments: See L<DBIx::Class::Storage::DBI/create_ddl_dir>
1142
1143 =back
1144
1145 A convenient shortcut to
1146 C<< $self->storage->create_ddl_dir($self, @args) >>.
1147
1148 Creates an SQL file based on the Schema, for each of the specified
1149 database types, in the given directory.
1150
1151 =cut
1152
1153 sub create_ddl_dir {
1154   my $self = shift;
1155
1156   $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1157   $self->storage->create_ddl_dir($self, @_);
1158 }
1159
1160 =head2 ddl_filename
1161
1162 =over 4
1163
1164 =item Arguments: $database-type, $version, $directory, $preversion
1165
1166 =item Return value: $normalised_filename
1167
1168 =back
1169
1170   my $filename = $table->ddl_filename($type, $version, $dir, $preversion)
1171
1172 This method is called by C<create_ddl_dir> to compose a file name out of
1173 the supplied directory, database type and version number. The default file
1174 name format is: C<$dir$schema-$version-$type.sql>.
1175
1176 You may override this method in your schema if you wish to use a different
1177 format.
1178
1179  WARNING
1180
1181  Prior to DBIx::Class version 0.08100 this method had a different signature:
1182
1183     my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1184
1185  In recent versions variables $dir and $version were reversed in order to
1186  bring the signature in line with other Schema/Storage methods. If you
1187  really need to maintain backward compatibility, you can do the following
1188  in any overriding methods:
1189
1190     ($dir, $version) = ($version, $dir) if ($DBIx::Class::VERSION < 0.08100);
1191
1192 =cut
1193
1194 sub ddl_filename {
1195   my ($self, $type, $version, $dir, $preversion) = @_;
1196
1197   require File::Spec;
1198
1199   my $filename = ref($self);
1200   $filename =~ s/::/-/g;
1201   $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
1202   $filename =~ s/$version/$preversion-$version/ if($preversion);
1203
1204   return $filename;
1205 }
1206
1207 =head2 thaw
1208
1209 Provided as the recommended way of thawing schema objects. You can call
1210 C<Storable::thaw> directly if you wish, but the thawed objects will not have a
1211 reference to any schema, so are rather useless.
1212
1213 =cut
1214
1215 sub thaw {
1216   my ($self, $obj) = @_;
1217   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1218   require Storable;
1219   return Storable::thaw($obj);
1220 }
1221
1222 =head2 freeze
1223
1224 This doesn't actually do anything more than call L<Storable/nfreeze>, it is just
1225 provided here for symmetry.
1226
1227 =cut
1228
1229 sub freeze {
1230   require Storable;
1231   return Storable::nfreeze($_[1]);
1232 }
1233
1234 =head2 dclone
1235
1236 =over 4
1237
1238 =item Arguments: $object
1239
1240 =item Return Value: dcloned $object
1241
1242 =back
1243
1244 Recommended way of dcloning L<DBIx::Class::Row> and L<DBIx::Class::ResultSet>
1245 objects so their references to the schema object
1246 (which itself is B<not> cloned) are properly maintained.
1247
1248 =cut
1249
1250 sub dclone {
1251   my ($self, $obj) = @_;
1252   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1253   require Storable;
1254   return Storable::dclone($obj);
1255 }
1256
1257 =head2 schema_version
1258
1259 Returns the current schema class' $VERSION in a normalised way.
1260
1261 =cut
1262
1263 sub schema_version {
1264   my ($self) = @_;
1265   my $class = ref($self)||$self;
1266
1267   # does -not- use $schema->VERSION
1268   # since that varies in results depending on if version.pm is installed, and if
1269   # so the perl or XS versions. If you want this to change, bug the version.pm
1270   # author to make vpp and vxs behave the same.
1271
1272   my $version;
1273   {
1274     no strict 'refs';
1275     $version = ${"${class}::VERSION"};
1276   }
1277   return $version;
1278 }
1279
1280
1281 =head2 register_class
1282
1283 =over 4
1284
1285 =item Arguments: $moniker, $component_class
1286
1287 =back
1288
1289 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.
1290
1291 You will only need this method if you have your Result classes in
1292 files which are not named after the packages (or all in the same
1293 file). You may also need it to register classes at runtime.
1294
1295 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
1296 calling:
1297
1298   $schema->register_source($moniker, $component_class->result_source_instance);
1299
1300 =cut
1301
1302 sub register_class {
1303   my ($self, $moniker, $to_register) = @_;
1304   $self->register_source($moniker => $to_register->result_source_instance);
1305 }
1306
1307 =head2 register_source
1308
1309 =over 4
1310
1311 =item Arguments: $moniker, $result_source
1312
1313 =back
1314
1315 This method is called by L</register_class>.
1316
1317 Registers the L<DBIx::Class::ResultSource> in the schema with the given
1318 moniker.
1319
1320 =cut
1321
1322 sub register_source {
1323   my $self = shift;
1324
1325   $self->_register_source(@_);
1326 }
1327
1328 =head2 unregister_source
1329
1330 =over 4
1331
1332 =item Arguments: $moniker
1333
1334 =back
1335
1336 Removes the L<DBIx::Class::ResultSource> from the schema for the given moniker.
1337
1338 =cut
1339
1340 sub unregister_source {
1341   my $self = shift;
1342
1343   $self->_unregister_source(@_);
1344 }
1345
1346 =head2 register_extra_source
1347
1348 =over 4
1349
1350 =item Arguments: $moniker, $result_source
1351
1352 =back
1353
1354 As L</register_source> but should be used if the result class already
1355 has a source and you want to register an extra one.
1356
1357 =cut
1358
1359 sub register_extra_source {
1360   my $self = shift;
1361
1362   $self->_register_source(@_, { extra => 1 });
1363 }
1364
1365 sub _register_source {
1366   my ($self, $moniker, $source, $params) = @_;
1367
1368   my $orig_source = $source;
1369
1370   $source = $source->new({ %$source, source_name => $moniker });
1371   $source->schema($self);
1372   weaken $source->{schema} if ref($self);
1373
1374   my $rs_class = $source->result_class;
1375
1376   my %reg = %{$self->source_registrations};
1377   $reg{$moniker} = $source;
1378   $self->source_registrations(\%reg);
1379
1380   return if ($params->{extra});
1381   return unless defined($rs_class) && $rs_class->can('result_source_instance');
1382
1383   my %map = %{$self->class_mappings};
1384   if (
1385     exists $map{$rs_class}
1386       and
1387     $map{$rs_class} ne $moniker
1388       and
1389     $rs_class->result_source_instance ne $orig_source
1390   ) {
1391     carp "$rs_class already has a source, use register_extra_source for additional sources";
1392   }
1393   $map{$rs_class} = $moniker;
1394   $self->class_mappings(\%map);
1395 }
1396
1397 {
1398   my $global_phase_destroy;
1399
1400   # SpeedyCGI runs END blocks every cycle but keeps object instances
1401   # hence we have to disable the globaldestroy hatch, and rely on the
1402   # eval trap below (which appears to work, but is risky done so late)
1403   END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy }
1404
1405   sub DESTROY {
1406     return if $global_phase_destroy;
1407
1408     my $self = shift;
1409     my $srcs = $self->source_registrations;
1410
1411     for my $moniker (keys %$srcs) {
1412       # find first source that is not about to be GCed (someone other than $self
1413       # holds a reference to it) and reattach to it, weakening our own link
1414       #
1415       # during global destruction (if we have not yet bailed out) this will throw
1416       # which will serve as a signal to not try doing anything else
1417       if (ref $srcs->{$moniker} and svref_2object($srcs->{$moniker})->REFCNT > 1) {
1418         local $@;
1419         eval {
1420           $srcs->{$moniker}->schema($self);
1421           1;
1422         } or do {
1423           $global_phase_destroy = 1;
1424           last;
1425         };
1426
1427         weaken $srcs->{$moniker};
1428         last;
1429       }
1430     }
1431   }
1432 }
1433
1434 sub _unregister_source {
1435     my ($self, $moniker) = @_;
1436     my %reg = %{$self->source_registrations};
1437
1438     my $source = delete $reg{$moniker};
1439     $self->source_registrations(\%reg);
1440     if ($source->result_class) {
1441         my %map = %{$self->class_mappings};
1442         delete $map{$source->result_class};
1443         $self->class_mappings(\%map);
1444     }
1445 }
1446
1447
1448 =head2 compose_connection (DEPRECATED)
1449
1450 =over 4
1451
1452 =item Arguments: $target_namespace, @db_info
1453
1454 =item Return Value: $new_schema
1455
1456 =back
1457
1458 DEPRECATED. You probably wanted compose_namespace.
1459
1460 Actually, you probably just wanted to call connect.
1461
1462 =begin hidden
1463
1464 (hidden due to deprecation)
1465
1466 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
1467 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
1468 then injects the L<DBix::Class::ResultSetProxy> component and a
1469 resultset_instance classdata entry on all the new classes, in order to support
1470 $target_namespaces::$class->search(...) method calls.
1471
1472 This is primarily useful when you have a specific need for class method access
1473 to a connection. In normal usage it is preferred to call
1474 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
1475 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
1476 more information.
1477
1478 =end hidden
1479
1480 =cut
1481
1482 sub compose_connection {
1483   my ($self, $target, @info) = @_;
1484
1485   carp_once "compose_connection deprecated as of 0.08000"
1486     unless $INC{"DBIx/Class/CDBICompat.pm"};
1487
1488   my $base = 'DBIx::Class::ResultSetProxy';
1489   try {
1490     eval "require ${base};"
1491   }
1492   catch {
1493     $self->throw_exception
1494       ("No arguments to load_classes and couldn't load ${base} ($_)")
1495   };
1496
1497   if ($self eq $target) {
1498     # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
1499     foreach my $moniker ($self->sources) {
1500       my $source = $self->source($moniker);
1501       my $class = $source->result_class;
1502       $self->inject_base($class, $base);
1503       $class->mk_classdata(resultset_instance => $source->resultset);
1504       $class->mk_classdata(class_resolver => $self);
1505     }
1506     $self->connection(@info);
1507     return $self;
1508   }
1509
1510   my $schema = $self->compose_namespace($target, $base);
1511   {
1512     no strict 'refs';
1513     my $name = join '::', $target, 'schema';
1514     *$name = subname $name, sub { $schema };
1515   }
1516
1517   $schema->connection(@info);
1518   foreach my $moniker ($schema->sources) {
1519     my $source = $schema->source($moniker);
1520     my $class = $source->result_class;
1521     #warn "$moniker $class $source ".$source->storage;
1522     $class->mk_classdata(result_source_instance => $source);
1523     $class->mk_classdata(resultset_instance => $source->resultset);
1524     $class->mk_classdata(class_resolver => $schema);
1525   }
1526   return $schema;
1527 }
1528
1529 1;
1530
1531 =head1 AUTHORS
1532
1533 Matt S. Trout <mst@shadowcatsystems.co.uk>
1534
1535 =head1 LICENSE
1536
1537 You may distribute this code under the same terms as Perl itself.
1538
1539 =cut