1 package DBIx::Class::Schema;
6 use Carp::Clan qw/^DBIx::Class/;
8 use base qw/DBIx::Class/;
10 __PACKAGE__->mk_classdata('class_mappings' => {});
11 __PACKAGE__->mk_classdata('source_registrations' => {});
12 __PACKAGE__->mk_classdata('storage_type' => '::DBI');
13 __PACKAGE__->mk_classdata('storage');
17 DBIx::Class::Schema - composable schemas
21 package Library::Schema;
22 use base qw/DBIx::Class::Schema/;
24 # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
25 __PACKAGE__->load_classes(qw/CD Book DVD/);
27 package Library::Schema::CD;
28 use base qw/DBIx::Class/;
29 __PACKAGE__->load_components(qw/PK::Auto Core/); # for example
30 __PACKAGE__->table('cd');
32 # Elsewhere in your code:
33 my $schema1 = Library::Schema->connect(
40 my $schema2 = Library::Schema->connect($coderef_returning_dbh);
42 # fetch objects using Library::Schema::DVD
43 my $resultset = $schema1->resultset('DVD')->search( ... );
44 my @dvd_objects = $schema2->resultset('DVD')->search( ... );
48 Creates database classes based on a schema. This is the recommended way to
49 use L<DBIx::Class> and allows you to use more than one concurrent connection
52 NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
53 carefully, as DBIx::Class does things a little differently. Note in
54 particular which module inherits off which.
62 =item Arguments: $moniker, $component_class
66 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
69 $schema->register_source($moniker, $component_class->result_source_instance);
74 my ($self, $moniker, $to_register) = @_;
75 $self->register_source($moniker => $to_register->result_source_instance);
78 =head2 register_source
82 =item Arguments: $moniker, $result_source
86 Registers the L<DBIx::Class::ResultSource> in the schema with the given
92 my ($self, $moniker, $source) = @_;
93 my %reg = %{$self->source_registrations};
94 $reg{$moniker} = $source;
95 $self->source_registrations(\%reg);
96 $source->schema($self);
97 if ($source->result_class) {
98 my %map = %{$self->class_mappings};
99 $map{$source->result_class} = $moniker;
100 $self->class_mappings(\%map);
108 =item Arguments: $moniker
110 =item Return Value: $classname
114 Retrieves the result class name for the given moniker. For example:
116 my $class = $schema->class('CD');
121 my ($self, $moniker) = @_;
122 return $self->source($moniker)->result_class;
129 =item Arguments: $moniker
131 =item Return Value: $result_source
135 my $source = $schema->source('Book');
137 Returns the L<DBIx::Class::ResultSource> object for the registered moniker.
142 my ($self, $moniker) = @_;
143 my $sreg = $self->source_registrations;
144 return $sreg->{$moniker} if exists $sreg->{$moniker};
146 # if we got here, they probably passed a full class name
147 my $mapped = $self->class_mappings->{$moniker};
148 $self->throw_exception("Can't find source for ${moniker}")
149 unless $mapped && exists $sreg->{$mapped};
150 return $sreg->{$mapped};
157 =item Return Value: @source_monikers
161 Returns the source monikers of all source registrations on this schema.
164 my @source_monikers = $schema->sources;
168 sub sources { return keys %{shift->source_registrations}; }
174 =item Arguments: $moniker
176 =item Return Value: $result_set
180 my $rs = $schema->resultset('DVD');
182 Returns the L<DBIx::Class::ResultSet> object for the registered moniker.
187 my ($self, $moniker) = @_;
188 return $self->source($moniker)->resultset;
195 =item Arguments: @classes?, { $namespace => [ @classes ] }+
199 With no arguments, this method uses L<Module::Find> to find all classes under
200 the schema's namespace. Otherwise, this method loads the classes you specify
201 (using L<use>), and registers them (using L</"register_class">).
203 It is possible to comment out classes with a leading C<#>, but note that perl
204 will think it's a mistake (trying to use a comment in a qw list), so you'll
205 need to add C<no warnings 'qw';> before your load_classes call.
209 My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
210 # etc. (anything under the My::Schema namespace)
212 # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
213 # not Other::Namespace::LinerNotes nor My::Schema::Track
214 My::Schema->load_classes(qw/ CD Artist #Track /, {
215 Other::Namespace => [qw/ Producer #LinerNotes /],
221 my ($class, @params) = @_;
226 foreach my $param (@params) {
227 if (ref $param eq 'ARRAY') {
228 # filter out commented entries
229 my @modules = grep { $_ !~ /^#/ } @$param;
231 push (@{$comps_for{$class}}, @modules);
233 elsif (ref $param eq 'HASH') {
234 # more than one namespace possible
235 for my $comp ( keys %$param ) {
236 # filter out commented entries
237 my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
239 push (@{$comps_for{$comp}}, @modules);
243 # filter out commented entries
244 push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
248 eval "require Module::Find;";
249 $class->throw_exception(
250 "No arguments to load_classes and couldn't load Module::Find ($@)"
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 eval "use $comp_class"; # If it fails, assume the user fixed it
266 $comp_class =~ s/::/\//g;
267 die $@ unless $@ =~ /Can't locate.+$comp_class\.pm\sin\s\@INC/;
271 $comp_class->source_name($comp) unless $comp_class->source_name;
273 push(@to_register, [ $comp_class->source_name, $comp_class ]);
277 Class::C3->reinitialize;
279 foreach my $to (@to_register) {
280 $class->register_class(@$to);
281 # if $class->can('result_source_instance');
285 =head2 compose_connection
289 =item Arguments: $target_namespace, @db_info
291 =item Return Value: $new_schema
295 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
296 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
297 then injects the L<DBix::Class::ResultSetProxy> component and a
298 resultset_instance classdata entry on all the new classes, in order to support
299 $target_namespaces::$class->search(...) method calls.
301 This is primarily useful when you have a specific need for class method access
302 to a connection. In normal usage it is preferred to call
303 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
304 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
309 sub compose_connection {
310 my ($self, $target, @info) = @_;
311 my $base = 'DBIx::Class::ResultSetProxy';
312 eval "require ${base};";
313 $self->throw_exception
314 ("No arguments to load_classes and couldn't load ${base} ($@)")
317 if ($self eq $target) {
318 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
319 foreach my $moniker ($self->sources) {
320 my $source = $self->source($moniker);
321 my $class = $source->result_class;
322 $self->inject_base($class, $base);
323 $class->mk_classdata(resultset_instance => $source->resultset);
324 $class->mk_classdata(class_resolver => $self);
326 $self->connection(@info);
330 my $schema = $self->compose_namespace($target, $base);
333 *{"${target}::schema"} = sub { $schema };
336 $schema->connection(@info);
337 foreach my $moniker ($schema->sources) {
338 my $source = $schema->source($moniker);
339 my $class = $source->result_class;
340 #warn "$moniker $class $source ".$source->storage;
341 $class->mk_classdata(result_source_instance => $source);
342 $class->mk_classdata(resultset_instance => $source->resultset);
343 $class->mk_classdata(class_resolver => $schema);
348 =head2 compose_namespace
352 =item Arguments: $target_namespace, $additional_base_class?
354 =item Return Value: $new_schema
358 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
359 class in the target namespace (e.g. $target_namespace::CD,
360 $target_namespace::Artist) that inherits from the corresponding classes
361 attached to the current schema.
363 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
364 new $schema object. If C<$additional_base_class> is given, the new composed
365 classes will inherit from first the corresponding classe from the current
366 schema then the base class.
368 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
370 $schema->compose_namespace('My::DB', 'Base::Class');
371 print join (', ', @My::DB::CD::ISA) . "\n";
372 print join (', ', @My::DB::Artist::ISA) ."\n";
374 will produce the output
376 My::Schema::CD, Base::Class
377 My::Schema::Artist, Base::Class
381 sub compose_namespace {
382 my ($self, $target, $base) = @_;
383 my %reg = %{ $self->source_registrations };
386 my $schema = $self->clone;
388 no warnings qw/redefine/;
389 local *Class::C3::reinitialize = sub { };
390 foreach my $moniker ($schema->sources) {
391 my $source = $schema->source($moniker);
392 my $target_class = "${target}::${moniker}";
394 $target_class => $source->result_class, ($base ? $base : ())
396 $source->result_class($target_class);
399 Class::C3->reinitialize();
402 foreach my $meth (qw/class source resultset/) {
403 *{"${target}::${meth}"} =
404 sub { shift->schema->$meth(@_) };
410 =head2 setup_connection_class
414 =item Arguments: $target, @info
418 Sets up a database connection class to inject between the schema and the
419 subclasses that the schema creates.
423 sub setup_connection_class {
424 my ($class, $target, @info) = @_;
425 $class->inject_base($target => 'DBIx::Class::DB');
426 #$target->load_components('DB');
427 $target->connection(@info);
434 =item Arguments: @args
436 =item Return Value: $new_schema
440 Instantiates a new Storage object of type
441 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
442 $storage->connect_info. Sets the connection in-place on the schema. See
443 L<DBIx::Class::Storage::DBI/"connect_info"> for more information.
448 my ($self, @info) = @_;
449 return $self if !@info && $self->storage;
450 my $storage_class = $self->storage_type;
451 $storage_class = 'DBIx::Class::Storage'.$storage_class
452 if $storage_class =~ m/^::/;
453 eval "require ${storage_class};";
454 $self->throw_exception(
455 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
457 my $storage = $storage_class->new;
458 $storage->connect_info(\@info);
459 $self->storage($storage);
467 =item Arguments: @info
469 =item Return Value: $new_schema
473 This is a convenience method. It is equivalent to calling
474 $schema->clone->connection(@info). See L</connection> and L</clone> for more
479 sub connect { shift->clone->connection(@_) }
483 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
484 calling $schema->storage->txn_begin. See
485 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
489 sub txn_begin { shift->storage->txn_begin }
493 Commits the current transaction. Equivalent to calling
494 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
495 for more information.
499 sub txn_commit { shift->storage->txn_commit }
503 Rolls back the current transaction. Equivalent to calling
504 $schema->storage->txn_rollback. See
505 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
509 sub txn_rollback { shift->storage->txn_rollback }
515 =item Arguments: C<$coderef>, @coderef_args?
517 =item Return Value: The return value of $coderef
521 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
522 returning its result (if any). If an exception is caught, a rollback is issued
523 and the exception is rethrown. If the rollback fails, (i.e. throws an
524 exception) an exception is thrown that includes a "Rollback failed" message.
528 my $author_rs = $schema->resultset('Author')->find(1);
531 my ($author, @titles) = @_;
533 # If any one of these fails, the entire transaction fails
534 $author->create_related('books', {
536 }) foreach (@titles);
538 return $author->books;
543 $rs = $schema->txn_do($coderef, $author_rs, qw/Night Day It/);
548 if ($error =~ /Rollback failed/) {
549 die "something terrible has happened!";
551 deal_with_failed_transaction();
555 In a nested transaction (calling txn_do() from within a txn_do() coderef) only
556 the outermost transaction will issue a L<DBIx::Class::Schema/"txn_commit"> on
557 the Schema's storage, and txn_do() can be called in void, scalar and list
558 context and it will behave as expected.
563 my ($self, $coderef, @args) = @_;
565 ref $self or $self->throw_exception
566 ('Cannot execute txn_do as a class method');
567 ref $coderef eq 'CODE' or $self->throw_exception
568 ('$coderef must be a CODE reference');
570 my (@return_values, $return_value);
572 $self->txn_begin; # If this throws an exception, no rollback is needed
574 my $wantarray = wantarray; # Need to save this since the context
575 # inside the eval{} block is independent
576 # of the context that called txn_do()
579 # Need to differentiate between scalar/list context to allow for
580 # returning a list in scalar context to get the size of the list
583 @return_values = $coderef->(@args);
584 } elsif (defined $wantarray) {
586 $return_value = $coderef->(@args);
602 my $rollback_error = $@;
603 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
604 $self->throw_exception($error) # propagate nested rollback
605 if $rollback_error =~ /$exception_class/;
607 $self->throw_exception(
608 "Transaction aborted: $error. Rollback failed: ${rollback_error}"
611 $self->throw_exception($error); # txn failed but rollback succeeded
615 return $wantarray ? @return_values : $return_value;
622 =item Return Value: $new_schema
626 Clones the schema and its associated result_source objects and returns the
633 my $clone = bless({ (ref $self ? %$self : ()) }, ref $self || $self);
634 foreach my $moniker ($self->sources) {
635 my $source = $self->source($moniker);
636 my $new = $source->new($source);
637 $clone->register_source($moniker => $new);
646 =item Arguments: $moniker, \@data;
650 Populates the source registered with the given moniker with the supplied data.
651 @data should be a list of listrefs -- the first containing column names, the
652 second matching values.
656 $schema->populate('Artist', [
657 [ qw/artistid name/ ],
658 [ 1, 'Popular Band' ],
666 my ($self, $name, $data) = @_;
667 my $rs = $self->resultset($name);
668 my @names = @{shift(@$data)};
670 foreach my $item (@$data) {
672 @create{@names} = @$item;
673 push(@created, $rs->create(\%create));
678 =head2 throw_exception
682 =item Arguments: $message
686 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
691 sub throw_exception {
696 =head2 deploy (EXPERIMENTAL)
700 =item Arguments: $sqlt_args
704 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
706 Note that this feature is currently EXPERIMENTAL and may not work correctly
707 across all databases, or fully handle complex relationships.
712 my ($self, $sqltargs) = @_;
713 $self->throw_exception("Can't deploy without storage") unless $self->storage;
714 $self->storage->deploy($self, undef, $sqltargs);
717 =head2 create_ddl_dir (EXPERIMENTAL)
721 =item Arguments: \@databases, $version, $directory, $sqlt_args
725 Creates an SQL file based on the Schema, for each of the specified
726 database types, in the given directory.
728 Note that this feature is currently EXPERIMENTAL and may not work correctly
729 across all databases, or fully handle complex relationships.
737 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
738 $self->storage->create_ddl_dir($self, @_);
743 my ($self, $type, $dir, $version) = @_;
745 my $filename = ref($self);
746 $filename =~ s/^.*:://;
747 $filename = "$dir$filename-$version-$type.sql";
756 Matt S. Trout <mst@shadowcatsystems.co.uk>
760 You may distribute this code under the same terms as Perl itself.