1 package DBIx::Class::Schema;
6 use Carp::Clan qw/^DBIx::Class/;
7 use Scalar::Util qw/weaken/;
9 use base qw/DBIx::Class/;
11 __PACKAGE__->mk_classdata('class_mappings' => {});
12 __PACKAGE__->mk_classdata('source_registrations' => {});
13 __PACKAGE__->mk_classdata('storage_type' => '::DBI');
14 __PACKAGE__->mk_classdata('storage');
18 DBIx::Class::Schema - composable schemas
22 package Library::Schema;
23 use base qw/DBIx::Class::Schema/;
25 # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
26 __PACKAGE__->load_classes(qw/CD Book DVD/);
28 package Library::Schema::CD;
29 use base qw/DBIx::Class/;
30 __PACKAGE__->load_components(qw/PK::Auto Core/); # for example
31 __PACKAGE__->table('cd');
33 # Elsewhere in your code:
34 my $schema1 = Library::Schema->connect(
41 my $schema2 = Library::Schema->connect($coderef_returning_dbh);
43 # fetch objects using Library::Schema::DVD
44 my $resultset = $schema1->resultset('DVD')->search( ... );
45 my @dvd_objects = $schema2->resultset('DVD')->search( ... );
49 Creates database classes based on a schema. This is the recommended way to
50 use L<DBIx::Class> and allows you to use more than one concurrent connection
53 NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
54 carefully, as DBIx::Class does things a little differently. Note in
55 particular which module inherits off which.
63 =item Arguments: $moniker, $component_class
67 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
70 $schema->register_source($moniker, $component_class->result_source_instance);
75 my ($self, $moniker, $to_register) = @_;
76 $self->register_source($moniker => $to_register->result_source_instance);
79 =head2 register_source
83 =item Arguments: $moniker, $result_source
87 Registers the L<DBIx::Class::ResultSource> in the schema with the given
93 my ($self, $moniker, $source) = @_;
94 my %reg = %{$self->source_registrations};
95 $reg{$moniker} = $source;
96 $self->source_registrations(\%reg);
97 $source->schema($self);
98 weaken($source->{schema}) if ref($self);
99 if ($source->result_class) {
100 my %map = %{$self->class_mappings};
101 $map{$source->result_class} = $moniker;
102 $self->class_mappings(\%map);
110 =item Arguments: $moniker
112 =item Return Value: $classname
116 Retrieves the result class name for the given moniker. For example:
118 my $class = $schema->class('CD');
123 my ($self, $moniker) = @_;
124 return $self->source($moniker)->result_class;
131 =item Arguments: $moniker
133 =item Return Value: $result_source
137 my $source = $schema->source('Book');
139 Returns the L<DBIx::Class::ResultSource> object for the registered moniker.
144 my ($self, $moniker) = @_;
145 my $sreg = $self->source_registrations;
146 return $sreg->{$moniker} if exists $sreg->{$moniker};
148 # if we got here, they probably passed a full class name
149 my $mapped = $self->class_mappings->{$moniker};
150 $self->throw_exception("Can't find source for ${moniker}")
151 unless $mapped && exists $sreg->{$mapped};
152 return $sreg->{$mapped};
159 =item Return Value: @source_monikers
163 Returns the source monikers of all source registrations on this schema.
166 my @source_monikers = $schema->sources;
170 sub sources { return keys %{shift->source_registrations}; }
176 =item Arguments: $moniker
178 =item Return Value: $result_set
182 my $rs = $schema->resultset('DVD');
184 Returns the L<DBIx::Class::ResultSet> object for the registered moniker.
189 my ($self, $moniker) = @_;
190 return $self->source($moniker)->resultset;
197 =item Arguments: @classes?, { $namespace => [ @classes ] }+
201 With no arguments, this method uses L<Module::Find> to find all classes under
202 the schema's namespace. Otherwise, this method loads the classes you specify
203 (using L<use>), and registers them (using L</"register_class">).
205 It is possible to comment out classes with a leading C<#>, but note that perl
206 will think it's a mistake (trying to use a comment in a qw list), so you'll
207 need to add C<no warnings 'qw';> before your load_classes call.
211 My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
212 # etc. (anything under the My::Schema namespace)
214 # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
215 # not Other::Namespace::LinerNotes nor My::Schema::Track
216 My::Schema->load_classes(qw/ CD Artist #Track /, {
217 Other::Namespace => [qw/ Producer #LinerNotes /],
223 my ($class, @params) = @_;
228 foreach my $param (@params) {
229 if (ref $param eq 'ARRAY') {
230 # filter out commented entries
231 my @modules = grep { $_ !~ /^#/ } @$param;
233 push (@{$comps_for{$class}}, @modules);
235 elsif (ref $param eq 'HASH') {
236 # more than one namespace possible
237 for my $comp ( keys %$param ) {
238 # filter out commented entries
239 my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
241 push (@{$comps_for{$comp}}, @modules);
245 # filter out commented entries
246 push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
250 eval "require Module::Find;";
251 $class->throw_exception(
252 "No arguments to load_classes and couldn't load Module::Find ($@)"
254 my @comp = map { substr $_, length "${class}::" }
255 Module::Find::findallmod($class);
256 $comps_for{$class} = \@comp;
261 no warnings qw/redefine/;
262 local *Class::C3::reinitialize = sub { };
263 foreach my $prefix (keys %comps_for) {
264 foreach my $comp (@{$comps_for{$prefix}||[]}) {
265 my $comp_class = "${prefix}::${comp}";
266 $class->ensure_class_loaded($comp_class);
267 $comp_class->source_name($comp) unless $comp_class->source_name;
269 push(@to_register, [ $comp_class->source_name, $comp_class ]);
273 Class::C3->reinitialize;
275 foreach my $to (@to_register) {
276 $class->register_class(@$to);
277 # if $class->can('result_source_instance');
281 =head2 load_namespaces
285 =item Arguments: %options?
289 This is an alternative to L</load_classes> above which assumes an alternative
290 layout for automatic class loading. It assumes that all ResultSource classes
291 to be loaded are underneath a sub-namespace of the schema called
292 "ResultSource", any corresponding ResultSet classes to be underneath a
293 sub-namespace of the schema called "ResultSet", and any corresponing
294 Result classes to be underneath a sub-namespace of the schema called "Result".
296 All of those sub-namespaces are configurable if you don't like the defaults,
297 via the options C<resultsource_namespace>, C<resultset_namespace>, and
298 C<result_namespace>, respectively.
300 If (and only if) you specify the option C<default_resultset_base>, any found
301 ResultSource classes that have no manually-created corresponding ResultSet
302 class will have one created for them in memory in the C<resultset_namespace>,
303 based on C<default_resultset_base>.
305 All of the namespace and classname options to this method are relative to
306 the schema classname by default. To specify a fully-qualified name, prefix
307 it with a literal C<+>.
309 This method requires L<Module::Find> to be installed on the system.
313 # load My::Schema::ResultSource::CD, My::Schema::ResultSource::Artist,
314 # My::Schema::ResultSet::CD, etc...
315 My::Schema->load_namespaces;
317 # Override everything...
318 My::Schema->load_namespaces(
319 resultsource_namespace => 'RSources',
320 resultset_namespace => 'RSets',
321 result_namespace => 'Results',
322 default_resultset_base => 'RSetBase',
324 # ... and if there is a My::Schema::RSources::Foo, but no matching
325 # My::Schema::RSets::Foo, then My::Schema::RSets::Foo will be created
326 # for you in memory, based on My::Schema::RSetBase
328 # Put things in other namespaces
329 My::Schema->load_namespaces(
330 resultsource_namespace => '+Some::Place::RSources',
331 resultset_namespace => '+Another::Place::RSets',
332 result_namespace => '+Crazy::Stuff::Results',
333 default_resultset_base => '+You::Never::Know::RSetBase',
339 sub load_namespaces {
340 my ($class, %args) = @_;
342 my $resultsource_namespace = $args{resultsource_namespace} || 'ResultSource';
343 my $resultset_namespace = $args{resultset_namespace} || 'ResultSet';
344 my $result_namespace = $args{result_namespace} || 'Result';
345 my $default_resultset_base = $args{default_resultset_base};
347 foreach ($resultsource_namespace, $resultset_namespace,
348 $result_namespace, $default_resultset_base) {
350 $_ = $class . '::' . $_ if !s/^\+//;
353 eval "require Module::Find";
354 $class->throw_exception("Couldn't load Module::Find ($@)") if $@;
356 my %sources = map { (substr($_, length "${resultsource_namespace}::"), $_) }
357 Module::Find::findallmod($resultsource_namespace);
359 my %resultsets = map { (substr($_, length "${resultset_namespace}::"), $_) }
360 Module::Find::findallmod($resultset_namespace);
362 my %results = map { (substr($_, length "${result_namespace}::"), $_) }
363 Module::Find::findallmod($result_namespace);
367 no warnings qw/redefine/;
368 local *Class::C3::reinitialize = sub { };
369 use warnings qw/redefine/;
371 foreach my $source (keys %sources) {
372 my $source_class = $sources{$source};
373 $class->ensure_class_loaded($source_class);
374 $source_class->source_name($source) unless $source_class->source_name;
376 my $rs_class = delete $resultsets{$source};
377 my $rs_set = $source_class->resultset_class;
378 if(!$rs_set || $rs_set eq 'DBIx::Class::ResultSet') {
380 $class->ensure_class_loaded($rs_class);
381 $source_class->resultset_class($rs_class);
383 elsif($default_resultset_base) {
384 $class->ensure_class_loaded($default_resultset_base);
385 $rs_class = "$resultset_namespace\::$source";
386 { no strict qw/refs/; @{"$rs_class\::ISA"} = ($default_resultset_base); }
387 $source_class->resultset_class($rs_class);
390 elsif($rs_set && $rs_class) {
391 warn "We found ResultSet class '$rs_class' for '$source', but it seems "
392 . "that you had already set '$source' to use '$rs_set' instead";
395 push(@to_register, [ $source_class->source_name, $source_class ]);
399 foreach (sort keys %resultsets) {
400 warn "load_namespaces found ResultSet class $_ with no "
401 . 'corresponding ResultSource';
404 Class::C3->reinitialize;
405 $class->register_class(@$_) for (@to_register);
407 foreach my $source (keys %sources) {
408 my $r_class = delete $results{$source};
410 my $r_set = $class->source($source)->result_class;
411 if(!$r_set || $r_set eq $sources{$source}) {
412 $class->ensure_class_loaded($r_class);
413 $class->source($source)->result_class($r_class);
416 warn "We found Result class '$r_class' for '$source', but it seems "
417 . "that you had already set '$source' to use '$r_set' instead";
422 foreach (sort keys %results) {
423 warn "load_namespaces found Result class $_ with no "
424 . 'corresponding ResultSource';
430 =head2 compose_connection
434 =item Arguments: $target_namespace, @db_info
436 =item Return Value: $new_schema
440 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
441 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
442 then injects the L<DBix::Class::ResultSetProxy> component and a
443 resultset_instance classdata entry on all the new classes, in order to support
444 $target_namespaces::$class->search(...) method calls.
446 This is primarily useful when you have a specific need for class method access
447 to a connection. In normal usage it is preferred to call
448 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
449 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
454 sub compose_connection {
455 my ($self, $target, @info) = @_;
456 my $base = 'DBIx::Class::ResultSetProxy';
457 eval "require ${base};";
458 $self->throw_exception
459 ("No arguments to load_classes and couldn't load ${base} ($@)")
462 if ($self eq $target) {
463 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
464 foreach my $moniker ($self->sources) {
465 my $source = $self->source($moniker);
466 my $class = $source->result_class;
467 $self->inject_base($class, $base);
468 $class->mk_classdata(resultset_instance => $source->resultset);
469 $class->mk_classdata(class_resolver => $self);
471 $self->connection(@info);
475 my $schema = $self->compose_namespace($target, $base);
478 *{"${target}::schema"} = sub { $schema };
481 $schema->connection(@info);
482 foreach my $moniker ($schema->sources) {
483 my $source = $schema->source($moniker);
484 my $class = $source->result_class;
485 #warn "$moniker $class $source ".$source->storage;
486 $class->mk_classdata(result_source_instance => $source);
487 $class->mk_classdata(resultset_instance => $source->resultset);
488 $class->mk_classdata(class_resolver => $schema);
493 =head2 compose_namespace
497 =item Arguments: $target_namespace, $additional_base_class?
499 =item Return Value: $new_schema
503 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
504 class in the target namespace (e.g. $target_namespace::CD,
505 $target_namespace::Artist) that inherits from the corresponding classes
506 attached to the current schema.
508 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
509 new $schema object. If C<$additional_base_class> is given, the new composed
510 classes will inherit from first the corresponding classe from the current
511 schema then the base class.
513 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
515 $schema->compose_namespace('My::DB', 'Base::Class');
516 print join (', ', @My::DB::CD::ISA) . "\n";
517 print join (', ', @My::DB::Artist::ISA) ."\n";
519 will produce the output
521 My::Schema::CD, Base::Class
522 My::Schema::Artist, Base::Class
526 sub compose_namespace {
527 my ($self, $target, $base) = @_;
528 my %reg = %{ $self->source_registrations };
531 my $schema = $self->clone;
533 no warnings qw/redefine/;
534 local *Class::C3::reinitialize = sub { };
535 foreach my $moniker ($schema->sources) {
536 my $source = $schema->source($moniker);
537 my $target_class = "${target}::${moniker}";
539 $target_class => $source->result_class, ($base ? $base : ())
541 $source->result_class($target_class);
542 $target_class->result_source_instance($source)
543 if $target_class->can('result_source_instance');
546 Class::C3->reinitialize();
549 foreach my $meth (qw/class source resultset/) {
550 *{"${target}::${meth}"} =
551 sub { shift->schema->$meth(@_) };
557 =head2 setup_connection_class
561 =item Arguments: $target, @info
565 Sets up a database connection class to inject between the schema and the
566 subclasses that the schema creates.
570 sub setup_connection_class {
571 my ($class, $target, @info) = @_;
572 $class->inject_base($target => 'DBIx::Class::DB');
573 #$target->load_components('DB');
574 $target->connection(@info);
581 =item Arguments: @args
583 =item Return Value: $new_schema
587 Instantiates a new Storage object of type
588 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
589 $storage->connect_info. Sets the connection in-place on the schema. See
590 L<DBIx::Class::Storage::DBI/"connect_info"> for more information.
595 my ($self, @info) = @_;
596 return $self if !@info && $self->storage;
597 my $storage_class = $self->storage_type;
598 $storage_class = 'DBIx::Class::Storage'.$storage_class
599 if $storage_class =~ m/^::/;
600 eval "require ${storage_class};";
601 $self->throw_exception(
602 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
604 my $storage = $storage_class->new;
605 $storage->connect_info(\@info);
606 $self->storage($storage);
614 =item Arguments: @info
616 =item Return Value: $new_schema
620 This is a convenience method. It is equivalent to calling
621 $schema->clone->connection(@info). See L</connection> and L</clone> for more
626 sub connect { shift->clone->connection(@_) }
630 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
631 calling $schema->storage->txn_begin. See
632 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
636 sub txn_begin { shift->storage->txn_begin }
640 Commits the current transaction. Equivalent to calling
641 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
642 for more information.
646 sub txn_commit { shift->storage->txn_commit }
650 Rolls back the current transaction. Equivalent to calling
651 $schema->storage->txn_rollback. See
652 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
656 sub txn_rollback { shift->storage->txn_rollback }
662 =item Arguments: C<$coderef>, @coderef_args?
664 =item Return Value: The return value of $coderef
668 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
669 returning its result (if any). If an exception is caught, a rollback is issued
670 and the exception is rethrown. If the rollback fails, (i.e. throws an
671 exception) an exception is thrown that includes a "Rollback failed" message.
675 my $author_rs = $schema->resultset('Author')->find(1);
676 my @titles = qw/Night Day It/;
679 # If any one of these fails, the entire transaction fails
680 $author_rs->create_related('books', {
682 }) foreach (@titles);
684 return $author->books;
689 $rs = $schema->txn_do($coderef);
692 if ($@) { # Transaction failed
693 die "something terrible has happened!" #
694 if ($@ =~ /Rollback failed/); # Rollback failed
696 deal_with_failed_transaction();
699 In a nested transaction (calling txn_do() from within a txn_do() coderef) only
700 the outermost transaction will issue a L<DBIx::Class::Schema/"txn_commit"> on
701 the Schema's storage, and txn_do() can be called in void, scalar and list
702 context and it will behave as expected.
707 my ($self, $coderef, @args) = @_;
709 $self->storage or $self->throw_exception
710 ('txn_do called on $schema without storage');
711 ref $coderef eq 'CODE' or $self->throw_exception
712 ('$coderef must be a CODE reference');
714 my (@return_values, $return_value);
716 $self->txn_begin; # If this throws an exception, no rollback is needed
718 my $wantarray = wantarray; # Need to save this since the context
719 # inside the eval{} block is independent
720 # of the context that called txn_do()
723 # Need to differentiate between scalar/list context to allow for
724 # returning a list in scalar context to get the size of the list
727 @return_values = $coderef->(@args);
728 } elsif (defined $wantarray) {
730 $return_value = $coderef->(@args);
746 my $rollback_error = $@;
747 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
748 $self->throw_exception($error) # propagate nested rollback
749 if $rollback_error =~ /$exception_class/;
751 $self->throw_exception(
752 "Transaction aborted: $error. Rollback failed: ${rollback_error}"
755 $self->throw_exception($error); # txn failed but rollback succeeded
759 return $wantarray ? @return_values : $return_value;
766 =item Return Value: $new_schema
770 Clones the schema and its associated result_source objects and returns the
777 my $clone = bless({ (ref $self ? %$self : ()) }, ref $self || $self);
778 foreach my $moniker ($self->sources) {
779 my $source = $self->source($moniker);
780 my $new = $source->new($source);
781 $clone->register_source($moniker => $new);
790 =item Arguments: $moniker, \@data;
794 Populates the source registered with the given moniker with the supplied data.
795 @data should be a list of listrefs -- the first containing column names, the
796 second matching values.
800 $schema->populate('Artist', [
801 [ qw/artistid name/ ],
802 [ 1, 'Popular Band' ],
810 my ($self, $name, $data) = @_;
811 my $rs = $self->resultset($name);
812 my @names = @{shift(@$data)};
814 foreach my $item (@$data) {
816 @create{@names} = @$item;
817 push(@created, $rs->create(\%create));
822 =head2 throw_exception
826 =item Arguments: $message
830 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
835 sub throw_exception {
840 =head2 deploy (EXPERIMENTAL)
844 =item Arguments: $sqlt_args
848 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
850 Note that this feature is currently EXPERIMENTAL and may not work correctly
851 across all databases, or fully handle complex relationships.
853 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
854 common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
855 produced include a DROP TABLE statement for each table created.
860 my ($self, $sqltargs) = @_;
861 $self->throw_exception("Can't deploy without storage") unless $self->storage;
862 $self->storage->deploy($self, undef, $sqltargs);
865 =head2 create_ddl_dir (EXPERIMENTAL)
869 =item Arguments: \@databases, $version, $directory, $sqlt_args
873 Creates an SQL file based on the Schema, for each of the specified
874 database types, in the given directory.
876 Note that this feature is currently EXPERIMENTAL and may not work correctly
877 across all databases, or fully handle complex relationships.
885 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
886 $self->storage->create_ddl_dir($self, @_);
889 =head2 ddl_filename (EXPERIMENTAL)
891 my $filename = $table->ddl_filename($type, $dir, $version)
893 Creates a filename for a SQL file based on the table class name. Not
894 intended for direct end user use.
900 my ($self, $type, $dir, $version) = @_;
902 my $filename = ref($self);
903 $filename =~ s/::/-/;
904 $filename = "$dir$filename-$version-$type.sql";
913 Matt S. Trout <mst@shadowcatsystems.co.uk>
917 You may distribute this code under the same terms as Perl itself.