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