lib/DBIx/Class/AccessorGroup.pm

   1 package DBIx::Class::AccessorGroup;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/Class::Accessor::Grouped/;
   7 use Scalar::Util qw/weaken blessed/;
   8 use namespace::clean;
   9
  10 my $successfully_loaded_components;
  11
  12 sub get_component_class {
  13   my $class = $_[0]->get_inherited($_[1]);
  14
  15   # It's already an object, just go for it.
  16   return $class if blessed $class;
  17
  18   if (defined $class and ! $successfully_loaded_components->{$class} ) {
  19     $_[0]->ensure_class_loaded($class);
  20
  21     no strict 'refs';
  22     $successfully_loaded_components->{$class}
  23       = ${"${class}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"}
  24         = do { \(my $anon = 'loaded') };
  25     weaken($successfully_loaded_components->{$class});
  26   }
  27
  28   $class;
  29 };
  30
  31 sub set_component_class {
  32   shift->set_inherited(@_);
  33 }
  34
  35 1;
  36
  37 =head1 NAME
  38
  39 DBIx::Class::AccessorGroup - See Class::Accessor::Grouped
  40
  41 =head1 SYNOPSIS
  42
  43 =head1 DESCRIPTION
  44
  45 This class now exists in its own right on CPAN as Class::Accessor::Grouped
  46
  47 =head1 AUTHOR AND CONTRIBUTORS
  48
  49 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
  50
  51 =head1 LICENSE
  52
  53 You may distribute this code under the same terms as Perl itself.
  54
  55 =cut
  56