Commit | Line | Data |
fe5d862b |
1 | package DBIx::Class::AccessorGroup; |
2 | |
12bbb339 |
3 | use strict; |
4 | use warnings; |
5 | |
5f48fa56 |
6 | use base qw( DBIx::Class::MethodAttributes Class::Accessor::Grouped ); |
983f766d |
7 | |
d46eac43 |
8 | use Scalar::Util 'blessed'; |
e5053694 |
9 | use DBIx::Class::_Util 'fail_on_internal_call'; |
0d374214 |
10 | use namespace::clean; |
701da8c4 |
11 | |
1b822bd3 |
12 | sub mk_classdata :DBIC_method_is_indirect_sugar { |
e5053694 |
13 | DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
d009cb7d |
14 | shift->mk_classaccessor(@_); |
15 | } |
16 | |
1b822bd3 |
17 | sub mk_classaccessor :DBIC_method_is_indirect_sugar { |
d009cb7d |
18 | my $self = shift; |
19 | $self->mk_group_accessors('inherited', $_[0]); |
e5053694 |
20 | (@_ > 1) |
21 | ? $self->set_inherited(@_) |
22 | : ( DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call ) |
23 | ; |
d009cb7d |
24 | } |
25 | |
09d8fb4a |
26 | sub mk_group_accessors { |
27 | my $class = shift; |
28 | my $type = shift; |
29 | |
30 | $class->next::method($type, @_); |
31 | |
32 | # label things |
33 | if( $type =~ /^ ( inflated_ | filtered_ )? column $/x ) { |
34 | |
35 | $class = ref $class |
36 | if length ref $class; |
37 | |
38 | for my $acc_pair ( |
39 | map |
40 | { [ $_, "_${_}_accessor" ] } |
41 | map |
42 | { ref $_ ? $_->[0] : $_ } |
43 | @_ |
44 | ) { |
45 | |
46 | for my $i (0, 1) { |
47 | |
48 | my $acc_name = $acc_pair->[$i]; |
49 | |
50 | attributes->import( |
51 | $class, |
52 | ( |
53 | $class->can($acc_name) |
54 | || |
55 | Carp::confess("Accessor '$acc_name' we just created on $class can't be found...?") |
56 | ), |
57 | 'DBIC_method_is_generated_from_resultsource_metadata', |
58 | ($i |
59 | ? "DBIC_method_is_${type}_extra_accessor" |
60 | : "DBIC_method_is_${type}_accessor" |
61 | ), |
62 | ) |
63 | } |
64 | } |
65 | } |
66 | } |
67 | |
db29433c |
68 | sub get_component_class { |
69 | my $class = $_[0]->get_inherited($_[1]); |
0d374214 |
70 | |
d46eac43 |
71 | no strict 'refs'; |
72 | if ( |
73 | defined $class |
74 | and |
75 | # inherited CAG can't be set to undef effectively, so people may use '' |
76 | length $class |
77 | and |
78 | # It's already an object, just go for it. |
79 | ! defined blessed $class |
80 | and |
81 | ! ${"${class}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"} |
82 | ) { |
db29433c |
83 | $_[0]->ensure_class_loaded($class); |
0d374214 |
84 | |
d46eac43 |
85 | ${"${class}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"} |
86 | = do { \(my $anon = 'loaded') }; |
db29433c |
87 | } |
0d374214 |
88 | |
db29433c |
89 | $class; |
90 | }; |
91 | |
92 | sub set_component_class { |
dd185339 |
93 | $_[0]->set_inherited($_[1], $_[2]); |
94 | |
95 | # trigger a load for the case of $foo->component_accessor("bar")->new |
96 | $_[0]->get_component_class($_[1]) |
97 | if defined wantarray; |
db29433c |
98 | } |
99 | |
fe0e9f67 |
100 | 1; |
101 | |
75d07914 |
102 | =head1 NAME |
34d52be2 |
103 | |
73281318 |
104 | DBIx::Class::AccessorGroup - See Class::Accessor::Grouped |
34d52be2 |
105 | |
106 | =head1 SYNOPSIS |
107 | |
108 | =head1 DESCRIPTION |
109 | |
73281318 |
110 | This class now exists in its own right on CPAN as Class::Accessor::Grouped |
fc969005 |
111 | |
a2bd3796 |
112 | =head1 FURTHER QUESTIONS? |
34d52be2 |
113 | |
a2bd3796 |
114 | Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>. |
34d52be2 |
115 | |
a2bd3796 |
116 | =head1 COPYRIGHT AND LICENSE |
34d52be2 |
117 | |
a2bd3796 |
118 | This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE> |
119 | by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can |
120 | redistribute it and/or modify it under the same terms as the |
121 | L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>. |
34d52be2 |
122 | |
123 | =cut |