[Bps-public-commit] r15112 - in Class-Require/trunk: . t t/lib t/lib/Class t/lib/Class/Require

[sartak at bestpractical.com]

Author: sartak
Date: Wed Aug 13 06:02:28 2008
New Revision: 15112

Added:
   Class-Require/trunk/t/002-try-load-class.t
   Class-Require/trunk/t/lib/
   Class-Require/trunk/t/lib/Class/
   Class-Require/trunk/t/lib/Class/Require/
   Class-Require/trunk/t/lib/Class/Require/OK.pm
Modified:
   Class-Require/trunk/   (props changed)
   Class-Require/trunk/lib/Class/Require.pm
   Class-Require/trunk/t/001-is-class-loaded.t

Log:
 r69460 at onn:  sartak | 2008-08-13 06:02:14 -0400
 Implementations of load_class and try_load_class, some tests


Modified: Class-Require/trunk/lib/Class/Require.pm
==============================================================================
--- Class-Require/trunk/lib/Class/Require.pm	(original)
+++ Class-Require/trunk/lib/Class/Require.pm	Wed Aug 13 06:02:28 2008
@@ -9,14 +9,33 @@
     all => \@EXPORT_OK,
 );
 
+our $ERROR;
+
 sub load_class {
     my $class = shift;
 
+    return 1 if try_load_class($class);
+    die "Unable to load class $class: $ERROR";
 }
 
 sub try_load_class {
     my $class = shift;
 
+    undef $ERROR;
+
+    return 1 if is_class_loaded($class);
+
+    my $file = $class . '.pm';
+    $file =~ s{::}{/}g;
+
+    return 1 if eval {
+        local $SIG{__DIE__} = 'DEFAULT';
+        require $file;
+        1;
+    };
+
+    $ERROR = $@;
+    return 0;
 }
 
 sub is_class_loaded {
@@ -38,6 +57,7 @@
     # ..such as $VERSION?
     return 1 if exists $table->{VERSION};
 
+    # ..or a method?
     for my $glob (values %$table) {
         return 1 if *{$glob}{CODE};
     }

Modified: Class-Require/trunk/t/001-is-class-loaded.t
==============================================================================
--- Class-Require/trunk/t/001-is-class-loaded.t	(original)
+++ Class-Require/trunk/t/001-is-class-loaded.t	Wed Aug 13 06:02:28 2008
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 8;
+use Test::More tests => 11;
 
 use Class::Require 'is_class_loaded';
 
@@ -52,4 +52,25 @@
 };
 ok(!is_class_loaded('Class::Require::WithScalar'), "class that defines just a scalar is not loaded");
 # }}}
+# subpackage (no) {{{
+do {
+    package Class::Require::Foo::Bar;
+    sub bar {}
+};
+ok(!is_class_loaded('Class::Require::Foo'), "even if Foo::Bar is loaded, Foo is not");
+# }}}
+# superstring (no) {{{
+do {
+    package Class::Require::Quuxquux;
+    sub quux {}
+};
+ok(!is_class_loaded('Class::Require::Quux'), "Quuxquux does not imply the existence of Quux");
+# }}}
+# use constant (yes) {{{
+do {
+    package Class::Require::WithConstant;
+    use constant PI => 3;
+};
+ok(is_class_loaded('Class::Require::WithConstant'), "defining a constant means the class is loaded");
+# }}}
 

Added: Class-Require/trunk/t/002-try-load-class.t
==============================================================================
--- (empty file)
+++ Class-Require/trunk/t/002-try-load-class.t	Wed Aug 13 06:02:28 2008
@@ -0,0 +1,16 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 6;
+use Class::Require 'try_load_class';
+use lib 't/lib';
+
+ok(try_load_class('Class::Require::OK'), "loaded class OK");
+is($Class::Require::ERROR, undef);
+
+ok(!try_load_class('Class::Require::Nonexistent'), "didn't load class Nonexistent");
+like($Class::Require::ERROR, qr{^Can't locate Class/Require/Nonexistent.pm in \@INC});
+
+ok(try_load_class('Class::Require::OK'), "loaded class OK");
+is($Class::Require::ERROR, undef);
+

Added: Class-Require/trunk/t/lib/Class/Require/OK.pm
==============================================================================
--- (empty file)
+++ Class-Require/trunk/t/lib/Class/Require/OK.pm	Wed Aug 13 06:02:28 2008
@@ -0,0 +1,9 @@
+#!/usr/bin/env perl
+package Class::Require::OK;
+use strict;
+use warnings;
+
+sub ok { 1 }
+
+1;
+