lib/DBIx/Class/Schema.pm

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