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 $class->ensure_class_loaded($comp_class);
272 $comp_class->source_name($comp) unless $comp_class->source_name;
274 push(@to_register, [ $comp_class->source_name, $comp_class ]);
278 Class::C3->reinitialize;
280 foreach my $to (@to_register) {
281 $class->register_class(@$to);
282 # if $class->can('result_source_instance');
286 =head2 load_namespaces
290 =item Arguments: %options?
294 This is an alternative to L</load_classes> above which assumes an alternative
295 layout for automatic class loading. It assumes that all result
296 classes are underneath a sub-namespace of the schema called C<Result>, any
297 corresponding ResultSet classes are underneath a sub-namespace of the schema
300 Both of the sub-namespaces are configurable if you don't like the defaults,
301 via the options C<result_namespace> and C<resultset_namespace>.
303 If (and only if) you specify the option C<default_resultset_class>, any found
304 Result classes for which we do not find a corresponding
305 ResultSet class will have their C<resultset_class> set to
306 C<default_resultset_class>.
308 C<load_namespaces> takes care of calling C<resultset_class> for you where
309 neccessary if you didn't do it for yourself.
311 All of the namespace and classname options to this method are relative to
312 the schema classname by default. To specify a fully-qualified name, prefix
313 it with a literal C<+>.
317 # load My::Schema::Result::CD, My::Schema::Result::Artist,
318 # My::Schema::ResultSet::CD, etc...
319 My::Schema->load_namespaces;
321 # Override everything to use ugly names.
322 # In this example, if there is a My::Schema::Res::Foo, but no matching
323 # My::Schema::RSets::Foo, then Foo will have its
324 # resultset_class set to My::Schema::RSetBase
325 My::Schema->load_namespaces(
326 result_namespace => 'Res',
327 resultset_namespace => 'RSets',
328 default_resultset_class => 'RSetBase',
331 # Put things in other namespaces
332 My::Schema->load_namespaces(
333 result_namespace => '+Some::Place::Results',
334 resultset_namespace => '+Another::Place::RSets',
337 If you'd like to use multiple namespaces of each type, simply use an arrayref
338 of namespaces for that option. In the case that the same result
339 (or resultset) class exists in multiple namespaces, the latter entries in
340 your list of namespaces will override earlier ones.
342 My::Schema->load_namespaces(
343 # My::Schema::Results_C::Foo takes precedence over My::Schema::Results_B::Foo :
344 result_namespace => [ 'Results_A', 'Results_B', 'Results_C' ],
345 resultset_namespace => [ '+Some::Place::RSets', 'RSets' ],
350 # Pre-pends our classname to the given relative classname or
351 # class namespace, unless there is a '+' prefix, which will
353 sub _expand_relative_name {
354 my ($class, $name) = @_;
356 $name = $class . '::' . $name if ! ($name =~ s/^\+//);
360 # returns a hash of $shortname => $fullname for every package
361 # found in the given namespaces ($shortname is with the $fullname's
362 # namespace stripped off)
363 sub _map_namespaces {
364 my ($class, @namespaces) = @_;
367 foreach my $namespace (@namespaces) {
370 map { (substr($_, length "${namespace}::"), $_) }
371 Module::Find::findallmod($namespace)
378 sub load_namespaces {
379 my ($class, %args) = @_;
381 my $result_namespace = delete $args{result_namespace} || 'Result';
382 my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
383 my $default_resultset_class = delete $args{default_resultset_class};
385 $class->throw_exception('load_namespaces: unknown option(s): '
386 . join(q{,}, map { qq{'$_'} } keys %args))
387 if scalar keys %args;
389 $default_resultset_class
390 = $class->_expand_relative_name($default_resultset_class);
392 for my $arg ($result_namespace, $resultset_namespace) {
393 $arg = [ $arg ] if !ref($arg) && $arg;
395 $class->throw_exception('load_namespaces: namespace arguments must be '
396 . 'a simple string or an arrayref')
397 if ref($arg) ne 'ARRAY';
399 $_ = $class->_expand_relative_name($_) for (@$arg);
402 my %results = $class->_map_namespaces(@$result_namespace);
403 my %resultsets = $class->_map_namespaces(@$resultset_namespace);
407 no warnings 'redefine';
408 local *Class::C3::reinitialize = sub { };
409 use warnings 'redefine';
411 foreach my $result (keys %results) {
412 my $result_class = $results{$result};
413 $class->ensure_class_loaded($result_class);
414 $result_class->source_name($result) unless $result_class->source_name;
416 my $rs_class = delete $resultsets{$result};
417 my $rs_set = $result_class->resultset_class;
418 if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
419 if($rs_class && $rs_class ne $rs_set) {
420 warn "We found ResultSet class '$rs_class' for '$result', but it seems "
421 . "that you had already set '$result' to use '$rs_set' instead";
424 elsif($rs_class ||= $default_resultset_class) {
425 $class->ensure_class_loaded($rs_class);
426 $result_class->resultset_class($rs_class);
429 push(@to_register, [ $result_class->source_name, $result_class ]);
433 foreach (sort keys %resultsets) {
434 warn "load_namespaces found ResultSet class $_ with no "
435 . 'corresponding Result class';
438 Class::C3->reinitialize;
439 $class->register_class(@$_) for (@to_register);
444 =head2 compose_connection
448 =item Arguments: $target_namespace, @db_info
450 =item Return Value: $new_schema
454 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
455 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
456 then injects the L<DBix::Class::ResultSetProxy> component and a
457 resultset_instance classdata entry on all the new classes, in order to support
458 $target_namespaces::$class->search(...) method calls.
460 This is primarily useful when you have a specific need for class method access
461 to a connection. In normal usage it is preferred to call
462 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
463 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
468 sub compose_connection {
469 my ($self, $target, @info) = @_;
470 my $base = 'DBIx::Class::ResultSetProxy';
471 eval "require ${base};";
472 $self->throw_exception
473 ("No arguments to load_classes and couldn't load ${base} ($@)")
476 if ($self eq $target) {
477 # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
478 foreach my $moniker ($self->sources) {
479 my $source = $self->source($moniker);
480 my $class = $source->result_class;
481 $self->inject_base($class, $base);
482 $class->mk_classdata(resultset_instance => $source->resultset);
483 $class->mk_classdata(class_resolver => $self);
485 $self->connection(@info);
489 my $schema = $self->compose_namespace($target, $base);
492 *{"${target}::schema"} = sub { $schema };
495 $schema->connection(@info);
496 foreach my $moniker ($schema->sources) {
497 my $source = $schema->source($moniker);
498 my $class = $source->result_class;
499 #warn "$moniker $class $source ".$source->storage;
500 $class->mk_classdata(result_source_instance => $source);
501 $class->mk_classdata(resultset_instance => $source->resultset);
502 $class->mk_classdata(class_resolver => $schema);
507 =head2 compose_namespace
511 =item Arguments: $target_namespace, $additional_base_class?
513 =item Return Value: $new_schema
517 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
518 class in the target namespace (e.g. $target_namespace::CD,
519 $target_namespace::Artist) that inherits from the corresponding classes
520 attached to the current schema.
522 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
523 new $schema object. If C<$additional_base_class> is given, the new composed
524 classes will inherit from first the corresponding classe from the current
525 schema then the base class.
527 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
529 $schema->compose_namespace('My::DB', 'Base::Class');
530 print join (', ', @My::DB::CD::ISA) . "\n";
531 print join (', ', @My::DB::Artist::ISA) ."\n";
533 will produce the output
535 My::Schema::CD, Base::Class
536 My::Schema::Artist, Base::Class
540 sub compose_namespace {
541 my ($self, $target, $base) = @_;
542 my %reg = %{ $self->source_registrations };
545 my $schema = $self->clone;
547 no warnings qw/redefine/;
548 local *Class::C3::reinitialize = sub { };
549 foreach my $moniker ($schema->sources) {
550 my $source = $schema->source($moniker);
551 my $target_class = "${target}::${moniker}";
553 $target_class => $source->result_class, ($base ? $base : ())
555 $source->result_class($target_class);
556 $target_class->result_source_instance($source)
557 if $target_class->can('result_source_instance');
560 Class::C3->reinitialize();
563 foreach my $meth (qw/class source resultset/) {
564 *{"${target}::${meth}"} =
565 sub { shift->schema->$meth(@_) };
571 =head2 setup_connection_class
575 =item Arguments: $target, @info
579 Sets up a database connection class to inject between the schema and the
580 subclasses that the schema creates.
584 sub setup_connection_class {
585 my ($class, $target, @info) = @_;
586 $class->inject_base($target => 'DBIx::Class::DB');
587 #$target->load_components('DB');
588 $target->connection(@info);
595 =item Arguments: $storage_type
597 =item Return Value: $storage_type
601 Set the storage class that will be instantiated when L</connect> is called.
602 If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
603 assumed by L</connect>. Defaults to C<::DBI>,
604 which is L<DBIx::Class::Storage::DBI>.
606 You want to use this to hardcoded subclasses of L<DBIx::Class::Storage::DBI>
607 in cases where the appropriate subclass is not autodetected, such as when
608 dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it to
609 C<::DBI::Sybase::MSSQL>.
615 =item Arguments: @args
617 =item Return Value: $new_schema
621 Instantiates a new Storage object of type
622 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
623 $storage->connect_info. Sets the connection in-place on the schema.
625 See L<DBIx::Class::Storage::DBI/"connect_info"> for DBI-specific syntax,
626 or L<DBIx::Class::Storage> in general.
631 my ($self, @info) = @_;
632 return $self if !@info && $self->storage;
633 my $storage_class = $self->storage_type;
634 $storage_class = 'DBIx::Class::Storage'.$storage_class
635 if $storage_class =~ m/^::/;
636 eval "require ${storage_class};";
637 $self->throw_exception(
638 "No arguments to load_classes and couldn't load ${storage_class} ($@)"
640 my $storage = $storage_class->new($self);
641 $storage->connect_info(\@info);
642 $self->storage($storage);
643 $self->on_connect() if($self->can('on_connect'));
651 =item Arguments: @info
653 =item Return Value: $new_schema
657 This is a convenience method. It is equivalent to calling
658 $schema->clone->connection(@info). See L</connection> and L</clone> for more
663 sub connect { shift->clone->connection(@_) }
669 =item Arguments: C<$coderef>, @coderef_args?
671 =item Return Value: The return value of $coderef
675 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
676 returning its result (if any). Equivalent to calling $schema->storage->txn_do.
677 See L<DBIx::Class::Storage/"txn_do"> for more information.
679 This interface is preferred over using the individual methods L</txn_begin>,
680 L</txn_commit>, and L</txn_rollback> below.
687 $self->storage or $self->throw_exception
688 ('txn_do called on $schema without storage');
690 $self->storage->txn_do(@_);
695 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
696 calling $schema->storage->txn_begin. See
697 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
704 $self->storage or $self->throw_exception
705 ('txn_begin called on $schema without storage');
707 $self->storage->txn_begin;
712 Commits the current transaction. Equivalent to calling
713 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
714 for more information.
721 $self->storage or $self->throw_exception
722 ('txn_commit called on $schema without storage');
724 $self->storage->txn_commit;
729 Rolls back the current transaction. Equivalent to calling
730 $schema->storage->txn_rollback. See
731 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
738 $self->storage or $self->throw_exception
739 ('txn_rollback called on $schema without storage');
741 $self->storage->txn_rollback;
748 =item Return Value: $new_schema
752 Clones the schema and its associated result_source objects and returns the
759 my $clone = { (ref $self ? %$self : ()) };
760 bless $clone, (ref $self || $self);
762 foreach my $moniker ($self->sources) {
763 my $source = $self->source($moniker);
764 my $new = $source->new($source);
765 $clone->register_source($moniker => $new);
767 $clone->storage->set_schema($clone) if $clone->storage;
775 =item Arguments: $source_name, \@data;
779 Pass this method a resultsource name, and an arrayref of
780 arrayrefs. The arrayrefs should contain a list of column names,
781 followed by one or many sets of matching data for the given columns.
783 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
784 to insert the data, as this is a fast method. However, insert_bulk currently
785 assumes that your datasets all contain the same type of values, using scalar
786 references in a column in one row, and not in another will probably not work.
788 Otherwise, each set of data is inserted into the database using
789 L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
794 $schema->populate('Artist', [
795 [ qw/artistid name/ ],
796 [ 1, 'Popular Band' ],
804 my ($self, $name, $data) = @_;
805 my $rs = $self->resultset($name);
806 my @names = @{shift(@$data)};
807 if(defined wantarray) {
809 foreach my $item (@$data) {
811 @create{@names} = @$item;
812 push(@created, $rs->create(\%create));
816 $self->storage->insert_bulk($self->source($name)->from, \@names, $data);
819 =head2 exception_action
823 =item Arguments: $code_reference
827 If C<exception_action> is set for this class/object, L</throw_exception>
828 will prefer to call this code reference with the exception as an argument,
829 rather than its normal <croak> action.
831 Your subroutine should probably just wrap the error in the exception
832 object/class of your choosing and rethrow. If, against all sage advice,
833 you'd like your C<exception_action> to suppress a particular exception
834 completely, simply have it return true.
839 use base qw/DBIx::Class::Schema/;
840 use My::ExceptionClass;
841 __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
842 __PACKAGE__->load_classes;
845 my $schema_obj = My::Schema->connect( .... );
846 $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
848 # suppress all exceptions, like a moron:
849 $schema_obj->exception_action(sub { 1 });
851 =head2 throw_exception
855 =item Arguments: $message
859 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
860 user's perspective. See L</exception_action> for details on overriding
861 this method's behavior.
865 sub throw_exception {
867 croak @_ if !$self->exception_action || !$self->exception_action->(@_);
870 =head2 deploy (EXPERIMENTAL)
874 =item Arguments: $sqlt_args, $dir
878 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
880 Note that this feature is currently EXPERIMENTAL and may not work correctly
881 across all databases, or fully handle complex relationships.
883 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
884 common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
885 produced include a DROP TABLE statement for each table created.
890 my ($self, $sqltargs, $dir) = @_;
891 $self->throw_exception("Can't deploy without storage") unless $self->storage;
892 $self->storage->deploy($self, undef, $sqltargs, $dir);
895 =head2 create_ddl_dir (EXPERIMENTAL)
899 =item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args
903 Creates an SQL file based on the Schema, for each of the specified
904 database types, in the given directory. Given a previous version number,
905 this will also create a file containing the ALTER TABLE statements to
906 transform the previous schema into the current one. Note that these
907 statements may contain DROP TABLE or DROP COLUMN statements that can
908 potentially destroy data.
910 The file names are created using the C<ddl_filename> method below, please
911 override this method in your schema if you would like a different file
912 name format. For the ALTER file, the same format is used, replacing
913 $version in the name with "$preversion-$version".
915 If no arguments are passed, then the following default values are used:
919 =item databases - ['MySQL', 'SQLite', 'PostgreSQL']
921 =item version - $schema->VERSION
923 =item directory - './'
925 =item preversion - <none>
929 Note that this feature is currently EXPERIMENTAL and may not work correctly
930 across all databases, or fully handle complex relationships.
932 WARNING: Please check all SQL files created, before applying them.
939 $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
940 $self->storage->create_ddl_dir($self, @_);
943 =head2 ddl_filename (EXPERIMENTAL)
947 =item Arguments: $directory, $database-type, $version, $preversion
951 my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
953 This method is called by C<create_ddl_dir> to compose a file name out of
954 the supplied directory, database type and version number. The default file
955 name format is: C<$dir$schema-$version-$type.sql>.
957 You may override this method in your schema if you wish to use a different
963 my ($self, $type, $dir, $version, $pversion) = @_;
965 my $filename = ref($self);
966 $filename =~ s/::/-/;
967 $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
968 $filename =~ s/$version/$pversion-$version/ if($pversion);
977 Matt S. Trout <mst@shadowcatsystems.co.uk>
981 You may distribute this code under the same terms as Perl itself.