Commit | Line | Data |
a02675cd |
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; |