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;