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