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 are underneath a sub-namespace of the schema called C<Source>, any
290 corresponding ResultSet classes are underneath a sub-namespace of the schema
291 called C<ResultSet>, and any corresponding Result classes are underneath a
292 sub-namespace of the schema called C<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 for which we do not find a 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 # In the above, 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
348 sub _expand_relative_name {
349 my ($class, $name) = @_;
351 $name = $class . '::' . $name if ! ($name =~ s/^\+//);
355 # returns a hash of $shortname => $fullname for every package
356 # found in the given namespaces ($shortname is with the $fullname's
357 # namespace stripped off)
358 sub _map_namespaces {
359 my ($class, @namespaces) = @_;
362 foreach my $namespace (@namespaces) {
365 map { (substr($_, length "${namespace}::"), $_) }
366 Module::Find::findallmod($namespace)
373 sub load_namespaces {
374 my ($class, %args) = @_;
376 my $source_namespace = delete $args{source_namespace} || 'Source';
377 my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
378 my $result_namespace = delete $args{result_namespace} || 'Result';
379 my $default_resultset_class = delete $args{default_resultset_class};
381 $class->throw_exception('load_namespaces: unknown option(s): '
382 . join(q{,}, map { qq{'$_'} } keys %args))
383 if scalar keys %args;
385 $default_resultset_class
386 = $class->_expand_relative_name($default_resultset_class);
388 for my $arg ($source_namespace, $resultset_namespace, $result_namespace) {
389 $arg = [ $arg ] if !ref($arg) && $arg;
391 $class->throw_exception('load_namespaces: namespace arguments must be '
392 . 'a simple string or an arrayref')
393 if ref($arg) ne 'ARRAY';
395 $_ = $class->_expand_relative_name($_) for (@$arg);
398 my %sources = $class->_map_namespaces(@$source_namespace);
399 my %resultsets = $class->_map_namespaces(@$resultset_namespace);
400 my %results = $class->_map_namespaces(@$result_namespace);
404 no warnings 'redefine';
405 local *Class::C3::reinitialize = sub { };
406 use warnings 'redefine';
408 foreach my $source (keys %sources) {
409 my $source_class = $sources{$source};
410 $class->ensure_class_loaded($source_class);
411 $source_class->source_name($source) unless $source_class->source_name;
413 my $rs_class = delete $resultsets{$source};
414 my $rs_set = $source_class->resultset_class;
415 if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
416 if($rs_class && $rs_class ne $rs_set) {
417 warn "We found ResultSet class '$rs_class' for '$source', but it seems "
418 . "that you had already set '$source' to use '$rs_set' instead";
421 elsif($rs_class ||= $default_resultset_class) {
422 $class->ensure_class_loaded($rs_class);
423 $source_class->resultset_class($rs_class);
426 my $r_class = delete $results{$source};
428 my $r_set = $source_class->result_class;
429 if(!$r_set || $r_set eq $sources{$source}) {
430 $class->ensure_class_loaded($r_class);
431 $source_class->result_class($r_class);
433 elsif($r_set ne $r_class) {
434 warn "We found Result class '$r_class' for '$source', but it seems "
435 . "that you had already set '$source' to use '$r_set' instead";
439 push(@to_register, [ $source_class->source_name, $source_class ]);
443 foreach (sort keys %resultsets) {
444 warn "load_namespaces found ResultSet class $_ with no "
445 . 'corresponding source-definition class';
448 foreach (sort keys %results) {
449 warn "load_namespaces found Result class $_ with no "
450 . 'corresponding source-definition class';
453 Class::C3->reinitialize;
454 $class->register_class(@$_) for (@to_register);
459 =head2 compose_connection
463 =item Arguments: $target_namespace, @db_info
465 =item Return Value: $new_schema
469 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
470 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
471 then injects the L<DBix::Class::ResultSetProxy> component and a
472 resultset_instance classdata entry on all the new classes, in order to support
473 $target_namespaces::$class->search(...) method calls.
475 This is primarily useful when you have a specific need for class method access
476 to a connection. In normal usage it is preferred to call
477 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
478 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
483 sub compose_connection {
484 my ($self, $target, @info) = @_;
485 my $base = 'DBIx::Class::ResultSetProxy';
486 eval "require ${base};";
487 $self->throw_exception
488 ("No arguments to load_classes and couldn't load ${base} ($@)")
491 if ($self eq $target) {
492 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
493 foreach my $moniker ($self->sources) {
494 my $source = $self->source($moniker);
495 my $class = $source->result_class;
496 $self->inject_base($class, $base);
497 $class->mk_classdata(resultset_instance => $source->resultset);
498 $class->mk_classdata(class_resolver => $self);
500 $self->connection(@info);
504 my $schema = $self->compose_namespace($target, $base);
507 *{"${target}::schema"} = sub { $schema };
510 $schema->connection(@info);
511 foreach my $moniker ($schema->sources) {
512 my $source = $schema->source($moniker);
513 my $class = $source->result_class;
514 #warn "$moniker $class $source ".$source->storage;
515 $class->mk_classdata(result_source_instance => $source);
516 $class->mk_classdata(resultset_instance => $source->resultset);
517 $class->mk_classdata(class_resolver => $schema);
522 =head2 compose_namespace
526 =item Arguments: $target_namespace, $additional_base_class?
528 =item Return Value: $new_schema
532 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
533 class in the target namespace (e.g. $target_namespace::CD,
534 $target_namespace::Artist) that inherits from the corresponding classes
535 attached to the current schema.
537 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
538 new $schema object. If C<$additional_base_class> is given, the new composed
539 classes will inherit from first the corresponding classe from the current
540 schema then the base class.
542 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
544 $schema->compose_namespace('My::DB', 'Base::Class');
545 print join (', ', @My::DB::CD::ISA) . "\n";
546 print join (', ', @My::DB::Artist::ISA) ."\n";
548 will produce the output
550 My::Schema::CD, Base::Class
551 My::Schema::Artist, Base::Class
555 sub compose_namespace {
556 my ($self, $target, $base) = @_;
557 my %reg = %{ $self->source_registrations };
560 my $schema = $self->clone;
562 no warnings qw/redefine/;
563 local *Class::C3::reinitialize = sub { };
564 foreach my $moniker ($schema->sources) {
565 my $source = $schema->source($moniker);
566 my $target_class = "${target}::${moniker}";
568 $target_class => $source->result_class, ($base ? $base : ())
570 $source->result_class($target_class);
571 $target_class->result_source_instance($source)
572 if $target_class->can('result_source_instance');
575 Class::C3->reinitialize();
578 foreach my $meth (qw/class source resultset/) {
579 *{"${target}::${meth}"} =
580 sub { shift->schema->$meth(@_) };
586 =head2 setup_connection_class
590 =item Arguments: $target, @info
594 Sets up a database connection class to inject between the schema and the
595 subclasses that the schema creates.
599 sub setup_connection_class {
600 my ($class, $target, @info) = @_;
601 $class->inject_base($target => 'DBIx::Class::DB');
602 #$target->load_components('DB');
603 $target->connection(@info);
610 =item Arguments: @args
612 =item Return Value: $new_schema
616 Instantiates a new Storage object of type
617 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
618 $storage->connect_info. Sets the connection in-place on the schema. See
619 L<DBIx::Class::Storage::DBI/"connect_info"> for more information.
624 my ($self, @info) = @_;
625 return $self if !@info && $self->storage;
626 my $storage_class = $self->storage_type;
627 $storage_class = 'DBIx::Class::Storage'.$storage_class
628 if $storage_class =~ m/^::/;
629 eval "require ${storage_class};";
630 $self->throw_exception(
631 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
633 my $storage = $storage_class->new($self);
634 $storage->connect_info(\@info);
635 $self->storage($storage);
643 =item Arguments: @info
645 =item Return Value: $new_schema
649 This is a convenience method. It is equivalent to calling
650 $schema->clone->connection(@info). See L</connection> and L</clone> for more
655 sub connect { shift->clone->connection(@_) }
659 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
660 calling $schema->storage->txn_begin. See
661 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
665 sub txn_begin { shift->storage->txn_begin }
669 Commits the current transaction. Equivalent to calling
670 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
671 for more information.
675 sub txn_commit { shift->storage->txn_commit }
679 Rolls back the current transaction. Equivalent to calling
680 $schema->storage->txn_rollback. See
681 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
685 sub txn_rollback { shift->storage->txn_rollback }
691 =item Arguments: C<$coderef>, @coderef_args?
693 =item Return Value: The return value of $coderef
697 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
698 returning its result (if any). If an exception is caught, a rollback is issued
699 and the exception is rethrown. If the rollback fails, (i.e. throws an
700 exception) an exception is thrown that includes a "Rollback failed" message.
704 my $author_rs = $schema->resultset('Author')->find(1);
705 my @titles = qw/Night Day It/;
708 # If any one of these fails, the entire transaction fails
709 $author_rs->create_related('books', {
711 }) foreach (@titles);
713 return $author->books;
718 $rs = $schema->txn_do($coderef);
721 if ($@) { # Transaction failed
722 die "something terrible has happened!" #
723 if ($@ =~ /Rollback failed/); # Rollback failed
725 deal_with_failed_transaction();
728 In a nested transaction (calling txn_do() from within a txn_do() coderef) only
729 the outermost transaction will issue a L<DBIx::Class::Schema/"txn_commit"> on
730 the Schema's storage, and txn_do() can be called in void, scalar and list
731 context and it will behave as expected.
736 my ($self, $coderef, @args) = @_;
738 $self->storage or $self->throw_exception
739 ('txn_do called on $schema without storage');
740 ref $coderef eq 'CODE' or $self->throw_exception
741 ('$coderef must be a CODE reference');
743 my (@return_values, $return_value);
745 $self->txn_begin; # If this throws an exception, no rollback is needed
747 my $wantarray = wantarray; # Need to save this since the context
748 # inside the eval{} block is independent
749 # of the context that called txn_do()
752 # Need to differentiate between scalar/list context to allow for
753 # returning a list in scalar context to get the size of the list
756 @return_values = $coderef->(@args);
757 } elsif (defined $wantarray) {
759 $return_value = $coderef->(@args);
775 my $rollback_error = $@;
776 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
777 $self->throw_exception($error) # propagate nested rollback
778 if $rollback_error =~ /$exception_class/;
780 $self->throw_exception(
781 "Transaction aborted: $error. Rollback failed: ${rollback_error}"
784 $self->throw_exception($error); # txn failed but rollback succeeded
788 return $wantarray ? @return_values : $return_value;
795 =item Return Value: $new_schema
799 Clones the schema and its associated result_source objects and returns the
806 my $clone = bless({ (ref $self ? %$self : ()) }, ref $self || $self);
807 foreach my $moniker ($self->sources) {
808 my $source = $self->source($moniker);
809 my $new = $source->new($source);
810 $clone->register_source($moniker => $new);
812 $clone->storage->set_schema($clone) if $clone->storage;
820 =item Arguments: $moniker, \@data;
824 Populates the source registered with the given moniker with the supplied data.
825 @data should be a list of listrefs -- the first containing column names, the
826 second matching values.
830 $schema->populate('Artist', [
831 [ qw/artistid name/ ],
832 [ 1, 'Popular Band' ],
840 my ($self, $name, $data) = @_;
841 my $rs = $self->resultset($name);
842 my @names = @{shift(@$data)};
844 foreach my $item (@$data) {
846 @create{@names} = @$item;
847 push(@created, $rs->create(\%create));
852 =head2 exception_action
856 =item Arguments: $code_reference
860 If C<exception_action> is set for this class/object, L</throw_exception>
861 will prefer to call this code reference with the exception as an argument,
862 rather than its normal <croak> action.
864 Your subroutine should probably just wrap the error in the exception
865 object/class of your choosing and rethrow. If, against all sage advice,
866 you'd like your C<exception_action> to suppress a particular exception
867 completely, simply have it return true.
872 use base qw/DBIx::Class::Schema/;
873 use My::ExceptionClass;
874 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
875 __PACKAGE__->load_classes;
878 my $schema_obj = My::Schema->connect( .... );
879 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
881 # suppress all exceptions, like a moron:
882 $schema_obj->exception_action(sub { 1 });
884 =head2 throw_exception
888 =item Arguments: $message
892 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
893 user's perspective. See L</exception_action> for details on overriding
894 this method's behavior.
898 sub throw_exception {
900 croak @_ if !$self->exception_action || !$self->exception_action->(@_);
903 =head2 deploy (EXPERIMENTAL)
907 =item Arguments: $sqlt_args
911 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
913 Note that this feature is currently EXPERIMENTAL and may not work correctly
914 across all databases, or fully handle complex relationships.
916 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
917 common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
918 produced include a DROP TABLE statement for each table created.
923 my ($self, $sqltargs) = @_;
924 $self->throw_exception("Can't deploy without storage") unless $self->storage;
925 $self->storage->deploy($self, undef, $sqltargs);
928 =head2 create_ddl_dir (EXPERIMENTAL)
932 =item Arguments: \@databases, $version, $directory, $sqlt_args
936 Creates an SQL file based on the Schema, for each of the specified
937 database types, in the given directory.
939 Note that this feature is currently EXPERIMENTAL and may not work correctly
940 across all databases, or fully handle complex relationships.
948 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
949 $self->storage->create_ddl_dir($self, @_);
952 =head2 ddl_filename (EXPERIMENTAL)
954 my $filename = $table->ddl_filename($type, $dir, $version)
956 Creates a filename for a SQL file based on the table class name. Not
957 intended for direct end user use.
963 my ($self, $type, $dir, $version) = @_;
965 my $filename = ref($self);
966 $filename =~ s/::/-/;
967 $filename = "$dir$filename-$version-$type.sql";
976 Matt S. Trout <mst@shadowcatsystems.co.uk>
980 You may distribute this code under the same terms as Perl itself.