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