[Catalyst-commits] r11540 - in Catalyst-Plugin-Authentication/0.10000/trunk: . lib/Catalyst/Authentication t

[t0m at dev.catalyst.perl.org]

Author: t0m
Date: 2009-10-16 00:50:28 +0000 (Fri, 16 Oct 2009)
New Revision: 11540

Modified:
   Catalyst-Plugin-Authentication/0.10000/trunk/Changes
   Catalyst-Plugin-Authentication/0.10000/trunk/Makefile.PL
   Catalyst-Plugin-Authentication/0.10000/trunk/lib/Catalyst/Authentication/User.pm
   Catalyst-Plugin-Authentication/0.10000/trunk/t/06_user.t
Log:
Add AUTOLOAD nicked from the dbic store to base class

Modified: Catalyst-Plugin-Authentication/0.10000/trunk/Changes
===================================================================
--- Catalyst-Plugin-Authentication/0.10000/trunk/Changes	2009-10-15 21:19:26 UTC (rev 11539)
+++ Catalyst-Plugin-Authentication/0.10000/trunk/Changes	2009-10-16 00:50:28 UTC (rev 11540)
@@ -1,5 +1,8 @@
 Revision history for Perl extension Catalyst::Plugin::Authentication
 
+     - Add AUTOLOAD method to the default user class so that methods are
+       delegated down onto the underlieing user object retrieved from
+       the store (if present)
      - Fix typos in documentation (RT#49476)
      - Fix compatibilty with Catalyst 5.70 (RT#50466)
 

Modified: Catalyst-Plugin-Authentication/0.10000/trunk/Makefile.PL
===================================================================
--- Catalyst-Plugin-Authentication/0.10000/trunk/Makefile.PL	2009-10-15 21:19:26 UTC (rev 11539)
+++ Catalyst-Plugin-Authentication/0.10000/trunk/Makefile.PL	2009-10-16 00:50:28 UTC (rev 11540)
@@ -16,7 +16,7 @@
 requires 'MRO::Compat';
 requires 'Catalyst::Plugin::Session' => '0.10';
 
-test_requires 'Test::More';
+test_requires 'Test::More' => '0.88';
 test_requires 'Test::Exception';
 test_requires 'Class::MOP';
 test_requires 'Moose';

Modified: Catalyst-Plugin-Authentication/0.10000/trunk/lib/Catalyst/Authentication/User.pm
===================================================================
--- Catalyst-Plugin-Authentication/0.10000/trunk/lib/Catalyst/Authentication/User.pm	2009-10-15 21:19:26 UTC (rev 11539)
+++ Catalyst-Plugin-Authentication/0.10000/trunk/lib/Catalyst/Authentication/User.pm	2009-10-16 00:50:28 UTC (rev 11540)
@@ -3,11 +3,10 @@
 use strict;
 use warnings;
 use base qw/Class::Accessor::Fast/;
+use Scalar::Util qw/refaddr/;
 
 ## auth_realm is the realm this user came from. 
-BEGIN {
-    __PACKAGE__->mk_accessors(qw/auth_realm store/);
-}
+__PACKAGE__->mk_accessors(qw/auth_realm store/);
 
 ## THIS IS NOT A COMPLETE CLASS! it is intended to provide base functionality only.  
 ## translation - it won't work if you try to use it directly.
@@ -45,7 +44,7 @@
 ## you most likely want to write this yourself.
 sub get {
     my ($self, $field) = @_;
-    
+
     my $object;
     if ($object = $self->get_object and $object->can($field)) {
         return $object->$field();
@@ -71,14 +70,18 @@
     return $self->get_object(@_);
 }
 
-## Backwards Compatibility
-## you probably want auth_realm, in fact.  but this does work for backwards compatibility.
-## store should be a read-write accessor - so it was moved to mk_accessors
-##sub store { 
-##    my ($self) = @_;
-##    return $self->auth_realm->{store};
-##}
+sub AUTOLOAD {
+    my $self = shift;
+    (my $method) = (our $AUTOLOAD =~ /([^:]+)$/);
+    return if $method eq "DESTROY";
 
+    my $obj = $self->obj;
+    # Don't bother unless we have a backing object
+    return if refaddr($obj) eq refaddr($self);
+
+    $obj->$method(@_);
+}
+
 __PACKAGE__;
 
 __END__
@@ -96,8 +99,18 @@
 
 =head1 DESCRIPTION
 
-This is the base class for authenticated 
+This is the base class for authentication user objects.
 
+THIS IS NOT A COMPLETE CLASS! it is intended to provide base functionality only.
+
+It provides the base methods listed below, and any additional methods
+are proxied onto the user object fetched from the underlieing store.
+
+=head1 NOTES TO STORE IMPLEMENTORS
+
+Please read the comments in the source code of this class to work out
+which methods you should override.
+
 =head1 METHODS
 
 =head2 id( )
@@ -119,12 +132,17 @@
 
 =head2 get_object( )
 
-Returns the underlying object storing the user data.  The return value of this function will vary depending
+Returns the underlying object storing the user data.  The return value of this
+method will vary depending
 on the storage module used.
 
 =head2 obj( )
 
 Shorthand for get_object( )
 
+=head2 AUTOLOAD
+
+Delegates any unknown methods onto the user object returned by ->obj
+
 =cut
 

Modified: Catalyst-Plugin-Authentication/0.10000/trunk/t/06_user.t
===================================================================
--- Catalyst-Plugin-Authentication/0.10000/trunk/t/06_user.t	2009-10-15 21:19:26 UTC (rev 11539)
+++ Catalyst-Plugin-Authentication/0.10000/trunk/t/06_user.t	2009-10-16 00:50:28 UTC (rev 11540)
@@ -1,12 +1,17 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6;
+use Test::More;
 use Test::Exception;
 
 my $m; BEGIN { use_ok($m = "Catalyst::Authentication::User") }
 
 {
+    package SomeBaseUser;
+    sub other_method { 'FNAR' };
+}
+
+{
 	package SomeUser;
 	use base $m;
 
@@ -21,6 +26,9 @@
 			top_level => 1,
 		}
 	}
+    sub get_object {
+        bless {}, 'SomeBaseUser';
+    }
 }
 
 my $o = SomeUser->new;
@@ -39,4 +47,10 @@
 #	$o->supports(qw/bad_key subfeature/)
 #} "but can't traverse into one";
 
+lives_ok {
+    is $o->other_method, 'FNAR', 'Delegation onto user object works';
+} 'Delegation lives';
 
+done_testing;
+
+