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