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