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