lib/DBIx/Class/Schema/Loader/Optional/Dependencies.pm

   1 package DBIx::Class::Schema::Loader::Optional::Dependencies;
   2
   3 ### This may look crazy, but it in fact tangibly ( by 50(!)% ) shortens
   4 #   the skip-test time when everything requested is unavailable
   5 BEGIN {
   6   if ( $ENV{RELEASE_TESTING} ) {
   7     require warnings and warnings->import;
   8     require strict and strict->import;
   9   }
  10 }
  11
  12 sub croak {
  13   require Carp;
  14   Carp::croak(@_);
  15 };
  16 ###
  17
  18 # NO EXTERNAL NON-5.8.1 CORE DEPENDENCIES EVER (e.g. C::A::G)
  19 # This module is to be loaded by Makefile.PM on a pristine system
  20
  21 # POD is generated automatically by calling _gen_pod from the
  22 # Makefile.PL in $AUTHOR mode
  23
  24 my $dbic_reqs = {
  25
  26   use_moose => {
  27     req => {
  28       'Moose' => '1.12',
  29       'MooseX::NonMoose' => '0.25',
  30       'namespace::autoclean' => '0.09',
  31       'MooseX::MarkAsMethods' => '0.13',
  32     },
  33     pod => {
  34       title => 'use_moose',
  35       desc  => 'Modules required for the use_moose option',
  36     },
  37   },
  38
  39   dbicdump_config => {
  40     req => {
  41       'Config::Any' => '0',
  42     },
  43     pod => {
  44       title => 'dbicdump config file',
  45       desc  => 'Modules required for using a config file with dbicdump',
  46     },
  47   },
  48
  49   test_dbicdump_config => {
  50     include => 'dbicdump_config',
  51     req => {
  52       'Config::General' => '0',
  53     },
  54     pod => {
  55       title => 'dbicdump config file testing',
  56       desc  => 'Modules required for using testing using a config file with dbicdump',
  57     },
  58   },
  59
  60   _rdbms_generic_odbc => {
  61     req => {
  62       'DBD::ODBC' => 0,
  63     }
  64   },
  65
  66   _rdbms_generic_ado => {
  67     req => {
  68       'DBD::ADO' => 0,
  69     }
  70   },
  71
  72   # must list any dep used by adhoc testing
  73   # this prevents the "skips due to forgotten deps" issue
  74   test_adhoc => {
  75     req => {
  76     },
  77   },
  78
  79   id_shortener => {
  80     req => {
  81       'Math::BigInt' => '1.80',
  82       'Math::Base36' => '0.07',
  83     },
  84   },
  85
  86   test_pod => {
  87     req => {
  88       'Test::Pod'                 => '1.14',
  89       'Pod::Simple'               => '3.22',
  90     },
  91     pod => {
  92       title => 'POD testing',
  93       desc  => 'Modules required for testing POD in this distribution',
  94     },
  95     release_testing_mandatory => 1,
  96   },
  97
  98   test_podcoverage => {
  99     req => {
 100       'Test::Pod::Coverage'       => '1.08',
 101       'Pod::Coverage'             => '0.20',
 102     },
 103     release_testing_mandatory => 1,
 104   },
 105
 106   test_whitespace => {
 107     req => {
 108       'Test::EOL'                 => '1.0',
 109       'Test::NoTabs'              => '0.9',
 110     },
 111     release_testing_mandatory => 1,
 112   },
 113
 114   test_strictures => {
 115     req => {
 116       'Test::Strict'              => '0.20',
 117     },
 118     release_testing_mandatory => 1,
 119   },
 120
 121   test_backcompat => {
 122     env => [
 123       SCHEMA_LOADER_TESTS_BACKCOMPAT => 1,
 124     ],
 125   },
 126
 127   # this is just for completeness as SQLite
 128   # is a core dep of DBIC for testing
 129   rdbms_sqlite => {
 130     req => {
 131       'DBD::SQLite' => 0,
 132     },
 133     pod => {
 134       title => 'SQLite support',
 135       desc => 'Modules required to connect to SQLite',
 136     },
 137     augment => {
 138     },
 139   },
 140
 141   rdbms_pg => {
 142     req => {
 143       # when changing this list make sure to adjust xt/optional_deps.t
 144       'DBD::Pg' => 0,
 145     },
 146     pod => {
 147       title => 'PostgreSQL support',
 148       desc => 'Modules required to connect to PostgreSQL',
 149     },
 150   },
 151
 152   _rdbms_mssql_common => {
 153   },
 154
 155   rdbms_mssql_odbc => {
 156     include => [qw( _rdbms_generic_odbc _rdbms_mssql_common )],
 157     pod => {
 158       title => 'MSSQL support via DBD::ODBC',
 159       desc => 'Modules required to connect to MSSQL via DBD::ODBC',
 160     },
 161   },
 162
 163   rdbms_mssql_sybase => {
 164     include => '_rdbms_mssql_common',
 165     req => {
 166       'DBD::Sybase' => 0,
 167     },
 168     pod => {
 169       title => 'MSSQL support via DBD::Sybase',
 170       desc => 'Modules required to connect to MSSQL via DBD::Sybase',
 171     },
 172   },
 173
 174   rdbms_mssql_ado => {
 175     include => [qw( _rdbms_generic_ado _rdbms_mssql_common )],
 176     pod => {
 177       title => 'MSSQL support via DBD::ADO (Windows only)',
 178       desc => 'Modules required to connect to MSSQL via DBD::ADO. This particular DBD is available on Windows only',
 179     },
 180   },
 181
 182   _rdbms_msaccess_common => {
 183   },
 184
 185   rdbms_msaccess_odbc => {
 186     include => [qw( _rdbms_generic_odbc _rdbms_msaccess_common )],
 187     pod => {
 188       title => 'MS Access support via DBD::ODBC',
 189       desc => 'Modules required to connect to MS Access via DBD::ODBC',
 190     },
 191   },
 192
 193   rdbms_msaccess_ado => {
 194     include => [qw( _rdbms_generic_ado _rdbms_msaccess_common )],
 195     pod => {
 196       title => 'MS Access support via DBD::ADO (Windows only)',
 197       desc => 'Modules required to connect to MS Access via DBD::ADO. This particular DBD is available on Windows only',
 198     },
 199   },
 200
 201   rdbms_mysql => {
 202     req => {
 203       'DBD::mysql' => 0,
 204     },
 205     pod => {
 206       title => 'MySQL support',
 207       desc => 'Modules required to connect to MySQL',
 208     },
 209   },
 210
 211   rdbms_oracle => {
 212     include => 'id_shortener',
 213     req => {
 214       'DBD::Oracle' => 0,
 215     },
 216     pod => {
 217       title => 'Oracle support',
 218       desc => 'Modules required to connect to Oracle',
 219     },
 220     augment => {
 221     },
 222   },
 223
 224   rdbms_ase => {
 225     req => {
 226       'DBD::Sybase' => 0,
 227     },
 228     pod => {
 229       title => 'Sybase ASE support',
 230       desc => 'Modules required to connect to Sybase ASE',
 231     },
 232   },
 233
 234   rdbms_db2 => {
 235     req => {
 236       'DBD::DB2' => 0,
 237     },
 238     pod => {
 239       title => 'DB2 support',
 240       desc => 'Modules required to connect to DB2',
 241     },
 242   },
 243
 244   rdbms_informix => {
 245     req => {
 246       'DBD::Informix' => 0,
 247     },
 248     pod => {
 249       title => 'Informix support',
 250       desc => 'Modules required to connect to Informix',
 251     },
 252   },
 253
 254   _rdbms_sqlanywhere_common => {
 255   },
 256
 257   rdbms_sqlanywhere => {
 258     include => '_rdbms_sqlanywhere_common',
 259     req => {
 260       'DBD::SQLAnywhere' => 0,
 261     },
 262     pod => {
 263       title => 'SQLAnywhere support',
 264       desc => 'Modules required to connect to SQLAnywhere',
 265     },
 266   },
 267
 268   rdbms_sqlanywhere_odbc => {
 269     include => [qw( _rdbms_generic_odbc _rdbms_sqlanywhere_common )],
 270     pod => {
 271       title => 'SQLAnywhere support via DBD::ODBC',
 272       desc => 'Modules required to connect to SQLAnywhere via DBD::ODBC',
 273     },
 274   },
 275
 276   _rdbms_firebird_common => {
 277   },
 278
 279   rdbms_firebird => {
 280     include => '_rdbms_firebird_common',
 281     req => {
 282       'DBD::Firebird' => 0,
 283     },
 284     pod => {
 285       title => 'Firebird support',
 286       desc => 'Modules required to connect to Firebird',
 287     },
 288   },
 289
 290   rdbms_firebird_interbase => {
 291     include => '_rdbms_firebird_common',
 292     req => {
 293       'DBD::InterBase' => 0,
 294     },
 295     pod => {
 296       title => 'Firebird support via DBD::InterBase',
 297       desc => 'Modules required to connect to Firebird via DBD::InterBase',
 298     },
 299   },
 300
 301   rdbms_firebird_odbc => {
 302     include => [qw( _rdbms_generic_odbc _rdbms_firebird_common )],
 303     pod => {
 304       title => 'Firebird support via DBD::ODBC',
 305       desc => 'Modules required to connect to Firebird via DBD::ODBC',
 306     },
 307   },
 308
 309   test_rdbms_sqlite => {
 310     include => 'rdbms_sqlite',
 311     req => {
 312       ###
 313       ### IMPORTANT - do not raise this dependency
 314       ### even though many bugfixes are present in newer versions, the general DBIC
 315       ### rule is to bend over backwards for available DBDs (given upgrading them is
 316       ### often *not* easy or even possible)
 317       ###
 318       'DBD::SQLite' => '1.29',
 319     },
 320   },
 321
 322   test_rdbms_pg => {
 323     include => 'rdbms_pg',
 324     env => [
 325       DBICTEST_PG_DSN => 1,
 326       DBICTEST_PG_USER => 0,
 327       DBICTEST_PG_PASS => 0,
 328     ],
 329     req => {
 330       # the order does matter because the rdbms support group might require
 331       # a different version that the test group
 332       #
 333       # when changing this list make sure to adjust xt/optional_deps.t
 334       'DBD::Pg' => '2.009002',  # specific version to test bytea
 335     },
 336   },
 337
 338   test_rdbms_mssql_odbc => {
 339     include => 'rdbms_mssql_odbc',
 340     env => [
 341       DBICTEST_MSSQL_ODBC_DSN => 1,
 342       DBICTEST_MSSQL_ODBC_USER => 0,
 343       DBICTEST_MSSQL_ODBC_PASS => 0,
 344     ],
 345   },
 346
 347   test_rdbms_mssql_ado => {
 348     include => 'rdbms_mssql_ado',
 349     env => [
 350       DBICTEST_MSSQL_ADO_DSN => 1,
 351       DBICTEST_MSSQL_ADO_USER => 0,
 352       DBICTEST_MSSQL_ADO_PASS => 0,
 353     ],
 354   },
 355
 356   test_rdbms_mssql_sybase => {
 357     include => 'rdbms_mssql_sybase',
 358     env => [
 359       DBICTEST_MSSQL_DSN => 1,
 360       DBICTEST_MSSQL_USER => 0,
 361       DBICTEST_MSSQL_PASS => 0,
 362     ],
 363   },
 364
 365   test_rdbms_msaccess_odbc => {
 366     include => 'rdbms_msaccess_odbc',
 367     env => [
 368       DBICTEST_MSACCESS_ODBC_DSN => 1,
 369       DBICTEST_MSACCESS_ODBC_USER => 0,
 370       DBICTEST_MSACCESS_ODBC_PASS => 0,
 371     ],
 372     req => {
 373       'Data::GUID' => '0',
 374     },
 375   },
 376
 377   test_rdbms_msaccess_ado => {
 378     include => 'rdbms_msaccess_ado',
 379     env => [
 380       DBICTEST_MSACCESS_ADO_DSN => 1,
 381       DBICTEST_MSACCESS_ADO_USER => 0,
 382       DBICTEST_MSACCESS_ADO_PASS => 0,
 383     ],
 384     req => {
 385       'Data::GUID' => 0,
 386     },
 387   },
 388
 389   test_rdbms_mysql => {
 390     include => 'rdbms_mysql',
 391     env => [
 392       DBICTEST_MYSQL_DSN => 1,
 393       DBICTEST_MYSQL_USER => 0,
 394       DBICTEST_MYSQL_PASS => 0,
 395     ],
 396   },
 397
 398   test_rdbms_oracle => {
 399     include => 'rdbms_oracle',
 400     env => [
 401       DBICTEST_ORA_DSN => 1,
 402       DBICTEST_ORA_USER => 0,
 403       DBICTEST_ORA_PASS => 0,
 404     ],
 405     req => {
 406       'DBD::Oracle'              => '1.24',
 407     },
 408   },
 409
 410   test_rdbms_ase => {
 411     include => 'rdbms_ase',
 412     env => [
 413       DBICTEST_SYBASE_DSN => 1,
 414       DBICTEST_SYBASE_USER => 0,
 415       DBICTEST_SYBASE_PASS => 0,
 416     ],
 417   },
 418
 419   test_rdbms_db2 => {
 420     include => 'rdbms_db2',
 421     env => [
 422       DBICTEST_DB2_DSN => 1,
 423       DBICTEST_DB2_USER => 0,
 424       DBICTEST_DB2_PASS => 0,
 425     ],
 426   },
 427
 428   test_rdbms_informix => {
 429     include => 'rdbms_informix',
 430     env => [
 431       DBICTEST_INFORMIX_DSN => 1,
 432       DBICTEST_INFORMIX_USER => 0,
 433       DBICTEST_INFORMIX_PASS => 0,
 434     ],
 435   },
 436
 437   test_rdbms_sqlanywhere => {
 438     include => 'rdbms_sqlanywhere',
 439     env => [
 440       DBICTEST_SQLANYWHERE_DSN => 1,
 441       DBICTEST_SQLANYWHERE_USER => 0,
 442       DBICTEST_SQLANYWHERE_PASS => 0,
 443     ],
 444   },
 445
 446   test_rdbms_sqlanywhere_odbc => {
 447     include => 'rdbms_sqlanywhere_odbc',
 448     env => [
 449       DBICTEST_SQLANYWHERE_ODBC_DSN => 1,
 450       DBICTEST_SQLANYWHERE_ODBC_USER => 0,
 451       DBICTEST_SQLANYWHERE_ODBC_PASS => 0,
 452     ],
 453   },
 454
 455   test_rdbms_firebird => {
 456     include => 'rdbms_firebird',
 457     env => [
 458       DBICTEST_FIREBIRD_DSN => 1,
 459       DBICTEST_FIREBIRD_USER => 0,
 460       DBICTEST_FIREBIRD_PASS => 0,
 461     ],
 462   },
 463
 464   test_rdbms_firebird_interbase => {
 465     include => 'rdbms_firebird_interbase',
 466     env => [
 467       DBICTEST_FIREBIRD_INTERBASE_DSN => 1,
 468       DBICTEST_FIREBIRD_INTERBASE_USER => 0,
 469       DBICTEST_FIREBIRD_INTERBASE_PASS => 0,
 470     ],
 471   },
 472
 473   test_rdbms_firebird_odbc => {
 474     include => 'rdbms_firebird_odbc',
 475     env => [
 476       DBICTEST_FIREBIRD_ODBC_DSN => 1,
 477       DBICTEST_FIREBIRD_ODBC_USER => 0,
 478       DBICTEST_FIREBIRD_ODBC_PASS => 0,
 479     ],
 480   },
 481
 482 };
 483
 484
 485
 486 ### Public API
 487
 488 sub import {
 489   my $class = shift;
 490
 491   if (@_) {
 492
 493     my $action = shift;
 494
 495     if ($action eq '-die_without') {
 496       my $err;
 497       {
 498         local $@;
 499         eval { $class->die_unless_req_ok_for(\@_); 1 }
 500           or $err = $@;
 501       }
 502       die "\n$err\n" if $err;
 503     }
 504     elsif ($action eq '-list_missing') {
 505       print $class->modreq_missing_for(\@_);
 506       print "\n";
 507       exit 0;
 508     }
 509     elsif ($action eq '-skip_all_without') {
 510
 511       # sanity check - make sure ->current_test is 0 and no plan has been declared
 512       do {
 513         local $@;
 514         defined eval {
 515           Test::Builder->new->current_test
 516             or
 517           Test::Builder->new->has_plan
 518         };
 519       } and croak("Unable to invoke -skip_all_without after testing has started");
 520
 521       if ( my $missing = $class->req_missing_for(\@_) ) {
 522
 523         die ("\nMandatory requirements not satisfied during release-testing: $missing\n\n")
 524           if $ENV{RELEASE_TESTING} and $class->_groups_to_reqs(\@_)->{release_testing_mandatory};
 525
 526         print "1..0 # SKIP requirements not satisfied: $missing\n";
 527         exit 0;
 528       }
 529     }
 530     elsif ($action =~ /^-/) {
 531       croak "Unknown import-time action '$action'";
 532     }
 533     else {
 534       croak "$class is not an exporter, unable to import '$action'";
 535     }
 536   }
 537
 538   1;
 539 }
 540
 541 sub unimport {
 542   croak( __PACKAGE__ . " does not implement unimport" );
 543 }
 544
 545 # OO for (mistakenly considered) ease of extensibility, not due to any need to
 546 # carry state of any sort. This API is currently used outside, so leave as-is.
 547 # FIXME - make sure to not propagate this further if module is extracted as a
 548 # standalone library - keep the stupidity to a DBIC-secific shim!
 549 #
 550 sub req_list_for {
 551   shift->_groups_to_reqs(shift)->{effective_modreqs};
 552 }
 553
 554 sub modreq_list_for {
 555   shift->_groups_to_reqs(shift)->{modreqs};
 556 }
 557
 558 sub req_group_list {
 559   +{ map
 560     { $_ => $_[0]->_groups_to_reqs($_) }
 561     grep { $_ !~ /^_/ } keys %$dbic_reqs
 562   }
 563 }
 564
 565 sub req_errorlist_for { shift->modreq_errorlist_for(shift) }  # deprecated
 566 sub modreq_errorlist_for {
 567   my ($self, $groups) = @_;
 568   $self->_errorlist_for_modreqs( $self->_groups_to_reqs($groups)->{modreqs} );
 569 }
 570
 571 sub req_ok_for {
 572   shift->req_missing_for(shift) ? 0 : 1;
 573 }
 574
 575 sub req_missing_for {
 576   my ($self, $groups) = @_;
 577
 578   my $reqs = $self->_groups_to_reqs($groups);
 579
 580   my $mods_missing = $reqs->{missing_envvars}
 581     ? $self->_list_physically_missing_modules( $reqs->{modreqs} )
 582     : $self->modreq_missing_for($groups)
 583   ;
 584
 585   return '' if
 586     ! $mods_missing
 587       and
 588     ! $reqs->{missing_envvars}
 589   ;
 590
 591   my @res = $mods_missing || ();
 592
 593   push @res, 'the following group(s) of environment variables: ' . join ' and ', sort map
 594     { __envvar_group_desc($_) }
 595     @{$reqs->{missing_envvars}}
 596   if $reqs->{missing_envvars};
 597
 598   return (
 599     ( join ' as well as ', @res )
 600       .
 601     ( $reqs->{modreqs_fully_documented} ? " (see @{[ ref $self || $self ]} documentation for details)" : '' ),
 602   );
 603 }
 604
 605 sub modreq_missing_for {
 606   my ($self, $groups) = @_;
 607
 608   my $reqs = $self->_groups_to_reqs($groups);
 609   my $modreq_errors = $self->_errorlist_for_modreqs($reqs->{modreqs})
 610     or return '';
 611
 612   join ' ', map
 613     { $reqs->{modreqs}{$_} ? "$_~$reqs->{modreqs}{$_}" : $_ }
 614     sort { lc($a) cmp lc($b) } keys %$modreq_errors
 615   ;
 616 }
 617
 618 my $tb;
 619 sub skip_without {
 620   my ($self, $groups) = @_;
 621
 622   $tb ||= do { local $@; eval { Test::Builder->new } }
 623     or croak "Calling skip_without() before loading Test::Builder makes no sense";
 624
 625   if ( my $err = $self->req_missing_for($groups) ) {
 626     my ($fn, $ln) = (caller(0))[1,2];
 627     $tb->skip("block in $fn around line $ln requires $err");
 628     local $^W = 0;
 629     last SKIP;
 630   }
 631
 632   1;
 633 }
 634
 635 sub die_unless_req_ok_for {
 636   if (my $err = shift->req_missing_for(shift) ) {
 637     die "Unable to continue due to missing requirements: $err\n";
 638   }
 639 }
 640
 641
 642
 643 ### Private functions
 644
 645 # potentially shorten group desc
 646 sub __envvar_group_desc {
 647   my @envs = @{$_[0]};
 648
 649   my (@res, $last_prefix);
 650   while (my $ev = shift @envs) {
 651     my ($pref, $sep, $suff) = split / ([\_\-]) (?= [^\_\-]+ \z )/x, $ev;
 652
 653     if ( defined $sep and ($last_prefix||'') eq $pref ) {
 654         push @res, "...${sep}${suff}"
 655     }
 656     else {
 657       push @res, $ev;
 658     }
 659
 660     $last_prefix = $pref if $sep;
 661   }
 662
 663   join '/', @res;
 664 }
 665
 666 my $groupname_re = qr/ [a-z_] [0-9_a-z]* /x;
 667 my $modname_re = qr/ [A-Z_a-z] [0-9A-Z_a-z]* (?:::[0-9A-Z_a-z]+)* /x;
 668 my $modver_re = qr/ [0-9]+ (?: \. [0-9]+ )? /x;
 669
 670 # Expand includes from a random group in a specific order:
 671 # nonvariable groups first, then their includes, then the variable groups,
 672 # then their includes.
 673 # This allows reliably marking the rest of the mod reqs as variable (this is
 674 # also why variable includes are currently not allowed)
 675 sub __expand_includes {
 676   my ($groups, $seen) = @_;
 677
 678   # !! DIFFERENT !! behavior and return depending on invocation mode
 679   # (easier to recurse this way)
 680   my $is_toplevel = $seen
 681     ? 0
 682     : !! ($seen = {})
 683   ;
 684
 685   my ($res_per_type, $missing_envvars);
 686
 687   # breadth-first evaluation, with non-variable includes on top
 688   for my $g (@$groups) {
 689
 690     croak "Invalid requirement group name '$g': only ascii alphanumerics and _ are allowed"
 691       if $g !~ qr/ \A $groupname_re \z/x;
 692
 693     my $r = $dbic_reqs->{$g}
 694       or croak "Requirement group '$g' is not defined";
 695
 696     # always do this check *before* the $seen check
 697     croak "Group '$g' with variable effective_modreqs can not be specified as an 'include'"
 698       if ( $r->{env} and ! $is_toplevel );
 699
 700     next if $seen->{$g}++;
 701
 702     my $req_type = 'static';
 703
 704     if ( my @e = @{$r->{env}||[]} ) {
 705
 706       croak "Unexpected 'env' attribute under group '$g' (only allowed in test_* groups)"
 707         unless $g =~ /^test_/;
 708
 709       croak "Unexpected *odd* list in 'env' under group '$g'"
 710         if @e % 2;
 711
 712       # deconstruct the whole thing
 713       my (@group_envnames_list, $some_envs_required, $some_required_missing);
 714       while (@e) {
 715         push @group_envnames_list, my $envname = shift @e;
 716
 717         # env required or not
 718         next unless shift @e;
 719
 720         $some_envs_required ||= 1;
 721
 722         $some_required_missing ||= (
 723           ! defined $ENV{$envname}
 724             or
 725           ! length $ENV{$envname}
 726         );
 727       }
 728
 729       croak "None of the envvars in group '$g' declared as required, making the requirement moot"
 730         unless $some_envs_required;
 731
 732       if ($some_required_missing) {
 733         push @{$missing_envvars->{$g}}, \@group_envnames_list;
 734         $req_type = 'variable';
 735       }
 736     }
 737
 738     push @{$res_per_type->{"base_${req_type}"}}, $g;
 739
 740     if (my $i = $dbic_reqs->{$g}{include}) {
 741       $i = [ $i ] unless ref $i eq 'ARRAY';
 742
 743       croak "Malformed 'include' for group '$g': must be another existing group name or arrayref of existing group names"
 744         unless @$i;
 745
 746       push @{$res_per_type->{"incs_${req_type}"}}, @$i;
 747     }
 748   }
 749
 750   my @ret = map {
 751     @{ $res_per_type->{"base_${_}"} || [] },
 752     ( $res_per_type->{"incs_${_}"} ? __expand_includes( $res_per_type->{"incs_${_}"}, $seen ) : () ),
 753   } qw(static variable);
 754
 755   return ! $is_toplevel ? @ret : do {
 756     my $rv = {};
 757     $rv->{$_} = {
 758       idx => 1 + keys %$rv,
 759       missing_envvars => $missing_envvars->{$_},
 760     } for @ret;
 761     $rv->{$_}{user_requested} = 1 for @$groups;
 762     $rv;
 763   };
 764 }
 765
 766 ### Private OO API
 767 our %req_unavailability_cache;
 768
 769 # this method is just a lister and envvar/metadata checker - it does not try to load anything
 770 sub _groups_to_reqs {
 771   my ($self, $want) = @_;
 772
 773   $want = [ $want || () ]
 774     unless ref $want eq 'ARRAY';
 775
 776   croak "@{[ (caller(1))[3] ]}() expects a requirement group name or arrayref of group names"
 777     unless @$want;
 778
 779   my $ret = {
 780     modreqs => {},
 781     modreqs_fully_documented => 1,
 782   };
 783
 784   my $groups;
 785   for my $piece (@$want) {
 786     if ($piece =~ qr/ \A $groupname_re \z /x) {
 787       push @$groups, $piece;
 788     }
 789     elsif ( my ($mod, $ver) = $piece =~ qr/ \A ($modname_re) \>\= ($modver_re) \z /x ) {
 790       croak "Ad hoc module specification lists '$mod' twice"
 791         if exists $ret->{modreqs}{$mod};
 792
 793       croak "Ad hoc module specification '${mod} >= $ver' (or greater) not listed in the test_adhoc optdep group" if (
 794         ! defined $dbic_reqs->{test_adhoc}{req}{$mod}
 795           or
 796         $dbic_reqs->{test_adhoc}{req}{$mod} < $ver
 797       );
 798
 799       $ret->{modreqs}{$mod} = $ver;
 800       $ret->{modreqs_fully_documented} = 0;
 801     }
 802     else {
 803       croak "Unsupported argument '$piece' supplied to @{[ (caller(1))[3] ]}()"
 804     }
 805   }
 806
 807   my $all_groups = __expand_includes($groups);
 808
 809   # pre-assemble list of augmentations, perform basic sanity checks
 810   # Note that below we *DO NOT* respect the source/target reationship, but
 811   # instead always default to augment the "later" group
 812   # This is done so that the "stable/variable" boundary keeps working as
 813   # expected
 814   my $augmentations;
 815   for my $requesting_group (keys %$all_groups) {
 816     if (my $ag = $dbic_reqs->{$requesting_group}{augment}) {
 817       for my $target_group (keys %$ag) {
 818
 819         croak "Group '$requesting_group' claims to augment a non-existent group '$target_group'"
 820           unless $dbic_reqs->{$target_group};
 821
 822         croak "Augmentation combined with variable effective_modreqs currently unsupported for group '$requesting_group'"
 823           if $dbic_reqs->{$requesting_group}{env};
 824
 825         croak "Augmentation of group '$target_group' with variable effective_modreqs unsupported (requested by '$requesting_group')"
 826           if $dbic_reqs->{$target_group}{env};
 827
 828         if (my @foreign = grep { $_ ne 'req' } keys %{$ag->{$target_group}} ) {
 829           croak "Only 'req' augmentations are currently supported (group '$requesting_group' attempts to alter '$foreign[0]' of group '$target_group'";
 830         }
 831
 832         $ret->{augments}{$target_group} = 1;
 833
 834         # no augmentation for stuff that hasn't been selected
 835         if ( $all_groups->{$target_group} and my $ar = $ag->{$target_group}{req} ) {
 836           push @{$augmentations->{
 837             ( $all_groups->{$requesting_group}{idx} < $all_groups->{$target_group}{idx} )
 838               ? $target_group
 839               : $requesting_group
 840           }}, $ar;
 841         }
 842       }
 843     }
 844   }
 845
 846   for my $group (sort { $all_groups->{$a}{idx} <=> $all_groups->{$b}{idx} } keys %$all_groups ) {
 847
 848     my $group_reqs = $dbic_reqs->{$group}{req};
 849
 850     # sanity-check
 851     for my $req_bag ($group_reqs, @{ $augmentations->{$group} || [] } ) {
 852       for (keys %$req_bag) {
 853
 854         $_ =~ / \A $modname_re \z /x
 855           or croak "Requirement '$_' in group '$group' is not a valid module name";
 856
 857         # !!!DO NOT CHANGE!!!
 858         # remember - version.pm may not be available on the system
 859         croak "Requirement '$_' in group '$group' specifies an invalid version '$req_bag->{$_}' (only plain non-underscored floating point decimals are supported)"
 860           if ( ($req_bag->{$_}||0) !~ qr/ \A $modver_re \z /x );
 861       }
 862     }
 863
 864     if (my $e = $all_groups->{$group}{missing_envvars}) {
 865       push @{$ret->{missing_envvars}}, @$e;
 866     }
 867
 868     # assemble into the final ret
 869     for my $type (
 870       'modreqs',
 871       ( $ret->{missing_envvars} ? () : 'effective_modreqs' ),
 872     ) {
 873       for my $req_bag ($group_reqs, @{ $augmentations->{$group} || [] } ) {
 874         for my $mod (keys %$req_bag) {
 875
 876           $ret->{$type}{$mod} = $req_bag->{$mod}||0 if (
 877
 878             ! exists $ret->{$type}{$mod}
 879               or
 880             # we sanitized the version to be numeric above - we can just -gt it
 881             ($req_bag->{$mod}||0) > $ret->{$type}{$mod}
 882
 883           );
 884         }
 885       }
 886     }
 887
 888     $ret->{modreqs_fully_documented} &&= !!$dbic_reqs->{$group}{pod}
 889       if $all_groups->{$group}{user_requested};
 890
 891     $ret->{release_testing_mandatory} ||= !!$dbic_reqs->{$group}{release_testing_mandatory};
 892   }
 893
 894   return $ret;
 895 }
 896
 897
 898 # this method tries to find/load specified modreqs and returns a hashref of
 899 # module/loaderror pairs for anything that failed
 900 sub _errorlist_for_modreqs {
 901   # args supposedly already went through _groups_to_reqs and are therefore sanitized
 902   # safe to eval at will
 903   my ($self, $reqs) = @_;
 904
 905   my $ret;
 906
 907   for my $m ( keys %$reqs ) {
 908     my $v = $reqs->{$m};
 909
 910     if (! exists $req_unavailability_cache{$m}{$v} ) {
 911       local $@;
 912       eval( "require $m;" . ( $v ? "$m->VERSION(q($v))" : '' ) );
 913       $req_unavailability_cache{$m}{$v} = $@;
 914     }
 915
 916     $ret->{$m} = $req_unavailability_cache{$m}{$v}
 917       if $req_unavailability_cache{$m}{$v};
 918   }
 919
 920   $ret;
 921 }
 922
 923 # Unlike the above DO NOT try to load anything
 924 # This is executed when some needed envvars are not available
 925 # which in turn means a module load will never be reached anyway
 926 # This is important because some modules (especially DBDs) can be
 927 # *really* fickle when a require() is attempted, with pretty confusing
 928 # side-effects (especially on windows)
 929 sub _list_physically_missing_modules {
 930   my ($self, $modreqs) = @_;
 931
 932   # in case there is a coderef in @INC there is nothing we can definitively prove
 933   # so short circuit directly
 934   return '' if grep { length ref $_ } @INC;
 935
 936   my @definitely_missing;
 937   for my $mod (keys %$modreqs) {
 938     (my $fn = $mod . '.pm') =~ s|::|/|g;
 939
 940     push @definitely_missing, $mod unless grep
 941       # this should work on any combination of slashes
 942       { $_ and -d $_ and -f "$_/$fn" and -r "$_/$fn" }
 943       @INC
 944     ;
 945   }
 946
 947   join ' ', map
 948     { $modreqs->{$_} ? "$_~$modreqs->{$_}" : $_ }
 949     sort { lc($a) cmp lc($b) } @definitely_missing
 950   ;
 951 }
 952
 953
 954 # This is to be called by the author only (automatically in Makefile.PL)
 955 sub _gen_pod {
 956   my ($class, $distver, $pod_dir) = @_;
 957
 958   die "No POD root dir supplied" unless $pod_dir;
 959
 960   $distver ||=
 961     eval {
 962       require DBIx::Class::Schema::Loader;
 963       DBIx::Class::Schema::Loader->VERSION;
 964     } ||
 965     die
 966 "\n\n---------------------------------------------------------------------\n" .
 967 'Unable to load core DBIx::Class::Schema::Loader module to determine current version, '.
 968 'possibly due to missing dependencies. Author-mode autodocumentation ' .
 969 "halted\n\n" . $@ .
 970 "\n\n---------------------------------------------------------------------\n"
 971   ;
 972
 973   # do not ask for a recent version, use 1.x API calls
 974   # this *may* execute on a smoker with old perl or whatnot
 975   require File::Path;
 976
 977   (my $modfn = __PACKAGE__ . '.pm') =~ s|::|/|g;
 978
 979   (my $podfn = "$pod_dir/$modfn") =~ s/\.pm$/\.pod/;
 980   (my $dir = $podfn) =~ s|/[^/]+$||;
 981
 982   File::Path::mkpath([$dir]);
 983
 984   my $moosever = $class->req_list_for('use_moose')->{'Moose'}
 985     or die "Hrmm? No Moose dep?";
 986
 987
 988   my @chunks;
 989
 990 #@@
 991 #@@ HEADER
 992 #@@
 993   push @chunks, <<"EOC";
 994 #########################################################################
 995 #####################  A U T O G E N E R A T E D ########################
 996 #########################################################################
 997 #
 998 # The contents of this POD file are auto-generated.  Any changes you make
 999 # will be lost. If you need to change the generated text edit _gen_pod()
1000 # at the end of $modfn
1001 #
1002
1003 =head1 NAME
1004
1005 $class - Optional module dependency specifications (for module authors)
1006 EOC
1007
1008
1009 #@@
1010 #@@ SYNOPSIS HEADING
1011 #@@
1012   push @chunks, <<"EOC";
1013 =head1 SYNOPSIS
1014
1015 Somewhere in your build-file (e.g. L<ExtUtils::MakeMaker>'s F<Makefile.PL>):
1016
1017   ...
1018
1019   \$EUMM_ARGS{CONFIGURE_REQUIRES} = {
1020     \%{ \$EUMM_ARGS{CONFIGURE_REQUIRES} || {} },
1021     'DBIx::Class::Schema::Loader' => '$distver',
1022   };
1023
1024   ...
1025
1026   my %DBIC_CONFIG_AND_ORACLE_DEPS = %{ eval {
1027     require $class;
1028     $class->req_list_for([qw( dbicdump_config rdbms_oracle )]);
1029   } || {} };
1030
1031   \$EUMM_ARGS{PREREQ_PM} = {
1032     \%DBIC_CONFIG_AND_ORACLE_DEPS,
1033     \%{ \$EUMM_ARGS{PREREQ_PM} || {} },
1034   };
1035
1036   ...
1037
1038   ExtUtils::MakeMaker::WriteMakefile(\%EUMM_ARGS);
1039
1040 B<Note>: The C<eval> protection within the example is due to support for
1041 requirements during L<the C<configure> build phase|CPAN::Meta::Spec/Phases>
1042 not being available on a sufficient portion of production installations of
1043 Perl. Robust support for such dependency requirements is available in the
1044 L<CPAN> installer only since version C<1.94_56> first made available for
1045 production with perl version C<5.12>. It is the belief of the current
1046 maintainer that support for requirements during the C<configure> build phase
1047 will not be sufficiently ubiquitous until the B<year 2020> at the earliest,
1048 hence the extra care demonstrated above. It should also be noted that some
1049 3rd party installers (e.g. L<cpanminus|App::cpanminus>) do the right thing
1050 with configure requirements independent from the versions of perl and CPAN
1051 available.
1052 EOC
1053
1054
1055 #@@
1056 #@@ DESCRIPTION HEADING
1057 #@@
1058   push @chunks, <<'EOC';
1059 =head1 DESCRIPTION
1060
1061 Some of the less-frequently used features of L<DBIx::Class::Schema::Loader> have external
1062 module dependencies on their own. In order not to burden the average user
1063 with modules they will never use, these optional dependencies are not included
1064 in the base Makefile.PL. Instead an exception with a descriptive message is
1065 thrown when a specific feature can't find one or several modules required for
1066 its operation. This module is the central holding place for the current list
1067 of such dependencies, for DBIx::Class::Schema::Loader core authors, and DBIx::Class::Schema::Loader extension
1068 authors alike.
1069
1070 Dependencies are organized in L<groups|/CURRENT REQUIREMENT GROUPS> where each
1071 group can list one or more required modules, with an optional minimum version
1072 (or 0 for any version). In addition groups prefixed with C<test_> can specify
1073 a set of environment variables, some (or all) of which are marked as required
1074 for the group to be considered by L</req_list_for>
1075
1076 Each group name (or a combination thereof) can be used in the
1077 L<public methods|/METHODS> as described below.
1078 EOC
1079
1080
1081 #@@
1082 #@@ REQUIREMENT GROUPLIST HEADING
1083 #@@
1084   push @chunks, '=head1 CURRENT REQUIREMENT GROUPS';
1085
1086   my $standalone_info;
1087
1088   for my $group (sort keys %$dbic_reqs) {
1089
1090     my $info = $standalone_info->{$group} ||= $class->_groups_to_reqs($group);
1091
1092     next unless (
1093       $info->{modreqs_fully_documented}
1094         and
1095       ( $info->{augments} or $info->{modreqs} )
1096     );
1097
1098     my $p = $dbic_reqs->{$group}{pod};
1099
1100     push @chunks, (
1101       "=head2 $p->{title}",
1102       "=head3 $group",
1103       $p->{desc},
1104       '=over',
1105     );
1106
1107     if ( keys %{ $info->{modreqs}||{} } ) {
1108       push @chunks, map
1109         { "=item * $_" . ($info->{modreqs}{$_} ? " >= $info->{modreqs}{$_}" : '') }
1110         ( sort keys %{ $info->{modreqs} } )
1111       ;
1112     }
1113     else {
1114       push @chunks, '=item * No standalone requirements',
1115     }
1116
1117     push @chunks, '=back';
1118
1119     for my $ag ( sort keys %{ $info->{augments} || {} } ) {
1120       my $ag_info = $standalone_info->{$ag} ||= $class->_groups_to_reqs($ag);
1121
1122       my $newreqs = $class->modreq_list_for([ $group, $ag ]);
1123       for (keys %$newreqs) {
1124         delete $newreqs->{$_} if (
1125           ( defined $info->{modreqs}{$_}    and $info->{modreqs}{$_}    == $newreqs->{$_} )
1126             or
1127           ( defined $ag_info->{modreqs}{$_} and $ag_info->{modreqs}{$_} == $newreqs->{$_} )
1128         );
1129       }
1130
1131       if (keys %$newreqs) {
1132         push @chunks, (
1133           "Combined with L</$ag> additionally requires:",
1134           '=over',
1135           ( map
1136             { "=item * $_" . ($newreqs->{$_} ? " >= $newreqs->{$_}" : '') }
1137             ( sort keys %$newreqs )
1138           ),
1139           '=back',
1140         );
1141       }
1142     }
1143   }
1144
1145
1146 #@@
1147 #@@ API DOCUMENTATION HEADING
1148 #@@
1149   push @chunks, <<'EOC';
1150
1151 =head1 IMPORT-LIKE ACTIONS
1152
1153 Even though this module is not an L<Exporter>, it recognizes several C<actions>
1154 supplied to its C<import> method.
1155
1156 =head2 -skip_all_without
1157
1158 =over
1159
1160 =item Arguments: @group_names
1161
1162 =back
1163
1164 A convenience wrapper for use during testing:
1165 EOC
1166
1167   push @chunks, " use $class -skip_all_without => qw(admin test_rdbms_mysql);";
1168
1169   push @chunks, 'Roughly equivalent to the following code:';
1170
1171   push @chunks, sprintf <<'EOS', ($class) x 2;
1172
1173  BEGIN {
1174    require %s;
1175    if ( my $missing = %s->req_missing_for(\@group_names_) ) {
1176      print "1..0 # SKIP requirements not satisfied: $missing\n";
1177      exit 0;
1178    }
1179  }
1180 EOS
1181
1182   push @chunks, <<'EOC';
1183
1184 It also takes into account the C<RELEASE_TESTING> environment variable and
1185 behaves like L</-die_without> for any requirement groups marked as
1186 C<release_testing_mandatory>.
1187
1188 =head2 -die_without
1189
1190 =over
1191
1192 =item Arguments: @group_names
1193
1194 =back
1195
1196 A convenience wrapper around L</die_unless_req_ok_for>:
1197 EOC
1198
1199   push @chunks, " use $class -die_without => qw(deploy admin);";
1200
1201   push @chunks, <<'EOC';
1202
1203 =head2 -list_missing
1204
1205 =over
1206
1207 =item Arguments: @group_names
1208
1209 =back
1210
1211 A convenience wrapper around L</modreq_missing_for>:
1212
1213  perl -Ilib -MDBIx::Class::Schema::Loader::Optional::Dependencies=-list_missing,dbicdump_config,rdbms_oracle | cpanm
1214
1215 =head1 METHODS
1216
1217 =head2 req_group_list
1218
1219 =over
1220
1221 =item Arguments: none
1222
1223 =item Return Value: \%list_of_requirement_groups
1224
1225 =back
1226
1227 This method should be used by DBIx::Class::Schema::Loader packagers, to get a hashref of all
1228 dependencies B<keyed> by dependency group. Each key (group name), or a combination
1229 thereof (as an arrayref) can be supplied to the methods below.
1230 The B<values> of the returned hash are currently a set of options B<without a
1231 well defined structure>. If you have use for any of the contents - contact the
1232 maintainers, instead of treating this as public (left alone stable) API.
1233
1234 =head2 req_list_for
1235
1236 =over
1237
1238 =item Arguments: $group_name | \@group_names
1239
1240 =item Return Value: \%set_of_module_version_pairs
1241
1242 =back
1243
1244 This method should be used by DBIx::Class::Schema::Loader extension authors, to determine the
1245 version of modules a specific set of features requires for this version of
1246 DBIx::Class::Schema::Loader (regardless of their availability on the system).
1247 See the L</SYNOPSIS> for a real-world example.
1248
1249 When handling C<test_*> groups this method behaves B<differently> from
1250 L</modreq_list_for> below (and is the only such inconsistency among the
1251 C<req_*> methods). If a particular group declares as requirements some
1252 C<environment variables> and these requirements are not satisfied (the envvars
1253 are unset) - then the C<module requirements> of this group are not included in
1254 the returned list.
1255
1256 =head2 modreq_list_for
1257
1258 =over
1259
1260 =item Arguments: $group_name | \@group_names
1261
1262 =item Return Value: \%set_of_module_version_pairs
1263
1264 =back
1265
1266 Same as L</req_list_for> but does not take into consideration any
1267 C<environment variable requirements> - returns just the list of required
1268 modules.
1269
1270 =head2 req_ok_for
1271
1272 =over
1273
1274 =item Arguments: $group_name | \@group_names
1275
1276 =item Return Value: 1|0
1277
1278 =back
1279
1280 Returns true or false depending on whether all modules/envvars required by
1281 the group(s) are loadable/set on the system.
1282
1283 =head2 req_missing_for
1284
1285 =over
1286
1287 =item Arguments: $group_name | \@group_names
1288
1289 =item Return Value: $error_message_string
1290
1291 =back
1292
1293 Returns a single-line string suitable for inclusion in larger error messages.
1294 This method would normally be used by DBIx::Class::Schema::Loader core features, to indicate to
1295 the user that they need to install specific modules and/or set specific
1296 environment variables before being able to use a specific feature set.
1297
1298 For example if some of the requirements for C<deploy> are not available,
1299 the returned string could look like:
1300 EOC
1301
1302   push @chunks, qq{ "Moose~$moosever" (see $class documentation for details)};
1303
1304   push @chunks, <<'EOC';
1305 The author is expected to prepend the necessary text to this message before
1306 returning the actual error seen by the user. See also L</modreq_missing_for>
1307
1308 =head2 modreq_missing_for
1309
1310 =over
1311
1312 =item Arguments: $group_name | \@group_names
1313
1314 =item Return Value: $error_message_string
1315
1316 =back
1317
1318 Same as L</req_missing_for> except that the error string is guaranteed to be
1319 either empty, or contain a set of module requirement specifications suitable
1320 for piping to e.g. L<cpanminus|App::cpanminus>. The method explicitly does not
1321 attempt to validate the state of required environment variables (if any).
1322
1323 For instance if some of the requirements for C<deploy> are not available,
1324 the returned string could look like:
1325 EOC
1326
1327   push @chunks, qq{ "Moose~$moosever"};
1328
1329   push @chunks, <<'EOC';
1330
1331 See also L</-list_missing>.
1332
1333 =head2 skip_without
1334
1335 =over
1336
1337 =item Arguments: $group_name | \@group_names
1338
1339 =back
1340
1341 A convenience wrapper around L<skip|Test::More/SKIP>. It does not take neither
1342 a reason (it is generated by L</req_missing_for>) nor an amount of skipped tests
1343 (it is always C<1>, thus mandating unconditional use of
1344 L<done_testing|Test::More/done_testing>). Most useful in combination with ad hoc
1345 requirement specifications:
1346 EOC
1347
1348   push @chunks, <<EOC;
1349   SKIP: {
1350     $class->skip_without([ deploy YAML>=0.90 ]);
1351
1352     ...
1353   }
1354 EOC
1355
1356   push @chunks, <<'EOC';
1357
1358 =head2 die_unless_req_ok_for
1359
1360 =over
1361
1362 =item Arguments: $group_name | \@group_names
1363
1364 =back
1365
1366 Checks if L</req_ok_for> passes for the supplied group(s), and
1367 in case of failure throws an exception including the information
1368 from L</req_missing_for>. See also L</-die_without>.
1369
1370 =head2 modreq_errorlist_for
1371
1372 =over
1373
1374 =item Arguments: $group_name | \@group_names
1375
1376 =item Return Value: \%set_of_loaderrors_per_module
1377
1378 =back
1379
1380 Returns a hashref containing the actual errors that occurred while attempting
1381 to load each module in the requirement group(s).
1382
1383 =head2 req_errorlist_for
1384
1385 Deprecated method name, equivalent (via proxy) to L</modreq_errorlist_for>.
1386
1387 EOC
1388
1389 #@@
1390 #@@ FOOTER
1391 #@@
1392   push @chunks, <<'EOC';
1393 =head1 FURTHER QUESTIONS?
1394
1395 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
1396
1397 =head1 COPYRIGHT AND LICENSE
1398
1399 This module is free software L<copyright|DBIx::Class::Schema::Loader/COPYRIGHT AND LICENSE>
1400 by the L<DBIx::Class::Schema::Loader (DBICSL) authors|DBIx::Class::Schema::Loader/AUTHORS>.
1401 You can redistribute it and/or modify it under the same terms as the
1402 L<DBIx::Class::Schema::Loader library|DBIx::Class::Schema::Loader/COPYRIGHT AND LICENSE>.
1403 EOC
1404
1405   eval {
1406     open (my $fh, '>', $podfn) or die;
1407     print $fh join ("\n\n", @chunks) or die;
1408     print $fh "\n" or die;
1409     close ($fh) or die;
1410   } or croak( "Unable to write $podfn: " . ( $! || $@ || 'unknown error') );
1411 }
1412
1413 1;