Port ::Admin from Moose to Moo+Type::Tiny
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Optional / Dependencies.pm
index e07c732..d673380 100644 (file)
@@ -2,8 +2,12 @@ package DBIx::Class::Optional::Dependencies;
 
 ### This may look crazy, but it in fact tangibly ( by 50(!)% ) shortens
 #   the skip-test time when everything requested is unavailable
-use if $ENV{RELEASE_TESTING} => 'warnings';
-use if $ENV{RELEASE_TESTING} => 'strict';
+BEGIN {
+  if ( $ENV{RELEASE_TESTING} ) {
+    require warnings and warnings->import;
+    require strict and strict->import;
+  }
+}
 
 sub croak {
   require Carp;
@@ -17,14 +21,6 @@ sub croak {
 # POD is generated automatically by calling _gen_pod from the
 # Makefile.PL in $AUTHOR mode
 
-# *DELIBERATELY* not making a group for these - they must disappear
-# forever as optdeps in the first place
-my $moose_basic = {
-  'Moose'                         => '0.98',
-  'MooseX::Types'                 => '0.21',
-  'MooseX::Types::LoadableClass'  => '0.011',
-};
-
 my $dbic_reqs = {
 
   # NOTE: the rationale for 2 JSON::Any versions is that
@@ -42,6 +38,15 @@ my $dbic_reqs = {
     },
   },
 
+  _types_common => {
+    req => {
+      'Type::Utils' => '0',
+      'Type::Library' => '0',
+      'Types::Standard' => '0',
+      'Types::LoadableClass' => '0',
+    },
+  },
+
   # a common placeholder for engines with IC::DT support based off DT::F::S
   _icdt_strptime_based => {
     augment => {
@@ -65,8 +70,22 @@ my $dbic_reqs = {
     }
   },
 
+  # must list any dep used by adhoc testing
+  # this prevents the "skips due to forgotten deps" issue
+  test_adhoc => {
+    req => {
+      'Class::DBI::Plugin::DeepAbstractSearch' => '0',
+      'Class::DBI' => '3.000005',
+      'Date::Simple' => '3.03',
+      'YAML' => '0',
+      'Class::Unload' => '0.07',
+      'Time::Piece' => '0',
+      'Time::Piece::MySQL' => '0',
+    },
+  },
+
   replicated => {
-    req => $moose_basic,
+    include => '_types_common',
     pod => {
       title => 'Storage::Replicated',
       desc => 'Modules required for L<DBIx::Class::Storage::DBI::Replicated>',
@@ -75,18 +94,10 @@ my $dbic_reqs = {
 
   test_replicated => {
     include => 'replicated',
-    req => {
-      'Test::Moose' => '0',
-    },
   },
 
   admin => {
-    include => '_json_any',
-    req => {
-      %$moose_basic,
-      'MooseX::Types::Path::Class' => '0.05',
-      'MooseX::Types::JSON' => '0.02',
-    },
+    include => [qw(_json_any _types_common)],
     pod => {
       title => 'DBIx::Class::Admin',
       desc => 'Modules required for the DBIx::Class administrative library',
@@ -136,9 +147,16 @@ my $dbic_reqs = {
     },
   },
 
-  test_component_accessor => {
+  cdbicompat => {
     req => {
-      'Class::Unload'             => '0.07',
+      'Class::Data::Inheritable' => '0',
+      'Class::Trigger' => '0',
+      'DBIx::ContextualFetch' => '0',
+      'Clone' => '0.32',
+    },
+    pod => {
+      title => 'DBIx::Class::CDBICompat support',
+      desc => 'Modules required for L<DBIx::Class::CDBICompat>'
     },
   },
 
@@ -167,7 +185,7 @@ my $dbic_reqs = {
 
   test_strictures => {
     req => {
-      'Test::Strict'              => '0.20',
+      'Test::Strict'              => '0.24',
     },
     release_testing_mandatory => 1,
   },
@@ -199,14 +217,6 @@ my $dbic_reqs = {
     },
   },
 
-  test_cdbicompat => {
-    include => 'icdt',
-    req => {
-      'Class::DBI::Plugin::DeepAbstractSearch' => '0',
-      'Time::Piece::MySQL'        => '0',
-      'Date::Simple'              => '3.03',
-    },
-  },
 
   # this is just for completeness as SQLite
   # is a core dep of DBIC for testing
@@ -757,7 +767,11 @@ sub req_missing_for {
   my ($self, $groups) = @_;
 
   my $reqs = $self->_groups_to_reqs($groups);
-  my $mods_missing = $self->modreq_missing_for($groups);
+
+  my $mods_missing = $reqs->{missing_envvars}
+    ? $self->_list_physically_missing_modules( $reqs->{modreqs} )
+    : $self->modreq_missing_for($groups)
+  ;
 
   return '' if
     ! $mods_missing
@@ -792,6 +806,23 @@ sub modreq_missing_for {
   ;
 }
 
+my $tb;
+sub skip_without {
+  my ($self, $groups) = @_;
+
+  $tb ||= do { local $@; eval { Test::Builder->new } }
+    or croak "Calling skip_without() before loading Test::Builder makes no sense";
+
+  if ( my $err = $self->req_missing_for($groups) ) {
+    my ($fn, $ln) = (caller(0))[1,2];
+    $tb->skip("block in $fn around line $ln requires $err");
+    local $^W = 0;
+    last SKIP;
+  }
+
+  1;
+}
+
 sub die_unless_req_ok_for {
   if (my $err = shift->req_missing_for(shift) ) {
     die "Unable to continue due to missing requirements: $err\n";
@@ -823,6 +854,10 @@ sub __envvar_group_desc {
   join '/', @res;
 }
 
+my $groupname_re = qr/ [A-Z_a-z][0-9A-Z_a-z]* /x;
+my $modname_re = qr/ [A-Z_a-z] [0-9A-Z_a-z]* (?:::[0-9A-Z_a-z]+)* /x;
+my $modver_re = qr/ [0-9]+ (?: \. [0-9]+ )? /x;
+
 # Expand includes from a random group in a specific order:
 # nonvariable groups first, then their includes, then the variable groups,
 # then their includes.
@@ -844,7 +879,7 @@ sub __expand_includes {
   for my $g (@$groups) {
 
     croak "Invalid requirement group name '$g': only ascii alphanumerics and _ are allowed"
-      if $g !~ /\A [A-Z_a-z][0-9A-Z_a-z]* \z/x;
+      if $g !~ qr/ \A $groupname_re \z/x;
 
     my $r = $dbic_reqs->{$g}
       or croak "Requirement group '$g' is not defined";
@@ -924,19 +959,42 @@ our %req_unavailability_cache;
 
 # this method is just a lister and envvar/metadata checker - it does not try to load anything
 sub _groups_to_reqs {
-  my ($self, $groups) = @_;
+  my ($self, $want) = @_;
 
-  $groups = [ $groups || () ]
-    unless ref $groups eq 'ARRAY';
+  $want = [ $want || () ]
+    unless ref $want eq 'ARRAY';
 
   croak "@{[ (caller(1))[3] ]}() expects a requirement group name or arrayref of group names"
-    unless @$groups;
+    unless @$want;
 
   my $ret = {
     modreqs => {},
     modreqs_fully_documented => 1,
   };
 
+  my $groups;
+  for my $piece (@$want) {
+    if ($piece =~ qr/ \A $groupname_re \z /x) {
+      push @$groups, $piece;
+    }
+    elsif ( my ($mod, $ver) = $piece =~ qr/ \A ($modname_re) \>\= ($modver_re) \z /x ) {
+      croak "Ad hoc module specification lists '$mod' twice"
+        if exists $ret->{modreqs}{$mod};
+
+      croak "Ad hoc module specification '${mod} >= $ver' (or greater) not listed in the test_adhoc optdep group" if (
+        ! defined $dbic_reqs->{test_adhoc}{req}{$mod}
+          or
+        $dbic_reqs->{test_adhoc}{req}{$mod} < $ver
+      );
+
+      $ret->{modreqs}{$mod} = $ver;
+      $ret->{modreqs_fully_documented} = 0;
+    }
+    else {
+      croak "Unsupported argument '$piece' supplied to @{[ (caller(1))[3] ]}()"
+    }
+  }
+
   my $all_groups = __expand_includes($groups);
 
   # pre-assemble list of augmentations, perform basic sanity checks
@@ -984,13 +1042,13 @@ sub _groups_to_reqs {
     for my $req_bag ($group_reqs, @{ $augmentations->{$group} || [] } ) {
       for (keys %$req_bag) {
 
-        $_ =~ /\A [A-Z_a-z][0-9A-Z_a-z]* (?:::[0-9A-Z_a-z]+)* \z /x
+        $_ =~ / \A $modname_re \z /x
           or croak "Requirement '$_' in group '$group' is not a valid module name";
 
         # !!!DO NOT CHANGE!!!
         # remember - version.pm may not be available on the system
         croak "Requirement '$_' in group '$group' specifies an invalid version '$req_bag->{$_}' (only plain non-underscored floating point decimals are supported)"
-          if ( ($req_bag->{$_}||0) !~ / \A [0-9]+ (?: \. [0-9]+ )? \z /x );
+          if ( ($req_bag->{$_}||0) !~ qr/ \A $modver_re \z /x );
       }
     }
 
@@ -1028,7 +1086,7 @@ sub _groups_to_reqs {
 }
 
 
-# this method tries to load specified modreqs and returns a hashref of
+# this method tries to find/load specified modreqs and returns a hashref of
 # module/loaderror pairs for anything that failed
 sub _errorlist_for_modreqs {
   # args supposedly already went through _groups_to_reqs and are therefore sanitized
@@ -1053,6 +1111,36 @@ sub _errorlist_for_modreqs {
   $ret;
 }
 
+# Unlike the above DO NOT try to load anything
+# This is executed when some needed envvars are not available
+# which in turn means a module load will never be reached anyway
+# This is important because some modules (especially DBDs) can be
+# *really* fickle when a require() is attempted, with pretty confusing
+# side-effects (especially on windows)
+sub _list_physically_missing_modules {
+  my ($self, $modreqs) = @_;
+
+  # in case there is a coderef in @INC there is nothing we can definitively prove
+  # so short circuit directly
+  return '' if grep { length ref $_ } @INC;
+
+  my @definitely_missing;
+  for my $mod (keys %$modreqs) {
+    (my $fn = $mod . '.pm') =~ s|::|/|g;
+
+    push @definitely_missing, $mod unless grep
+      # this should work on any combination of slashes
+      { $_ and -d $_ and -f "$_/$fn" and -r "$_/$fn" }
+      @INC
+    ;
+  }
+
+  join ' ', map
+    { $modreqs->{$_} ? qq("$_~>=$modreqs->{$_}") : $_ }
+    sort { lc($a) cmp lc($b) } @definitely_missing
+  ;
+}
+
 
 # This is to be called by the author only (automatically in Makefile.PL)
 sub _gen_pod {
@@ -1431,6 +1519,31 @@ EOC
 
 See also L</-list_missing>.
 
+=head2 skip_without
+
+=over
+
+=item Arguments: $group_name | \@group_names
+
+=back
+
+A convenience wrapper around L<skip|Test::More/SKIP>. It does not take neither
+a reason (it is generated by L</req_missing_for>) nor an amount of skipped tests
+(it is always C<1>, thus mandating unconditional use of
+L<done_testing|Test::More/done_testing>). Most useful in combination with ad hoc
+requirement specifications:
+EOC
+
+  push @chunks, <<EOC;
+  SKIP: {
+    $class->skip_without([ deploy YAML>=0.90 ]);
+
+    ...
+  }
+EOC
+
+  push @chunks, <<'EOC';
+
 =head2 die_unless_req_ok_for
 
 =over