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 Carp::Clan qw/^DBIx::Class/;
   8 use Try::Tiny;
   9 use Scalar::Util 'weaken';
  10 use File::Spec;
  11 use Sub::Name 'subname';
  12 use Module::Find();
  13 use Storable();
  14 use namespace::clean;
  15
  16 use base qw/DBIx::Class/;
  17
  18 __PACKAGE__->mk_classdata('class_mappings' => {});
  19 __PACKAGE__->mk_classdata('source_registrations' => {});
  20 __PACKAGE__->mk_classdata('storage_type' => '::DBI');
  21 __PACKAGE__->mk_classdata('storage');
  22 __PACKAGE__->mk_classdata('exception_action');
  23 __PACKAGE__->mk_classdata('stacktrace' => $ENV{DBIC_TRACE} || 0);
  24 __PACKAGE__->mk_classdata('default_resultset_attributes' => {});
  25
  26 =head1 NAME
  27
  28 DBIx::Class::Schema - composable schemas
  29
  30 =head1 SYNOPSIS
  31
  32   package Library::Schema;
  33   use base qw/DBIx::Class::Schema/;
  34
  35   # load all Result classes in Library/Schema/Result/
  36   __PACKAGE__->load_namespaces();
  37
  38   package Library::Schema::Result::CD;
  39   use base qw/DBIx::Class::Core/;
  40
  41   __PACKAGE__->load_components(qw/InflateColumn::DateTime/); # for example
  42   __PACKAGE__->table('cd');
  43
  44   # Elsewhere in your code:
  45   my $schema1 = Library::Schema->connect(
  46     $dsn,
  47     $user,
  48     $password,
  49     { AutoCommit => 1 },
  50   );
  51
  52   my $schema2 = Library::Schema->connect($coderef_returning_dbh);
  53
  54   # fetch objects using Library::Schema::Result::DVD
  55   my $resultset = $schema1->resultset('DVD')->search( ... );
  56   my @dvd_objects = $schema2->resultset('DVD')->search( ... );
  57
  58 =head1 DESCRIPTION
  59
  60 Creates database classes based on a schema. This is the recommended way to
  61 use L<DBIx::Class> and allows you to use more than one concurrent connection
  62 with your classes.
  63
  64 NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
  65 carefully, as DBIx::Class does things a little differently. Note in
  66 particular which module inherits off which.
  67
  68 =head1 SETUP METHODS
  69
  70 =head2 load_namespaces
  71
  72 =over 4
  73
  74 =item Arguments: %options?
  75
  76 =back
  77
  78   __PACKAGE__->load_namespaces();
  79
  80   __PACKAGE__->load_namespaces(
  81    result_namespace => 'Res',
  82    resultset_namespace => 'RSet',
  83    default_resultset_class => '+MyDB::Othernamespace::RSet',
  84  );
  85
  86 With no arguments, this method uses L<Module::Find> to load all your
  87 Result classes from a sub-namespace F<Result> under your Schema class'
  88 namespace, i.e. with a Schema of I<MyDB::Schema> all files in
  89 I<MyDB::Schema::Result> are assumed to be Result classes.
  90
  91 It also finds all ResultSet classes in the namespace F<ResultSet> and
  92 loads them into the appropriate Result classes using for you. The
  93 matching is done by assuming the package name of the ResultSet class
  94 is the same as that of the Result class.
  95
  96 You will be warned if ResultSet classes are discovered for which there
  97 are no matching Result classes like this:
  98
  99   load_namespaces found ResultSet class $classname with no corresponding Result class
 100
 101 If a Result class is found to already have a ResultSet class set using
 102 L</resultset_class> to some other class, you will be warned like this:
 103
 104   We found ResultSet class '$rs_class' for '$result', but it seems
 105   that you had already set '$result' to use '$rs_set' instead
 106
 107 Both of the sub-namespaces are configurable if you don't like the defaults,
 108 via the options C<result_namespace> and C<resultset_namespace>.
 109
 110 If (and only if) you specify the option C<default_resultset_class>, any found
 111 Result classes for which we do not find a corresponding
 112 ResultSet class will have their C<resultset_class> set to
 113 C<default_resultset_class>.
 114
 115 All of the namespace and classname options to this method are relative to
 116 the schema classname by default.  To specify a fully-qualified name, prefix
 117 it with a literal C<+>.
 118
 119 Examples:
 120
 121   # load My::Schema::Result::CD, My::Schema::Result::Artist,
 122   #    My::Schema::ResultSet::CD, etc...
 123   My::Schema->load_namespaces;
 124
 125   # Override everything to use ugly names.
 126   # In this example, if there is a My::Schema::Res::Foo, but no matching
 127   #   My::Schema::RSets::Foo, then Foo will have its
 128   #   resultset_class set to My::Schema::RSetBase
 129   My::Schema->load_namespaces(
 130     result_namespace => 'Res',
 131     resultset_namespace => 'RSets',
 132     default_resultset_class => 'RSetBase',
 133   );
 134
 135   # Put things in other namespaces
 136   My::Schema->load_namespaces(
 137     result_namespace => '+Some::Place::Results',
 138     resultset_namespace => '+Another::Place::RSets',
 139   );
 140
 141 If you'd like to use multiple namespaces of each type, simply use an arrayref
 142 of namespaces for that option.  In the case that the same result
 143 (or resultset) class exists in multiple namespaces, the latter entries in
 144 your list of namespaces will override earlier ones.
 145
 146   My::Schema->load_namespaces(
 147     # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo :
 148     result_namespace => [ 'Results_A', 'Results_B', 'Results_C' ],
 149     resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
 150   );
 151
 152 =cut
 153
 154 # Pre-pends our classname to the given relative classname or
 155 #   class namespace, unless there is a '+' prefix, which will
 156 #   be stripped.
 157 sub _expand_relative_name {
 158   my ($class, $name) = @_;
 159   return if !$name;
 160   $name = $class . '::' . $name if ! ($name =~ s/^\+//);
 161   return $name;
 162 }
 163
 164 # Finds all modules in the supplied namespace, or if omitted in the
 165 # namespace of $class. Untaints all findings as they can be assumed
 166 # to be safe
 167 sub _findallmod {
 168   my $proto = shift;
 169   my $ns = shift || ref $proto || $proto;
 170
 171   my @mods = Module::Find::findallmod($ns);
 172
 173   # try to untaint module names. mods where this fails
 174   # are left alone so we don't have to change the old behavior
 175   no locale; # localized \w doesn't untaint expression
 176   return map { $_ =~ m/^( (?:\w+::)* \w+ )$/x ? $1 : $_ } @mods;
 177 }
 178
 179 # returns a hash of $shortname => $fullname for every package
 180 # found in the given namespaces ($shortname is with the $fullname's
 181 # namespace stripped off)
 182 sub _map_namespaces {
 183   my ($class, @namespaces) = @_;
 184
 185   my @results_hash;
 186   foreach my $namespace (@namespaces) {
 187     push(
 188       @results_hash,
 189       map { (substr($_, length "${namespace}::"), $_) }
 190       $class->_findallmod($namespace)
 191     );
 192   }
 193
 194   @results_hash;
 195 }
 196
 197 # returns the result_source_instance for the passed class/object,
 198 # or dies with an informative message (used by load_namespaces)
 199 sub _ns_get_rsrc_instance {
 200   my $class = shift;
 201   my $rs = ref ($_[0]) || $_[0];
 202
 203   if ($rs->can ('result_source_instance') ) {
 204     return $rs->result_source_instance;
 205   }
 206   else {
 207     $class->throw_exception (
 208       "Attempt to load_namespaces() class $rs failed - are you sure this is a real Result Class?"
 209     );
 210   }
 211 }
 212
 213 sub load_namespaces {
 214   my ($class, %args) = @_;
 215
 216   my $result_namespace = delete $args{result_namespace} || 'Result';
 217   my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
 218   my $default_resultset_class = delete $args{default_resultset_class};
 219
 220   $class->throw_exception('load_namespaces: unknown option(s): '
 221     . join(q{,}, map { qq{'$_'} } keys %args))
 222       if scalar keys %args;
 223
 224   $default_resultset_class
 225     = $class->_expand_relative_name($default_resultset_class);
 226
 227   for my $arg ($result_namespace, $resultset_namespace) {
 228     $arg = [ $arg ] if !ref($arg) && $arg;
 229
 230     $class->throw_exception('load_namespaces: namespace arguments must be '
 231       . 'a simple string or an arrayref')
 232         if ref($arg) ne 'ARRAY';
 233
 234     $_ = $class->_expand_relative_name($_) for (@$arg);
 235   }
 236
 237   my %results = $class->_map_namespaces(@$result_namespace);
 238   my %resultsets = $class->_map_namespaces(@$resultset_namespace);
 239
 240   my @to_register;
 241   {
 242     no warnings 'redefine';
 243     local *Class::C3::reinitialize = sub { };
 244     use warnings 'redefine';
 245
 246     # ensure classes are loaded and attached in inheritance order
 247     $class->ensure_class_loaded($_) foreach(values %results);
 248     my %inh_idx;
 249     my @subclass_last = sort {
 250
 251       ($inh_idx{$a} ||=
 252         scalar @{mro::get_linear_isa( $results{$a} )}
 253       )
 254
 255           <=>
 256
 257       ($inh_idx{$b} ||=
 258         scalar @{mro::get_linear_isa( $results{$b} )}
 259       )
 260
 261     } keys(%results);
 262
 263     foreach my $result (@subclass_last) {
 264       my $result_class = $results{$result};
 265
 266       my $rs_class = delete $resultsets{$result};
 267       my $rs_set = $class->_ns_get_rsrc_instance ($result_class)->resultset_class;
 268
 269       if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
 270         if($rs_class && $rs_class ne $rs_set) {
 271           carp "We found ResultSet class '$rs_class' for '$result', but it seems "
 272              . "that you had already set '$result' to use '$rs_set' instead";
 273         }
 274       }
 275       elsif($rs_class ||= $default_resultset_class) {
 276         $class->ensure_class_loaded($rs_class);
 277         if(!$rs_class->isa("DBIx::Class::ResultSet")) {
 278             carp "load_namespaces found ResultSet class $rs_class that does not subclass DBIx::Class::ResultSet";
 279         }
 280
 281         $class->_ns_get_rsrc_instance ($result_class)->resultset_class($rs_class);
 282       }
 283
 284       my $source_name = $class->_ns_get_rsrc_instance ($result_class)->source_name || $result;
 285
 286       push(@to_register, [ $source_name, $result_class ]);
 287     }
 288   }
 289
 290   foreach (sort keys %resultsets) {
 291     carp "load_namespaces found ResultSet class $_ with no "
 292       . 'corresponding Result class';
 293   }
 294
 295   Class::C3->reinitialize;
 296   $class->register_class(@$_) for (@to_register);
 297
 298   return;
 299 }
 300
 301 =head2 load_classes
 302
 303 =over 4
 304
 305 =item Arguments: @classes?, { $namespace => [ @classes ] }+
 306
 307 =back
 308
 309 L</load_classes> is an alternative method to L</load_namespaces>, both of
 310 which serve similar purposes, each with different advantages and disadvantages.
 311 In the general case you should use L</load_namespaces>, unless you need to
 312 be able to specify that only specific classes are loaded at runtime.
 313
 314 With no arguments, this method uses L<Module::Find> to find all classes under
 315 the schema's namespace. Otherwise, this method loads the classes you specify
 316 (using L<use>), and registers them (using L</"register_class">).
 317
 318 It is possible to comment out classes with a leading C<#>, but note that perl
 319 will think it's a mistake (trying to use a comment in a qw list), so you'll
 320 need to add C<no warnings 'qw';> before your load_classes call.
 321
 322 If any classes found do not appear to be Result class files, you will
 323 get the following warning:
 324
 325    Failed to load $comp_class. Can't find source_name method. Is
 326    $comp_class really a full DBIC result class? Fix it, move it elsewhere,
 327    or make your load_classes call more specific.
 328
 329 Example:
 330
 331   My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
 332                               # etc. (anything under the My::Schema namespace)
 333
 334   # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
 335   # not Other::Namespace::LinerNotes nor My::Schema::Track
 336   My::Schema->load_classes(qw/ CD Artist #Track /, {
 337     Other::Namespace => [qw/ Producer #LinerNotes /],
 338   });
 339
 340 =cut
 341
 342 sub load_classes {
 343   my ($class, @params) = @_;
 344
 345   my %comps_for;
 346
 347   if (@params) {
 348     foreach my $param (@params) {
 349       if (ref $param eq 'ARRAY') {
 350         # filter out commented entries
 351         my @modules = grep { $_ !~ /^#/ } @$param;
 352
 353         push (@{$comps_for{$class}}, @modules);
 354       }
 355       elsif (ref $param eq 'HASH') {
 356         # more than one namespace possible
 357         for my $comp ( keys %$param ) {
 358           # filter out commented entries
 359           my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
 360
 361           push (@{$comps_for{$comp}}, @modules);
 362         }
 363       }
 364       else {
 365         # filter out commented entries
 366         push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
 367       }
 368     }
 369   } else {
 370     my @comp = map { substr $_, length "${class}::"  }
 371                  $class->_findallmod;
 372     $comps_for{$class} = \@comp;
 373   }
 374
 375   my @to_register;
 376   {
 377     no warnings qw/redefine/;
 378     local *Class::C3::reinitialize = sub { };
 379     foreach my $prefix (keys %comps_for) {
 380       foreach my $comp (@{$comps_for{$prefix}||[]}) {
 381         my $comp_class = "${prefix}::${comp}";
 382         $class->ensure_class_loaded($comp_class);
 383
 384         my $snsub = $comp_class->can('source_name');
 385         if(! $snsub ) {
 386           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.";
 387           next;
 388         }
 389         $comp = $snsub->($comp_class) || $comp;
 390
 391         push(@to_register, [ $comp, $comp_class ]);
 392       }
 393     }
 394   }
 395   Class::C3->reinitialize;
 396
 397   foreach my $to (@to_register) {
 398     $class->register_class(@$to);
 399     #  if $class->can('result_source_instance');
 400   }
 401 }
 402
 403 =head2 storage_type
 404
 405 =over 4
 406
 407 =item Arguments: $storage_type|{$storage_type, \%args}
 408
 409 =item Return value: $storage_type|{$storage_type, \%args}
 410
 411 =item Default value: DBIx::Class::Storage::DBI
 412
 413 =back
 414
 415 Set the storage class that will be instantiated when L</connect> is called.
 416 If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
 417 assumed by L</connect>.
 418
 419 You want to use this to set subclasses of L<DBIx::Class::Storage::DBI>
 420 in cases where the appropriate subclass is not autodetected.
 421
 422 If your storage type requires instantiation arguments, those are
 423 defined as a second argument in the form of a hashref and the entire
 424 value needs to be wrapped into an arrayref or a hashref.  We support
 425 both types of refs here in order to play nice with your
 426 Config::[class] or your choice. See
 427 L<DBIx::Class::Storage::DBI::Replicated> for an example of this.
 428
 429 =head2 exception_action
 430
 431 =over 4
 432
 433 =item Arguments: $code_reference
 434
 435 =item Return value: $code_reference
 436
 437 =item Default value: None
 438
 439 =back
 440
 441 If C<exception_action> is set for this class/object, L</throw_exception>
 442 will prefer to call this code reference with the exception as an argument,
 443 rather than L<DBIx::Class::Exception/throw>.
 444
 445 Your subroutine should probably just wrap the error in the exception
 446 object/class of your choosing and rethrow.  If, against all sage advice,
 447 you'd like your C<exception_action> to suppress a particular exception
 448 completely, simply have it return true.
 449
 450 Example:
 451
 452    package My::Schema;
 453    use base qw/DBIx::Class::Schema/;
 454    use My::ExceptionClass;
 455    __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
 456    __PACKAGE__->load_classes;
 457
 458    # or:
 459    my $schema_obj = My::Schema->connect( .... );
 460    $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
 461
 462    # suppress all exceptions, like a moron:
 463    $schema_obj->exception_action(sub { 1 });
 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, $moniker) = @_;
 592   my $sreg = $self->source_registrations;
 593   return $sreg->{$moniker} if exists $sreg->{$moniker};
 594
 595   # if we got here, they probably passed a full class name
 596   my $mapped = $self->class_mappings->{$moniker};
 597   $self->throw_exception("Can't find source for ${moniker}")
 598     unless $mapped && exists $sreg->{$mapped};
 599   return $sreg->{$mapped};
 600 }
 601
 602 =head2 class
 603
 604 =over 4
 605
 606 =item Arguments: $source_name
 607
 608 =item Return Value: $classname
 609
 610 =back
 611
 612   my $class = $schema->class('CD');
 613
 614 Retrieves the Result class name for the given source name.
 615
 616 =cut
 617
 618 sub class {
 619   my ($self, $moniker) = @_;
 620   return $self->source($moniker)->result_class;
 621 }
 622
 623 =head2 txn_do
 624
 625 =over 4
 626
 627 =item Arguments: C<$coderef>, @coderef_args?
 628
 629 =item Return Value: The return value of $coderef
 630
 631 =back
 632
 633 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
 634 returning its result (if any). Equivalent to calling $schema->storage->txn_do.
 635 See L<DBIx::Class::Storage/"txn_do"> for more information.
 636
 637 This interface is preferred over using the individual methods L</txn_begin>,
 638 L</txn_commit>, and L</txn_rollback> below.
 639
 640 WARNING: If you are connected with C<< AutoCommit => 0 >> the transaction is
 641 considered nested, and you will still need to call L</txn_commit> to write your
 642 changes when appropriate. You will also want to connect with C<< auto_savepoint =>
 643 1 >> to get partial rollback to work, if the storage driver for your database
 644 supports it.
 645
 646 Connecting with C<< AutoCommit => 1 >> is recommended.
 647
 648 =cut
 649
 650 sub txn_do {
 651   my $self = shift;
 652
 653   $self->storage or $self->throw_exception
 654     ('txn_do called on $schema without storage');
 655
 656   $self->storage->txn_do(@_);
 657 }
 658
 659 =head2 txn_scope_guard
 660
 661 Runs C<txn_scope_guard> on the schema's storage. See
 662 L<DBIx::Class::Storage/txn_scope_guard>.
 663
 664 =cut
 665
 666 sub txn_scope_guard {
 667   my $self = shift;
 668
 669   $self->storage or $self->throw_exception
 670     ('txn_scope_guard called on $schema without storage');
 671
 672   $self->storage->txn_scope_guard(@_);
 673 }
 674
 675 =head2 txn_begin
 676
 677 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
 678 calling $schema->storage->txn_begin. See
 679 L<DBIx::Class::Storage/"txn_begin"> for more information.
 680
 681 =cut
 682
 683 sub txn_begin {
 684   my $self = shift;
 685
 686   $self->storage or $self->throw_exception
 687     ('txn_begin called on $schema without storage');
 688
 689   $self->storage->txn_begin;
 690 }
 691
 692 =head2 txn_commit
 693
 694 Commits the current transaction. Equivalent to calling
 695 $schema->storage->txn_commit. See L<DBIx::Class::Storage/"txn_commit">
 696 for more information.
 697
 698 =cut
 699
 700 sub txn_commit {
 701   my $self = shift;
 702
 703   $self->storage or $self->throw_exception
 704     ('txn_commit called on $schema without storage');
 705
 706   $self->storage->txn_commit;
 707 }
 708
 709 =head2 txn_rollback
 710
 711 Rolls back the current transaction. Equivalent to calling
 712 $schema->storage->txn_rollback. See
 713 L<DBIx::Class::Storage/"txn_rollback"> for more information.
 714
 715 =cut
 716
 717 sub txn_rollback {
 718   my $self = shift;
 719
 720   $self->storage or $self->throw_exception
 721     ('txn_rollback called on $schema without storage');
 722
 723   $self->storage->txn_rollback;
 724 }
 725
 726 =head2 storage
 727
 728   my $storage = $schema->storage;
 729
 730 Returns the L<DBIx::Class::Storage> object for this Schema. Grab this
 731 if you want to turn on SQL statement debugging at runtime, or set the
 732 quote character. For the default storage, the documentation can be
 733 found in L<DBIx::Class::Storage::DBI>.
 734
 735 =head2 populate
 736
 737 =over 4
 738
 739 =item Arguments: $source_name, \@data;
 740
 741 =item Return value: \@$objects | nothing
 742
 743 =back
 744
 745 Pass this method a resultsource name, and an arrayref of
 746 arrayrefs. The arrayrefs should contain a list of column names,
 747 followed by one or many sets of matching data for the given columns.
 748
 749 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
 750 to insert the data, as this is a fast method. However, insert_bulk currently
 751 assumes that your datasets all contain the same type of values, using scalar
 752 references in a column in one row, and not in another will probably not work.
 753
 754 Otherwise, each set of data is inserted into the database using
 755 L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
 756 objects is returned.
 757
 758 e.g.
 759
 760   $schema->populate('Artist', [
 761     [ qw/artistid name/ ],
 762     [ 1, 'Popular Band' ],
 763     [ 2, 'Indie Band' ],
 764     ...
 765   ]);
 766
 767 Since wantarray context is basically the same as looping over $rs->create(...)
 768 you won't see any performance benefits and in this case the method is more for
 769 convenience. Void context sends the column information directly to storage
 770 using <DBI>s bulk insert method. So the performance will be much better for
 771 storages that support this method.
 772
 773 Because of this difference in the way void context inserts rows into your
 774 database you need to note how this will effect any loaded components that
 775 override or augment insert.  For example if you are using a component such
 776 as L<DBIx::Class::UUIDColumns> to populate your primary keys you MUST use
 777 wantarray context if you want the PKs automatically created.
 778
 779 =cut
 780
 781 sub populate {
 782   my ($self, $name, $data) = @_;
 783   if(my $rs = $self->resultset($name)) {
 784     if(defined wantarray) {
 785         return $rs->populate($data);
 786     } else {
 787         $rs->populate($data);
 788     }
 789   } else {
 790       $self->throw_exception("$name is not a resultset");
 791   }
 792 }
 793
 794 =head2 connection
 795
 796 =over 4
 797
 798 =item Arguments: @args
 799
 800 =item Return Value: $new_schema
 801
 802 =back
 803
 804 Similar to L</connect> except sets the storage object and connection
 805 data in-place on the Schema class. You should probably be calling
 806 L</connect> to get a proper Schema object instead.
 807
 808 =head3 Overloading
 809
 810 Overload C<connection> to change the behaviour of C<connect>.
 811
 812 =cut
 813
 814 sub connection {
 815   my ($self, @info) = @_;
 816   return $self if !@info && $self->storage;
 817
 818   my ($storage_class, $args) = ref $self->storage_type ?
 819     ($self->_normalize_storage_type($self->storage_type),{}) : ($self->storage_type, {});
 820
 821   $storage_class = 'DBIx::Class::Storage'.$storage_class
 822     if $storage_class =~ m/^::/;
 823   try {
 824     $self->ensure_class_loaded ($storage_class);
 825   }
 826   catch {
 827     $self->throw_exception(
 828       "No arguments to load_classes and couldn't load ${storage_class} ($_)"
 829     );
 830   };
 831   my $storage = $storage_class->new($self=>$args);
 832   $storage->connect_info(\@info);
 833   $self->storage($storage);
 834   return $self;
 835 }
 836
 837 sub _normalize_storage_type {
 838   my ($self, $storage_type) = @_;
 839   if(ref $storage_type eq 'ARRAY') {
 840     return @$storage_type;
 841   } elsif(ref $storage_type eq 'HASH') {
 842     return %$storage_type;
 843   } else {
 844     $self->throw_exception('Unsupported REFTYPE given: '. ref $storage_type);
 845   }
 846 }
 847
 848 =head2 compose_namespace
 849
 850 =over 4
 851
 852 =item Arguments: $target_namespace, $additional_base_class?
 853
 854 =item Retur Value: $new_schema
 855
 856 =back
 857
 858 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
 859 class in the target namespace (e.g. $target_namespace::CD,
 860 $target_namespace::Artist) that inherits from the corresponding classes
 861 attached to the current schema.
 862
 863 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
 864 new $schema object. If C<$additional_base_class> is given, the new composed
 865 classes will inherit from first the corresponding class from the current
 866 schema then the base class.
 867
 868 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
 869
 870   $schema->compose_namespace('My::DB', 'Base::Class');
 871   print join (', ', @My::DB::CD::ISA) . "\n";
 872   print join (', ', @My::DB::Artist::ISA) ."\n";
 873
 874 will produce the output
 875
 876   My::Schema::CD, Base::Class
 877   My::Schema::Artist, Base::Class
 878
 879 =cut
 880
 881 # this might be oversimplified
 882 # sub compose_namespace {
 883 #   my ($self, $target, $base) = @_;
 884
 885 #   my $schema = $self->clone;
 886 #   foreach my $moniker ($schema->sources) {
 887 #     my $source = $schema->source($moniker);
 888 #     my $target_class = "${target}::${moniker}";
 889 #     $self->inject_base(
 890 #       $target_class => $source->result_class, ($base ? $base : ())
 891 #     );
 892 #     $source->result_class($target_class);
 893 #     $target_class->result_source_instance($source)
 894 #       if $target_class->can('result_source_instance');
 895 #     $schema->register_source($moniker, $source);
 896 #   }
 897 #   return $schema;
 898 # }
 899
 900 sub compose_namespace {
 901   my ($self, $target, $base) = @_;
 902   my $schema = $self->clone;
 903   {
 904     no warnings qw/redefine/;
 905 #    local *Class::C3::reinitialize = sub { };
 906     foreach my $moniker ($schema->sources) {
 907       my $source = $schema->source($moniker);
 908       my $target_class = "${target}::${moniker}";
 909       $self->inject_base(
 910         $target_class => $source->result_class, ($base ? $base : ())
 911       );
 912       $source->result_class($target_class);
 913       $target_class->result_source_instance($source)
 914         if $target_class->can('result_source_instance');
 915      $schema->register_source($moniker, $source);
 916     }
 917   }
 918 #  Class::C3->reinitialize();
 919   {
 920     no strict 'refs';
 921     no warnings 'redefine';
 922     foreach my $meth (qw/class source resultset/) {
 923       *{"${target}::${meth}"} = subname "${target}::${meth}" =>
 924         sub { shift->schema->$meth(@_) };
 925     }
 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 Return Value: $new_schema
 993
 994 =back
 995
 996 Clones the schema and its associated result_source objects and returns the
 997 copy.
 998
 999 =cut
1000
1001 sub clone {
1002   my ($self) = @_;
1003   my $clone = { (ref $self ? %$self : ()) };
1004   bless $clone, (ref $self || $self);
1005
1006   $clone->class_mappings({ %{$clone->class_mappings} });
1007   $clone->source_registrations({ %{$clone->source_registrations} });
1008   foreach my $moniker ($self->sources) {
1009     my $source = $self->source($moniker);
1010     my $new = $source->new($source);
1011     # we use extra here as we want to leave the class_mappings as they are
1012     # but overwrite the source_registrations entry with the new source
1013     $clone->register_extra_source($moniker => $new);
1014   }
1015   $clone->storage->set_schema($clone) if $clone->storage;
1016   return $clone;
1017 }
1018
1019 =head2 throw_exception
1020
1021 =over 4
1022
1023 =item Arguments: $message
1024
1025 =back
1026
1027 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
1028 user's perspective.  See L</exception_action> for details on overriding
1029 this method's behavior.  If L</stacktrace> is turned on, C<throw_exception>'s
1030 default behavior will provide a detailed stack trace.
1031
1032 =cut
1033
1034 sub throw_exception {
1035   my $self = shift;
1036
1037   DBIx::Class::Exception->throw($_[0], $self->stacktrace)
1038     if !$self->exception_action || !$self->exception_action->(@_);
1039 }
1040
1041 =head2 deploy
1042
1043 =over 4
1044
1045 =item Arguments: \%sqlt_args, $dir
1046
1047 =back
1048
1049 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
1050
1051 See L<SQL::Translator/METHODS> for a list of values for C<\%sqlt_args>.
1052 The most common value for this would be C<< { add_drop_table => 1 } >>
1053 to have the SQL produced include a C<DROP TABLE> statement for each table
1054 created. For quoting purposes supply C<quote_table_names> and
1055 C<quote_field_names>.
1056
1057 Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
1058 ref or an array ref, containing a list of source to deploy. If present, then
1059 only the sources listed will get deployed. Furthermore, you can use the
1060 C<add_fk_index> parser parameter to prevent the parser from creating an index for each
1061 FK.
1062
1063 =cut
1064
1065 sub deploy {
1066   my ($self, $sqltargs, $dir) = @_;
1067   $self->throw_exception("Can't deploy without storage") unless $self->storage;
1068   $self->storage->deploy($self, undef, $sqltargs, $dir);
1069 }
1070
1071 =head2 deployment_statements
1072
1073 =over 4
1074
1075 =item Arguments: See L<DBIx::Class::Storage::DBI/deployment_statements>
1076
1077 =item Return value: $listofstatements
1078
1079 =back
1080
1081 A convenient shortcut to
1082 C<< $self->storage->deployment_statements($self, @args) >>.
1083 Returns the SQL statements used by L</deploy> and
1084 L<DBIx::Class::Schema::Storage/deploy>.
1085
1086 =cut
1087
1088 sub deployment_statements {
1089   my $self = shift;
1090
1091   $self->throw_exception("Can't generate deployment statements without a storage")
1092     if not $self->storage;
1093
1094   $self->storage->deployment_statements($self, @_);
1095 }
1096
1097 =head2 create_ddl_dir
1098
1099 =over 4
1100
1101 =item Arguments: See L<DBIx::Class::Storage::DBI/create_ddl_dir>
1102
1103 =back
1104
1105 A convenient shortcut to
1106 C<< $self->storage->create_ddl_dir($self, @args) >>.
1107
1108 Creates an SQL file based on the Schema, for each of the specified
1109 database types, in the given directory.
1110
1111 =cut
1112
1113 sub create_ddl_dir {
1114   my $self = shift;
1115
1116   $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
1117   $self->storage->create_ddl_dir($self, @_);
1118 }
1119
1120 =head2 ddl_filename
1121
1122 =over 4
1123
1124 =item Arguments: $database-type, $version, $directory, $preversion
1125
1126 =item Return value: $normalised_filename
1127
1128 =back
1129
1130   my $filename = $table->ddl_filename($type, $version, $dir, $preversion)
1131
1132 This method is called by C<create_ddl_dir> to compose a file name out of
1133 the supplied directory, database type and version number. The default file
1134 name format is: C<$dir$schema-$version-$type.sql>.
1135
1136 You may override this method in your schema if you wish to use a different
1137 format.
1138
1139  WARNING
1140
1141  Prior to DBIx::Class version 0.08100 this method had a different signature:
1142
1143     my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
1144
1145  In recent versions variables $dir and $version were reversed in order to
1146  bring the signature in line with other Schema/Storage methods. If you
1147  really need to maintain backward compatibility, you can do the following
1148  in any overriding methods:
1149
1150     ($dir, $version) = ($version, $dir) if ($DBIx::Class::VERSION < 0.08100);
1151
1152 =cut
1153
1154 sub ddl_filename {
1155   my ($self, $type, $version, $dir, $preversion) = @_;
1156
1157   my $filename = ref($self);
1158   $filename =~ s/::/-/g;
1159   $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
1160   $filename =~ s/$version/$preversion-$version/ if($preversion);
1161
1162   return $filename;
1163 }
1164
1165 =head2 thaw
1166
1167 Provided as the recommended way of thawing schema objects. You can call
1168 C<Storable::thaw> directly if you wish, but the thawed objects will not have a
1169 reference to any schema, so are rather useless.
1170
1171 =cut
1172
1173 sub thaw {
1174   my ($self, $obj) = @_;
1175   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1176   return Storable::thaw($obj);
1177 }
1178
1179 =head2 freeze
1180
1181 This doesn't actually do anything more than call L<Storable/freeze>, it is just
1182 provided here for symmetry.
1183
1184 =cut
1185
1186 sub freeze {
1187   return Storable::freeze($_[1]);
1188 }
1189
1190 =head2 dclone
1191
1192 =over 4
1193
1194 =item Arguments: $object
1195
1196 =item Return Value: dcloned $object
1197
1198 =back
1199
1200 Recommended way of dcloning L<DBIx::Class::Row> and L<DBIx::Class::ResultSet>
1201 objects so their references to the schema object
1202 (which itself is B<not> cloned) are properly maintained.
1203
1204 =cut
1205
1206 sub dclone {
1207   my ($self, $obj) = @_;
1208   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
1209   return Storable::dclone($obj);
1210 }
1211
1212 =head2 schema_version
1213
1214 Returns the current schema class' $VERSION in a normalised way.
1215
1216 =cut
1217
1218 sub schema_version {
1219   my ($self) = @_;
1220   my $class = ref($self)||$self;
1221
1222   # does -not- use $schema->VERSION
1223   # since that varies in results depending on if version.pm is installed, and if
1224   # so the perl or XS versions. If you want this to change, bug the version.pm
1225   # author to make vpp and vxs behave the same.
1226
1227   my $version;
1228   {
1229     no strict 'refs';
1230     $version = ${"${class}::VERSION"};
1231   }
1232   return $version;
1233 }
1234
1235
1236 =head2 register_class
1237
1238 =over 4
1239
1240 =item Arguments: $moniker, $component_class
1241
1242 =back
1243
1244 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.
1245
1246 You will only need this method if you have your Result classes in
1247 files which are not named after the packages (or all in the same
1248 file). You may also need it to register classes at runtime.
1249
1250 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
1251 calling:
1252
1253   $schema->register_source($moniker, $component_class->result_source_instance);
1254
1255 =cut
1256
1257 sub register_class {
1258   my ($self, $moniker, $to_register) = @_;
1259   $self->register_source($moniker => $to_register->result_source_instance);
1260 }
1261
1262 =head2 register_source
1263
1264 =over 4
1265
1266 =item Arguments: $moniker, $result_source
1267
1268 =back
1269
1270 This method is called by L</register_class>.
1271
1272 Registers the L<DBIx::Class::ResultSource> in the schema with the given
1273 moniker.
1274
1275 =cut
1276
1277 sub register_source {
1278   my $self = shift;
1279
1280   $self->_register_source(@_);
1281 }
1282
1283 =head2 unregister_source
1284
1285 =over 4
1286
1287 =item Arguments: $moniker
1288
1289 =back
1290
1291 Removes the L<DBIx::Class::ResultSource> from the schema for the given moniker.
1292
1293 =cut
1294
1295 sub unregister_source {
1296   my $self = shift;
1297
1298   $self->_unregister_source(@_);
1299 }
1300
1301 =head2 register_extra_source
1302
1303 =over 4
1304
1305 =item Arguments: $moniker, $result_source
1306
1307 =back
1308
1309 As L</register_source> but should be used if the result class already
1310 has a source and you want to register an extra one.
1311
1312 =cut
1313
1314 sub register_extra_source {
1315   my $self = shift;
1316
1317   $self->_register_source(@_, { extra => 1 });
1318 }
1319
1320 sub _register_source {
1321   my ($self, $moniker, $source, $params) = @_;
1322
1323   my $orig_source = $source;
1324
1325   $source = $source->new({ %$source, source_name => $moniker });
1326   $source->schema($self);
1327   weaken $source->{schema} if ref($self);
1328
1329   my $rs_class = $source->result_class;
1330
1331   my %reg = %{$self->source_registrations};
1332   $reg{$moniker} = $source;
1333   $self->source_registrations(\%reg);
1334
1335   return if ($params->{extra});
1336   return unless defined($rs_class) && $rs_class->can('result_source_instance');
1337
1338   my %map = %{$self->class_mappings};
1339   if (
1340     exists $map{$rs_class}
1341       and
1342     $map{$rs_class} ne $moniker
1343       and
1344     $rs_class->result_source_instance ne $orig_source
1345   ) {
1346     carp "$rs_class already has a source, use register_extra_source for additional sources";
1347   }
1348   $map{$rs_class} = $moniker;
1349   $self->class_mappings(\%map);
1350 }
1351
1352 sub _unregister_source {
1353     my ($self, $moniker) = @_;
1354     my %reg = %{$self->source_registrations};
1355
1356     my $source = delete $reg{$moniker};
1357     $self->source_registrations(\%reg);
1358     if ($source->result_class) {
1359         my %map = %{$self->class_mappings};
1360         delete $map{$source->result_class};
1361         $self->class_mappings(\%map);
1362     }
1363 }
1364
1365
1366 =head2 compose_connection (DEPRECATED)
1367
1368 =over 4
1369
1370 =item Arguments: $target_namespace, @db_info
1371
1372 =item Return Value: $new_schema
1373
1374 =back
1375
1376 DEPRECATED. You probably wanted compose_namespace.
1377
1378 Actually, you probably just wanted to call connect.
1379
1380 =begin hidden
1381
1382 (hidden due to deprecation)
1383
1384 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
1385 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
1386 then injects the L<DBix::Class::ResultSetProxy> component and a
1387 resultset_instance classdata entry on all the new classes, in order to support
1388 $target_namespaces::$class->search(...) method calls.
1389
1390 This is primarily useful when you have a specific need for class method access
1391 to a connection. In normal usage it is preferred to call
1392 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
1393 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
1394 more information.
1395
1396 =end hidden
1397
1398 =cut
1399
1400 {
1401   my $warn;
1402
1403   sub compose_connection {
1404     my ($self, $target, @info) = @_;
1405
1406     carp "compose_connection deprecated as of 0.08000"
1407       unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++);
1408
1409     my $base = 'DBIx::Class::ResultSetProxy';
1410     try {
1411       eval "require ${base};"
1412     }
1413     catch {
1414       $self->throw_exception
1415         ("No arguments to load_classes and couldn't load ${base} ($_)")
1416     };
1417
1418     if ($self eq $target) {
1419       # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
1420       foreach my $moniker ($self->sources) {
1421         my $source = $self->source($moniker);
1422         my $class = $source->result_class;
1423         $self->inject_base($class, $base);
1424         $class->mk_classdata(resultset_instance => $source->resultset);
1425         $class->mk_classdata(class_resolver => $self);
1426       }
1427       $self->connection(@info);
1428       return $self;
1429     }
1430
1431     my $schema = $self->compose_namespace($target, $base);
1432     {
1433       no strict 'refs';
1434       my $name = join '::', $target, 'schema';
1435       *$name = subname $name, sub { $schema };
1436     }
1437
1438     $schema->connection(@info);
1439     foreach my $moniker ($schema->sources) {
1440       my $source = $schema->source($moniker);
1441       my $class = $source->result_class;
1442       #warn "$moniker $class $source ".$source->storage;
1443       $class->mk_classdata(result_source_instance => $source);
1444       $class->mk_classdata(resultset_instance => $source->resultset);
1445       $class->mk_classdata(class_resolver => $schema);
1446     }
1447     return $schema;
1448   }
1449 }
1450
1451 1;
1452
1453 =head1 AUTHORS
1454
1455 Matt S. Trout <mst@shadowcatsystems.co.uk>
1456
1457 =head1 LICENSE
1458
1459 You may distribute this code under the same terms as Perl itself.
1460
1461 =cut