Refactor the version handling
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Optional / Dependencies.pm
1 package DBIx::Class::Optional::Dependencies;
2
3 use warnings;
4 use strict;
5
6 use Carp;
7
8 # NO EXTERNAL NON-5.8.1 CORE DEPENDENCIES EVER (e.g. C::A::G)
9 # This module is to be loaded by Makefile.PM on a pristine system
10
11 # POD is generated automatically by calling _gen_pod from the
12 # Makefile.PL in $AUTHOR mode
13
14 my $moose_basic = {
15   'Moose'                      => '0.98',
16   'MooseX::Types'              => '0.21',
17 };
18
19 my $admin_basic = {
20   %$moose_basic,
21   'MooseX::Types::Path::Class' => '0.05',
22   'MooseX::Types::JSON'        => '0.02',
23   'JSON::Any'                  => '1.22',
24   'namespace::autoclean'       => '0.09',
25 };
26
27 my $reqs = {
28   dist => {
29     #'Module::Install::Pod::Inherit' => '0.01',
30   },
31
32   replicated => {
33     req => {
34       %$moose_basic,
35       'namespace::clean'          => '0.11',
36       'Hash::Merge'               => '0.12',
37     },
38     pod => {
39       title => 'Storage::Replicated',
40       desc => 'Modules required for L<DBIx::Class::Storage::DBI::Replicated>',
41     },
42   },
43
44   admin => {
45     req => {
46       %$admin_basic,
47     },
48     pod => {
49       title => 'DBIx::Class::Admin',
50       desc => 'Modules required for the DBIx::Class administrative library',
51     },
52   },
53
54   admin_script => {
55     req => {
56       %$moose_basic,
57       %$admin_basic,
58       'Getopt::Long::Descriptive' => '0.081',
59       'Text::CSV'                 => '1.16',
60     },
61     pod => {
62       title => 'dbicadmin',
63       desc => 'Modules required for the CLI DBIx::Class interface dbicadmin',
64     },
65   },
66
67   deploy => {
68     req => {
69       'SQL::Translator'           => '0.11005',
70     },
71     pod => {
72       title => 'Storage::DBI::deploy()',
73       desc => 'Modules required for L<DBIx::Class::Storage::DBI/deploy> and L<DBIx::Class::Storage::DBI/deploymen_statements>',
74     },
75   },
76
77
78   test_pod => {
79     req => {
80       'Test::Pod'                 => '1.41',
81     },
82   },
83
84   test_podcoverage => {
85     req => {
86       'Test::Pod::Coverage'       => '1.08',
87       'Pod::Coverage'             => '0.20',
88     },
89   },
90
91   test_notabs => {
92     req => {
93       'Test::NoTabs'              => '0.9',
94     },
95   },
96
97   test_eol => {
98     req => {
99       'Test::EOL'                 => '0.6',
100     },
101   },
102
103   test_cycle => {
104     req => {
105       'Test::Memory::Cycle'       => '0',
106       'Devel::Cycle'              => '1.10',
107     },
108   },
109
110   test_dtrelated => {
111     req => {
112       # t/36datetime.t
113       # t/60core.t
114       'DateTime::Format::SQLite'  => '0',
115
116       # t/96_is_deteministic_value.t
117       'DateTime::Format::Strptime'=> '0',
118
119       # t/inflate/datetime_mysql.t
120       # (doesn't need Mysql itself)
121       'DateTime::Format::MySQL' => '0',
122
123       # t/inflate/datetime_pg.t
124       # (doesn't need PG itself)
125       'DateTime::Format::Pg'  => '0',
126     },
127   },
128
129   cdbicompat => {
130     req => {
131       'DBIx::ContextualFetch'     => '0',
132       'Class::DBI::Plugin::DeepAbstractSearch' => '0',
133       'Class::Trigger'            => '0',
134       'Time::Piece::MySQL'        => '0',
135       'Clone'                     => '0',
136       'Date::Simple'              => '3.03',
137     },
138   },
139
140   rdbms_pg => {
141     req => {
142       $ENV{DBICTEST_PG_DSN}
143         ? (
144           'Sys::SigAction'        => '0',
145           'DBD::Pg'               => '2.009002',
146         ) : ()
147     },
148   },
149
150   rdbms_mysql => {
151     req => {
152       $ENV{DBICTEST_MYSQL_DSN}
153         ? (
154           'DBD::mysql'              => '0',
155         ) : ()
156     },
157   },
158
159   rdbms_oracle => {
160     req => {
161       $ENV{DBICTEST_ORA_DSN}
162         ? (
163           'DateTime::Format::Oracle' => '0',
164         ) : ()
165     },
166   },
167
168   rdbms_ase => {
169     req => {
170       $ENV{DBICTEST_SYBASE_DSN}
171         ? (
172           'DateTime::Format::Sybase' => 0,
173         ) : ()
174     },
175   },
176
177   rdbms_asa => {
178     req => {
179       (scalar grep { $ENV{$_} } (qw/DBICTEST_SYBASE_ASA_DSN DBICTEST_SYBASE_ASA_ODBC_DSN/) )
180         ? (
181           'DateTime::Format::Strptime' => 0,
182         ) : ()
183     },
184   },
185
186   rdbms_db2 => {
187     req => {
188       $ENV{DBICTEST_DB2_DSN}
189         ? (
190           'DBD::DB2' => 0,
191         ) : ()
192     },
193   },
194
195 };
196
197
198 sub req_list_for {
199   my ($class, $group) = @_;
200
201   croak "req_list_for() expects a requirement group name"
202     unless $group;
203
204   my $deps = $reqs->{$group}{req}
205     or croak "Requirement group '$group' does not exist";
206
207   return { %$deps };
208 }
209
210
211 our %req_availability_cache;
212 sub req_ok_for {
213   my ($class, $group) = @_;
214
215   croak "req_ok_for() expects a requirement group name"
216     unless $group;
217
218   $class->_check_deps ($group) unless $req_availability_cache{$group};
219
220   return $req_availability_cache{$group}{status};
221 }
222
223 sub req_missing_for {
224   my ($class, $group) = @_;
225
226   croak "req_missing_for() expects a requirement group name"
227     unless $group;
228
229   $class->_check_deps ($group) unless $req_availability_cache{$group};
230
231   return $req_availability_cache{$group}{missing};
232 }
233
234 sub req_errorlist_for {
235   my ($class, $group) = @_;
236
237   croak "req_errorlist_for() expects a requirement group name"
238     unless $group;
239
240   $class->_check_deps ($group) unless $req_availability_cache{$group};
241
242   return $req_availability_cache{$group}{errorlist};
243 }
244
245 sub _check_deps {
246   my ($class, $group) = @_;
247
248   my $deps = $class->req_list_for ($group);
249
250   my %errors;
251   for my $mod (keys %$deps) {
252     if (my $ver = $deps->{$mod}) {
253       eval "use $mod $ver ()";
254     }
255     else {
256       eval "require $mod";
257     }
258
259     $errors{$mod} = $@ if $@;
260   }
261
262   if (keys %errors) {
263     my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) );
264     $missing .= " (see $class for details)" if $reqs->{$group}{pod};
265     $req_availability_cache{$group} = {
266       status => 0,
267       errorlist => { %errors },
268       missing => $missing,
269     };
270   }
271   else {
272     $req_availability_cache{$group} = {
273       status => 1,
274       errorlist => {},
275       missing => '',
276     };
277   }
278 }
279
280 sub req_group_list {
281   return { map { $_ => { %{ $reqs->{$_}{req} || {} } } } (keys %$reqs) };
282 }
283
284 # This is to be called by the author only (automatically in Makefile.PL)
285 sub _gen_pod {
286   my $class = shift;
287   my $modfn = __PACKAGE__ . '.pm';
288   $modfn =~ s/\:\:/\//g;
289
290   require DBIx::Class;
291   my $distver = DBIx::Class->VERSION;
292   my $sqltver = $class->req_list_for ('deploy')->{'SQL::Translator'}
293     or die "Hrmm? No sqlt dep?";
294
295   my @chunks = (
296     <<"EOC",
297 #########################################################################
298 #####################  A U T O G E N E R A T E D ########################
299 #########################################################################
300 #
301 # The contents of this POD file are auto-generated.  Any changes you make
302 # will be lost. If you need to change the generated text edit _gen_pod()
303 # at the end of $modfn
304 #
305 EOC
306     '=head1 NAME',
307     "$class - Optional module dependency specifications (for module authors)",
308     '=head1 SYNOPSIS',
309     <<EOS,
310 Somewhere in your build-file (e.g. L<Module::Install>'s Makefile.PL):
311
312   ...
313
314   configure_requires 'DBIx::Class' => '$distver';
315
316   require $class;
317
318   my \$deploy_deps = $class->req_list_for ('deploy');
319
320   for (keys %\$deploy_deps) {
321     requires \$_ => \$deploy_deps->{\$_};
322   }
323
324   ...
325
326 Note that there are some caveats regarding C<configure_requires()>, more info
327 can be found at L<Module::Install/configure_requires>
328 EOS
329     '=head1 DESCRIPTION',
330     <<'EOD',
331 Some of the less-frequently used features of L<DBIx::Class> have external
332 module dependencies on their own. In order not to burden the average user
333 with modules he will never use, these optional dependencies are not included
334 in the base Makefile.PL. Instead an exception with a descriptive message is
335 thrown when a specific feature is missing one or several modules required for
336 its operation. This module is the central holding place for  the current list
337 of such dependencies, for DBIx::Class core authors, and DBIx::Class extension
338 authors alike.
339 EOD
340     '=head1 CURRENT REQUIREMENT GROUPS',
341     <<'EOD',
342 Dependencies are organized in C<groups> and each group can list one or more
343 required modules, with an optional minimum version (or 0 for any version).
344 The group name can be used in the 
345 EOD
346   );
347
348   for my $group (sort keys %$reqs) {
349     my $p = $reqs->{$group}{pod}
350       or next;
351
352     my $modlist = $reqs->{$group}{req}
353       or next;
354
355     next unless keys %$modlist;
356
357     push @chunks, (
358       "=head2 $p->{title}",
359       "$p->{desc}",
360       '=over',
361       ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
362       '=back',
363       "Requirement group: B<$group>",
364     );
365   }
366
367   push @chunks, (
368     '=head1 METHODS',
369     '=head2 req_group_list',
370     '=over',
371     '=item Arguments: $none',
372     '=item Returns: \%list_of_requirement_groups',
373     '=back',
374     <<EOD,
375 This method should be used by DBIx::Class packagers, to get a hashref of all
376 dependencies keyed by dependency group. Each key (group name) can be supplied
377 to one of the group-specific methods below.
378 EOD
379
380     '=head2 req_list_for',
381     '=over',
382     '=item Arguments: $group_name',
383     '=item Returns: \%list_of_module_version_pairs',
384     '=back',
385     <<EOD,
386 This method should be used by DBIx::Class extension authors, to determine the
387 version of modules a specific feature requires in the B<current> version of
388 DBIx::Class. See the L</SYNOPSIS> for a real-world
389 example.
390 EOD
391
392     '=head2 req_ok_for',
393     '=over',
394     '=item Arguments: $group_name',
395     '=item Returns: 1|0',
396     '=back',
397     'Returns true or false depending on whether all modules required by C<$group_name> are present on the system and loadable',
398
399     '=head2 req_missing_for',
400     '=over',
401     '=item Arguments: $group_name',
402     '=item Returns: $error_message_string',
403     '=back',
404     <<EOD,
405 Returns a single line string suitable for inclusion in larger error messages.
406 This method would normally be used by DBIx::Class core-module author, to
407 indicate to the user that he needs to install specific modules before he will
408 be able to use a specific feature.
409
410 For example if some of the requirements for C<deploy> are not available,
411 the returned string could look like:
412
413  SQL::Translator >= $sqltver (see $class for details)
414
415 The author is expected to prepend the necessary text to this message before
416 returning the actual error seen by the user.
417 EOD
418
419     '=head2 req_errorlist_for',
420     '=over',
421     '=item Arguments: $group_name',
422     '=item Returns: \%list_of_loaderrors_per_module',
423     '=back',
424     <<'EOD',
425 Returns a hashref containing the actual errors that occured while attempting
426 to load each module in the requirement group.
427 EOD
428     '=head1 AUTHOR',
429     'See L<DBIx::Class/CONTRIBUTORS>.',
430     '=head1 LICENSE',
431     'You may distribute this code under the same terms as Perl itself',
432   );
433
434   my $fn = __FILE__;
435   $fn =~ s/\.pm$/\.pod/;
436
437   open (my $fh, '>', $fn) or croak "Unable to write to $fn: $!";
438   print $fh join ("\n\n", @chunks);
439   close ($fh);
440 }
441
442 1;