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 All of the namespace and classname options to this method are relative to
304 the schema classname by default. To specify a fully-qualified name, prefix
305 it with a literal C<+>.
309 # load My::Schema::Source::CD, My::Schema::Source::Artist,
310 # My::Schema::ResultSet::CD, etc...
311 My::Schema->load_namespaces;
313 # Override everything...
314 My::Schema->load_namespaces(
315 source_namespace => 'Srcs',
316 resultset_namespace => 'RSets',
317 result_namespace => 'Results',
318 default_resultset_class => 'RSetBase',
320 # ... and if there is a My::Schema::Srcs::Foo, but no matching
321 # My::Schema::RSets::Foo, then the Foo source will have its
322 # resultset_class set to My::Schema::RSetBase
324 # Put things in other namespaces
325 My::Schema->load_namespaces(
326 source_namespace => '+Some::Place::Sources',
327 resultset_namespace => '+Another::Place::RSets',
328 result_namespace => '+Crazy::Stuff::Results',
329 default_resultset_class => '+You::Never::Know::RSetBase',
335 sub load_namespaces {
336 my ($class, %args) = @_;
338 my $source_namespace = delete $args{source_namespace} || 'Source';
339 my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
340 my $result_namespace = delete $args{result_namespace} || 'Result';
341 my $default_resultset_class = delete $args{default_resultset_class};
343 $class->throw_exception('load_namespaces: unknown option(s): '
344 . join(q{,}, map { qq{'$_'} } keys %args))
345 if scalar keys %args;
347 foreach ($source_namespace, $resultset_namespace,
348 $result_namespace, $default_resultset_class) {
350 $_ = $class . '::' . $_ if !s/^\+//;
353 my %sources = map { (substr($_, length "${source_namespace}::"), $_) }
354 Module::Find::findallmod($source_namespace);
356 my %resultsets = map { (substr($_, length "${resultset_namespace}::"), $_) }
357 Module::Find::findallmod($resultset_namespace);
359 my %results = map { (substr($_, length "${result_namespace}::"), $_) }
360 Module::Find::findallmod($result_namespace);
364 no warnings 'redefine';
365 local *Class::C3::reinitialize = sub { };
366 use warnings 'redefine';
368 foreach my $source (keys %sources) {
369 my $source_class = $sources{$source};
370 $class->ensure_class_loaded($source_class);
371 $source_class->source_name($source) unless $source_class->source_name;
373 my $rs_class = delete $resultsets{$source};
374 my $rs_set = $source_class->resultset_class;
375 if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
377 warn "We found ResultSet class '$rs_class' for '$source', but it seems "
378 . "that you had already set '$source' to use '$rs_set' instead";
381 elsif($rs_class ||= $default_resultset_class) {
382 $class->ensure_class_loaded($rs_class);
383 $source_class->resultset_class($rs_class);
386 my $r_class = delete $results{$source};
388 my $r_set = $source_class->result_class;
389 if(!$r_set || $r_set eq $sources{$source}) {
390 $class->ensure_class_loaded($r_class);
391 $source_class->result_class($r_class);
394 warn "We found Result class '$r_class' for '$source', but it seems "
395 . "that you had already set '$source' to use '$r_set' instead";
399 push(@to_register, [ $source_class->source_name, $source_class ]);
403 foreach (sort keys %resultsets) {
404 warn "load_namespaces found ResultSet class $_ with no "
405 . 'corresponding source-definition class';
408 foreach (sort keys %results) {
409 warn "load_namespaces found Result class $_ with no "
410 . 'corresponding source-definition class';
413 Class::C3->reinitialize;
414 $class->register_class(@$_) for (@to_register);
419 =head2 compose_connection
423 =item Arguments: $target_namespace, @db_info
425 =item Return Value: $new_schema
429 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
430 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
431 then injects the L<DBix::Class::ResultSetProxy> component and a
432 resultset_instance classdata entry on all the new classes, in order to support
433 $target_namespaces::$class->search(...) method calls.
435 This is primarily useful when you have a specific need for class method access
436 to a connection. In normal usage it is preferred to call
437 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
438 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
443 sub compose_connection {
444 my ($self, $target, @info) = @_;
445 my $base = 'DBIx::Class::ResultSetProxy';
446 eval "require ${base};";
447 $self->throw_exception
448 ("No arguments to load_classes and couldn't load ${base} ($@)")
451 if ($self eq $target) {
452 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
453 foreach my $moniker ($self->sources) {
454 my $source = $self->source($moniker);
455 my $class = $source->result_class;
456 $self->inject_base($class, $base);
457 $class->mk_classdata(resultset_instance => $source->resultset);
458 $class->mk_classdata(class_resolver => $self);
460 $self->connection(@info);
464 my $schema = $self->compose_namespace($target, $base);
467 *{"${target}::schema"} = sub { $schema };
470 $schema->connection(@info);
471 foreach my $moniker ($schema->sources) {
472 my $source = $schema->source($moniker);
473 my $class = $source->result_class;
474 #warn "$moniker $class $source ".$source->storage;
475 $class->mk_classdata(result_source_instance => $source);
476 $class->mk_classdata(resultset_instance => $source->resultset);
477 $class->mk_classdata(class_resolver => $schema);
482 =head2 compose_namespace
486 =item Arguments: $target_namespace, $additional_base_class?
488 =item Return Value: $new_schema
492 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
493 class in the target namespace (e.g. $target_namespace::CD,
494 $target_namespace::Artist) that inherits from the corresponding classes
495 attached to the current schema.
497 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
498 new $schema object. If C<$additional_base_class> is given, the new composed
499 classes will inherit from first the corresponding classe from the current
500 schema then the base class.
502 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
504 $schema->compose_namespace('My::DB', 'Base::Class');
505 print join (', ', @My::DB::CD::ISA) . "\n";
506 print join (', ', @My::DB::Artist::ISA) ."\n";
508 will produce the output
510 My::Schema::CD, Base::Class
511 My::Schema::Artist, Base::Class
515 sub compose_namespace {
516 my ($self, $target, $base) = @_;
517 my %reg = %{ $self->source_registrations };
520 my $schema = $self->clone;
522 no warnings qw/redefine/;
523 local *Class::C3::reinitialize = sub { };
524 foreach my $moniker ($schema->sources) {
525 my $source = $schema->source($moniker);
526 my $target_class = "${target}::${moniker}";
528 $target_class => $source->result_class, ($base ? $base : ())
530 $source->result_class($target_class);
531 $target_class->result_source_instance($source)
532 if $target_class->can('result_source_instance');
535 Class::C3->reinitialize();
538 foreach my $meth (qw/class source resultset/) {
539 *{"${target}::${meth}"} =
540 sub { shift->schema->$meth(@_) };
546 =head2 setup_connection_class
550 =item Arguments: $target, @info
554 Sets up a database connection class to inject between the schema and the
555 subclasses that the schema creates.
559 sub setup_connection_class {
560 my ($class, $target, @info) = @_;
561 $class->inject_base($target => 'DBIx::Class::DB');
562 #$target->load_components('DB');
563 $target->connection(@info);
570 =item Arguments: @args
572 =item Return Value: $new_schema
576 Instantiates a new Storage object of type
577 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
578 $storage->connect_info. Sets the connection in-place on the schema. See
579 L<DBIx::Class::Storage::DBI/"connect_info"> for more information.
584 my ($self, @info) = @_;
585 return $self if !@info && $self->storage;
586 my $storage_class = $self->storage_type;
587 $storage_class = 'DBIx::Class::Storage'.$storage_class
588 if $storage_class =~ m/^::/;
589 eval "require ${storage_class};";
590 $self->throw_exception(
591 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
593 my $storage = $storage_class->new($self);
594 $storage->connect_info(\@info);
595 $self->storage($storage);
603 =item Arguments: @info
605 =item Return Value: $new_schema
609 This is a convenience method. It is equivalent to calling
610 $schema->clone->connection(@info). See L</connection> and L</clone> for more
615 sub connect { shift->clone->connection(@_) }
619 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
620 calling $schema->storage->txn_begin. See
621 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
625 sub txn_begin { shift->storage->txn_begin }
629 Commits the current transaction. Equivalent to calling
630 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
631 for more information.
635 sub txn_commit { shift->storage->txn_commit }
639 Rolls back the current transaction. Equivalent to calling
640 $schema->storage->txn_rollback. See
641 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
645 sub txn_rollback { shift->storage->txn_rollback }
651 =item Arguments: C<$coderef>, @coderef_args?
653 =item Return Value: The return value of $coderef
657 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
658 returning its result (if any). If an exception is caught, a rollback is issued
659 and the exception is rethrown. If the rollback fails, (i.e. throws an
660 exception) an exception is thrown that includes a "Rollback failed" message.
664 my $author_rs = $schema->resultset('Author')->find(1);
665 my @titles = qw/Night Day It/;
668 # If any one of these fails, the entire transaction fails
669 $author_rs->create_related('books', {
671 }) foreach (@titles);
673 return $author->books;
678 $rs = $schema->txn_do($coderef);
681 if ($@) { # Transaction failed
682 die "something terrible has happened!" #
683 if ($@ =~ /Rollback failed/); # Rollback failed
685 deal_with_failed_transaction();
688 In a nested transaction (calling txn_do() from within a txn_do() coderef) only
689 the outermost transaction will issue a L<DBIx::Class::Schema/"txn_commit"> on
690 the Schema's storage, and txn_do() can be called in void, scalar and list
691 context and it will behave as expected.
696 my ($self, $coderef, @args) = @_;
698 $self->storage or $self->throw_exception
699 ('txn_do called on $schema without storage');
700 ref $coderef eq 'CODE' or $self->throw_exception
701 ('$coderef must be a CODE reference');
703 my (@return_values, $return_value);
705 $self->txn_begin; # If this throws an exception, no rollback is needed
707 my $wantarray = wantarray; # Need to save this since the context
708 # inside the eval{} block is independent
709 # of the context that called txn_do()
712 # Need to differentiate between scalar/list context to allow for
713 # returning a list in scalar context to get the size of the list
716 @return_values = $coderef->(@args);
717 } elsif (defined $wantarray) {
719 $return_value = $coderef->(@args);
735 my $rollback_error = $@;
736 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
737 $self->throw_exception($error) # propagate nested rollback
738 if $rollback_error =~ /$exception_class/;
740 $self->throw_exception(
741 "Transaction aborted: $error. Rollback failed: ${rollback_error}"
744 $self->throw_exception($error); # txn failed but rollback succeeded
748 return $wantarray ? @return_values : $return_value;
755 =item Return Value: $new_schema
759 Clones the schema and its associated result_source objects and returns the
766 my $clone = bless({ (ref $self ? %$self : ()) }, ref $self || $self);
767 foreach my $moniker ($self->sources) {
768 my $source = $self->source($moniker);
769 my $new = $source->new($source);
770 $clone->register_source($moniker => $new);
772 $clone->storage->set_schema($clone) if $clone->storage;
780 =item Arguments: $moniker, \@data;
784 Populates the source registered with the given moniker with the supplied data.
785 @data should be a list of listrefs -- the first containing column names, the
786 second matching values.
790 $schema->populate('Artist', [
791 [ qw/artistid name/ ],
792 [ 1, 'Popular Band' ],
800 my ($self, $name, $data) = @_;
801 my $rs = $self->resultset($name);
802 my @names = @{shift(@$data)};
804 foreach my $item (@$data) {
806 @create{@names} = @$item;
807 push(@created, $rs->create(\%create));
812 =head2 exception_action
816 =item Arguments: $code_reference
820 If C<exception_action> is set for this class/object, L</throw_exception>
821 will prefer to call this code reference with the exception as an argument,
822 rather than its normal <croak> action.
824 Your subroutine should probably just wrap the error in the exception
825 object/class of your choosing and rethrow. If, against all sage advice,
826 you'd like your C<exception_action> to suppress a particular exception
827 completely, simply have it return true.
832 use base qw/DBIx::Class::Schema/;
833 use My::ExceptionClass;
834 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
835 __PACKAGE__->load_classes;
838 my $schema_obj = My::Schema->connect( .... );
839 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
841 # suppress all exceptions, like a moron:
842 $schema_obj->exception_action(sub { 1 });
844 =head2 throw_exception
848 =item Arguments: $message
852 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
853 user's perspective. See L</exception_action> for details on overriding
854 this method's behavior.
858 sub throw_exception {
860 croak @_ if !$self->exception_action || !$self->exception_action->(@_);
863 =head2 deploy (EXPERIMENTAL)
867 =item Arguments: $sqlt_args
871 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
873 Note that this feature is currently EXPERIMENTAL and may not work correctly
874 across all databases, or fully handle complex relationships.
876 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
877 common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
878 produced include a DROP TABLE statement for each table created.
883 my ($self, $sqltargs) = @_;
884 $self->throw_exception("Can't deploy without storage") unless $self->storage;
885 $self->storage->deploy($self, undef, $sqltargs);
888 =head2 create_ddl_dir (EXPERIMENTAL)
892 =item Arguments: \@databases, $version, $directory, $sqlt_args
896 Creates an SQL file based on the Schema, for each of the specified
897 database types, in the given directory.
899 Note that this feature is currently EXPERIMENTAL and may not work correctly
900 across all databases, or fully handle complex relationships.
908 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
909 $self->storage->create_ddl_dir($self, @_);
912 =head2 ddl_filename (EXPERIMENTAL)
914 my $filename = $table->ddl_filename($type, $dir, $version)
916 Creates a filename for a SQL file based on the table class name. Not
917 intended for direct end user use.
923 my ($self, $type, $dir, $version) = @_;
925 my $filename = ref($self);
926 $filename =~ s/::/-/;
927 $filename = "$dir$filename-$version-$type.sql";
936 Matt S. Trout <mst@shadowcatsystems.co.uk>
940 You may distribute this code under the same terms as Perl itself.