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