1 package DBIx::Class::Schema;
6 use Carp::Clan qw/^DBIx::Class/;
7 use Scalar::Util qw/weaken/;
11 use base qw/DBIx::Class/;
13 __PACKAGE__->mk_classdata('class_mappings' => {});
14 __PACKAGE__->mk_classdata('source_registrations' => {});
15 __PACKAGE__->mk_classdata('storage_type' => '::DBI');
16 __PACKAGE__->mk_classdata('storage');
17 __PACKAGE__->mk_classdata('exception_action');
21 DBIx::Class::Schema - composable schemas
25 package Library::Schema;
26 use base qw/DBIx::Class::Schema/;
28 # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
29 __PACKAGE__->load_classes(qw/CD Book DVD/);
31 package Library::Schema::CD;
32 use base qw/DBIx::Class/;
33 __PACKAGE__->load_components(qw/PK::Auto Core/); # for example
34 __PACKAGE__->table('cd');
36 # Elsewhere in your code:
37 my $schema1 = Library::Schema->connect(
44 my $schema2 = Library::Schema->connect($coderef_returning_dbh);
46 # fetch objects using Library::Schema::DVD
47 my $resultset = $schema1->resultset('DVD')->search( ... );
48 my @dvd_objects = $schema2->resultset('DVD')->search( ... );
52 Creates database classes based on a schema. This is the recommended way to
53 use L<DBIx::Class> and allows you to use more than one concurrent connection
56 NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
57 carefully, as DBIx::Class does things a little differently. Note in
58 particular which module inherits off which.
66 =item Arguments: $moniker, $component_class
70 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
73 $schema->register_source($moniker, $component_class->result_source_instance);
78 my ($self, $moniker, $to_register) = @_;
79 $self->register_source($moniker => $to_register->result_source_instance);
82 =head2 register_source
86 =item Arguments: $moniker, $result_source
90 Registers the L<DBIx::Class::ResultSource> in the schema with the given
96 my ($self, $moniker, $source) = @_;
97 my %reg = %{$self->source_registrations};
98 $reg{$moniker} = $source;
99 $self->source_registrations(\%reg);
100 $source->schema($self);
101 weaken($source->{schema}) if ref($self);
102 if ($source->result_class) {
103 my %map = %{$self->class_mappings};
104 $map{$source->result_class} = $moniker;
105 $self->class_mappings(\%map);
113 =item Arguments: $moniker
115 =item Return Value: $classname
119 Retrieves the result class name for the given moniker. For example:
121 my $class = $schema->class('CD');
126 my ($self, $moniker) = @_;
127 return $self->source($moniker)->result_class;
134 =item Arguments: $moniker
136 =item Return Value: $result_source
140 my $source = $schema->source('Book');
142 Returns the L<DBIx::Class::ResultSource> object for the registered moniker.
147 my ($self, $moniker) = @_;
148 my $sreg = $self->source_registrations;
149 return $sreg->{$moniker} if exists $sreg->{$moniker};
151 # if we got here, they probably passed a full class name
152 my $mapped = $self->class_mappings->{$moniker};
153 $self->throw_exception("Can't find source for ${moniker}")
154 unless $mapped && exists $sreg->{$mapped};
155 return $sreg->{$mapped};
162 =item Return Value: @source_monikers
166 Returns the source monikers of all source registrations on this schema.
169 my @source_monikers = $schema->sources;
173 sub sources { return keys %{shift->source_registrations}; }
177 my $storage = $schema->storage;
179 Returns the L<DBIx::Class::Storage> object for this Schema.
185 =item Arguments: $moniker
187 =item Return Value: $result_set
191 my $rs = $schema->resultset('DVD');
193 Returns the L<DBIx::Class::ResultSet> object for the registered moniker.
198 my ($self, $moniker) = @_;
199 return $self->source($moniker)->resultset;
206 =item Arguments: @classes?, { $namespace => [ @classes ] }+
210 With no arguments, this method uses L<Module::Find> to find all classes under
211 the schema's namespace. Otherwise, this method loads the classes you specify
212 (using L<use>), and registers them (using L</"register_class">).
214 It is possible to comment out classes with a leading C<#>, but note that perl
215 will think it's a mistake (trying to use a comment in a qw list), so you'll
216 need to add C<no warnings 'qw';> before your load_classes call.
220 My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
221 # etc. (anything under the My::Schema namespace)
223 # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
224 # not Other::Namespace::LinerNotes nor My::Schema::Track
225 My::Schema->load_classes(qw/ CD Artist #Track /, {
226 Other::Namespace => [qw/ Producer #LinerNotes /],
232 my ($class, @params) = @_;
237 foreach my $param (@params) {
238 if (ref $param eq 'ARRAY') {
239 # filter out commented entries
240 my @modules = grep { $_ !~ /^#/ } @$param;
242 push (@{$comps_for{$class}}, @modules);
244 elsif (ref $param eq 'HASH') {
245 # more than one namespace possible
246 for my $comp ( keys %$param ) {
247 # filter out commented entries
248 my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
250 push (@{$comps_for{$comp}}, @modules);
254 # filter out commented entries
255 push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
259 my @comp = map { substr $_, length "${class}::" }
260 Module::Find::findallmod($class);
261 $comps_for{$class} = \@comp;
266 no warnings qw/redefine/;
267 local *Class::C3::reinitialize = sub { };
268 foreach my $prefix (keys %comps_for) {
269 foreach my $comp (@{$comps_for{$prefix}||[]}) {
270 my $comp_class = "${prefix}::${comp}";
271 { # try to untaint module name. mods where this fails
272 # are left alone so we don't have to change the old behavior
273 no locale; # localized \w doesn't untaint expression
274 if ( $comp_class =~ m/^( (?:\w+::)* \w+ )$/x ) {
278 $class->ensure_class_loaded($comp_class);
279 $comp_class->source_name($comp) unless $comp_class->source_name;
281 push(@to_register, [ $comp_class->source_name, $comp_class ]);
285 Class::C3->reinitialize;
287 foreach my $to (@to_register) {
288 $class->register_class(@$to);
289 # if $class->can('result_source_instance');
293 =head2 load_namespaces
297 =item Arguments: %options?
301 This is an alternative to L</load_classes> above which assumes an alternative
302 layout for automatic class loading. It assumes that all result
303 classes are underneath a sub-namespace of the schema called C<Result>, any
304 corresponding ResultSet classes are underneath a sub-namespace of the schema
307 Both of the sub-namespaces are configurable if you don't like the defaults,
308 via the options C<result_namespace> and C<resultset_namespace>.
310 If (and only if) you specify the option C<default_resultset_class>, any found
311 Result classes for which we do not find a corresponding
312 ResultSet class will have their C<resultset_class> set to
313 C<default_resultset_class>.
315 C<load_namespaces> takes care of calling C<resultset_class> for you where
316 neccessary if you didn't do it for yourself.
318 All of the namespace and classname options to this method are relative to
319 the schema classname by default. To specify a fully-qualified name, prefix
320 it with a literal C<+>.
324 # load My::Schema::Result::CD, My::Schema::Result::Artist,
325 # My::Schema::ResultSet::CD, etc...
326 My::Schema->load_namespaces;
328 # Override everything to use ugly names.
329 # In this example, if there is a My::Schema::Res::Foo, but no matching
330 # My::Schema::RSets::Foo, then Foo will have its
331 # resultset_class set to My::Schema::RSetBase
332 My::Schema->load_namespaces(
333 result_namespace => 'Res',
334 resultset_namespace => 'RSets',
335 default_resultset_class => 'RSetBase',
338 # Put things in other namespaces
339 My::Schema->load_namespaces(
340 result_namespace => '+Some::Place::Results',
341 resultset_namespace => '+Another::Place::RSets',
344 If you'd like to use multiple namespaces of each type, simply use an arrayref
345 of namespaces for that option. In the case that the same result
346 (or resultset) class exists in multiple namespaces, the latter entries in
347 your list of namespaces will override earlier ones.
349 My::Schema->load_namespaces(
350 # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo :
351 result_namespace => [ 'Results_A', 'Results_B', 'Results_C' ],
352 resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
357 # Pre-pends our classname to the given relative classname or
358 # class namespace, unless there is a '+' prefix, which will
360 sub _expand_relative_name {
361 my ($class, $name) = @_;
363 $name = $class . '::' . $name if ! ($name =~ s/^\+//);
367 # returns a hash of $shortname => $fullname for every package
368 # found in the given namespaces ($shortname is with the $fullname's
369 # namespace stripped off)
370 sub _map_namespaces {
371 my ($class, @namespaces) = @_;
374 foreach my $namespace (@namespaces) {
377 map { (substr($_, length "${namespace}::"), $_) }
378 Module::Find::findallmod($namespace)
385 sub load_namespaces {
386 my ($class, %args) = @_;
388 my $result_namespace = delete $args{result_namespace} || 'Result';
389 my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
390 my $default_resultset_class = delete $args{default_resultset_class};
392 $class->throw_exception('load_namespaces: unknown option(s): '
393 . join(q{,}, map { qq{'$_'} } keys %args))
394 if scalar keys %args;
396 $default_resultset_class
397 = $class->_expand_relative_name($default_resultset_class);
399 for my $arg ($result_namespace, $resultset_namespace) {
400 $arg = [ $arg ] if !ref($arg) && $arg;
402 $class->throw_exception('load_namespaces: namespace arguments must be '
403 . 'a simple string or an arrayref')
404 if ref($arg) ne 'ARRAY';
406 $_ = $class->_expand_relative_name($_) for (@$arg);
409 my %results = $class->_map_namespaces(@$result_namespace);
410 my %resultsets = $class->_map_namespaces(@$resultset_namespace);
414 no warnings 'redefine';
415 local *Class::C3::reinitialize = sub { };
416 use warnings 'redefine';
418 foreach my $result (keys %results) {
419 my $result_class = $results{$result};
420 $class->ensure_class_loaded($result_class);
421 $result_class->source_name($result) unless $result_class->source_name;
423 my $rs_class = delete $resultsets{$result};
424 my $rs_set = $result_class->resultset_class;
425 if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
426 if($rs_class && $rs_class ne $rs_set) {
427 warn "We found ResultSet class '$rs_class' for '$result', but it seems "
428 . "that you had already set '$result' to use '$rs_set' instead";
431 elsif($rs_class ||= $default_resultset_class) {
432 $class->ensure_class_loaded($rs_class);
433 $result_class->resultset_class($rs_class);
436 push(@to_register, [ $result_class->source_name, $result_class ]);
440 foreach (sort keys %resultsets) {
441 warn "load_namespaces found ResultSet class $_ with no "
442 . 'corresponding Result class';
445 Class::C3->reinitialize;
446 $class->register_class(@$_) for (@to_register);
451 =head2 compose_connection
455 =item Arguments: $target_namespace, @db_info
457 =item Return Value: $new_schema
461 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
462 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
463 then injects the L<DBix::Class::ResultSetProxy> component and a
464 resultset_instance classdata entry on all the new classes, in order to support
465 $target_namespaces::$class->search(...) method calls.
467 This is primarily useful when you have a specific need for class method access
468 to a connection. In normal usage it is preferred to call
469 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
470 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
475 sub compose_connection {
476 my ($self, $target, @info) = @_;
477 my $base = 'DBIx::Class::ResultSetProxy';
478 eval "require ${base};";
479 $self->throw_exception
480 ("No arguments to load_classes and couldn't load ${base} ($@)")
483 if ($self eq $target) {
484 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
485 foreach my $moniker ($self->sources) {
486 my $source = $self->source($moniker);
487 my $class = $source->result_class;
488 $self->inject_base($class, $base);
489 $class->mk_classdata(resultset_instance => $source->resultset);
490 $class->mk_classdata(class_resolver => $self);
492 $self->connection(@info);
496 my $schema = $self->compose_namespace($target, $base);
499 *{"${target}::schema"} = sub { $schema };
502 $schema->connection(@info);
503 foreach my $moniker ($schema->sources) {
504 my $source = $schema->source($moniker);
505 my $class = $source->result_class;
506 #warn "$moniker $class $source ".$source->storage;
507 $class->mk_classdata(result_source_instance => $source);
508 $class->mk_classdata(resultset_instance => $source->resultset);
509 $class->mk_classdata(class_resolver => $schema);
514 =head2 compose_namespace
518 =item Arguments: $target_namespace, $additional_base_class?
520 =item Return Value: $new_schema
524 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
525 class in the target namespace (e.g. $target_namespace::CD,
526 $target_namespace::Artist) that inherits from the corresponding classes
527 attached to the current schema.
529 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
530 new $schema object. If C<$additional_base_class> is given, the new composed
531 classes will inherit from first the corresponding classe from the current
532 schema then the base class.
534 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
536 $schema->compose_namespace('My::DB', 'Base::Class');
537 print join (', ', @My::DB::CD::ISA) . "\n";
538 print join (', ', @My::DB::Artist::ISA) ."\n";
540 will produce the output
542 My::Schema::CD, Base::Class
543 My::Schema::Artist, Base::Class
547 sub compose_namespace {
548 my ($self, $target, $base) = @_;
549 my %reg = %{ $self->source_registrations };
552 my $schema = $self->clone;
554 no warnings qw/redefine/;
555 local *Class::C3::reinitialize = sub { };
556 foreach my $moniker ($schema->sources) {
557 my $source = $schema->source($moniker);
558 my $target_class = "${target}::${moniker}";
560 $target_class => $source->result_class, ($base ? $base : ())
562 $source->result_class($target_class);
563 $target_class->result_source_instance($source)
564 if $target_class->can('result_source_instance');
567 Class::C3->reinitialize();
570 foreach my $meth (qw/class source resultset/) {
571 *{"${target}::${meth}"} =
572 sub { shift->schema->$meth(@_) };
578 =head2 setup_connection_class
582 =item Arguments: $target, @info
586 Sets up a database connection class to inject between the schema and the
587 subclasses that the schema creates.
591 sub setup_connection_class {
592 my ($class, $target, @info) = @_;
593 $class->inject_base($target => 'DBIx::Class::DB');
594 #$target->load_components('DB');
595 $target->connection(@info);
602 =item Arguments: $storage_type
604 =item Return Value: $storage_type
608 Set the storage class that will be instantiated when L</connect> is called.
609 If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
610 assumed by L</connect>. Defaults to C<::DBI>,
611 which is L<DBIx::Class::Storage::DBI>.
613 You want to use this to hardcoded subclasses of L<DBIx::Class::Storage::DBI>
614 in cases where the appropriate subclass is not autodetected, such as when
615 dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it to
616 C<::DBI::Sybase::MSSQL>.
622 =item Arguments: @args
624 =item Return Value: $new_schema
628 Instantiates a new Storage object of type
629 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
630 $storage->connect_info. Sets the connection in-place on the schema.
632 See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific syntax,
633 or L<DBIx::Class::Storage> in general.
638 my ($self, @info) = @_;
639 return $self if !@info && $self->storage;
640 my $storage_class = $self->storage_type;
641 $storage_class = 'DBIx::Class::Storage'.$storage_class
642 if $storage_class =~ m/^::/;
643 eval "require ${storage_class};";
644 $self->throw_exception(
645 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
647 my $storage = $storage_class->new($self);
648 $storage->connect_info(\@info);
649 $self->storage($storage);
650 $self->on_connect() if($self->can('on_connect'));
658 =item Arguments: @info
660 =item Return Value: $new_schema
664 This is a convenience method. It is equivalent to calling
665 $schema->clone->connection(@info). See L</connection> and L</clone> for more
670 sub connect { shift->clone->connection(@_) }
676 =item Arguments: C<$coderef>, @coderef_args?
678 =item Return Value: The return value of $coderef
682 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
683 returning its result (if any). Equivalent to calling $schema->storage->txn_do.
684 See L<DBIx::Class::Storage/"txn_do"> for more information.
686 This interface is preferred over using the individual methods L</txn_begin>,
687 L</txn_commit>, and L</txn_rollback> below.
694 $self->storage or $self->throw_exception
695 ('txn_do called on $schema without storage');
697 $self->storage->txn_do(@_);
702 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
703 calling $schema->storage->txn_begin. See
704 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
711 $self->storage or $self->throw_exception
712 ('txn_begin called on $schema without storage');
714 $self->storage->txn_begin;
719 Commits the current transaction. Equivalent to calling
720 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
721 for more information.
728 $self->storage or $self->throw_exception
729 ('txn_commit called on $schema without storage');
731 $self->storage->txn_commit;
736 Rolls back the current transaction. Equivalent to calling
737 $schema->storage->txn_rollback. See
738 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
745 $self->storage or $self->throw_exception
746 ('txn_rollback called on $schema without storage');
748 $self->storage->txn_rollback;
755 =item Return Value: $new_schema
759 Clones the schema and its associated result_source objects and returns the
766 my $clone = { (ref $self ? %$self : ()) };
767 bless $clone, (ref $self || $self);
769 foreach my $moniker ($self->sources) {
770 my $source = $self->source($moniker);
771 my $new = $source->new($source);
772 $clone->register_source($moniker => $new);
774 $clone->storage->set_schema($clone) if $clone->storage;
782 =item Arguments: $source_name, \@data;
786 Pass this method a resultsource name, and an arrayref of
787 arrayrefs. The arrayrefs should contain a list of column names,
788 followed by one or many sets of matching data for the given columns.
790 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
791 to insert the data, as this is a fast method. However, insert_bulk currently
792 assumes that your datasets all contain the same type of values, using scalar
793 references in a column in one row, and not in another will probably not work.
795 Otherwise, each set of data is inserted into the database using
796 L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
801 $schema->populate('Artist', [
802 [ qw/artistid name/ ],
803 [ 1, 'Popular Band' ],
811 my ($self, $name, $data) = @_;
812 my $rs = $self->resultset($name);
813 my @names = @{shift(@$data)};
814 if(defined wantarray) {
816 foreach my $item (@$data) {
818 @create{@names} = @$item;
819 push(@created, $rs->create(\%create));
823 $self->storage->insert_bulk($self->source($name)->from, \@names, $data);
826 =head2 exception_action
830 =item Arguments: $code_reference
834 If C<exception_action> is set for this class/object, L</throw_exception>
835 will prefer to call this code reference with the exception as an argument,
836 rather than its normal <croak> action.
838 Your subroutine should probably just wrap the error in the exception
839 object/class of your choosing and rethrow. If, against all sage advice,
840 you'd like your C<exception_action> to suppress a particular exception
841 completely, simply have it return true.
846 use base qw/DBIx::Class::Schema/;
847 use My::ExceptionClass;
848 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
849 __PACKAGE__->load_classes;
852 my $schema_obj = My::Schema->connect( .... );
853 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
855 # suppress all exceptions, like a moron:
856 $schema_obj->exception_action(sub { 1 });
858 =head2 throw_exception
862 =item Arguments: $message
866 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
867 user's perspective. See L</exception_action> for details on overriding
868 this method's behavior.
872 sub throw_exception {
874 croak @_ if !$self->exception_action || !$self->exception_action->(@_);
877 =head2 deploy (EXPERIMENTAL)
881 =item Arguments: $sqlt_args, $dir
885 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
887 Note that this feature is currently EXPERIMENTAL and may not work correctly
888 across all databases, or fully handle complex relationships.
890 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
891 common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
892 produced include a DROP TABLE statement for each table created.
897 my ($self, $sqltargs, $dir) = @_;
898 $self->throw_exception("Can't deploy without storage") unless $self->storage;
899 $self->storage->deploy($self, undef, $sqltargs, $dir);
902 =head2 create_ddl_dir (EXPERIMENTAL)
906 =item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args
910 Creates an SQL file based on the Schema, for each of the specified
911 database types, in the given directory. Given a previous version number,
912 this will also create a file containing the ALTER TABLE statements to
913 transform the previous schema into the current one. Note that these
914 statements may contain DROP TABLE or DROP COLUMN statements that can
915 potentially destroy data.
917 The file names are created using the C<ddl_filename> method below, please
918 override this method in your schema if you would like a different file
919 name format. For the ALTER file, the same format is used, replacing
920 $version in the name with "$preversion-$version".
922 If no arguments are passed, then the following default values are used:
926 =item databases - ['MySQL', 'SQLite', 'PostgreSQL']
928 =item version - $schema->VERSION
930 =item directory - './'
932 =item preversion - <none>
936 Note that this feature is currently EXPERIMENTAL and may not work correctly
937 across all databases, or fully handle complex relationships.
939 WARNING: Please check all SQL files created, before applying them.
946 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
947 $self->storage->create_ddl_dir($self, @_);
950 =head2 ddl_filename (EXPERIMENTAL)
954 =item Arguments: $directory, $database-type, $version, $preversion
958 my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
960 This method is called by C<create_ddl_dir> to compose a file name out of
961 the supplied directory, database type and version number. The default file
962 name format is: C<$dir$schema-$version-$type.sql>.
964 You may override this method in your schema if you wish to use a different
970 my ($self, $type, $dir, $version, $pversion) = @_;
972 my $filename = ref($self);
973 $filename =~ s/::/-/;
974 $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
975 $filename =~ s/$version/$pversion-$version/ if($pversion);
984 Matt S. Trout <mst@shadowcatsystems.co.uk>
988 You may distribute this code under the same terms as Perl itself.