From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 12 Feb 2010 12:40:53 +0000 (+0000)
Subject: Support methods to verify group dependencies
X-Git-Tag: v0.08119~14^2~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fb39747c525a55b3b569057867d971878457ede0;p=dbsrgits%2FDBIx-Class.git

Support methods to verify group dependencies
---

diff --git a/lib/DBIx/Class/Optional/Dependencies.pm b/lib/DBIx/Class/Optional/Dependencies.pm
index 2c02144..aa4701f 100644
--- a/lib/DBIx/Class/Optional/Dependencies.pm
+++ b/lib/DBIx/Class/Optional/Dependencies.pm
@@ -3,7 +3,9 @@ package DBIx::Class::Optional::Dependencies;
 use warnings;
 use strict;
 
-# NO EXTERNAL DEPENDENCIES (e.g. C::A::G)
+use Carp;
+
+# NO EXTERNAL NON-5.8.1 CORE DEPENDENCIES EVER (e.g. C::A::G)
 # This module is to be loaded by Makefile.PM on a pristine system
 
 my $reqs = {
@@ -12,10 +14,10 @@ my $reqs = {
   },
 
   replicated => {
-    'Moose'                    => '0.98',
-    'MooseX::Types'            => '0.21',
+    'Moose'                     => '0.98',
+    'MooseX::Types'             => '0.21',
     'namespace::clean'          => '0.11',
-    'Hash::Merge'              => '0.11',
+    'Hash::Merge'               => '0.11',
   },
 
   admin => {
@@ -99,4 +101,85 @@ sub all_optional_requirements {
   return { map { %{ $_ || {} } } (values %$reqs) };
 }
 
+sub req_list_for {
+  my ($class, $group) = @_;
+
+  die "req_list_for() expects a requirement group name"
+    unless $group;
+
+  my $deps = $reqs->{$group}
+    or die "Requirement group '$group' does not exist";
+
+  return { %$deps };
+}
+
+
+our %req_availability_cache;
+sub req_ok_for {
+  my ($class, $group) = @_;
+
+  croak "req_ok_for() expects a requirement group name"
+    unless $group;
+
+  $class->_check_deps ($group) unless $req_availability_cache{$group};
+
+  return $req_availability_cache{$group}{status};
+}
+
+sub req_missing_for {
+  my ($class, $group) = @_;
+
+  croak "req_missing_for() expects a requirement group name"
+    unless $group;
+
+  $class->_check_deps ($group) unless $req_availability_cache{$group};
+
+  return $req_availability_cache{$group}{missing};
+}
+
+sub req_errorlist_for {
+  my ($class, $group) = @_;
+
+  croak "req_errorlist_for() expects a requirement group name"
+    unless $group;
+
+  $class->_check_deps ($group) unless $req_availability_cache{$group};
+
+  return $req_availability_cache{$group}{errorlist};
+}
+
+sub _check_deps {
+  my ($class, $group) = @_;
+
+  my $deps = $reqs->{$group}
+    or croak "Requirement group '$group' does not exist";
+
+  my %errors;
+  for my $mod (keys %$deps) {
+    if (my $ver = $deps->{$mod}) {
+      eval "use $mod $ver ()";
+    }
+    else {
+      eval "require $mod";
+    }
+
+    $errors{$mod} = $@ if $@;
+  }
+
+  if (keys %errors) {
+    $req_availability_cache{$group} = {
+      status => 0,
+      errorlist => { %errors },
+      missing => join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) ),
+    };
+  }
+  else {
+    $req_availability_cache{$group} = {
+      status => 1,
+      errorlist => {},
+      missing => '',
+    };
+  }
+}
+
 1;