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_leaks => {
 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_mssql_odbc => {
 177     req => {
 178       $ENV{DBICTEST_MSSQL_ODBC_DSN}
 179         ? (
 180           'DBD::ODBC'             => '0',
 181         ) : ()
 182     },
 183   },
 184
 185   test_rdbms_mssql_sybase => {
 186     req => {
 187       $ENV{DBICTEST_MSSQL_DSN}
 188         ? (
 189           'DBD::Sybase'           => '0',
 190         ) : ()
 191     },
 192   },
 193
 194   test_rdbms_mysql => {
 195     req => {
 196       $ENV{DBICTEST_MYSQL_DSN}
 197         ? (
 198           'DBD::mysql'            => '0',
 199         ) : ()
 200     },
 201   },
 202
 203   test_rdbms_oracle => {
 204     req => {
 205       $ENV{DBICTEST_ORA_DSN}
 206         ? (
 207           'DateTime::Format::Oracle' => '0',
 208           'DBD::Oracle'              => '1.24',
 209         ) : ()
 210     },
 211   },
 212
 213   test_rdbms_ase => {
 214     req => {
 215       $ENV{DBICTEST_SYBASE_DSN}
 216         ? (
 217           'DateTime::Format::Sybase' => 0,
 218         ) : ()
 219     },
 220   },
 221
 222   test_rdbms_db2 => {
 223     req => {
 224       $ENV{DBICTEST_DB2_DSN}
 225         ? (
 226           'DBD::DB2' => 0,
 227         ) : ()
 228     },
 229   },
 230
 231 };
 232
 233
 234 sub req_list_for {
 235   my ($class, $group) = @_;
 236
 237   croak "req_list_for() expects a requirement group name"
 238     unless $group;
 239
 240   my $deps = $reqs->{$group}{req}
 241     or croak "Requirement group '$group' does not exist";
 242
 243   return { %$deps };
 244 }
 245
 246
 247 our %req_availability_cache;
 248 sub req_ok_for {
 249   my ($class, $group) = @_;
 250
 251   croak "req_ok_for() expects a requirement group name"
 252     unless $group;
 253
 254   return $class->_check_deps($group)->{status};
 255 }
 256
 257 sub req_missing_for {
 258   my ($class, $group) = @_;
 259
 260   croak "req_missing_for() expects a requirement group name"
 261     unless $group;
 262
 263   return $class->_check_deps($group)->{missing};
 264 }
 265
 266 sub req_errorlist_for {
 267   my ($class, $group) = @_;
 268
 269   croak "req_errorlist_for() expects a requirement group name"
 270     unless $group;
 271
 272   return $class->_check_deps($group)->{errorlist};
 273 }
 274
 275 sub _check_deps {
 276   my ($class, $group) = @_;
 277
 278   return $req_availability_cache{$group} ||= do {
 279
 280     my $deps = $class->req_list_for ($group);
 281
 282     my %errors;
 283     for my $mod (keys %$deps) {
 284       my $req_line = "require $mod;";
 285       if (my $ver = $deps->{$mod}) {
 286         $req_line .= "$mod->VERSION($ver);";
 287       }
 288
 289       eval $req_line;
 290
 291       $errors{$mod} = $@ if $@;
 292     }
 293
 294     my $res;
 295
 296     if (keys %errors) {
 297       my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) );
 298       $missing .= " (see $class for details)" if $reqs->{$group}{pod};
 299       $res = {
 300         status => 0,
 301         errorlist => \%errors,
 302         missing => $missing,
 303       };
 304     }
 305     else {
 306       $res = {
 307         status => 1,
 308         errorlist => {},
 309         missing => '',
 310       };
 311     }
 312
 313     $res;
 314   };
 315 }
 316
 317 sub req_group_list {
 318   return { map { $_ => { %{ $reqs->{$_}{req} || {} } } } (keys %$reqs) };
 319 }
 320
 321 # This is to be called by the author only (automatically in Makefile.PL)
 322 sub _gen_pod {
 323   my ($class, $distver) = @_;
 324
 325   my $modfn = __PACKAGE__ . '.pm';
 326   $modfn =~ s/\:\:/\//g;
 327
 328   my $podfn = __FILE__;
 329   $podfn =~ s/\.pm$/\.pod/;
 330
 331   $distver ||=
 332     eval { require DBIx::Class; DBIx::Class->VERSION; }
 333       ||
 334     die
 335 "\n\n---------------------------------------------------------------------\n" .
 336 'Unable to load core DBIx::Class module to determine current version, '.
 337 'possibly due to missing dependencies. Author-mode autodocumentation ' .
 338 "halted\n\n" . $@ .
 339 "\n\n---------------------------------------------------------------------\n"
 340   ;
 341
 342   my $sqltver = $class->req_list_for ('deploy')->{'SQL::Translator'}
 343     or die "Hrmm? No sqlt dep?";
 344
 345   my @chunks = (
 346     <<'EOC',
 347 #########################################################################
 348 #####################  A U T O G E N E R A T E D ########################
 349 #########################################################################
 350 #
 351 # The contents of this POD file are auto-generated.  Any changes you make
 352 # will be lost. If you need to change the generated text edit _gen_pod()
 353 # at the end of $modfn
 354 #
 355 EOC
 356     '=head1 NAME',
 357     "$class - Optional module dependency specifications (for module authors)",
 358     '=head1 SYNOPSIS',
 359     <<"EOS",
 360 Somewhere in your build-file (e.g. L<Module::Install>'s Makefile.PL):
 361
 362   ...
 363
 364   configure_requires 'DBIx::Class' => '$distver';
 365
 366   require $class;
 367
 368   my \$deploy_deps = $class->req_list_for ('deploy');
 369
 370   for (keys %\$deploy_deps) {
 371     requires \$_ => \$deploy_deps->{\$_};
 372   }
 373
 374   ...
 375
 376 Note that there are some caveats regarding C<configure_requires()>, more info
 377 can be found at L<Module::Install/configure_requires>
 378 EOS
 379     '=head1 DESCRIPTION',
 380     <<'EOD',
 381 Some of the less-frequently used features of L<DBIx::Class> have external
 382 module dependencies on their own. In order not to burden the average user
 383 with modules he will never use, these optional dependencies are not included
 384 in the base Makefile.PL. Instead an exception with a descriptive message is
 385 thrown when a specific feature is missing one or several modules required for
 386 its operation. This module is the central holding place for  the current list
 387 of such dependencies, for DBIx::Class core authors, and DBIx::Class extension
 388 authors alike.
 389 EOD
 390     '=head1 CURRENT REQUIREMENT GROUPS',
 391     <<'EOD',
 392 Dependencies are organized in C<groups> and each group can list one or more
 393 required modules, with an optional minimum version (or 0 for any version).
 394 The group name can be used in the
 395 EOD
 396   );
 397
 398   for my $group (sort keys %$reqs) {
 399     my $p = $reqs->{$group}{pod}
 400       or next;
 401
 402     my $modlist = $reqs->{$group}{req}
 403       or next;
 404
 405     next unless keys %$modlist;
 406
 407     push @chunks, (
 408       "=head2 $p->{title}",
 409       "$p->{desc}",
 410       '=over',
 411       ( map { "=item * $_" . ($modlist->{$_} ? " >= $modlist->{$_}" : '') } (sort keys %$modlist) ),
 412       '=back',
 413       "Requirement group: B<$group>",
 414     );
 415   }
 416
 417   push @chunks, (
 418     '=head1 METHODS',
 419     '=head2 req_group_list',
 420     '=over',
 421     '=item Arguments: none',
 422     '=item Returns: \%list_of_requirement_groups',
 423     '=back',
 424     <<'EOD',
 425 This method should be used by DBIx::Class packagers, to get a hashref of all
 426 dependencies keyed by dependency group. Each key (group name) can be supplied
 427 to one of the group-specific methods below.
 428 EOD
 429
 430     '=head2 req_list_for',
 431     '=over',
 432     '=item Arguments: $group_name',
 433     '=item Returns: \%list_of_module_version_pairs',
 434     '=back',
 435     <<'EOD',
 436 This method should be used by DBIx::Class extension authors, to determine the
 437 version of modules a specific feature requires in the B<current> version of
 438 DBIx::Class. See the L</SYNOPSIS> for a real-world
 439 example.
 440 EOD
 441
 442     '=head2 req_ok_for',
 443     '=over',
 444     '=item Arguments: $group_name',
 445     '=item Returns: 1|0',
 446     '=back',
 447     <<'EOD',
 448 Returns true or false depending on whether all modules required by
 449 C<$group_name> are present on the system and loadable.
 450 EOD
 451
 452     '=head2 req_missing_for',
 453     '=over',
 454     '=item Arguments: $group_name',
 455     '=item Returns: $error_message_string',
 456     '=back',
 457     <<"EOD",
 458 Returns a single line string suitable for inclusion in larger error messages.
 459 This method would normally be used by DBIx::Class core-module author, to
 460 indicate to the user that he needs to install specific modules before he will
 461 be able to use a specific feature.
 462
 463 For example if some of the requirements for C<deploy> are not available,
 464 the returned string could look like:
 465
 466  SQL::Translator >= $sqltver (see $class for details)
 467
 468 The author is expected to prepend the necessary text to this message before
 469 returning the actual error seen by the user.
 470 EOD
 471
 472     '=head2 req_errorlist_for',
 473     '=over',
 474     '=item Arguments: $group_name',
 475     '=item Returns: \%list_of_loaderrors_per_module',
 476     '=back',
 477     <<'EOD',
 478 Returns a hashref containing the actual errors that occured while attempting
 479 to load each module in the requirement group.
 480 EOD
 481     '=head1 AUTHOR',
 482     'See L<DBIx::Class/CONTRIBUTORS>.',
 483     '=head1 LICENSE',
 484     'You may distribute this code under the same terms as Perl itself',
 485   );
 486
 487   open (my $fh, '>', $podfn) or croak "Unable to write to $podfn: $!";
 488   print $fh join ("\n\n", @chunks);
 489   close ($fh);
 490 }
 491
 492 1;