1 package DBIx::Class::Schema;
6 use Carp::Clan qw/^DBIx::Class/;
7 use Scalar::Util qw/weaken/;
10 use base qw/DBIx::Class/;
12 __PACKAGE__->mk_classdata('class_mappings' => {});
13 __PACKAGE__->mk_classdata('source_registrations' => {});
14 __PACKAGE__->mk_classdata('storage_type' => '::DBI');
15 __PACKAGE__->mk_classdata('storage');
16 __PACKAGE__->mk_classdata('exception_action');
20 DBIx::Class::Schema - composable schemas
24 package Library::Schema;
25 use base qw/DBIx::Class::Schema/;
27 # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
28 __PACKAGE__->load_classes(qw/CD Book DVD/);
30 package Library::Schema::CD;
31 use base qw/DBIx::Class/;
32 __PACKAGE__->load_components(qw/PK::Auto Core/); # for example
33 __PACKAGE__->table('cd');
35 # Elsewhere in your code:
36 my $schema1 = Library::Schema->connect(
43 my $schema2 = Library::Schema->connect($coderef_returning_dbh);
45 # fetch objects using Library::Schema::DVD
46 my $resultset = $schema1->resultset('DVD')->search( ... );
47 my @dvd_objects = $schema2->resultset('DVD')->search( ... );
51 Creates database classes based on a schema. This is the recommended way to
52 use L<DBIx::Class> and allows you to use more than one concurrent connection
55 NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
56 carefully, as DBIx::Class does things a little differently. Note in
57 particular which module inherits off which.
65 =item Arguments: $moniker, $component_class
69 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
72 $schema->register_source($moniker, $component_class->result_source_instance);
77 my ($self, $moniker, $to_register) = @_;
78 $self->register_source($moniker => $to_register->result_source_instance);
81 =head2 register_source
85 =item Arguments: $moniker, $result_source
89 Registers the L<DBIx::Class::ResultSource> in the schema with the given
95 my ($self, $moniker, $source) = @_;
96 my %reg = %{$self->source_registrations};
97 $reg{$moniker} = $source;
98 $self->source_registrations(\%reg);
99 $source->schema($self);
100 weaken($source->{schema}) if ref($self);
101 if ($source->result_class) {
102 my %map = %{$self->class_mappings};
103 $map{$source->result_class} = $moniker;
104 $self->class_mappings(\%map);
112 =item Arguments: $moniker
114 =item Return Value: $classname
118 Retrieves the result class name for the given moniker. For example:
120 my $class = $schema->class('CD');
125 my ($self, $moniker) = @_;
126 return $self->source($moniker)->result_class;
133 =item Arguments: $moniker
135 =item Return Value: $result_source
139 my $source = $schema->source('Book');
141 Returns the L<DBIx::Class::ResultSource> object for the registered moniker.
146 my ($self, $moniker) = @_;
147 my $sreg = $self->source_registrations;
148 return $sreg->{$moniker} if exists $sreg->{$moniker};
150 # if we got here, they probably passed a full class name
151 my $mapped = $self->class_mappings->{$moniker};
152 $self->throw_exception("Can't find source for ${moniker}")
153 unless $mapped && exists $sreg->{$mapped};
154 return $sreg->{$mapped};
161 =item Return Value: @source_monikers
165 Returns the source monikers of all source registrations on this schema.
168 my @source_monikers = $schema->sources;
172 sub sources { return keys %{shift->source_registrations}; }
178 =item Arguments: $moniker
180 =item Return Value: $result_set
184 my $rs = $schema->resultset('DVD');
186 Returns the L<DBIx::Class::ResultSet> object for the registered moniker.
191 my ($self, $moniker) = @_;
192 return $self->source($moniker)->resultset;
199 =item Arguments: @classes?, { $namespace => [ @classes ] }+
203 With no arguments, this method uses L<Module::Find> to find all classes under
204 the schema's namespace. Otherwise, this method loads the classes you specify
205 (using L<use>), and registers them (using L</"register_class">).
207 It is possible to comment out classes with a leading C<#>, but note that perl
208 will think it's a mistake (trying to use a comment in a qw list), so you'll
209 need to add C<no warnings 'qw';> before your load_classes call.
213 My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
214 # etc. (anything under the My::Schema namespace)
216 # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
217 # not Other::Namespace::LinerNotes nor My::Schema::Track
218 My::Schema->load_classes(qw/ CD Artist #Track /, {
219 Other::Namespace => [qw/ Producer #LinerNotes /],
225 my ($class, @params) = @_;
230 foreach my $param (@params) {
231 if (ref $param eq 'ARRAY') {
232 # filter out commented entries
233 my @modules = grep { $_ !~ /^#/ } @$param;
235 push (@{$comps_for{$class}}, @modules);
237 elsif (ref $param eq 'HASH') {
238 # more than one namespace possible
239 for my $comp ( keys %$param ) {
240 # filter out commented entries
241 my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
243 push (@{$comps_for{$comp}}, @modules);
247 # filter out commented entries
248 push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
252 my @comp = map { substr $_, length "${class}::" }
253 Module::Find::findallmod($class);
254 $comps_for{$class} = \@comp;
259 no warnings qw/redefine/;
260 local *Class::C3::reinitialize = sub { };
261 foreach my $prefix (keys %comps_for) {
262 foreach my $comp (@{$comps_for{$prefix}||[]}) {
263 my $comp_class = "${prefix}::${comp}";
264 $class->ensure_class_loaded($comp_class);
265 $comp_class->source_name($comp) unless $comp_class->source_name;
267 push(@to_register, [ $comp_class->source_name, $comp_class ]);
271 Class::C3->reinitialize;
273 foreach my $to (@to_register) {
274 $class->register_class(@$to);
275 # if $class->can('result_source_instance');
279 =head2 load_namespaces
283 =item Arguments: %options?
287 This is an alternative to L</load_classes> above which assumes an alternative
288 layout for automatic class loading. It assumes that all source-definition
289 classes to be loaded are underneath a sub-namespace of the schema called
290 "Source", any corresponding ResultSet classes to be underneath a sub-namespace
291 of the schema called "ResultSet", and any corresponing Result classes to be
292 underneath a sub-namespace of the schema called "Result".
294 All of those sub-namespaces are configurable if you don't like the defaults,
295 via the options C<source_namespace>, C<resultset_namespace>, and
296 C<result_namespace>, respectively.
298 If (and only if) you specify the option C<default_resultset_class>, any found
299 source-definition classes that have no manually-created corresponding
300 ResultSet class will have their C<resultset_class> set to
301 C<default_resultset_class>.
303 C<load_namespaces> takes care of calling C<resultset_class> and/or
304 C<result_class> for you where neccessary if you didn't do it for yourself.
306 All of the namespace and classname options to this method are relative to
307 the schema classname by default. To specify a fully-qualified name, prefix
308 it with a literal C<+>.
312 # load My::Schema::Source::CD, My::Schema::Source::Artist,
313 # My::Schema::ResultSet::CD, etc...
314 My::Schema->load_namespaces;
316 # Override everything...
317 My::Schema->load_namespaces(
318 source_namespace => 'Srcs',
319 resultset_namespace => 'RSets',
320 result_namespace => 'Results',
321 default_resultset_class => 'RSetBase',
323 # ... and if there is a My::Schema::Srcs::Foo, but no matching
324 # My::Schema::RSets::Foo, then the Foo source will have its
325 # resultset_class set to My::Schema::RSetBase
327 # Put things in other namespaces
328 My::Schema->load_namespaces(
329 source_namespace => '+Some::Place::Sources',
330 resultset_namespace => '+Another::Place::RSets',
333 If you'd like to use multiple namespaces of each type, simply use an arrayref
334 of namespaces for that option. In the case that the same source-definition
335 (or resultset, or result) class exists in multiple namespaces, the latter
336 entries in your list of namespaces will override earlier ones.
338 My::Schema->load_namespaces(
339 source_namespace => [ 'Sources_C', 'Sources_B', 'Sources_A' ],
340 resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
345 # Pre-pends our classname to the given relative classname or
346 # class namespace, unless there is a '+' prefix, which will
347 # be stripped. Modifies its argument!
348 sub _expand_relative_name {
351 $_[0] = $class . '::' . $_[0] if ! ($_[0] =~ s/^\+//);
354 # returns a hash of $shortname => $fullname for every package
355 # found in the given namespaces ($shortname is with the $fullname's
356 # namespace stripped off)
357 sub _map_namespaces {
358 my ($class, @namespaces) = @_;
361 foreach my $namespace (@namespaces) {
364 map { (substr($_, length "${namespace}::"), $_) }
365 Module::Find::findallmod($namespace)
372 sub load_namespaces {
373 my ($class, %args) = @_;
375 my $source_namespace = delete $args{source_namespace} || 'Source';
376 my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
377 my $result_namespace = delete $args{result_namespace} || 'Result';
378 my $default_resultset_class = delete $args{default_resultset_class};
380 $class->throw_exception('load_namespaces: unknown option(s): '
381 . join(q{,}, map { qq{'$_'} } keys %args))
382 if scalar keys %args;
384 $class->_expand_relative_name($default_resultset_class);
386 for my $arg ($source_namespace, $resultset_namespace, $result_namespace) {
387 $arg = [ $arg ] if !ref($arg) && $arg;
389 $class->throw_exception('load_namespaces: namespace arguments must be '
390 . 'a simple string or an arrayref')
391 if ref($arg) ne 'ARRAY';
393 $class->_expand_relative_name($_) for (@$arg);
396 my %sources = $class->_map_namespaces(@$source_namespace);
397 my %resultsets = $class->_map_namespaces(@$resultset_namespace);
398 my %results = $class->_map_namespaces(@$result_namespace);
402 no warnings 'redefine';
403 local *Class::C3::reinitialize = sub { };
404 use warnings 'redefine';
406 foreach my $source (keys %sources) {
407 my $source_class = $sources{$source};
408 $class->ensure_class_loaded($source_class);
409 $source_class->source_name($source) unless $source_class->source_name;
411 my $rs_class = delete $resultsets{$source};
412 my $rs_set = $source_class->resultset_class;
413 if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
414 if($rs_class && $rs_class ne $rs_set) {
415 warn "We found ResultSet class '$rs_class' for '$source', but it seems "
416 . "that you had already set '$source' to use '$rs_set' instead";
419 elsif($rs_class ||= $default_resultset_class) {
420 $class->ensure_class_loaded($rs_class);
421 $source_class->resultset_class($rs_class);
424 my $r_class = delete $results{$source};
426 my $r_set = $source_class->result_class;
427 if(!$r_set || $r_set eq $sources{$source}) {
428 $class->ensure_class_loaded($r_class);
429 $source_class->result_class($r_class);
431 elsif($r_set ne $r_class) {
432 warn "We found Result class '$r_class' for '$source', but it seems "
433 . "that you had already set '$source' to use '$r_set' instead";
437 push(@to_register, [ $source_class->source_name, $source_class ]);
441 foreach (sort keys %resultsets) {
442 warn "load_namespaces found ResultSet class $_ with no "
443 . 'corresponding source-definition class';
446 foreach (sort keys %results) {
447 warn "load_namespaces found Result class $_ with no "
448 . 'corresponding source-definition class';
451 Class::C3->reinitialize;
452 $class->register_class(@$_) for (@to_register);
457 =head2 compose_connection
461 =item Arguments: $target_namespace, @db_info
463 =item Return Value: $new_schema
467 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
468 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
469 then injects the L<DBix::Class::ResultSetProxy> component and a
470 resultset_instance classdata entry on all the new classes, in order to support
471 $target_namespaces::$class->search(...) method calls.
473 This is primarily useful when you have a specific need for class method access
474 to a connection. In normal usage it is preferred to call
475 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
476 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
481 sub compose_connection {
482 my ($self, $target, @info) = @_;
483 my $base = 'DBIx::Class::ResultSetProxy';
484 eval "require ${base};";
485 $self->throw_exception
486 ("No arguments to load_classes and couldn't load ${base} ($@)")
489 if ($self eq $target) {
490 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
491 foreach my $moniker ($self->sources) {
492 my $source = $self->source($moniker);
493 my $class = $source->result_class;
494 $self->inject_base($class, $base);
495 $class->mk_classdata(resultset_instance => $source->resultset);
496 $class->mk_classdata(class_resolver => $self);
498 $self->connection(@info);
502 my $schema = $self->compose_namespace($target, $base);
505 *{"${target}::schema"} = sub { $schema };
508 $schema->connection(@info);
509 foreach my $moniker ($schema->sources) {
510 my $source = $schema->source($moniker);
511 my $class = $source->result_class;
512 #warn "$moniker $class $source ".$source->storage;
513 $class->mk_classdata(result_source_instance => $source);
514 $class->mk_classdata(resultset_instance => $source->resultset);
515 $class->mk_classdata(class_resolver => $schema);
520 =head2 compose_namespace
524 =item Arguments: $target_namespace, $additional_base_class?
526 =item Return Value: $new_schema
530 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
531 class in the target namespace (e.g. $target_namespace::CD,
532 $target_namespace::Artist) that inherits from the corresponding classes
533 attached to the current schema.
535 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
536 new $schema object. If C<$additional_base_class> is given, the new composed
537 classes will inherit from first the corresponding classe from the current
538 schema then the base class.
540 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
542 $schema->compose_namespace('My::DB', 'Base::Class');
543 print join (', ', @My::DB::CD::ISA) . "\n";
544 print join (', ', @My::DB::Artist::ISA) ."\n";
546 will produce the output
548 My::Schema::CD, Base::Class
549 My::Schema::Artist, Base::Class
553 sub compose_namespace {
554 my ($self, $target, $base) = @_;
555 my %reg = %{ $self->source_registrations };
558 my $schema = $self->clone;
560 no warnings qw/redefine/;
561 local *Class::C3::reinitialize = sub { };
562 foreach my $moniker ($schema->sources) {
563 my $source = $schema->source($moniker);
564 my $target_class = "${target}::${moniker}";
566 $target_class => $source->result_class, ($base ? $base : ())
568 $source->result_class($target_class);
569 $target_class->result_source_instance($source)
570 if $target_class->can('result_source_instance');
573 Class::C3->reinitialize();
576 foreach my $meth (qw/class source resultset/) {
577 *{"${target}::${meth}"} =
578 sub { shift->schema->$meth(@_) };
584 =head2 setup_connection_class
588 =item Arguments: $target, @info
592 Sets up a database connection class to inject between the schema and the
593 subclasses that the schema creates.
597 sub setup_connection_class {
598 my ($class, $target, @info) = @_;
599 $class->inject_base($target => 'DBIx::Class::DB');
600 #$target->load_components('DB');
601 $target->connection(@info);
608 =item Arguments: @args
610 =item Return Value: $new_schema
614 Instantiates a new Storage object of type
615 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
616 $storage->connect_info. Sets the connection in-place on the schema. See
617 L<DBIx::Class::Storage::DBI/"connect_info"> for more information.
622 my ($self, @info) = @_;
623 return $self if !@info && $self->storage;
624 my $storage_class = $self->storage_type;
625 $storage_class = 'DBIx::Class::Storage'.$storage_class
626 if $storage_class =~ m/^::/;
627 eval "require ${storage_class};";
628 $self->throw_exception(
629 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
631 my $storage = $storage_class->new($self);
632 $storage->connect_info(\@info);
633 $self->storage($storage);
641 =item Arguments: @info
643 =item Return Value: $new_schema
647 This is a convenience method. It is equivalent to calling
648 $schema->clone->connection(@info). See L</connection> and L</clone> for more
653 sub connect { shift->clone->connection(@_) }
657 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
658 calling $schema->storage->txn_begin. See
659 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
663 sub txn_begin { shift->storage->txn_begin }
667 Commits the current transaction. Equivalent to calling
668 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
669 for more information.
673 sub txn_commit { shift->storage->txn_commit }
677 Rolls back the current transaction. Equivalent to calling
678 $schema->storage->txn_rollback. See
679 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
683 sub txn_rollback { shift->storage->txn_rollback }
689 =item Arguments: C<$coderef>, @coderef_args?
691 =item Return Value: The return value of $coderef
695 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
696 returning its result (if any). If an exception is caught, a rollback is issued
697 and the exception is rethrown. If the rollback fails, (i.e. throws an
698 exception) an exception is thrown that includes a "Rollback failed" message.
702 my $author_rs = $schema->resultset('Author')->find(1);
703 my @titles = qw/Night Day It/;
706 # If any one of these fails, the entire transaction fails
707 $author_rs->create_related('books', {
709 }) foreach (@titles);
711 return $author->books;
716 $rs = $schema->txn_do($coderef);
719 if ($@) { # Transaction failed
720 die "something terrible has happened!" #
721 if ($@ =~ /Rollback failed/); # Rollback failed
723 deal_with_failed_transaction();
726 In a nested transaction (calling txn_do() from within a txn_do() coderef) only
727 the outermost transaction will issue a L<DBIx::Class::Schema/"txn_commit"> on
728 the Schema's storage, and txn_do() can be called in void, scalar and list
729 context and it will behave as expected.
734 my ($self, $coderef, @args) = @_;
736 $self->storage or $self->throw_exception
737 ('txn_do called on $schema without storage');
738 ref $coderef eq 'CODE' or $self->throw_exception
739 ('$coderef must be a CODE reference');
741 my (@return_values, $return_value);
743 $self->txn_begin; # If this throws an exception, no rollback is needed
745 my $wantarray = wantarray; # Need to save this since the context
746 # inside the eval{} block is independent
747 # of the context that called txn_do()
750 # Need to differentiate between scalar/list context to allow for
751 # returning a list in scalar context to get the size of the list
754 @return_values = $coderef->(@args);
755 } elsif (defined $wantarray) {
757 $return_value = $coderef->(@args);
773 my $rollback_error = $@;
774 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
775 $self->throw_exception($error) # propagate nested rollback
776 if $rollback_error =~ /$exception_class/;
778 $self->throw_exception(
779 "Transaction aborted: $error. Rollback failed: ${rollback_error}"
782 $self->throw_exception($error); # txn failed but rollback succeeded
786 return $wantarray ? @return_values : $return_value;
793 =item Return Value: $new_schema
797 Clones the schema and its associated result_source objects and returns the
804 my $clone = bless({ (ref $self ? %$self : ()) }, ref $self || $self);
805 foreach my $moniker ($self->sources) {
806 my $source = $self->source($moniker);
807 my $new = $source->new($source);
808 $clone->register_source($moniker => $new);
810 $clone->storage->set_schema($clone) if $clone->storage;
818 =item Arguments: $moniker, \@data;
822 Populates the source registered with the given moniker with the supplied data.
823 @data should be a list of listrefs -- the first containing column names, the
824 second matching values.
828 $schema->populate('Artist', [
829 [ qw/artistid name/ ],
830 [ 1, 'Popular Band' ],
838 my ($self, $name, $data) = @_;
839 my $rs = $self->resultset($name);
840 my @names = @{shift(@$data)};
842 foreach my $item (@$data) {
844 @create{@names} = @$item;
845 push(@created, $rs->create(\%create));
850 =head2 exception_action
854 =item Arguments: $code_reference
858 If C<exception_action> is set for this class/object, L</throw_exception>
859 will prefer to call this code reference with the exception as an argument,
860 rather than its normal <croak> action.
862 Your subroutine should probably just wrap the error in the exception
863 object/class of your choosing and rethrow. If, against all sage advice,
864 you'd like your C<exception_action> to suppress a particular exception
865 completely, simply have it return true.
870 use base qw/DBIx::Class::Schema/;
871 use My::ExceptionClass;
872 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
873 __PACKAGE__->load_classes;
876 my $schema_obj = My::Schema->connect( .... );
877 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
879 # suppress all exceptions, like a moron:
880 $schema_obj->exception_action(sub { 1 });
882 =head2 throw_exception
886 =item Arguments: $message
890 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
891 user's perspective. See L</exception_action> for details on overriding
892 this method's behavior.
896 sub throw_exception {
898 croak @_ if !$self->exception_action || !$self->exception_action->(@_);
901 =head2 deploy (EXPERIMENTAL)
905 =item Arguments: $sqlt_args
909 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
911 Note that this feature is currently EXPERIMENTAL and may not work correctly
912 across all databases, or fully handle complex relationships.
914 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
915 common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
916 produced include a DROP TABLE statement for each table created.
921 my ($self, $sqltargs) = @_;
922 $self->throw_exception("Can't deploy without storage") unless $self->storage;
923 $self->storage->deploy($self, undef, $sqltargs);
926 =head2 create_ddl_dir (EXPERIMENTAL)
930 =item Arguments: \@databases, $version, $directory, $sqlt_args
934 Creates an SQL file based on the Schema, for each of the specified
935 database types, in the given directory.
937 Note that this feature is currently EXPERIMENTAL and may not work correctly
938 across all databases, or fully handle complex relationships.
946 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
947 $self->storage->create_ddl_dir($self, @_);
950 =head2 ddl_filename (EXPERIMENTAL)
952 my $filename = $table->ddl_filename($type, $dir, $version)
954 Creates a filename for a SQL file based on the table class name. Not
955 intended for direct end user use.
961 my ($self, $type, $dir, $version) = @_;
963 my $filename = ref($self);
964 $filename =~ s/::/-/;
965 $filename = "$dir$filename-$version-$type.sql";
974 Matt S. Trout <mst@shadowcatsystems.co.uk>
978 You may distribute this code under the same terms as Perl itself.