Commit | Line | Data |
ef8e9c69 |
1 | package DBIx::Class::Schema::Loader::Optional::Dependencies; |
2 | |
3 | use warnings; |
4 | use strict; |
5 | |
6 | use Carp; |
7 | |
8 | # Stolen from DBIx::Class |
9 | |
10 | # NO EXTERNAL NON-5.8.1 CORE DEPENDENCIES EVER (e.g. C::A::G) |
11 | # This module is to be loaded by Makefile.PM on a pristine system |
12 | |
13 | # POD is generated automatically by calling _gen_pod from the |
14 | # Makefile.PL in $AUTHOR mode |
15 | |
16 | my $reqs = { |
0322c5b3 |
17 | dist => { |
18 | #'Module::Install::Pod::Inherit' => '0.01', |
ef8e9c69 |
19 | }, |
0322c5b3 |
20 | |
21 | use_moose => { |
22 | req => { |
23 | 'Moose' => '1.12', |
c2911c59 |
24 | 'MooseX::NonMoose' => '0.25', |
46163796 |
25 | 'namespace::autoclean' => '0.09', |
7d265d7f |
26 | 'MooseX::MarkAsMethods' => '0.13', |
0322c5b3 |
27 | }, |
28 | pod => { |
29 | title => 'use_moose', |
30 | desc => 'Modules required for the use_moose option', |
31 | }, |
32 | }, |
33 | |
34 | dbicdump_config => { |
35 | req => { |
36 | 'Config::Any' => '0', |
37 | }, |
38 | pod => { |
39 | title => 'dbicdump config file', |
40 | desc => 'Modules required for using a config file with dbicdump', |
41 | }, |
42 | }, |
43 | |
44 | test_dbicdump_config => { |
45 | req => { |
46 | 'Config::Any' => '0', |
47 | 'Config::General' => '0', |
48 | }, |
49 | pod => { |
50 | title => 'dbicdump config file testing', |
51 | desc => 'Modules required for using testing using a config file with dbicdump', |
52 | }, |
ef8e9c69 |
53 | }, |
a04e5e2c |
54 | |
55 | test_pod => { |
56 | req => { |
57 | 'Test::Pod' => '1.14', |
58 | 'Pod::Simple' => '3.22', |
59 | }, |
60 | pod => { |
61 | title => 'POD testing', |
62 | desc => 'Modules required for testing POD in this distribution', |
63 | }, |
64 | }, |
ef8e9c69 |
65 | }; |
66 | |
67 | sub req_list_for { |
68 | my ($class, $group) = @_; |
69 | |
70 | croak "req_list_for() expects a requirement group name" |
71 | unless $group; |
72 | |
73 | my $deps = $reqs->{$group}{req} |
74 | or croak "Requirement group '$group' does not exist"; |
75 | |
76 | return { %$deps }; |
77 | } |
78 | |
79 | |
80 | our %req_availability_cache; |
81 | sub req_ok_for { |
82 | my ($class, $group) = @_; |
83 | |
84 | croak "req_ok_for() expects a requirement group name" |
85 | unless $group; |
86 | |
87 | $class->_check_deps ($group) unless $req_availability_cache{$group}; |
88 | |
89 | return $req_availability_cache{$group}{status}; |
90 | } |
91 | |
92 | sub req_missing_for { |
93 | my ($class, $group) = @_; |
94 | |
95 | croak "req_missing_for() expects a requirement group name" |
96 | unless $group; |
97 | |
98 | $class->_check_deps ($group) unless $req_availability_cache{$group}; |
99 | |
100 | return $req_availability_cache{$group}{missing}; |
101 | } |
102 | |
103 | sub req_errorlist_for { |
104 | my ($class, $group) = @_; |
105 | |
106 | croak "req_errorlist_for() expects a requirement group name" |
107 | unless $group; |
108 | |
109 | $class->_check_deps ($group) unless $req_availability_cache{$group}; |
110 | |
111 | return $req_availability_cache{$group}{errorlist}; |
112 | } |
113 | |
114 | sub _check_deps { |
115 | my ($class, $group) = @_; |
116 | |
117 | my $deps = $class->req_list_for ($group); |
118 | |
119 | my %errors; |
120 | for my $mod (keys %$deps) { |
121 | if (my $ver = $deps->{$mod}) { |
122 | eval "use $mod $ver ()"; |
123 | } |
124 | else { |
125 | eval "require $mod"; |
126 | } |
127 | |
128 | $errors{$mod} = $@ if $@; |
129 | } |
130 | |
131 | if (keys %errors) { |
132 | my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) ); |
133 | $missing .= " (see $class for details)" if $reqs->{$group}{pod}; |
134 | $req_availability_cache{$group} = { |
135 | status => 0, |
136 | errorlist => { %errors }, |
137 | missing => $missing, |
138 | }; |
139 | } |
140 | else { |
141 | $req_availability_cache{$group} = { |
142 | status => 1, |
143 | errorlist => {}, |
144 | missing => '', |
145 | }; |
146 | } |
147 | } |
148 | |
149 | sub req_group_list { |
150 | return { map { $_ => { %{ $reqs->{$_}{req} || {} } } } (keys %$reqs) }; |
151 | } |
152 | |
153 | # This is to be called by the author only (automatically in Makefile.PL) |
154 | sub _gen_pod { |
155 | |
156 | my $class = shift; |
157 | my $modfn = __PACKAGE__ . '.pm'; |
158 | $modfn =~ s/\:\:/\//g; |
159 | |
160 | my $podfn = __FILE__; |
161 | $podfn =~ s/\.pm$/\.pod/; |
162 | |
163 | my $distver = |
164 | eval { require DBIx::Class::Schema::Loader; DBIx::Class::Schema::Loader->VERSION; } |
165 | || |
166 | do { |
167 | warn |
168 | "\n\n---------------------------------------------------------------------\n" . |
169 | 'Unable to load the DBIx::Class::Schema::Loader module to determine current ' . |
170 | 'version, possibly due to missing dependencies. Author-mode autodocumentation ' . |
171 | "halted\n\n" . $@ . |
172 | "\n\n---------------------------------------------------------------------\n" |
173 | ; |
174 | '*UNKNOWN*'; # rv |
175 | } |
176 | ; |
177 | |
178 | my @chunks = ( |
179 | <<"EOC", |
180 | ######################################################################### |
181 | ##################### A U T O G E N E R A T E D ######################## |
182 | ######################################################################### |
183 | # |
184 | # The contents of this POD file are auto-generated. Any changes you make |
185 | # will be lost. If you need to change the generated text edit _gen_pod() |
186 | # at the end of $modfn |
187 | # |
188 | EOC |
189 | '=head1 NAME', |
190 | "$class - Optional module dependency specifications (for module authors)", |
191 | '=head1 SYNOPSIS', |
192 | <<EOS, |
193 | Somewhere in your build-file (e.g. L<Module::Install>'s Makefile.PL): |
194 | |
195 | ... |
196 | |
197 | configure_requires 'DBIx::Class::Schema::Loader' => '$distver'; |
198 | |
199 | require $class; |
200 | |
201 | my \$use_moose_deps = $class->req_list_for ('use_moose'); |
202 | |
203 | for (keys %\$use_moose_deps) { |
204 | requires \$_ => \$use_moose_deps->{\$_}; |
205 | } |
206 | |
207 | ... |
208 | |
209 | Note that there are some caveats regarding C<configure_requires()>, more info |
210 | can be found at L<Module::Install/configure_requires> |
211 | EOS |
212 | '=head1 DESCRIPTION', |
213 | <<'EOD', |
214 | Some of the features of L<DBIx::Class::Schema::Loader> have external |
215 | module dependencies on their own. In order not to burden the average user |
216 | with modules he will never use, these optional dependencies are not included |
217 | in the base Makefile.PL. Instead an exception with a descriptive message is |
218 | thrown when a specific feature is missing one or several modules required for |
219 | its operation. This module is the central holding place for the current list |
220 | of such dependencies. |
221 | EOD |
222 | '=head1 CURRENT REQUIREMENT GROUPS', |
223 | <<'EOD', |
224 | Dependencies are organized in C<groups> and each group can list one or more |
225 | required modules, with an optional minimum version (or 0 for any version). |
226 | EOD |
227 | ); |
228 | |
229 | for my $group (sort keys %$reqs) { |
230 | my $p = $reqs->{$group}{pod} |
231 | or next; |
232 | |
233 | my $modlist = $reqs->{$group}{req} |
234 | or next; |
235 | |
236 | next unless keys %$modlist; |
237 | |
238 | push @chunks, ( |
239 | "=head2 $p->{title}", |
240 | "$p->{desc}", |
241 | '=over', |
242 | ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ), |
243 | '=back', |
244 | "Requirement group: B<$group>", |
245 | ); |
246 | } |
247 | |
248 | push @chunks, ( |
249 | '=head1 METHODS', |
250 | '=head2 req_group_list', |
251 | '=over', |
252 | '=item Arguments: $none', |
253 | '=item Returns: \%list_of_requirement_groups', |
254 | '=back', |
255 | <<EOD, |
256 | This method should be used by DBIx::Class packagers, to get a hashref of all |
257 | dependencies keyed by dependency group. Each key (group name) can be supplied |
258 | to one of the group-specific methods below. |
259 | EOD |
260 | |
261 | '=head2 req_list_for', |
262 | '=over', |
263 | '=item Arguments: $group_name', |
264 | '=item Returns: \%list_of_module_version_pairs', |
265 | '=back', |
266 | <<EOD, |
267 | This method should be used by DBIx::Class extension authors, to determine the |
268 | version of modules a specific feature requires in the B<current> version of |
269 | L<DBIx::Class::Schema::Loader>. See the L</SYNOPSIS> for a real-world |
270 | example. |
271 | EOD |
272 | |
273 | '=head2 req_ok_for', |
274 | '=over', |
275 | '=item Arguments: $group_name', |
276 | '=item Returns: 1|0', |
277 | '=back', |
278 | 'Returns true or false depending on whether all modules required by C<$group_name> are present on the system and loadable', |
279 | |
280 | '=head2 req_missing_for', |
281 | '=over', |
282 | '=item Arguments: $group_name', |
283 | '=item Returns: $error_message_string', |
284 | '=back', |
285 | <<EOD, |
286 | Returns a single line string suitable for inclusion in larger error messages. |
287 | This method would normally be used by L<DBIx::Class::Schema::Loader> |
288 | maintainers, to indicate to the user that he needs to install specific modules |
289 | before he will be able to use a specific feature. |
290 | |
291 | For example if some of the requirements for C<use_moose> are not available, |
292 | the returned string could look like: |
293 | |
294 | Moose >= 0 (see use_moose for details) |
295 | |
296 | The author is expected to prepend the necessary text to this message before |
297 | returning the actual error seen by the user. |
298 | EOD |
299 | |
300 | '=head2 req_errorlist_for', |
301 | '=over', |
302 | '=item Arguments: $group_name', |
303 | '=item Returns: \%list_of_loaderrors_per_module', |
304 | '=back', |
305 | <<'EOD', |
dee01f3b |
306 | Returns a hashref containing the actual errors that occurred while attempting |
ef8e9c69 |
307 | to load each module in the requirement group. |
308 | EOD |
309 | '=head1 AUTHOR', |
310 | 'See L<DBIx::Class/CONTRIBUTORS>.', |
311 | '=head1 LICENSE', |
312 | 'You may distribute this code under the same terms as Perl itself', |
313 | ); |
314 | |
315 | open (my $fh, '>', $podfn) or croak "Unable to write to $podfn: $!"; |
316 | print $fh join ("\n\n", @chunks); |
317 | close ($fh); |
318 | } |
319 | |
320 | 1; |