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',
 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
 306   my $class = shift;
 307   my $modfn = __PACKAGE__ . '.pm';
 308   $modfn =~ s/\:\:/\//g;
 309
 310   my $podfn = __FILE__;
 311   $podfn =~ s/\.pm$/\.pod/;
 312
 313   my $distver =
 314     eval { require DBIx::Class; DBIx::Class->VERSION; }
 315       ||
 316     do {
 317       warn
 318 "\n\n---------------------------------------------------------------------\n" .
 319 'Unable to load core DBIx::Class module to determine current version, '.
 320 'possibly due to missing dependencies. Author-mode autodocumentation ' .
 321 "halted\n\n" . $@ .
 322 "\n\n---------------------------------------------------------------------\n"
 323       ;
 324       '*UNKNOWN*';  # rv
 325     }
 326   ;
 327
 328   my $sqltver = $class->req_list_for ('deploy')->{'SQL::Translator'}
 329     or die "Hrmm? No sqlt dep?";
 330
 331   my @chunks = (
 332     <<'EOC',
 333 #########################################################################
 334 #####################  A U T O G E N E R A T E D ########################
 335 #########################################################################
 336 #
 337 # The contents of this POD file are auto-generated.  Any changes you make
 338 # will be lost. If you need to change the generated text edit _gen_pod()
 339 # at the end of $modfn
 340 #
 341 EOC
 342     '=head1 NAME',
 343     "$class - Optional module dependency specifications (for module authors)",
 344     '=head1 SYNOPSIS',
 345     <<"EOS",
 346 Somewhere in your build-file (e.g. L<Module::Install>'s Makefile.PL):
 347
 348   ...
 349
 350   configure_requires 'DBIx::Class' => '$distver';
 351
 352   require $class;
 353
 354   my \$deploy_deps = $class->req_list_for ('deploy');
 355
 356   for (keys %\$deploy_deps) {
 357     requires \$_ => \$deploy_deps->{\$_};
 358   }
 359
 360   ...
 361
 362 Note that there are some caveats regarding C<configure_requires()>, more info
 363 can be found at L<Module::Install/configure_requires>
 364 EOS
 365     '=head1 DESCRIPTION',
 366     <<'EOD',
 367 Some of the less-frequently used features of L<DBIx::Class> have external
 368 module dependencies on their own. In order not to burden the average user
 369 with modules he will never use, these optional dependencies are not included
 370 in the base Makefile.PL. Instead an exception with a descriptive message is
 371 thrown when a specific feature is missing one or several modules required for
 372 its operation. This module is the central holding place for  the current list
 373 of such dependencies, for DBIx::Class core authors, and DBIx::Class extension
 374 authors alike.
 375 EOD
 376     '=head1 CURRENT REQUIREMENT GROUPS',
 377     <<'EOD',
 378 Dependencies are organized in C<groups> and each group can list one or more
 379 required modules, with an optional minimum version (or 0 for any version).
 380 The group name can be used in the
 381 EOD
 382   );
 383
 384   for my $group (sort keys %$reqs) {
 385     my $p = $reqs->{$group}{pod}
 386       or next;
 387
 388     my $modlist = $reqs->{$group}{req}
 389       or next;
 390
 391     next unless keys %$modlist;
 392
 393     push @chunks, (
 394       "=head2 $p->{title}",
 395       "$p->{desc}",
 396       '=over',
 397       ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
 398       '=back',
 399       "Requirement group: B<$group>",
 400     );
 401   }
 402
 403   push @chunks, (
 404     '=head1 METHODS',
 405     '=head2 req_group_list',
 406     '=over',
 407     '=item Arguments: none',
 408     '=item Returns: \%list_of_requirement_groups',
 409     '=back',
 410     <<'EOD',
 411 This method should be used by DBIx::Class packagers, to get a hashref of all
 412 dependencies keyed by dependency group. Each key (group name) can be supplied
 413 to one of the group-specific methods below.
 414 EOD
 415
 416     '=head2 req_list_for',
 417     '=over',
 418     '=item Arguments: $group_name',
 419     '=item Returns: \%list_of_module_version_pairs',
 420     '=back',
 421     <<'EOD',
 422 This method should be used by DBIx::Class extension authors, to determine the
 423 version of modules a specific feature requires in the B<current> version of
 424 DBIx::Class. See the L</SYNOPSIS> for a real-world
 425 example.
 426 EOD
 427
 428     '=head2 req_ok_for',
 429     '=over',
 430     '=item Arguments: $group_name',
 431     '=item Returns: 1|0',
 432     '=back',
 433     <<'EOD',
 434 Returns true or false depending on whether all modules required by
 435 C<$group_name> are present on the system and loadable.
 436 EOD
 437
 438     '=head2 req_missing_for',
 439     '=over',
 440     '=item Arguments: $group_name',
 441     '=item Returns: $error_message_string',
 442     '=back',
 443     <<"EOD",
 444 Returns a single line string suitable for inclusion in larger error messages.
 445 This method would normally be used by DBIx::Class core-module author, to
 446 indicate to the user that he needs to install specific modules before he will
 447 be able to use a specific feature.
 448
 449 For example if some of the requirements for C<deploy> are not available,
 450 the returned string could look like:
 451
 452  SQL::Translator >= $sqltver (see $class for details)
 453
 454 The author is expected to prepend the necessary text to this message before
 455 returning the actual error seen by the user.
 456 EOD
 457
 458     '=head2 req_errorlist_for',
 459     '=over',
 460     '=item Arguments: $group_name',
 461     '=item Returns: \%list_of_loaderrors_per_module',
 462     '=back',
 463     <<'EOD',
 464 Returns a hashref containing the actual errors that occured while attempting
 465 to load each module in the requirement group.
 466 EOD
 467     '=head1 AUTHOR',
 468     'See L<DBIx::Class/CONTRIBUTORS>.',
 469     '=head1 LICENSE',
 470     'You may distribute this code under the same terms as Perl itself',
 471   );
 472
 473   open (my $fh, '>', $podfn) or croak "Unable to write to $podfn: $!";
 474   print $fh join ("\n\n", @chunks);
 475   close ($fh);
 476 }
 477
 478 1;