[Bast-commits] r8663 - DBIx-Class/0.08/branches/dephandling/lib/DBIx/Class/Optional

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2010-02-12 12:40:53 +0000 (Fri, 12 Feb 2010)
New Revision: 8663

Modified:
   DBIx-Class/0.08/branches/dephandling/lib/DBIx/Class/Optional/Dependencies.pm
Log:
Support methods to verify group dependencies

Modified: DBIx-Class/0.08/branches/dephandling/lib/DBIx/Class/Optional/Dependencies.pm
===================================================================
--- DBIx-Class/0.08/branches/dephandling/lib/DBIx/Class/Optional/Dependencies.pm	2010-02-12 11:46:11 UTC (rev 8662)
+++ DBIx-Class/0.08/branches/dephandling/lib/DBIx/Class/Optional/Dependencies.pm	2010-02-12 12:40:53 UTC (rev 8663)
@@ -3,7 +3,9 @@
 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 @@
   },
 
   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 @@
   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;