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 (DEPRECATED)
455 =item Arguments: $target_namespace, @db_info
457 =item Return Value: $new_schema
461 DEPRECATED. You probably wanted compose_namespace.
463 Actually, you probably just wanted to call connect.
465 =for hidden due to deprecation
467 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
468 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
469 then injects the L<DBix::Class::ResultSetProxy> component and a
470 resultset_instance classdata entry on all the new classes, in order to support
471 $target_namespaces::$class->search(...) method calls.
473 This is primarily useful when you have a specific need for class method access
474 to a connection. In normal usage it is preferred to call
475 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
476 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
484 sub compose_connection {
485 my ($self, $target, @info) = @_;
487 warn "compose_connection deprecated as of 0.08000" unless $warn++;
489 my $base = 'DBIx::Class::ResultSetProxy';
490 eval "require ${base};";
491 $self->throw_exception
492 ("No arguments to load_classes and couldn't load ${base} ($@)")
495 if ($self eq $target) {
496 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
497 foreach my $moniker ($self->sources) {
498 my $source = $self->source($moniker);
499 my $class = $source->result_class;
500 $self->inject_base($class, $base);
501 $class->mk_classdata(resultset_instance => $source->resultset);
502 $class->mk_classdata(class_resolver => $self);
504 $self->connection(@info);
508 my $schema = $self->compose_namespace($target, $base);
511 *{"${target}::schema"} = sub { $schema };
514 $schema->connection(@info);
515 foreach my $moniker ($schema->sources) {
516 my $source = $schema->source($moniker);
517 my $class = $source->result_class;
518 #warn "$moniker $class $source ".$source->storage;
519 $class->mk_classdata(result_source_instance => $source);
520 $class->mk_classdata(resultset_instance => $source->resultset);
521 $class->mk_classdata(class_resolver => $schema);
527 =head2 compose_namespace
531 =item Arguments: $target_namespace, $additional_base_class?
533 =item Return Value: $new_schema
537 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
538 class in the target namespace (e.g. $target_namespace::CD,
539 $target_namespace::Artist) that inherits from the corresponding classes
540 attached to the current schema.
542 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
543 new $schema object. If C<$additional_base_class> is given, the new composed
544 classes will inherit from first the corresponding classe from the current
545 schema then the base class.
547 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
549 $schema->compose_namespace('My::DB', 'Base::Class');
550 print join (', ', @My::DB::CD::ISA) . "\n";
551 print join (', ', @My::DB::Artist::ISA) ."\n";
553 will produce the output
555 My::Schema::CD, Base::Class
556 My::Schema::Artist, Base::Class
560 sub compose_namespace {
561 my ($self, $target, $base) = @_;
562 my %reg = %{ $self->source_registrations };
565 my $schema = $self->clone;
567 no warnings qw/redefine/;
568 local *Class::C3::reinitialize = sub { };
569 foreach my $moniker ($schema->sources) {
570 my $source = $schema->source($moniker);
571 my $target_class = "${target}::${moniker}";
573 $target_class => $source->result_class, ($base ? $base : ())
575 $source->result_class($target_class);
576 $target_class->result_source_instance($source)
577 if $target_class->can('result_source_instance');
580 Class::C3->reinitialize();
583 foreach my $meth (qw/class source resultset/) {
584 *{"${target}::${meth}"} =
585 sub { shift->schema->$meth(@_) };
591 =head2 setup_connection_class
595 =item Arguments: $target, @info
599 Sets up a database connection class to inject between the schema and the
600 subclasses that the schema creates.
604 sub setup_connection_class {
605 my ($class, $target, @info) = @_;
606 $class->inject_base($target => 'DBIx::Class::DB');
607 #$target->load_components('DB');
608 $target->connection(@info);
615 =item Arguments: $storage_type
617 =item Return Value: $storage_type
621 Set the storage class that will be instantiated when L</connect> is called.
622 If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
623 assumed by L</connect>. Defaults to C<::DBI>,
624 which is L<DBIx::Class::Storage::DBI>.
626 You want to use this to hardcoded subclasses of L<DBIx::Class::Storage::DBI>
627 in cases where the appropriate subclass is not autodetected, such as when
628 dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it to
629 C<::DBI::Sybase::MSSQL>.
635 =item Arguments: @args
637 =item Return Value: $new_schema
641 Instantiates a new Storage object of type
642 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
643 $storage->connect_info. Sets the connection in-place on the schema.
645 See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific syntax,
646 or L<DBIx::Class::Storage> in general.
651 my ($self, @info) = @_;
652 return $self if !@info && $self->storage;
653 my $storage_class = $self->storage_type;
654 $storage_class = 'DBIx::Class::Storage'.$storage_class
655 if $storage_class =~ m/^::/;
656 eval "require ${storage_class};";
657 $self->throw_exception(
658 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
660 my $storage = $storage_class->new($self);
661 $storage->connect_info(\@info);
662 $self->storage($storage);
663 $self->on_connect() if($self->can('on_connect'));
671 =item Arguments: @info
673 =item Return Value: $new_schema
677 This is a convenience method. It is equivalent to calling
678 $schema->clone->connection(@info). See L</connection> and L</clone> for more
683 sub connect { shift->clone->connection(@_) }
689 =item Arguments: C<$coderef>, @coderef_args?
691 =item Return Value: The return value of $coderef
695 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
696 returning its result (if any). Equivalent to calling $schema->storage->txn_do.
697 See L<DBIx::Class::Storage/"txn_do"> for more information.
699 This interface is preferred over using the individual methods L</txn_begin>,
700 L</txn_commit>, and L</txn_rollback> below.
707 $self->storage or $self->throw_exception
708 ('txn_do called on $schema without storage');
710 $self->storage->txn_do(@_);
715 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
716 calling $schema->storage->txn_begin. See
717 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
724 $self->storage or $self->throw_exception
725 ('txn_begin called on $schema without storage');
727 $self->storage->txn_begin;
732 Commits the current transaction. Equivalent to calling
733 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
734 for more information.
741 $self->storage or $self->throw_exception
742 ('txn_commit called on $schema without storage');
744 $self->storage->txn_commit;
749 Rolls back the current transaction. Equivalent to calling
750 $schema->storage->txn_rollback. See
751 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
758 $self->storage or $self->throw_exception
759 ('txn_rollback called on $schema without storage');
761 $self->storage->txn_rollback;
768 =item Return Value: $new_schema
772 Clones the schema and its associated result_source objects and returns the
779 my $clone = { (ref $self ? %$self : ()) };
780 bless $clone, (ref $self || $self);
782 foreach my $moniker ($self->sources) {
783 my $source = $self->source($moniker);
784 my $new = $source->new($source);
785 $clone->register_source($moniker => $new);
787 $clone->storage->set_schema($clone) if $clone->storage;
795 =item Arguments: $source_name, \@data;
799 Pass this method a resultsource name, and an arrayref of
800 arrayrefs. The arrayrefs should contain a list of column names,
801 followed by one or many sets of matching data for the given columns.
803 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
804 to insert the data, as this is a fast method. However, insert_bulk currently
805 assumes that your datasets all contain the same type of values, using scalar
806 references in a column in one row, and not in another will probably not work.
808 Otherwise, each set of data is inserted into the database using
809 L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
814 $schema->populate('Artist', [
815 [ qw/artistid name/ ],
816 [ 1, 'Popular Band' ],
824 my ($self, $name, $data) = @_;
825 my $rs = $self->resultset($name);
826 my @names = @{shift(@$data)};
827 if(defined wantarray) {
829 foreach my $item (@$data) {
831 @create{@names} = @$item;
832 push(@created, $rs->create(\%create));
836 $self->storage->insert_bulk($self->source($name)->from, \@names, $data);
839 =head2 exception_action
843 =item Arguments: $code_reference
847 If C<exception_action> is set for this class/object, L</throw_exception>
848 will prefer to call this code reference with the exception as an argument,
849 rather than its normal <croak> action.
851 Your subroutine should probably just wrap the error in the exception
852 object/class of your choosing and rethrow. If, against all sage advice,
853 you'd like your C<exception_action> to suppress a particular exception
854 completely, simply have it return true.
859 use base qw/DBIx::Class::Schema/;
860 use My::ExceptionClass;
861 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
862 __PACKAGE__->load_classes;
865 my $schema_obj = My::Schema->connect( .... );
866 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
868 # suppress all exceptions, like a moron:
869 $schema_obj->exception_action(sub { 1 });
871 =head2 throw_exception
875 =item Arguments: $message
879 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
880 user's perspective. See L</exception_action> for details on overriding
881 this method's behavior.
885 sub throw_exception {
887 croak @_ if !$self->exception_action || !$self->exception_action->(@_);
890 =head2 deploy (EXPERIMENTAL)
894 =item Arguments: $sqlt_args, $dir
898 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
900 Note that this feature is currently EXPERIMENTAL and may not work correctly
901 across all databases, or fully handle complex relationships. Saying that, it
902 has been used successfully by many people, including the core dev team.
904 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
905 common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
906 produced include a DROP TABLE statement for each table created.
908 Additionally, the DBIx::Class parser accepts a C<sources> parameter as a hash
909 ref or an array ref, containing a list of source to deploy. If present, then
910 only the sources listed will get deployed.
915 my ($self, $sqltargs, $dir) = @_;
916 $self->throw_exception("Can't deploy without storage") unless $self->storage;
917 $self->storage->deploy($self, undef, $sqltargs, $dir);
920 =head2 create_ddl_dir (EXPERIMENTAL)
924 =item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args
928 Creates an SQL file based on the Schema, for each of the specified
929 database types, in the given directory. Given a previous version number,
930 this will also create a file containing the ALTER TABLE statements to
931 transform the previous schema into the current one. Note that these
932 statements may contain DROP TABLE or DROP COLUMN statements that can
933 potentially destroy data.
935 The file names are created using the C<ddl_filename> method below, please
936 override this method in your schema if you would like a different file
937 name format. For the ALTER file, the same format is used, replacing
938 $version in the name with "$preversion-$version".
940 If no arguments are passed, then the following default values are used:
944 =item databases - ['MySQL', 'SQLite', 'PostgreSQL']
946 =item version - $schema->VERSION
948 =item directory - './'
950 =item preversion - <none>
954 Note that this feature is currently EXPERIMENTAL and may not work correctly
955 across all databases, or fully handle complex relationships.
957 WARNING: Please check all SQL files created, before applying them.
964 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
965 $self->storage->create_ddl_dir($self, @_);
968 =head2 ddl_filename (EXPERIMENTAL)
972 =item Arguments: $directory, $database-type, $version, $preversion
976 my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
978 This method is called by C<create_ddl_dir> to compose a file name out of
979 the supplied directory, database type and version number. The default file
980 name format is: C<$dir$schema-$version-$type.sql>.
982 You may override this method in your schema if you wish to use a different
988 my ($self, $type, $dir, $version, $pversion) = @_;
990 my $filename = ref($self);
991 $filename =~ s/::/-/;
992 $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
993 $filename =~ s/$version/$pversion-$version/ if($pversion);
1002 Matt S. Trout <mst@shadowcatsystems.co.uk>
1006 You may distribute this code under the same terms as Perl itself.