lib/DBIx/Class/Schema.pm

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