Rewrite optdeps to accept a list of groups
Peter Rabbitson [Fri, 17 Oct 2014 09:27:27 +0000 (11:27 +0200)]
Requires a one-time break of req_group_list()
Also tighten up the optdep spec and handle conflicting versions saner

As a side effect fix 34d2deae to be truly copy-paste-able (no , separator)

Changes to ::Opt::Deps and xt/optional_deps.t best viewed under -w

Changes
lib/DBIx/Class/Optional/Dependencies.pm
maint/Makefile.PL.inc/12_authordeps.pl
xt/optional_deps.t

diff --git a/Changes b/Changes
index 0128cf2..c7300e5 100644 (file)
--- a/Changes
+++ b/Changes
@@ -10,6 +10,8 @@ Revision history for DBIx::Class
 
     * Misc
         - Make the Optional::Dependencies error messages cpanm-friendly
+        - Incompatibly change values (not keys) of the hash returned by
+          Optional::Dependencies::req_group_list (no known users in the wild)
         - Depend on newer SQL::Abstract (fixing overly-aggressive parenthesis
           opener: RT#99503)
         - Depend on newer Moo, fixing some interoperability issues:
index 94b61c4..d81f5b7 100644 (file)
@@ -111,7 +111,7 @@ my $rdbms_firebird_odbc = {
   'DBD::ODBC'                     => '0',
 };
 
-my $reqs = {
+my $dbic_reqs = {
   replicated => {
     req => $replicated,
     pod => {
@@ -445,12 +445,13 @@ my $reqs = {
     },
   },
 
-# the order does matter because the rdbms support group might require
-# a different version that the test group
   test_rdbms_pg => {
     req => {
       $ENV{DBICTEST_PG_DSN}
         ? (
+          # the order does matter because the rdbms support group might require
+          # a different version that the test group
+          #
           # when changing this list make sure to adjust xt/optional_deps.t
           %$rdbms_pg,
           'DBD::Pg'               => '2.009002',
@@ -643,105 +644,134 @@ my $reqs = {
 # standalone library - keep the stupidity to a DBIC-secific shim!
 #
 sub req_list_for {
-  my ($class, $group) = @_;
-
-  croak "req_list_for() expects a requirement group name"
-    unless $group;
-
-  my $deps = $reqs->{$group}{req}
-    or croak "Requirement group '$group' does not exist";
-
-  return { %$deps };
+  shift->_groups_to_reqs(@_)->{modreqs};
 }
 
 sub req_group_list {
-  return { map { $_ => { %{ $reqs->{$_}{req} || {} } } } (keys %$reqs) };
+  +{ map
+    { $_ => $_[0]->_groups_to_reqs($_) }
+    keys %$dbic_reqs
+  }
 }
 
 sub req_errorlist_for {
-  my ($class, $group) = @_;
-
-  croak "req_errorlist_for() expects a requirement group name"
-    unless $group;
-
-  return $class->_check_deps($group)->{errorlist};
+  my $self = shift;
+  $self->_errorlist_for_modreqs( $self->_groups_to_reqs(@_)->{modreqs} );
 }
 
 sub req_ok_for {
-  my ($class, $group) = @_;
-
-  croak "req_ok_for() expects a requirement group name"
-    unless $group;
-
-  return $class->_check_deps($group)->{status};
+  my $self = shift;
+  $self->_errorlist_for_modreqs( $self->_groups_to_reqs(@_)->{modreqs} )
+    ? 0
+    : 1
+  ;
 }
 
 sub req_missing_for {
-  my ($class, $group) = @_;
+  my $self = shift;
 
-  croak "req_missing_for() expects a requirement group name"
-    unless $group;
+  my $reqs = $self->_groups_to_reqs(@_);
+  my $modreq_errors = $self->_errorlist_for_modreqs($reqs->{modreqs}) or return '';
 
-  return $class->_check_deps($group)->{missing};
+  join ' ',
+    (map { $reqs->{modreqs}{$_} ? qq("$_~>=$reqs->{modreqs}{$_}") : $_ } sort keys %$modreq_errors),
+    ( $reqs->{modreqs_fully_documented} ? "(see @{[ ref $self || $self ]} documentation for details)" : () ),
+  ;
 }
 
 sub die_unless_req_ok_for {
-  my ($class, $group) = @_;
-
-  croak "die_unless_req_ok_for() expects a requirement group name"
-    unless $group;
-
-  $class->_check_deps($group)->{status}
-    or die sprintf( "Required modules missing, unable to continue: %s\n", $class->_check_deps($group)->{missing} );
+  if (my $err = shift->req_missing_for(@_) ) {
+    die "Required modules missing, unable to continue: $err\n";
+  }
 }
 
 
 
 ### Private OO API
+our %req_unavailability_cache;
+
+# this method is just a lister/metadata checker - it does not try to load anything
+sub _groups_to_reqs {
+  my ($self, $groups) = @_;
+
+  $groups = [ $groups || () ]
+    unless ref $groups eq 'ARRAY';
+
+  croak "@{[ (caller(1))[3] ]}() expects a requirement group name or arrayref of group names"
+    unless @$groups;
+
+  my $ret = {
+    modreqs => {},
+    modreqs_fully_documented => 1,
+  };
 
-our %req_availability_cache;
-sub _check_deps {
-  my ($class, $group) = @_;
 
-  return $req_availability_cache{$group} ||= do {
+  for my $group ( @$groups ) {
 
-    my $deps = $class->req_list_for ($group);
+    $group =~ /\A [A-Za-z][0-9A-Z_a-z]* \z/x
+      or croak "Invalid requirement group name '$group': only ascii alphanumerics and _ are allowed";
 
-    my %errors;
-    for my $mod (keys %$deps) {
-      my $req_line = "require $mod;";
-      if (my $ver = $deps->{$mod}) {
-        $req_line .= "$mod->VERSION($ver);";
-      }
+    my $group_reqs = ($dbic_reqs->{$group}||{})->{req}
+      or croak "Requirement group '$group' is not defined";
 
-      eval $req_line;
+    # sanity-check
+    for (keys %$group_reqs) {
 
-      $errors{$mod} = $@ if $@;
+      $_ =~ /\A [A-Z_a-z][0-9A-Z_a-z]* (?:::[0-9A-Z_a-z]+)* \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 '$group_reqs->{$_}' (only plain non-underscored floating point decimals are supported)"
+        if ( ($group_reqs->{$_}||0) !~ / \A [0-9]+ (?: \. [0-9]+ )? \z /x );
     }
 
-    my $res;
+    # assemble into the final ret
+    for (keys %$group_reqs) {
+
+      $ret->{modreqs}{$_} = $group_reqs->{$_}||0 if (
+
+        ! exists $ret->{modreqs}{$_}
+          or
+        # we sanitized the version to be numeric above - we can just -gt it
+        ($group_reqs->{$_}||0) > $ret->{modreqs}{$_}
 
-    if (keys %errors) {
-      my $missing = join (', ', map { $deps->{$_} ? qq("${_}~>=$deps->{$_}") : $_ } (sort keys %errors) );
-      $missing .= " (see $class documentation for details)" if $reqs->{$group}{pod};
-      $res = {
-        status => 0,
-        errorlist => \%errors,
-        missing => $missing,
-      };
+      );
     }
-    else {
-      $res = {
-        status => 1,
-        errorlist => {},
-        missing => '',
-      };
+
+    $ret->{modreqs_fully_documented} &&= !!$dbic_reqs->{$group}{pod};
+  }
+
+  return $ret;
+}
+
+
+# this method tries to 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
+  # safe to eval at will
+  my ($self, $reqs) = @_;
+
+  my $ret;
+
+  for my $m ( keys %$reqs ) {
+    my $v = $reqs->{$m};
+
+    if (! exists $req_unavailability_cache{$m}{$v} ) {
+      local $@;
+      eval( "require $m;" . ( $v ? "$m->VERSION(q($v))" : '' ) );
+      $req_unavailability_cache{$m}{$v} = $@;
     }
 
-    $res;
-  };
+    $ret->{$m} = $req_unavailability_cache{$m}{$v}
+      if $req_unavailability_cache{$m}{$v};
+  }
+
+  $ret;
 }
 
+
 # This is to be called by the author only (automatically in Makefile.PL)
 sub _gen_pod {
   my ($class, $distver, $pod_dir) = @_;
@@ -770,7 +800,7 @@ sub _gen_pod {
 
   File::Path::mkpath([$dir]);
 
-  my $sqltver = $class->req_list_for ('deploy')->{'SQL::Translator'}
+  my $sqltver = $class->req_list_for('deploy')->{'SQL::Translator'}
     or die "Hrmm? No sqlt dep?";
 
 
@@ -858,8 +888,8 @@ authors alike.
 
 Dependencies are organized in L<groups|/CURRENT REQUIREMENT GROUPS> where each
 group can list one or more required modules, with an optional minimum version
-(or 0 for any version). The group name can be used in the
-L<public methods|/METHODS> as described below.
+(or 0 for any version). Each group name (or a combination thereof) can be used
+in the L<public methods|/METHODS> as described below.
 EOC
 
 
@@ -868,11 +898,11 @@ EOC
 #@@
   push @chunks, '=head1 CURRENT REQUIREMENT GROUPS';
 
-  for my $group (sort keys %$reqs) {
-    my $p = $reqs->{$group}{pod}
+  for my $group (sort keys %$dbic_reqs) {
+    my $p = $dbic_reqs->{$group}{pod}
       or next;
 
-    my $modlist = $reqs->{$group}{req}
+    my $modlist = $dbic_reqs->{$group}{req}
       or next;
 
     next unless keys %$modlist;
@@ -906,8 +936,8 @@ EOC
 =back
 
 This method should be used by DBIx::Class packagers, to get a hashref of all
-dependencies keyed by dependency group. Each key (group name) can be supplied
-to one of the group-specific methods below.
+dependencies B<keyed> by dependency group. Each key (group name), or a combination
+thereof (as an arrayref) can be supplied to the methods below.
 The B<values> of the returned hash are currently a set of options B<without a
 well defined structure>. If you have use for any of the contents - contact the
 maintainers, instead of treating this as public (left alone stable) API.
@@ -916,39 +946,40 @@ maintainers, instead of treating this as public (left alone stable) API.
 
 =over
 
-=item Arguments: $group_name
+=item Arguments: $group_name | \@group_names
 
-=item Return Value: \%list_of_module_version_pairs
+=item Return Value: \%set_of_module_version_pairs
 
 =back
 
 This method should be used by DBIx::Class extension authors, to determine the
-version of modules a specific feature requires in the B<current> version of
+version of modules a specific set of features requires for this version of
 DBIx::Class. See the L</SYNOPSIS> for a real-world example.
 
 =head2 req_ok_for
 
 =over
 
-=item Arguments: $group_name
+=item Arguments: $group_name | \@group_names
 
 =item Return Value: 1|0
 
 =back
 
 Returns true or false depending on whether all modules required by
-C<$group_name> are present on the system and loadable.
+the group(s) are present on the system and loadable.
 
 =head2 req_missing_for
 
 =over
 
-=item Arguments: $group_name
+=item Arguments: $group_name | \@group_names
 
 =item Return Value: $error_message_string
 
 =back
 
+Returns a single-line string suitable for inclusion in larger error messages.
 This method would normally be used by DBIx::Class core-modules, to indicate to
 the user that they need to install specific modules before being able to use a
 specific feature set.
@@ -967,11 +998,11 @@ returning the actual error seen by the user.
 
 =over
 
-=item Arguments: $group_name
+=item Arguments: $group_name | \@group_names
 
 =back
 
-Checks if L</req_ok_for> passes for the supplied C<$group_name>, and
+Checks if L</req_ok_for> passes for the supplied group(s), and
 in case of failure throws an exception including the information
 from L</req_missing_for>.
 
@@ -979,16 +1010,17 @@ from L</req_missing_for>.
 
 =over
 
-=item Arguments: $group_name
+=item Arguments: $group_name | \@group_names
 
-=item Return Value: \%list_of_loaderrors_per_module
+=item Return Value: \%set_of_loaderrors_per_module
 
 =back
 
 Returns a hashref containing the actual errors that occurred while attempting
-to load each module in the requirement group.
+to load each module in the requirement group(s).
 EOC
 
+
 #@@
 #@@ FOOTER
 #@@
index 334f186..b91d1de 100644 (file)
@@ -32,17 +32,16 @@ else {
 EOW
 
   require DBIx::Class::Optional::Dependencies;
-  my %reqs_for_group = %{DBIx::Class::Optional::Dependencies->req_group_list};
 
   # exclude the rdbms_* groups which are for DBIC users
   # and the moose-related stuff iff we are under 5.8.3
-  $opt_testdeps = {
-    map { %{$reqs_for_group{$_}} } grep {
+  $opt_testdeps = DBIx::Class::Optional::Dependencies->req_list_for([
+    grep {
       !/^rdbms_|^dist_/
         and
       ($] > 5.008002 or !/^ (?: test_ )? (?: admin | admin_script | replicated ) $/x )
-    } keys %reqs_for_group
-  };
+    } keys %{DBIx::Class::Optional::Dependencies->req_group_list}
+  ]);
 
   print "Including all optional deps\n";
   $reqs->{test_requires} = {
index d73aab3..57b333d 100644 (file)
@@ -29,71 +29,111 @@ is_deeply (
   'Nothing loaded other than DBIx::Class::OptDeps',
 );
 
-my $sqlt_dep = DBIx::Class::Optional::Dependencies->req_list_for ('deploy');
+
+# check the project-local groups for sanity
+lives_ok {
+  DBIx::Class::Optional::Dependencies->req_group_list
+} "The entire optdep list is well formed";
+
 is_deeply (
-  [ keys %$sqlt_dep ],
+  [ keys %{ DBIx::Class::Optional::Dependencies->req_list_for ('deploy') } ],
   [ 'SQL::Translator' ],
   'Correct deploy() dependency list',
 );
 
-# make module loading impossible, regardless of actual libpath contents
+# scope to break require()
 {
+
+# make module loading impossible, regardless of actual libpath contents
   local @INC = (sub { die('Optional Dep Test') } );
 
-  ok (
-    ! DBIx::Class::Optional::Dependencies->req_ok_for ('deploy'),
-    'deploy() deps missing',
+# basic test using the deploy target
+  for ('deploy', ['deploy']) {
+
+    # explicitly blow up cache
+    %DBIx::Class::Optional::Dependencies::req_unavailability_cache = ();
+
+    ok (
+      ! DBIx::Class::Optional::Dependencies->req_ok_for ($_),
+      'deploy() deps missing',
+    );
+
+    like (
+      DBIx::Class::Optional::Dependencies->req_missing_for ($_),
+      qr/
+        (?: \A|\s )
+        " SQL::Translator \~ \>\= [\d\.]+ "
+        \s
+        .*?
+        \Q(see DBIx::Class::Optional::Dependencies documentation for details)\E
+        \z
+      /x,
+      'expected missing string contents',
+    );
+
+    like (
+      DBIx::Class::Optional::Dependencies->req_errorlist_for ($_)->{'SQL::Translator'},
+      qr/Optional Dep Test/,
+      'custom exception found in errorlist',
+    );
+
+    #make it so module appears loaded
+    local $INC{'SQL/Translator.pm'} = 1;
+    local $SQL::Translator::VERSION = 999;
+
+    ok (
+      ! DBIx::Class::Optional::Dependencies->req_ok_for ($_),
+      'deploy() deps missing cached properly from previous run',
+    );
+
+    # blow cache again
+    %DBIx::Class::Optional::Dependencies::req_unavailability_cache = ();
+
+    ok (
+      DBIx::Class::Optional::Dependencies->req_ok_for ($_),
+      'deploy() deps present',
+    );
+
+    is (
+      DBIx::Class::Optional::Dependencies->req_missing_for ($_),
+      '',
+      'expected null missing string',
+    );
+
+    is_deeply (
+      DBIx::Class::Optional::Dependencies->req_errorlist_for ($_),
+      undef,
+      'expected empty errorlist',
+    );
+  }
+
+# test lack of deps for oracle test (envvar deleted higher up)
+  is_deeply(
+    DBIx::Class::Optional::Dependencies->req_list_for('test_rdbms_oracle'),
+    {},
+    'empty optional dependencies list for testing Oracle without ENV var',
   );
 
-  like (
-    DBIx::Class::Optional::Dependencies->req_missing_for ('deploy'),
-    qr/
-      (?: \A|\s )
-      " SQL::Translator \~ \>\= [\d\.]+ "
-      \s
-      .*?
-      \Q(see DBIx::Class::Optional::Dependencies documentation for details)\E
-      \z
-    /x,
-    'expected missing string contents',
+# test combination of different requirements on same module (pg's are relatively stable)
+  is_deeply(
+    DBIx::Class::Optional::Dependencies->req_list_for('rdbms_pg'),
+    { 'DBD::Pg' => '0', },
+    'optional dependencies list for using Postgres matches',
   );
 
-  like (
-    DBIx::Class::Optional::Dependencies->req_errorlist_for ('deploy')->{'SQL::Translator'},
-    qr/Optional Dep Test/,
-    'custom exception found in errorlist',
+  is_deeply (
+    DBIx::Class::Optional::Dependencies->req_list_for([qw( rdbms_pg test_rdbms_pg )]),
+    { 'DBD::Pg' => '2.009002' },
+    'optional dependencies list for testing Postgres matches',
   );
-}
-
-#make it so module appears loaded
-$INC{'SQL/Translator.pm'} = 1;
-$SQL::Translator::VERSION = 999;
-
-ok (
-  ! DBIx::Class::Optional::Dependencies->req_ok_for ('deploy'),
-  'deploy() deps missing cached properly',
-);
-
-#reset cache
-%DBIx::Class::Optional::Dependencies::req_availability_cache = ();
 
+  is(
+    DBIx::Class::Optional::Dependencies->req_missing_for([qw( rdbms_pg test_rdbms_pg )]),
+    '"DBD::Pg~>=2.009002"',
+    'optional dependencies error text for testing Postgres matches',
+  );
 
-ok (
-  DBIx::Class::Optional::Dependencies->req_ok_for ('deploy'),
-  'deploy() deps present',
-);
-
-is (
-  DBIx::Class::Optional::Dependencies->req_missing_for ('deploy'),
-  '',
-  'expected null missing string',
-);
-
-is_deeply (
-  DBIx::Class::Optional::Dependencies->req_errorlist_for ('deploy'),
-  {},
-  'expected empty errorlist',
-);
+}
 
 # test multiple times to find autovivification bugs
 for (1..2) {
@@ -109,24 +149,8 @@ for (1..2) {
 
   throws_ok {
     DBIx::Class::Optional::Dependencies->req_list_for('invalid_groupname');
-  } qr/Requirement group 'invalid_groupname' does not exist/,
+  } qr/Requirement group 'invalid_groupname' is not defined/,
   "req_list_for with invalid groupname throws exception on run $_";
 }
 
-is_deeply(
-  DBIx::Class::Optional::Dependencies->req_list_for('rdbms_pg'),
-  {
-    'DBD::Pg' => '0',
-  }, 'optional dependencies for deploying to Postgres ok');
-
-is_deeply(
-  DBIx::Class::Optional::Dependencies->req_list_for('test_rdbms_pg'),
-  {
-    'DBD::Pg'        => '2.009002',
-  }, 'optional dependencies for testing Postgres with ENV var ok');
-
-is_deeply(
-  DBIx::Class::Optional::Dependencies->req_list_for('test_rdbms_oracle'),
-  {}, 'optional dependencies for testing Oracle without ENV var ok');
-
 done_testing;