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 sub mk_classdata {
  11   shift->mk_classaccessor(@_);
  12 }
  13
  14 sub mk_classaccessor {
  15   my $self = shift;
  16   $self->mk_group_accessors('inherited', $_[0]);
  17   $self->set_inherited(@_) if @_ > 1;
  18 }
  19
  20 my $successfully_loaded_components;
  21
  22 sub get_component_class {
  23   my $class = $_[0]->get_inherited($_[1]);
  24
  25   # It's already an object, just go for it.
  26   return $class if blessed $class;
  27
  28   if (defined $class and ! $successfully_loaded_components->{$class} ) {
  29     $_[0]->ensure_class_loaded($class);
  30
  31     mro::set_mro( $class, 'c3' );
  32
  33     no strict 'refs';
  34     $successfully_loaded_components->{$class}
  35       = ${"${class}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"}
  36         = do { \(my $anon = 'loaded') };
  37     weaken($successfully_loaded_components->{$class});
  38   }
  39
  40   $class;
  41 };
  42
  43 sub set_component_class {
  44   shift->set_inherited(@_);
  45 }
  46
  47 1;
  48
  49 =head1 NAME
  50
  51 DBIx::Class::AccessorGroup - See Class::Accessor::Grouped
  52
  53 =head1 SYNOPSIS
  54
  55 =head1 DESCRIPTION
  56
  57 This class now exists in its own right on CPAN as Class::Accessor::Grouped
  58
  59 =head1 FURTHER QUESTIONS?
  60
  61 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
  62
  63 =head1 COPYRIGHT AND LICENSE
  64
  65 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
  66 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
  67 redistribute it and/or modify it under the same terms as the
  68 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
  69
  70 =cut