From: Christopher H. Laco <claco@cpan.org>
Date: Fri, 11 May 2007 01:34:21 +0000 (+0000)
Subject: set_comonent_class now only dies when the class is an installed/installable class... 
X-Git-Tag: v0.05001^0
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=874177a3c7d7d3628958c65e86baad8aad1d3d26;p=p5sagit%2FClass-Accessor-Grouped.git

set_comonent_class now only dies when the class is an installed/installable class and can't be loaded
---

diff --git a/Changes b/Changes
index 4e041a0..46fe8c3 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Revision history for Class::Accessor::Grouped.
 
+0.05001 Thur May 10 20:55:11 2007
+    - set_component_class now only dies if the specified class is a
+        installed/installable class and fails to load it.
+
 0.05000 Tue May 08 19:42:33 2007
     - Added get/set_component_class
 
diff --git a/lib/Class/Accessor/Grouped.pm b/lib/Class/Accessor/Grouped.pm
index 6a317ed..0264651 100644
--- a/lib/Class/Accessor/Grouped.pm
+++ b/lib/Class/Accessor/Grouped.pm
@@ -4,11 +4,11 @@ use warnings;
 use Carp;
 use Class::Inspector ();
 use Class::ISA ();
-use Scalar::Util ();
+use Scalar::Util qw/reftype blessed/;
 
 use vars qw($VERSION);
 
-$VERSION = '0.05000';
+$VERSION = '0.05001';
 
 =head1 NAME
 
@@ -58,7 +58,7 @@ sub mk_group_accessors {
 
     sub _mk_group_accessors {
         my($self, $maker, $group, @fields) = @_;
-        my $class = Scalar::Util::blessed($self) || $self;
+        my $class = blessed $self || $self;
 
         # So we don't have to do lots of lookups inside the loop.
         $maker = $self->can($maker) unless ref $maker;
@@ -294,8 +294,8 @@ sub get_inherited {
     my ($self, $get) = @_;
     my $class;
 
-    if (Scalar::Util::blessed($self)) {
-        my $reftype = Scalar::Util::reftype($self);
+    if (blessed $self) {
+        my $reftype = reftype $self;
         $class = ref $self;
 
         if ($reftype eq 'HASH' && exists $self->{$get}) {
@@ -344,8 +344,8 @@ hash-based object.
 sub set_inherited {
     my ($self, $set, $val) = @_;
 
-    if (Scalar::Util::blessed($self)) {
-        if (Scalar::Util::reftype($self) eq 'HASH') {
+    if (blessed $self) {
+        if (reftype $self eq 'HASH') {
             return $self->{$set} = $val;
         } else {
             croak('Cannot set inherited value on an object instance that is not hash-based');
@@ -408,7 +408,7 @@ sub set_component_class {
     my ($self, $field, $value) = @_;
 
     if ($value) {
-        if (!Class::Inspector->loaded($value)) {
+        if (Class::Inspector->installed($value) && !Class::Inspector->loaded($value)) {
             eval "use $value";
 
             croak("Could not load $field '$value': ", $@) if $@;
@@ -425,7 +425,7 @@ Returns a list of 'parent' or 'super' class names that the current class inherit
 =cut
 
 sub get_super_paths {
-    my $class = Scalar::Util::blessed $_[0] || $_[0];
+    my $class = blessed $_[0] || $_[0];
 
     return Class::ISA::super_path($class);
 };
diff --git a/t/component.t b/t/component.t
index 0cdcac2..d151644 100644
--- a/t/component.t
+++ b/t/component.t
@@ -1,4 +1,4 @@
-use Test::More tests => 7;
+use Test::More tests => 8;
 use strict;
 use warnings;
 use lib 't/lib';
@@ -7,14 +7,20 @@ use AccessorGroups;
 
 is(AccessorGroups->result_class, undef);
 
-# croak on set where class can't be loaded
+## croak on set where class can't be loaded and it's a physical class
 my $dying = AccessorGroups->new;
 eval {
-    $dying->result_class('Junkies');
+    $dying->result_class('NotReallyAClass');
 };
-ok($@ =~ /Could not load result_class 'Junkies'/);
+ok($@ =~ /Could not load result_class 'NotReallyAClass'/);
 is($dying->result_class, undef);
 
+
+## don't croak when the class isn't available but not loaded for people
+## who create class/packages on the fly
+$dying->result_class('JunkiesNeverInstalled');
+is($dying->result_class, 'JunkiesNeverInstalled');
+
 ok(!Class::Inspector->loaded('BaseInheritedGroups'));
 AccessorGroups->result_class('BaseInheritedGroups');
 ok(Class::Inspector->loaded('BaseInheritedGroups'));
diff --git a/t/lib/NotReallyAClass.pm b/t/lib/NotReallyAClass.pm
new file mode 100644
index 0000000..e69de29
diff --git a/t/strict.t b/t/strict.t
index 3ef1d59..d77daa6 100644
--- a/t/strict.t
+++ b/t/strict.t
@@ -20,7 +20,7 @@ BEGIN {
 ## finally run under -T. Until then, I'm on my own here. ;-)
 my @files;
 my %trusted = (
-
+    'NotReallyAClass.pm' => 1
 );
 
 find({  wanted => \&wanted,
diff --git a/t/warnings.t b/t/warnings.t
index a8d749d..5d23e0d 100644
--- a/t/warnings.t
+++ b/t/warnings.t
@@ -20,7 +20,7 @@ BEGIN {
 ## finally run under -T. Until then, I'm on my own here. ;-)
 my @files;
 my %trusted = (
-
+    'NotReallyAClass.pm' => 1
 );
 
 find({  wanted => \&wanted,