Add an explicit Sub::Quote dep in ::_Util
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / AccessorGroup.pm
CommitLineData
fe5d862b 1package DBIx::Class::AccessorGroup;
2
12bbb339 3use strict;
4use warnings;
5
5f48fa56 6use base qw( DBIx::Class::MethodAttributes Class::Accessor::Grouped );
983f766d 7use mro 'c3';
8
91fe73bc 9use Scalar::Util qw/weaken blessed/;
e5053694 10use DBIx::Class::_Util 'fail_on_internal_call';
0d374214 11use namespace::clean;
701da8c4 12
d009cb7d 13sub mk_classdata {
e5053694 14 DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
d009cb7d 15 shift->mk_classaccessor(@_);
16}
17
18sub mk_classaccessor {
19 my $self = shift;
20 $self->mk_group_accessors('inherited', $_[0]);
e5053694 21 (@_ > 1)
22 ? $self->set_inherited(@_)
23 : ( DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call )
24 ;
d009cb7d 25}
26
0d374214 27my $successfully_loaded_components;
db29433c 28
29sub get_component_class {
30 my $class = $_[0]->get_inherited($_[1]);
0d374214 31
91fe73bc 32 # It's already an object, just go for it.
33 return $class if blessed $class;
34
0d374214 35 if (defined $class and ! $successfully_loaded_components->{$class} ) {
db29433c 36 $_[0]->ensure_class_loaded($class);
0d374214 37
d009cb7d 38 mro::set_mro( $class, 'c3' );
39
0d374214 40 no strict 'refs';
41 $successfully_loaded_components->{$class}
42 = ${"${class}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"}
43 = do { \(my $anon = 'loaded') };
44 weaken($successfully_loaded_components->{$class});
db29433c 45 }
0d374214 46
db29433c 47 $class;
48};
49
50sub set_component_class {
dd185339 51 $_[0]->set_inherited($_[1], $_[2]);
52
53 # trigger a load for the case of $foo->component_accessor("bar")->new
54 $_[0]->get_component_class($_[1])
55 if defined wantarray;
db29433c 56}
57
fe0e9f67 581;
59
75d07914 60=head1 NAME
34d52be2 61
73281318 62DBIx::Class::AccessorGroup - See Class::Accessor::Grouped
34d52be2 63
64=head1 SYNOPSIS
65
66=head1 DESCRIPTION
67
73281318 68This class now exists in its own right on CPAN as Class::Accessor::Grouped
fc969005 69
a2bd3796 70=head1 FURTHER QUESTIONS?
34d52be2 71
a2bd3796 72Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
34d52be2 73
a2bd3796 74=head1 COPYRIGHT AND LICENSE
34d52be2 75
a2bd3796 76This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
77by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
78redistribute it and/or modify it under the same terms as the
79L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
34d52be2 80
81=cut