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