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