lib/DBIx/Class/Schema.pm

   1 package DBIx::Class::Schema;
   2
   3 use strict;
   4 use warnings;
   5 use DBIx::Class::DB;
   6
   7 use base qw/DBIx::Class/;
   8
   9 __PACKAGE__->load_components(qw/Exception/);
  10 __PACKAGE__->mk_classdata('class_mappings' => {});
  11 __PACKAGE__->mk_classdata('source_registrations' => {});
  12 __PACKAGE__->mk_classdata('storage_type' => 'DBI');
  13 __PACKAGE__->mk_classdata('storage');
  14
  15 =head1 NAME
  16
  17 DBIx::Class::Schema - composable schemas
  18
  19 =head1 SYNOPSIS
  20
  21 in My/Schema.pm
  22
  23   package My::Schema;
  24
  25   use base qw/DBIx::Class::Schema/;
  26
  27   __PACKAGE__->load_classes(qw/Foo Bar Baz/);
  28
  29 in My/Schema/Foo.pm
  30
  31   package My::Schema::Foo;
  32
  33   use base qw/DBIx::Class/;
  34
  35   __PACKAGE__->load_components(qw/PK::Auto::Pg Core/); # for example
  36   __PACKAGE__->table('foo');
  37   ...
  38
  39 in My/DB.pm
  40
  41   use My::Schema;
  42
  43   My::Schema->compose_connection('My::DB', $dsn, $user, $pass, $attrs);
  44
  45 then in app code
  46
  47   my @obj = My::DB::Foo->search({}); # My::DB::Foo isa My::Schema::Foo My::DB
  48
  49 =head1 DESCRIPTION
  50
  51 Creates database classes based on a schema. This allows you to have more than
  52 one concurrent connection using the same database classes, by making
  53 subclasses under a new namespace for each connection. If you only need one
  54 class, you should probably use L<DBIx::Class::DB> directly instead.
  55
  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.
  59
  60 =head1 METHODS
  61
  62 =head2 register_class <moniker> <component_class>
  63
  64 Registers the class in the schema's class_registrations. This is a hash
  65 containing database classes, keyed by their monikers. It's used by
  66 compose_connection to create/modify all the existing database classes.
  67
  68 =cut
  69
  70 sub register_class {
  71   my ($self, $moniker, $to_register) = @_;
  72   $self->register_source($moniker => $to_register->result_source_instance);
  73 }
  74
  75 =head2 register_source <moniker> <result source>
  76
  77 Registers the result source in the schema with the given moniker
  78
  79 =cut
  80
  81 sub register_source {
  82   my ($self, $moniker, $source) = @_;
  83   my %reg = %{$self->source_registrations};
  84   $reg{$moniker} = $source;
  85   $self->source_registrations(\%reg);
  86   $source->schema($self);
  87   if ($source->result_class) {
  88     my %map = %{$self->class_mappings};
  89     $map{$source->result_class} = $moniker;
  90     $self->class_mappings(\%map);
  91   }
  92 }
  93
  94 =head2 class
  95
  96   my $class = $schema->class('Foo');
  97
  98 Retrieves the result class name for a given result source
  99
 100 =cut
 101
 102 sub class {
 103   my ($self, $moniker) = @_;
 104   return $self->source($moniker)->result_class;
 105 }
 106
 107 =head2 source
 108
 109   my $source = $schema->source('Foo');
 110
 111 Returns the result source object for the registered name
 112
 113 =cut
 114
 115 sub source {
 116   my ($self, $moniker) = @_;
 117   my $sreg = $self->source_registrations;
 118   return $sreg->{$moniker} if exists $sreg->{$moniker};
 119
 120   # if we got here, they probably passed a full class name
 121   my $mapped = $self->class_mappings->{$moniker};
 122   die "Can't find source for ${moniker}"
 123     unless $mapped && exists $sreg->{$mapped};
 124   return $sreg->{$mapped};
 125 }
 126
 127 =head2 sources
 128
 129   my @source_monikers = $schema->sources;
 130
 131 Returns the source monikers of all source registrations on this schema
 132
 133 =cut
 134
 135 sub sources { return keys %{shift->source_registrations}; }
 136
 137 =head2 resultset
 138
 139   my $rs = $schema->resultset('Foo');
 140
 141 Returns the resultset for the registered moniker
 142
 143 =cut
 144
 145 sub resultset {
 146   my ($self, $moniker) = @_;
 147   return $self->source($moniker)->resultset;
 148 }
 149
 150 =head2  load_classes [<classes>, (<class>, <class>), {<namespace> => [<classes>]}]
 151
 152 Uses L<Module::Find> to find all classes under the database class' namespace,
 153 or uses the classes you select.  Then it loads the component (using L<use>),
 154 and registers them (using B<register_class>);
 155
 156 It is possible to comment out classes with a leading '#', but note that perl
 157 will think it's a mistake (trying to use a comment in a qw list) so you'll
 158 need to add "no warnings 'qw';" before your load_classes call.
 159
 160 =cut
 161
 162 sub load_classes {
 163   my ($class, @params) = @_;
 164
 165   my %comps_for;
 166
 167   if (@params) {
 168     foreach my $param (@params) {
 169       if (ref $param eq 'ARRAY') {
 170         # filter out commented entries
 171         my @modules = grep { $_ !~ /^#/ } @$param;
 172
 173         push (@{$comps_for{$class}}, @modules);
 174       }
 175       elsif (ref $param eq 'HASH') {
 176         # more than one namespace possible
 177         for my $comp ( keys %$param ) {
 178           # filter out commented entries
 179           my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
 180
 181           push (@{$comps_for{$comp}}, @modules);
 182         }
 183       }
 184       else {
 185         # filter out commented entries
 186         push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
 187       }
 188     }
 189   } else {
 190     eval "require Module::Find;";
 191     $class->throw("No arguments to load_classes and couldn't load".
 192       " Module::Find ($@)") if $@;
 193     my @comp = map { substr $_, length "${class}::"  } Module::Find::findallmod($class);
 194     $comps_for{$class} = \@comp;
 195   }
 196
 197   foreach my $prefix (keys %comps_for) {
 198     foreach my $comp (@{$comps_for{$prefix}||[]}) {
 199       my $comp_class = "${prefix}::${comp}";
 200       eval "use $comp_class"; # If it fails, assume the user fixed it
 201       if ($@) {
 202         die $@ unless $@ =~ /Can't locate/;
 203       }
 204       $class->register_class($comp => $comp_class);
 205     }
 206   }
 207 }
 208
 209 =head2 compose_connection <target> <@db_info>
 210
 211 This is the most important method in this class. it takes a target namespace,
 212 as well as dbh connection info, and creates a L<DBIx::Class::DB> class as
 213 well as subclasses for each of your database classes in this namespace, using
 214 this connection.
 215
 216 It will also setup a ->class method on the target class, which lets you
 217 resolve database classes based on the schema component name, for example
 218
 219   MyApp::DB->class('Foo') # returns MyApp::DB::Foo,
 220                           # which ISA MyApp::Schema::Foo
 221
 222 This is the recommended API for accessing Schema generated classes, and
 223 using it might give you instant advantages with future versions of DBIC.
 224
 225 WARNING: Loading components into Schema classes after compose_connection
 226 may not cause them to be seen by the classes in your target namespace due
 227 to the dispatch table approach used by Class::C3. If you do this you may find
 228 you need to call Class::C3->reinitialize() afterwards to get the behaviour
 229 you expect.
 230
 231 =cut
 232
 233 sub compose_connection {
 234   my ($self, $target, @info) = @_;
 235   my $conn_class = "${target}::_db";
 236   $self->setup_connection_class($conn_class, @info);
 237   my $schema = $self->compose_namespace($target, $conn_class);
 238   $schema->storage($conn_class->storage);
 239   foreach my $moniker ($schema->sources) {
 240     my $source = $schema->source($moniker);
 241     my $class = $source->result_class;
 242     #warn "$moniker $class $source ".$source->storage;
 243     $class->mk_classdata(result_source_instance => $source);
 244     $class->mk_classdata(resultset_instance => $source->resultset);
 245   }
 246   return $schema;
 247 }
 248
 249 sub compose_namespace {
 250   my ($class, $target, $base) = @_;
 251   my %reg = %{ $class->source_registrations };
 252   my %target;
 253   my %map;
 254   my $schema = bless({ }, $class);
 255   while (my ($moniker, $source) = each %reg) {
 256     my $target_class = "${target}::${moniker}";
 257     $class->inject_base(
 258       $target_class => $source->result_class, ($base ? $base : ())
 259     );
 260     my $new_source = $source->new($source);
 261     $new_source->result_class($target_class);
 262     $new_source->schema($schema);
 263     $map{$moniker} = $new_source;
 264   }
 265   $schema->source_registrations(\%map);
 266   {
 267     no strict 'refs';
 268     *{"${target}::schema"} =
 269       sub { $schema };
 270     foreach my $meth (qw/class source resultset/) {
 271       *{"${target}::${meth}"} =
 272         sub { shift->schema->$meth(@_) };
 273     }
 274   }
 275   $base->class_resolver($target);
 276   return $schema;
 277 }
 278
 279 =head2 setup_connection_class <$target> <@info>
 280
 281 Sets up a database connection class to inject between the schema
 282 and the subclasses the schema creates.
 283
 284 =cut
 285
 286 sub setup_connection_class {
 287   my ($class, $target, @info) = @_;
 288   $class->inject_base($target => 'DBIx::Class::DB');
 289   #$target->load_components('DB');
 290   $target->connection(@info);
 291 }
 292
 293 1;
 294
 295 =head1 AUTHORS
 296
 297 Matt S. Trout <mst@shadowcatsystems.co.uk>
 298
 299 =head1 LICENSE
 300
 301 You may distribute this code under the same terms as Perl itself.
 302
 303 =cut
 304