From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 6 Feb 2015 11:37:29 +0000 (+0100)
Subject: Rewrite internals of the optdep include mechanism (introduced in e163f484b)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a3f8bd014894e2b48c0a8bb12d07e0524c6b9a35;p=dbsrgits%2FDBIx-Class-Historic.git

Rewrite internals of the optdep include mechanism (introduced in e163f484b)

No functional changes, "simply" moves the include-parsing logic and the env
checks to an earlier point, in order to get a complete list of all groups
mentioned (facilitating the augment functionality in the next commit)
---

diff --git a/lib/DBIx/Class/Optional/Dependencies.pm b/lib/DBIx/Class/Optional/Dependencies.pm
index ff28cad..2a8b177 100644
--- a/lib/DBIx/Class/Optional/Dependencies.pm
+++ b/lib/DBIx/Class/Optional/Dependencies.pm
@@ -788,59 +788,50 @@ sub __envvar_group_desc {
   join '/', @res;
 }
 
-### Private OO API
-our %req_unavailability_cache;
-
-# this method is just a lister and envvar/metadata checker - it does not try to load anything
-my $processed_groups = {};
-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,
-  };
+# Expand includes from a random group in a specific order:
+# nonvariable groups first, then their includes, then the variable groups,
+# then their includes.
+# This allows reliably marking the rest of the mod reqs as variable (this is
+# also why variable includes are currently not allowed)
+sub __expand_includes {
+  my ($groups, $seen) = @_;
+
+  # !! DIFFERENT !! behavior and return depending on invocation mode
+  # (easier to recurse this way)
+  my $is_toplevel = $seen
+    ? 0
+    : !! ($seen = {})
+  ;
 
-  for my $group ( grep { ! $processed_groups->{$_} } @$groups ) {
+  my ($res_per_type, $missing_envvars);
 
-    $group =~ /\A [A-Z_a-z][0-9A-Z_a-z]* \z/x
-      or croak "Invalid requirement group name '$group': only ascii alphanumerics and _ are allowed";
+  # breadth-first evaluation, with non-variable includes on top
+  for my $g (@$groups) {
 
-    croak "Requirement group '$group' is not defined" unless defined $dbic_reqs->{$group};
+    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;
 
-    my $group_reqs = $dbic_reqs->{$group}{req};
+    my $r = $dbic_reqs->{$g}
+      or croak "Requirement group '$g' is not defined";
 
-    # sanity-check
-    for (keys %$group_reqs) {
+    # always do this check *before* the $seen check
+    croak "Group '$g' with variable effective_modreqs can not be specified as an 'include'"
+      if ( $r->{env} and ! $is_toplevel );
 
-      $_ =~ /\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";
+    next if $seen->{$g}++;
 
-      # !!!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 $req_type = 'static';
 
-    # check if we have all required envvars if such names are defined
-    my ($some_envs_required, $some_envs_missing);
-    if (my @e = @{$dbic_reqs->{$group}{env} || [] }) {
+    if ( my @e = @{$r->{env}||[]} ) {
 
-      croak "Unexpected 'env' attribute under group '$group' (only allowed in test_* groups)"
-        unless $group =~ /^test_/;
+      croak "Unexpected 'env' attribute under group '$g' (only allowed in test_* groups)"
+        unless $g =~ /^test_/;
 
-      croak "Unexpected *odd* list in 'env' under group '$group'"
+      croak "Unexpected *odd* list in 'env' under group '$g'"
         if @e % 2;
 
-      my @group_envnames_list;
-
       # deconstruct the whole thing
+      my (@group_envnames_list, $some_envs_required, $some_required_missing);
       while (@e) {
         push @group_envnames_list, my $envname = shift @e;
 
@@ -849,44 +840,95 @@ sub _groups_to_reqs {
 
         $some_envs_required ||= 1;
 
-        $some_envs_missing ||= (
+        $some_required_missing ||= (
           ! defined $ENV{$envname}
             or
           ! length $ENV{$envname}
         );
       }
 
-      croak "None of the envvars in group '$group' declared as required, making the requirement moot"
+      croak "None of the envvars in group '$g' declared as required, making the requirement moot"
         unless $some_envs_required;
 
-      push @{$ret->{missing_envvars}}, \@group_envnames_list if $some_envs_missing;
+      if ($some_required_missing) {
+        push @{$missing_envvars->{$g}}, \@group_envnames_list;
+        $req_type = 'variable';
+      }
+    }
+
+    push @{$res_per_type->{"base_${req_type}"}}, $g;
+
+    if (my $i = $dbic_reqs->{$g}{include}) {
+      $i = [ $i ] unless ref $i eq 'ARRAY';
+
+      croak "Malformed 'include' for group '$g': must be another existing group name or arrayref of existing group names"
+        unless @$i;
+
+      push @{$res_per_type->{"incs_${req_type}"}}, @$i;
     }
+  }
+
+  my @ret = map {
+    @{ $res_per_type->{"base_${_}"} || [] },
+    ( $res_per_type->{"incs_${_}"} ? __expand_includes( $res_per_type->{"incs_${_}"}, $seen ) : () ),
+  } qw(static variable);
+
+  return ! $is_toplevel ? @ret : do {
+    my $rv = {};
+    $rv->{$_} = {
+      idx => 1 + keys %$rv,
+      missing_envvars => $missing_envvars->{$_},
+    } for @ret;
+    $rv;
+  };
+}
+
+### Private OO API
+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) = @_;
+
+  $groups = [ $groups || () ]
+    unless ref $groups eq 'ARRAY';
+
+  croak "@{[ (caller(1))[3] ]}() expects a requirement group name or arrayref of group names"
+    unless @$groups;
 
-    # get the reqs for includes if any
-    my $inc_reqs;
-    if (my $incs = $dbic_reqs->{$group}{include}) {
-      $incs = [ $incs ] unless ref $incs eq 'ARRAY';
+  my $ret = {
+    modreqs => {},
+    modreqs_fully_documented => 1,
+  };
 
-      croak "Malformed 'include' for group '$group': must be another existing group name or arrayref of existing group names"
-        unless @$incs;
+  my $all_groups = __expand_includes($groups);
 
-      local $processed_groups->{$group} = 1;
+  for my $group (sort { $all_groups->{$a}{idx} <=> $all_groups->{$b}{idx} } keys %$all_groups ) {
 
-      my $subreqs = $self->_groups_to_reqs($incs);
+    my $group_reqs = $dbic_reqs->{$group}{req};
 
-      croak "Includes with variable effective_modreqs not yet supported"
-        if $subreqs->{effective_modreqs_differ};
+    # sanity-check
+    for (keys %$group_reqs) {
 
-      $inc_reqs = $subreqs->{modreqs};
+      $_ =~ /\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 );
+    }
 
+    if (my $e = $all_groups->{$group}{missing_envvars}) {
+      push @{$ret->{missing_envvars}}, @$e;
     }
 
     # assemble into the final ret
     for my $type (
       'modreqs',
-      $some_envs_missing ? () : 'effective_modreqs'
+      ( $ret->{missing_envvars} ? () : 'effective_modreqs' ),
     ) {
-      for my $req_bag ($group_reqs, $inc_reqs||()) {
+      for my $req_bag ($group_reqs) {
         for my $mod (keys %$req_bag) {
 
           $ret->{$type}{$mod} = $req_bag->{$mod}||0 if (
@@ -901,8 +943,6 @@ sub _groups_to_reqs {
       }
     }
 
-    $ret->{effective_modreqs_differ} ||= !!$some_envs_missing;
-
     $ret->{modreqs_fully_documented} &&= !!$dbic_reqs->{$group}{pod};
 
     $ret->{release_testing_mandatory} ||= !!$dbic_reqs->{$group}{release_testing_mandatory};