[Catalyst-commits] r13643 - in Catalyst-Authentication-Store-LDAP/trunk: lib/Catalyst/Authentication/Store/LDAP t

[rafl at dev.catalyst.perl.org]

Author: rafl
Date: 2010-10-05 00:00:20 +0100 (Tue, 05 Oct 2010)
New Revision: 13643

Modified:
   Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm
   Catalyst-Authentication-Store-LDAP/trunk/t/pod-coverage.t
Log:
Implement can() for attribute delegation

Modified: Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm	2010-10-04 23:00:14 UTC (rev 13642)
+++ Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm	2010-10-04 23:00:20 UTC (rev 13643)
@@ -314,6 +314,15 @@
     delete $_ldap_connection_passwords{refaddr($self)};
 }
 
+sub can {
+    my ($self, $method) = @_;
+
+    return $self->SUPER::can($method) || do {
+        return unless $self->has_attribute($method);
+        return sub { $_[0]->has_attribute($method) };
+    };
+}
+
 sub AUTOLOAD {
     my $self = shift;
 

Modified: Catalyst-Authentication-Store-LDAP/trunk/t/pod-coverage.t
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/t/pod-coverage.t	2010-10-04 23:00:14 UTC (rev 13642)
+++ Catalyst-Authentication-Store-LDAP/trunk/t/pod-coverage.t	2010-10-04 23:00:20 UTC (rev 13643)
@@ -3,4 +3,4 @@
 use Test::More;
 eval "use Test::Pod::Coverage 1.04";
 plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
-all_pod_coverage_ok();
+all_pod_coverage_ok({ also_private => ['can'] });