Commit | Line | Data |
75d07914 |
1 | package # hide from PAUSE |
c0e7b4e5 |
2 | DBIx::Class::Componentised; |
227d4dee |
3 | |
bf5ecff9 |
4 | use strict; |
5 | use warnings; |
6 | |
147dd158 |
7 | use Class::C3; |
c037c03a |
8 | use Class::Inspector; |
aaba9524 |
9 | use Carp::Clan qw/^DBIx::Class/; |
147dd158 |
10 | |
227d4dee |
11 | sub inject_base { |
12 | my ($class, $target, @to_inject) = @_; |
13 | { |
14 | no strict 'refs'; |
eb47985e |
15 | foreach my $to (reverse @to_inject) { |
df88a29c |
16 | my @comps = qw(DigestColumns ResultSetManager Ordered UTF8Columns); |
17 | # Add components here that need to be loaded before Core |
18 | foreach my $first_comp (@comps) { |
19 | if ($to eq 'DBIx::Class::Core' && |
20 | $target->isa("DBIx::Class::${first_comp}")) { |
21 | warn "Possible incorrect order of components in ". |
22 | "${target}::load_components($first_comp) call: Core loaded ". |
23 | "before $first_comp. See the documentation for ". |
24 | "DBIx::Class::$first_comp for more information"; |
25 | } |
26 | } |
27 | unshift( @{"${target}::ISA"}, $to ) |
28 | unless ($target eq $to || $target->isa($to)); |
eb47985e |
29 | } |
227d4dee |
30 | } |
20518cb4 |
31 | |
32 | # Yes, this is hack. But it *does* work. Please don't submit tickets about |
33 | # it on the basis of the comments in Class::C3, the author was on #dbix-class |
34 | # while I was implementing this. |
35 | |
5c46030a |
36 | eval "package $target; import Class::C3;" unless exists $Class::C3::MRO{$target}; |
227d4dee |
37 | } |
38 | |
39 | sub load_components { |
40 | my $class = shift; |
7411204b |
41 | my $base = $class->component_base_class; |
6db94aca |
42 | my @comp = map { /^\+(.*)$/ ? $1 : "${base}::$_" } grep { $_ !~ /^#/ } @_; |
227d4dee |
43 | $class->_load_components(@comp); |
971c0085 |
44 | Class::C3::reinitialize(); |
227d4dee |
45 | } |
46 | |
47 | sub load_own_components { |
48 | my $class = shift; |
49 | my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_; |
50 | $class->_load_components(@comp); |
51 | } |
52 | |
53 | sub _load_components { |
54 | my ($class, @comp) = @_; |
55 | foreach my $comp (@comp) { |
c037c03a |
56 | $class->ensure_class_loaded($comp); |
227d4dee |
57 | } |
58 | $class->inject_base($class => @comp); |
59 | } |
60 | |
efe6365b |
61 | # Given a class name, tests to see if it is already loaded or otherwise |
62 | # defined. If it is not yet loaded, the package is require'd, and an exception |
63 | # is thrown if the class is still not loaded. |
64 | # |
c037c03a |
65 | # TODO: handle ->has_many('rel', 'Class'...) instead of |
66 | # ->has_many('rel', 'Some::Schema::Class'...) |
9d3d92ab |
67 | # |
68 | # BUG: For some reason, packages with syntax errors are added to %INC on |
69 | # require |
c037c03a |
70 | sub ensure_class_loaded { |
71 | my ($class, $f_class) = @_; |
175e2616 |
72 | return if Class::Inspector->loaded($f_class); |
9d3d92ab |
73 | eval "require $f_class"; # require needs a bareword or filename |
4d87db01 |
74 | if ($@) { |
75 | if ($class->can('throw_exception')) { |
76 | $class->throw_exception($@); |
77 | } else { |
78 | croak $@; |
79 | } |
80 | } |
efe6365b |
81 | } |
82 | |
83 | # Returns true if the specified class is installed or already loaded, false |
84 | # otherwise |
85 | sub ensure_class_found { |
86 | my ($class, $f_class) = @_; |
87 | return Class::Inspector->loaded($f_class) || |
88 | Class::Inspector->installed($f_class); |
89 | } |
90 | |
91 | # Returns a true value if the specified class is installed and loaded |
92 | # successfully, throws an exception if the class is found but not loaded |
93 | # successfully, and false if the class is not installed |
94 | sub load_optional_class { |
95 | my ($class, $f_class) = @_; |
96 | if ($class->ensure_class_found($f_class)) { |
97 | $class->ensure_class_loaded($f_class); |
98 | return 1; |
99 | } else { |
100 | return 0; |
101 | } |
c037c03a |
102 | } |
103 | |
227d4dee |
104 | 1; |