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}; }
176 my $storage = $schema->storage;
178 Returns the L<DBIx::Class::Storage> object for this Schema.
184 =item Arguments: $moniker
186 =item Return Value: $result_set
190 my $rs = $schema->resultset('DVD');
192 Returns the L<DBIx::Class::ResultSet> object for the registered moniker.
197 my ($self, $moniker) = @_;
198 return $self->source($moniker)->resultset;
205 =item Arguments: @classes?, { $namespace => [ @classes ] }+
209 With no arguments, this method uses L<Module::Find> to find all classes under
210 the schema's namespace. Otherwise, this method loads the classes you specify
211 (using L<use>), and registers them (using L</"register_class">).
213 It is possible to comment out classes with a leading C<#>, but note that perl
214 will think it's a mistake (trying to use a comment in a qw list), so you'll
215 need to add C<no warnings 'qw';> before your load_classes call.
219 My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
220 # etc. (anything under the My::Schema namespace)
222 # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
223 # not Other::Namespace::LinerNotes nor My::Schema::Track
224 My::Schema->load_classes(qw/ CD Artist #Track /, {
225 Other::Namespace => [qw/ Producer #LinerNotes /],
231 my ($class, @params) = @_;
236 foreach my $param (@params) {
237 if (ref $param eq 'ARRAY') {
238 # filter out commented entries
239 my @modules = grep { $_ !~ /^#/ } @$param;
241 push (@{$comps_for{$class}}, @modules);
243 elsif (ref $param eq 'HASH') {
244 # more than one namespace possible
245 for my $comp ( keys %$param ) {
246 # filter out commented entries
247 my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
249 push (@{$comps_for{$comp}}, @modules);
253 # filter out commented entries
254 push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
258 my @comp = map { substr $_, length "${class}::" }
259 Module::Find::findallmod($class);
260 $comps_for{$class} = \@comp;
265 no warnings qw/redefine/;
266 local *Class::C3::reinitialize = sub { };
267 foreach my $prefix (keys %comps_for) {
268 foreach my $comp (@{$comps_for{$prefix}||[]}) {
269 my $comp_class = "${prefix}::${comp}";
270 $class->ensure_class_loaded($comp_class);
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 load_namespaces
289 =item Arguments: %options?
293 This is an alternative to L</load_classes> above which assumes an alternative
294 layout for automatic class loading. It assumes that all result
295 classes are underneath a sub-namespace of the schema called C<Result>, any
296 corresponding ResultSet classes are underneath a sub-namespace of the schema
299 Both of the sub-namespaces are configurable if you don't like the defaults,
300 via the options C<result_namespace> and C<resultset_namespace>.
302 If (and only if) you specify the option C<default_resultset_class>, any found
303 Result classes for which we do not find a corresponding
304 ResultSet class will have their C<resultset_class> set to
305 C<default_resultset_class>.
307 C<load_namespaces> takes care of calling C<resultset_class> for you where
308 neccessary if you didn't do it for yourself.
310 All of the namespace and classname options to this method are relative to
311 the schema classname by default. To specify a fully-qualified name, prefix
312 it with a literal C<+>.
316 # load My::Schema::Result::CD, My::Schema::Result::Artist,
317 # My::Schema::ResultSet::CD, etc...
318 My::Schema->load_namespaces;
320 # Override everything to use ugly names.
321 # In this example, if there is a My::Schema::Res::Foo, but no matching
322 # My::Schema::RSets::Foo, then Foo will have its
323 # resultset_class set to My::Schema::RSetBase
324 My::Schema->load_namespaces(
325 result_namespace => 'Res',
326 resultset_namespace => 'RSets',
327 default_resultset_class => 'RSetBase',
330 # Put things in other namespaces
331 My::Schema->load_namespaces(
332 result_namespace => '+Some::Place::Results',
333 resultset_namespace => '+Another::Place::RSets',
336 If you'd like to use multiple namespaces of each type, simply use an arrayref
337 of namespaces for that option. In the case that the same result
338 (or resultset) class exists in multiple namespaces, the latter entries in
339 your list of namespaces will override earlier ones.
341 My::Schema->load_namespaces(
342 # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo :
343 result_namespace => [ 'Results_A', 'Results_B', 'Results_C' ],
344 resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
349 # Pre-pends our classname to the given relative classname or
350 # class namespace, unless there is a '+' prefix, which will
352 sub _expand_relative_name {
353 my ($class, $name) = @_;
355 $name = $class . '::' . $name if ! ($name =~ s/^\+//);
359 # returns a hash of $shortname => $fullname for every package
360 # found in the given namespaces ($shortname is with the $fullname's
361 # namespace stripped off)
362 sub _map_namespaces {
363 my ($class, @namespaces) = @_;
366 foreach my $namespace (@namespaces) {
369 map { (substr($_, length "${namespace}::"), $_) }
370 Module::Find::findallmod($namespace)
377 sub load_namespaces {
378 my ($class, %args) = @_;
380 my $result_namespace = delete $args{result_namespace} || 'Result';
381 my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
382 my $default_resultset_class = delete $args{default_resultset_class};
384 $class->throw_exception('load_namespaces: unknown option(s): '
385 . join(q{,}, map { qq{'$_'} } keys %args))
386 if scalar keys %args;
388 $default_resultset_class
389 = $class->_expand_relative_name($default_resultset_class);
391 for my $arg ($result_namespace, $resultset_namespace) {
392 $arg = [ $arg ] if !ref($arg) && $arg;
394 $class->throw_exception('load_namespaces: namespace arguments must be '
395 . 'a simple string or an arrayref')
396 if ref($arg) ne 'ARRAY';
398 $_ = $class->_expand_relative_name($_) for (@$arg);
401 my %results = $class->_map_namespaces(@$result_namespace);
402 my %resultsets = $class->_map_namespaces(@$resultset_namespace);
406 no warnings 'redefine';
407 local *Class::C3::reinitialize = sub { };
408 use warnings 'redefine';
410 foreach my $result (keys %results) {
411 my $result_class = $results{$result};
412 $class->ensure_class_loaded($result_class);
413 $result_class->source_name($result) unless $result_class->source_name;
415 my $rs_class = delete $resultsets{$result};
416 my $rs_set = $result_class->resultset_class;
417 if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
418 if($rs_class && $rs_class ne $rs_set) {
419 warn "We found ResultSet class '$rs_class' for '$result', but it seems "
420 . "that you had already set '$result' to use '$rs_set' instead";
423 elsif($rs_class ||= $default_resultset_class) {
424 $class->ensure_class_loaded($rs_class);
425 $result_class->resultset_class($rs_class);
428 push(@to_register, [ $result_class->source_name, $result_class ]);
432 foreach (sort keys %resultsets) {
433 warn "load_namespaces found ResultSet class $_ with no "
434 . 'corresponding Result class';
437 Class::C3->reinitialize;
438 $class->register_class(@$_) for (@to_register);
443 =head2 compose_connection
447 =item Arguments: $target_namespace, @db_info
449 =item Return Value: $new_schema
453 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
454 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
455 then injects the L<DBix::Class::ResultSetProxy> component and a
456 resultset_instance classdata entry on all the new classes, in order to support
457 $target_namespaces::$class->search(...) method calls.
459 This is primarily useful when you have a specific need for class method access
460 to a connection. In normal usage it is preferred to call
461 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
462 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
467 sub compose_connection {
468 my ($self, $target, @info) = @_;
469 my $base = 'DBIx::Class::ResultSetProxy';
470 eval "require ${base};";
471 $self->throw_exception
472 ("No arguments to load_classes and couldn't load ${base} ($@)")
475 if ($self eq $target) {
476 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
477 foreach my $moniker ($self->sources) {
478 my $source = $self->source($moniker);
479 my $class = $source->result_class;
480 $self->inject_base($class, $base);
481 $class->mk_classdata(resultset_instance => $source->resultset);
482 $class->mk_classdata(class_resolver => $self);
484 $self->connection(@info);
488 my $schema = $self->compose_namespace($target, $base);
491 *{"${target}::schema"} = sub { $schema };
494 $schema->connection(@info);
495 foreach my $moniker ($schema->sources) {
496 my $source = $schema->source($moniker);
497 my $class = $source->result_class;
498 #warn "$moniker $class $source ".$source->storage;
499 $class->mk_classdata(result_source_instance => $source);
500 $class->mk_classdata(resultset_instance => $source->resultset);
501 $class->mk_classdata(class_resolver => $schema);
506 =head2 compose_namespace
510 =item Arguments: $target_namespace, $additional_base_class?
512 =item Return Value: $new_schema
516 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
517 class in the target namespace (e.g. $target_namespace::CD,
518 $target_namespace::Artist) that inherits from the corresponding classes
519 attached to the current schema.
521 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
522 new $schema object. If C<$additional_base_class> is given, the new composed
523 classes will inherit from first the corresponding classe from the current
524 schema then the base class.
526 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
528 $schema->compose_namespace('My::DB', 'Base::Class');
529 print join (', ', @My::DB::CD::ISA) . "\n";
530 print join (', ', @My::DB::Artist::ISA) ."\n";
532 will produce the output
534 My::Schema::CD, Base::Class
535 My::Schema::Artist, Base::Class
539 sub compose_namespace {
540 my ($self, $target, $base) = @_;
541 my %reg = %{ $self->source_registrations };
544 my $schema = $self->clone;
546 no warnings qw/redefine/;
547 local *Class::C3::reinitialize = sub { };
548 foreach my $moniker ($schema->sources) {
549 my $source = $schema->source($moniker);
550 my $target_class = "${target}::${moniker}";
552 $target_class => $source->result_class, ($base ? $base : ())
554 $source->result_class($target_class);
555 $target_class->result_source_instance($source)
556 if $target_class->can('result_source_instance');
559 Class::C3->reinitialize();
562 foreach my $meth (qw/class source resultset/) {
563 *{"${target}::${meth}"} =
564 sub { shift->schema->$meth(@_) };
570 =head2 setup_connection_class
574 =item Arguments: $target, @info
578 Sets up a database connection class to inject between the schema and the
579 subclasses that the schema creates.
583 sub setup_connection_class {
584 my ($class, $target, @info) = @_;
585 $class->inject_base($target => 'DBIx::Class::DB');
586 #$target->load_components('DB');
587 $target->connection(@info);
594 =item Arguments: $storage_type
596 =item Return Value: $storage_type
600 Set the storage class that will be instantiated when L</connect> is called.
601 If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
602 assumed by L</connect>. Defaults to C<::DBI>,
603 which is L<DBIx::Class::Storage::DBI>.
605 You want to use this to hardcoded subclasses of L<DBIx::Class::Storage::DBI>
606 in cases where the appropriate subclass is not autodetected, such as when
607 dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it to
608 C<::DBI::Sybase::MSSQL>.
614 =item Arguments: @args
616 =item Return Value: $new_schema
620 Instantiates a new Storage object of type
621 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
622 $storage->connect_info. Sets the connection in-place on the schema.
624 See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific syntax,
625 or L<DBIx::Class::Storage> in general.
630 my ($self, @info) = @_;
631 return $self if !@info && $self->storage;
632 my $storage_class = $self->storage_type;
633 $storage_class = 'DBIx::Class::Storage'.$storage_class
634 if $storage_class =~ m/^::/;
635 eval "require ${storage_class};";
636 $self->throw_exception(
637 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
639 my $storage = $storage_class->new($self);
640 $storage->connect_info(\@info);
641 $self->storage($storage);
649 =item Arguments: @info
651 =item Return Value: $new_schema
655 This is a convenience method. It is equivalent to calling
656 $schema->clone->connection(@info). See L</connection> and L</clone> for more
661 sub connect { shift->clone->connection(@_) }
667 =item Arguments: C<$coderef>, @coderef_args?
669 =item Return Value: The return value of $coderef
673 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
674 returning its result (if any). Equivalent to calling $schema->storage->txn_do.
675 See L<DBIx::Class::Storage/"txn_do"> for more information.
677 This interface is preferred over using the individual methods L</txn_begin>,
678 L</txn_commit>, and L</txn_rollback> below.
685 $self->storage or $self->throw_exception
686 ('txn_do called on $schema without storage');
688 $self->storage->txn_do(@_);
693 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
694 calling $schema->storage->txn_begin. See
695 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
702 $self->storage or $self->throw_exception
703 ('txn_begin called on $schema without storage');
705 $self->storage->txn_begin;
710 Commits the current transaction. Equivalent to calling
711 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
712 for more information.
719 $self->storage or $self->throw_exception
720 ('txn_commit called on $schema without storage');
722 $self->storage->txn_commit;
727 Rolls back the current transaction. Equivalent to calling
728 $schema->storage->txn_rollback. See
729 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
736 $self->storage or $self->throw_exception
737 ('txn_rollback called on $schema without storage');
739 $self->storage->txn_rollback;
746 =item Return Value: $new_schema
750 Clones the schema and its associated result_source objects and returns the
757 my $clone = { (ref $self ? %$self : ()) };
758 bless $clone, (ref $self || $self);
760 foreach my $moniker ($self->sources) {
761 my $source = $self->source($moniker);
762 my $new = $source->new($source);
763 $clone->register_source($moniker => $new);
765 $clone->storage->set_schema($clone) if $clone->storage;
773 =item Arguments: $source_name, \@data;
777 Pass this method a resultsource name, and an arrayref of
778 arrayrefs. The arrayrefs should contain a list of column names,
779 followed by one or many sets of matching data for the given columns.
781 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
782 to insert the data, as this is a fast method. However, insert_bulk currently
783 assumes that your datasets all contain the same type of values, using scalar
784 references in a column in one row, and not in another will probably not work.
786 Otherwise, each set of data is inserted into the database using
787 L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
792 $schema->populate('Artist', [
793 [ qw/artistid name/ ],
794 [ 1, 'Popular Band' ],
802 my ($self, $name, $data) = @_;
803 my $rs = $self->resultset($name);
804 my @names = @{shift(@$data)};
805 if(defined wantarray) {
807 foreach my $item (@$data) {
809 @create{@names} = @$item;
810 push(@created, $rs->create(\%create));
814 $self->storage->insert_bulk($self->source($name)->from, \@names, $data);
817 =head2 exception_action
821 =item Arguments: $code_reference
825 If C<exception_action> is set for this class/object, L</throw_exception>
826 will prefer to call this code reference with the exception as an argument,
827 rather than its normal <croak> action.
829 Your subroutine should probably just wrap the error in the exception
830 object/class of your choosing and rethrow. If, against all sage advice,
831 you'd like your C<exception_action> to suppress a particular exception
832 completely, simply have it return true.
837 use base qw/DBIx::Class::Schema/;
838 use My::ExceptionClass;
839 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
840 __PACKAGE__->load_classes;
843 my $schema_obj = My::Schema->connect( .... );
844 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
846 # suppress all exceptions, like a moron:
847 $schema_obj->exception_action(sub { 1 });
849 =head2 throw_exception
853 =item Arguments: $message
857 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
858 user's perspective. See L</exception_action> for details on overriding
859 this method's behavior.
863 sub throw_exception {
865 croak @_ if !$self->exception_action || !$self->exception_action->(@_);
868 =head2 deploy (EXPERIMENTAL)
872 =item Arguments: $sqlt_args, $dir
876 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
878 Note that this feature is currently EXPERIMENTAL and may not work correctly
879 across all databases, or fully handle complex relationships.
881 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
882 common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
883 produced include a DROP TABLE statement for each table created.
888 my ($self, $sqltargs, $dir) = @_;
889 $self->throw_exception("Can't deploy without storage") unless $self->storage;
890 $self->storage->deploy($self, undef, $sqltargs, $dir);
893 =head2 create_ddl_dir (EXPERIMENTAL)
897 =item Arguments: \@databases, $version, $directory, $sqlt_args
901 Creates an SQL file based on the Schema, for each of the specified
902 database types, in the given directory.
904 Note that this feature is currently EXPERIMENTAL and may not work correctly
905 across all databases, or fully handle complex relationships.
912 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
913 $self->storage->create_ddl_dir($self, @_);
916 =head2 ddl_filename (EXPERIMENTAL)
918 my $filename = $table->ddl_filename($type, $dir, $version)
920 Creates a filename for a SQL file based on the table class name. Not
921 intended for direct end user use.
926 my ($self, $type, $dir, $version) = @_;
928 my $filename = ref($self);
929 $filename =~ s/::/-/;
930 $filename = "$dir$filename-$version-$type.sql";
939 Matt S. Trout <mst@shadowcatsystems.co.uk>
943 You may distribute this code under the same terms as Perl itself.