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