fd992e19939fd8343dcee69edcf9c22d28459d32
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Schema.pm
1 package DBIx::Class::Schema;
2
3 use strict;
4 use warnings;
5
6 use base qw/Class::Data::Inheritable/;
7 use DBIx::Class;
8
9 __PACKAGE__->mk_classdata('_class_registrations' => {});
10
11 sub register_class {
12   my ($class, $name, $to_register) = @_;
13   my %reg = %{$class->_class_registrations};
14   $reg{$name} = $to_register;
15   $class->_class_registrations(\%reg);
16 }
17
18 sub load_classes {
19   my $class = shift;
20   my @comp = grep { $_ !~ /^#/ } @_;
21   foreach my $comp (@comp) {
22     my $comp_class = "${class}::${comp}";
23     eval "use $comp_class";
24     die $@ if $@;
25     $class->register_class($comp => $comp_class);
26   }
27 }
28
29 sub compose_connection {
30   my ($class, $target, @info) = @_;
31   {
32     no strict 'refs';
33     unshift(@{"${target}::ISA"}, 'DBIx::Class');
34   }
35   $target->load_components('DB');
36   $target->connection(@info);
37   my %reg = %{ $class->_class_registrations };
38   while (my ($comp, $comp_class) = each %reg) {
39     my $target_class = "${target}::${comp}";
40     {
41       no strict 'refs';
42       unshift(@{"${target_class}::ISA"}, $comp_class, $target);
43     }
44   }
45 }
46
47 1;