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');
19 DBIx::Class::Schema - composable schemas
23 package Library::Schema;
24 use base qw/DBIx::Class::Schema/;
26 # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
27 __PACKAGE__->load_classes(qw/CD Book DVD/);
29 package Library::Schema::CD;
30 use base qw/DBIx::Class/;
31 __PACKAGE__->load_components(qw/PK::Auto Core/); # for example
32 __PACKAGE__->table('cd');
34 # Elsewhere in your code:
35 my $schema1 = Library::Schema->connect(
42 my $schema2 = Library::Schema->connect($coderef_returning_dbh);
44 # fetch objects using Library::Schema::DVD
45 my $resultset = $schema1->resultset('DVD')->search( ... );
46 my @dvd_objects = $schema2->resultset('DVD')->search( ... );
50 Creates database classes based on a schema. This is the recommended way to
51 use L<DBIx::Class> and allows you to use more than one concurrent connection
54 NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
55 carefully, as DBIx::Class does things a little differently. Note in
56 particular which module inherits off which.
64 =item Arguments: $moniker, $component_class
68 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
71 $schema->register_source($moniker, $component_class->result_source_instance);
76 my ($self, $moniker, $to_register) = @_;
77 $self->register_source($moniker => $to_register->result_source_instance);
80 =head2 register_source
84 =item Arguments: $moniker, $result_source
88 Registers the L<DBIx::Class::ResultSource> in the schema with the given
94 my ($self, $moniker, $source) = @_;
95 my %reg = %{$self->source_registrations};
96 $reg{$moniker} = $source;
97 $self->source_registrations(\%reg);
98 $source->schema($self);
99 weaken($source->{schema}) if ref($self);
100 if ($source->result_class) {
101 my %map = %{$self->class_mappings};
102 $map{$source->result_class} = $moniker;
103 $self->class_mappings(\%map);
111 =item Arguments: $moniker
113 =item Return Value: $classname
117 Retrieves the result class name for the given moniker. For example:
119 my $class = $schema->class('CD');
124 my ($self, $moniker) = @_;
125 return $self->source($moniker)->result_class;
132 =item Arguments: $moniker
134 =item Return Value: $result_source
138 my $source = $schema->source('Book');
140 Returns the L<DBIx::Class::ResultSource> object for the registered moniker.
145 my ($self, $moniker) = @_;
146 my $sreg = $self->source_registrations;
147 return $sreg->{$moniker} if exists $sreg->{$moniker};
149 # if we got here, they probably passed a full class name
150 my $mapped = $self->class_mappings->{$moniker};
151 $self->throw_exception("Can't find source for ${moniker}")
152 unless $mapped && exists $sreg->{$mapped};
153 return $sreg->{$mapped};
160 =item Return Value: @source_monikers
164 Returns the source monikers of all source registrations on this schema.
167 my @source_monikers = $schema->sources;
171 sub sources { return keys %{shift->source_registrations}; }
177 =item Arguments: $moniker
179 =item Return Value: $result_set
183 my $rs = $schema->resultset('DVD');
185 Returns the L<DBIx::Class::ResultSet> object for the registered moniker.
190 my ($self, $moniker) = @_;
191 return $self->source($moniker)->resultset;
198 =item Arguments: @classes?, { $namespace => [ @classes ] }+
202 With no arguments, this method uses L<Module::Find> to find all classes under
203 the schema's namespace. Otherwise, this method loads the classes you specify
204 (using L<use>), and registers them (using L</"register_class">).
206 It is possible to comment out classes with a leading C<#>, but note that perl
207 will think it's a mistake (trying to use a comment in a qw list), so you'll
208 need to add C<no warnings 'qw';> before your load_classes call.
212 My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
213 # etc. (anything under the My::Schema namespace)
215 # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
216 # not Other::Namespace::LinerNotes nor My::Schema::Track
217 My::Schema->load_classes(qw/ CD Artist #Track /, {
218 Other::Namespace => [qw/ Producer #LinerNotes /],
224 my ($class, @params) = @_;
229 foreach my $param (@params) {
230 if (ref $param eq 'ARRAY') {
231 # filter out commented entries
232 my @modules = grep { $_ !~ /^#/ } @$param;
234 push (@{$comps_for{$class}}, @modules);
236 elsif (ref $param eq 'HASH') {
237 # more than one namespace possible
238 for my $comp ( keys %$param ) {
239 # filter out commented entries
240 my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
242 push (@{$comps_for{$comp}}, @modules);
246 # filter out commented entries
247 push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
251 eval "require Module::Find;";
252 $class->throw_exception(
253 "No arguments to load_classes and couldn't load Module::Find ($@)"
255 my @comp = map { substr $_, length "${class}::" }
256 Module::Find::findallmod($class);
257 $comps_for{$class} = \@comp;
262 no warnings qw/redefine/;
263 local *Class::C3::reinitialize = sub { };
264 foreach my $prefix (keys %comps_for) {
265 foreach my $comp (@{$comps_for{$prefix}||[]}) {
266 my $comp_class = "${prefix}::${comp}";
267 eval "use $comp_class"; # If it fails, assume the user fixed it
269 $comp_class =~ s/::/\//g;
270 die $@ unless $@ =~ /Can't locate.+$comp_class\.pm\sin\s\@INC/;
274 $comp_class->source_name($comp) unless $comp_class->source_name;
276 push(@to_register, [ $comp_class->source_name, $comp_class ]);
280 Class::C3->reinitialize;
282 foreach my $to (@to_register) {
283 $class->register_class(@$to);
284 # if $class->can('result_source_instance');
288 =head2 compose_connection
292 =item Arguments: $target_namespace, @db_info
294 =item Return Value: $new_schema
298 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
299 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
300 then injects the L<DBix::Class::ResultSetProxy> component and a
301 resultset_instance classdata entry on all the new classes, in order to support
302 $target_namespaces::$class->search(...) method calls.
304 This is primarily useful when you have a specific need for class method access
305 to a connection. In normal usage it is preferred to call
306 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
307 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
312 sub compose_connection {
313 my ($self, $target, @info) = @_;
314 my $base = 'DBIx::Class::ResultSetProxy';
315 eval "require ${base};";
316 $self->throw_exception
317 ("No arguments to load_classes and couldn't load ${base} ($@)")
320 if ($self eq $target) {
321 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
322 foreach my $moniker ($self->sources) {
323 my $source = $self->source($moniker);
324 my $class = $source->result_class;
325 $self->inject_base($class, $base);
326 $class->mk_classdata(resultset_instance => $source->resultset);
327 $class->mk_classdata(class_resolver => $self);
329 $self->connection(@info);
333 my $schema = $self->compose_namespace($target, $base);
336 *{"${target}::schema"} = sub { $schema };
339 $schema->connection(@info);
340 foreach my $moniker ($schema->sources) {
341 my $source = $schema->source($moniker);
342 my $class = $source->result_class;
343 #warn "$moniker $class $source ".$source->storage;
344 $class->mk_classdata(result_source_instance => $source);
345 $class->mk_classdata(resultset_instance => $source->resultset);
346 $class->mk_classdata(class_resolver => $schema);
351 =head2 compose_namespace
355 =item Arguments: $target_namespace, $additional_base_class?
357 =item Return Value: $new_schema
361 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
362 class in the target namespace (e.g. $target_namespace::CD,
363 $target_namespace::Artist) that inherits from the corresponding classes
364 attached to the current schema.
366 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
367 new $schema object. If C<$additional_base_class> is given, the new composed
368 classes will inherit from first the corresponding classe from the current
369 schema then the base class.
371 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
373 $schema->compose_namespace('My::DB', 'Base::Class');
374 print join (', ', @My::DB::CD::ISA) . "\n";
375 print join (', ', @My::DB::Artist::ISA) ."\n";
377 will produce the output
379 My::Schema::CD, Base::Class
380 My::Schema::Artist, Base::Class
384 sub compose_namespace {
385 my ($self, $target, $base) = @_;
386 my %reg = %{ $self->source_registrations };
389 my $schema = $self->clone;
391 no warnings qw/redefine/;
392 local *Class::C3::reinitialize = sub { };
393 foreach my $moniker ($schema->sources) {
394 my $source = $schema->source($moniker);
395 my $target_class = "${target}::${moniker}";
397 $target_class => $source->result_class, ($base ? $base : ())
399 $source->result_class($target_class);
402 Class::C3->reinitialize();
405 foreach my $meth (qw/class source resultset/) {
406 *{"${target}::${meth}"} =
407 sub { shift->schema->$meth(@_) };
413 =head2 setup_connection_class
417 =item Arguments: $target, @info
421 Sets up a database connection class to inject between the schema and the
422 subclasses that the schema creates.
426 sub setup_connection_class {
427 my ($class, $target, @info) = @_;
428 $class->inject_base($target => 'DBIx::Class::DB');
429 #$target->load_components('DB');
430 $target->connection(@info);
437 =item Arguments: @args
439 =item Return Value: $new_schema
443 Instantiates a new Storage object of type
444 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
445 $storage->connect_info. Sets the connection in-place on the schema. See
446 L<DBIx::Class::Storage::DBI/"connect_info"> for more information.
451 my ($self, @info) = @_;
452 return $self if !@info && $self->storage;
453 my $storage_class = $self->storage_type;
454 $storage_class = 'DBIx::Class::Storage'.$storage_class
455 if $storage_class =~ m/^::/;
456 eval "require ${storage_class};";
457 $self->throw_exception(
458 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
460 my $storage = $storage_class->new;
461 $storage->connect_info(\@info);
462 $self->storage($storage);
463 $self->on_connect() if($self->can('on_connect'));
471 =item Arguments: @info
473 =item Return Value: $new_schema
477 This is a convenience method. It is equivalent to calling
478 $schema->clone->connection(@info). See L</connection> and L</clone> for more
483 sub connect { shift->clone->connection(@_) }
487 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
488 calling $schema->storage->txn_begin. See
489 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
493 sub txn_begin { shift->storage->txn_begin }
497 Commits the current transaction. Equivalent to calling
498 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
499 for more information.
503 sub txn_commit { shift->storage->txn_commit }
507 Rolls back the current transaction. Equivalent to calling
508 $schema->storage->txn_rollback. See
509 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
513 sub txn_rollback { shift->storage->txn_rollback }
519 =item Arguments: C<$coderef>, @coderef_args?
521 =item Return Value: The return value of $coderef
525 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
526 returning its result (if any). If an exception is caught, a rollback is issued
527 and the exception is rethrown. If the rollback fails, (i.e. throws an
528 exception) an exception is thrown that includes a "Rollback failed" message.
532 my $author_rs = $schema->resultset('Author')->find(1);
535 my ($author, @titles) = @_;
537 # If any one of these fails, the entire transaction fails
538 $author->create_related('books', {
540 }) foreach (@titles);
542 return $author->books;
547 $rs = $schema->txn_do($coderef, $author_rs, qw/Night Day It/);
552 if ($error =~ /Rollback failed/) {
553 die "something terrible has happened!";
555 deal_with_failed_transaction();
559 In a nested transaction (calling txn_do() from within a txn_do() coderef) only
560 the outermost transaction will issue a L<DBIx::Class::Schema/"txn_commit"> on
561 the Schema's storage, and txn_do() can be called in void, scalar and list
562 context and it will behave as expected.
567 my ($self, $coderef, @args) = @_;
569 ref $self or $self->throw_exception
570 ('Cannot execute txn_do as a class method');
571 ref $coderef eq 'CODE' or $self->throw_exception
572 ('$coderef must be a CODE reference');
574 my (@return_values, $return_value);
576 $self->txn_begin; # If this throws an exception, no rollback is needed
578 my $wantarray = wantarray; # Need to save this since the context
579 # inside the eval{} block is independent
580 # of the context that called txn_do()
583 # Need to differentiate between scalar/list context to allow for
584 # returning a list in scalar context to get the size of the list
587 @return_values = $coderef->(@args);
588 } elsif (defined $wantarray) {
590 $return_value = $coderef->(@args);
606 my $rollback_error = $@;
607 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
608 $self->throw_exception($error) # propagate nested rollback
609 if $rollback_error =~ /$exception_class/;
611 $self->throw_exception(
612 "Transaction aborted: $error. Rollback failed: ${rollback_error}"
615 $self->throw_exception($error); # txn failed but rollback succeeded
619 return $wantarray ? @return_values : $return_value;
626 =item Return Value: $new_schema
630 Clones the schema and its associated result_source objects and returns the
637 my $clone = bless({ (ref $self ? %$self : ()) }, ref $self || $self);
638 foreach my $moniker ($self->sources) {
639 my $source = $self->source($moniker);
640 my $new = $source->new($source);
641 $clone->register_source($moniker => $new);
650 =item Arguments: $moniker, \@data;
654 Populates the source registered with the given moniker with the supplied data.
655 @data should be a list of listrefs -- the first containing column names, the
656 second matching values.
660 $schema->populate('Artist', [
661 [ qw/artistid name/ ],
662 [ 1, 'Popular Band' ],
670 my ($self, $name, $data) = @_;
671 my $rs = $self->resultset($name);
672 my @names = @{shift(@$data)};
674 foreach my $item (@$data) {
676 @create{@names} = @$item;
677 push(@created, $rs->create(\%create));
682 =head2 throw_exception
686 =item Arguments: $message
690 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
695 sub throw_exception {
700 =head2 deploy (EXPERIMENTAL)
704 =item Arguments: $sqlt_args
708 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
710 Note that this feature is currently EXPERIMENTAL and may not work correctly
711 across all databases, or fully handle complex relationships.
716 my ($self, $sqltargs) = @_;
717 $self->throw_exception("Can't deploy without storage") unless $self->storage;
718 $self->storage->deploy($self, undef, $sqltargs);
721 =head2 create_ddl_dir (EXPERIMENTAL)
725 =item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args
729 Creates an SQL file based on the Schema, for each of the specified
730 database types, in the given directory. Given a previous version number,
731 this will also create a file containing the ALTER TABLE statements to
732 transform the previous schema into the current one. Note that these
733 statements may contain DROP TABLE or DROP COLUMN statements that can
734 potentially destroy data.
736 The file names are created using the C<ddl_filename> method below, please
737 override thus method in your schema if you would like a different file
738 name format. For the ALTER file, the same format is used, replacing
739 $version in the name with "$preversion-$version".
741 If no arguments are passed, then the following default values are used:
745 =item databases - ['MySQL', 'SQLite', 'PostgreSQL']
747 =item version - $schema->VERSION
749 =item directory - './'
751 =item preversion - <none>
754 Note that this feature is currently EXPERIMENTAL and may not work correctly
755 across all databases, or fully handle complex relationships.
757 WARNING: Please check all SQL files created, before applying them.
765 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
766 $self->storage->create_ddl_dir($self, @_);
773 =item Arguments: $directory, $database-type, $version
777 This method is called by C<create_ddl_dir> to compose a file name out of
778 the supplied directory, database type and version number. The default file
779 name format is: "$filename-$version-$type.sql".
781 You may override this method in your schema if you wish to use a different
788 my ($self, $dir, $type, $version) = @_;
790 my $filename = ref($self);
791 $filename =~ s/^.*:://;
792 $filename = File::Spec->catpath($dir, "$filename-$version-$type.sql");
801 Matt S. Trout <mst@shadowcatsystems.co.uk>
805 You may distribute this code under the same terms as Perl itself.