lib/DBIx/Class/Schema.pm

   1 package DBIx::Class::Schema;
   2
   3 use strict;
   4 use warnings;
   5 use UNIVERSAL::require;
   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 a class which isa ResultSourceInstance; equivalent to calling
  65
  66   $schema->register_source($moniker, $class->result_source_instance);
  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 $base = 'DBIx::Class::ResultSetInstance';
 236   $base->require;
 237   my $schema = $self->compose_namespace($target, $base);
 238   $schema->connection(@info);
 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     $class->mk_classdata(class_resolver => $schema);
 246   }
 247   return $schema;
 248 }
 249
 250 sub compose_namespace {
 251   my ($self, $target, $base) = @_;
 252   my %reg = %{ $self->source_registrations };
 253   my %target;
 254   my %map;
 255   my $schema = $self->clone;
 256   foreach my $moniker ($schema->sources) {
 257     my $source = $schema->source($moniker);
 258     my $target_class = "${target}::${moniker}";
 259     $self->inject_base(
 260       $target_class => $source->result_class, ($base ? $base : ())
 261     );
 262     $source->result_class($target_class);
 263   }
 264   {
 265     no strict 'refs';
 266     *{"${target}::schema"} =
 267       sub { $schema };
 268     foreach my $meth (qw/class source resultset/) {
 269       *{"${target}::${meth}"} =
 270         sub { shift->schema->$meth(@_) };
 271     }
 272   }
 273   return $schema;
 274 }
 275
 276 =head2 setup_connection_class <$target> <@info>
 277
 278 Sets up a database connection class to inject between the schema
 279 and the subclasses the schema creates.
 280
 281 =cut
 282
 283 sub setup_connection_class {
 284   my ($class, $target, @info) = @_;
 285   $class->inject_base($target => 'DBIx::Class::DB');
 286   #$target->load_components('DB');
 287   $target->connection(@info);
 288 }
 289
 290 =head2 connection(@args)
 291
 292 Instantiates a new Storage object of type storage_type and passes the
 293 arguments to $storage->connection_info. Sets the connection in-place on
 294 the schema.
 295
 296 =cut
 297
 298 sub connection {
 299   my ($self, @info) = @_;
 300   my $storage_class = 'DBIx::Class::Storage::'.$self->storage_type;
 301   $storage_class->require;
 302   my $storage = $storage_class->new;
 303   $storage->connect_info(\@info);
 304   $self->storage($storage);
 305   return $self;
 306 }
 307
 308 =head2 connect(@info)
 309
 310 Conveneience method, equivalent to $schema->clone->connection(@info)
 311
 312 =cut
 313
 314 sub connect { shift->clone->connection(@_) };
 315
 316 =head2 clone
 317
 318 Clones the schema and its associated result_source objects and returns the
 319 copy.
 320
 321 =cut
 322
 323 sub clone {
 324   my ($self) = @_;
 325   my $clone = bless({ (ref $self ? %$self : ()) }, ref $self || $self);
 326   foreach my $moniker ($self->sources) {
 327     my $source = $self->source($moniker);
 328     my $new = $source->new($source);
 329     $clone->register_source($moniker => $new);
 330   }
 331   return $clone;
 332 }
 333
 334 1;
 335
 336 =head1 AUTHORS
 337
 338 Matt S. Trout <mst@shadowcatsystems.co.uk>
 339
 340 =head1 LICENSE
 341
 342 You may distribute this code under the same terms as Perl itself.
 343
 344 =cut
 345