[Catalyst-commits] r13567 - in Catalyst-Authentication-Store-DBIx-Class/trunk: . lib/Catalyst/Authentication/Store/DBIx/Class

[matthewt at dev.catalyst.perl.org]

Author: matthewt
Date: 2010-09-01 20:17:04 +0100 (Wed, 01 Sep 2010)
New Revision: 13567

Modified:
   Catalyst-Authentication-Store-DBIx-Class/trunk/Changes
   Catalyst-Authentication-Store-DBIx-Class/trunk/lib/Catalyst/Authentication/Store/DBIx/Class/User.pm
Log:
fix the delegation code in User.pm

Modified: Catalyst-Authentication-Store-DBIx-Class/trunk/Changes
===================================================================
--- Catalyst-Authentication-Store-DBIx-Class/trunk/Changes	2010-09-01 15:11:15 UTC (rev 13566)
+++ Catalyst-Authentication-Store-DBIx-Class/trunk/Changes	2010-09-01 19:17:04 UTC (rev 13567)
@@ -1,5 +1,7 @@
 Revision history for Catalyst-Plugin-Authentication-Store-DBIx-Class
 
+        * Make can() work as well as AUTOLOADing.
+
 0.1300  2010-06-16
         * Support columns with accessors that aren't the column name.
         * Fix some documentation typos.

Modified: Catalyst-Authentication-Store-DBIx-Class/trunk/lib/Catalyst/Authentication/Store/DBIx/Class/User.pm
===================================================================
--- Catalyst-Authentication-Store-DBIx-Class/trunk/lib/Catalyst/Authentication/Store/DBIx/Class/User.pm	2010-09-01 15:11:15 UTC (rev 13566)
+++ Catalyst-Authentication-Store-DBIx-Class/trunk/lib/Catalyst/Authentication/Store/DBIx/Class/User.pm	2010-09-01 19:17:04 UTC (rev 13567)
@@ -238,6 +238,21 @@
     $self->_user->auto_update( @_ );
 }
 
+sub can {
+    my $self = shift;
+    return $self->SUPER::can(@_) || do {
+        my ($method) = @_; warn $method;
+        if (my $code = $self->_user->can($method)) {
+            sub { shift->_user->$code(@_) }
+        } elsif (my $accessor =
+            try { $self->_user->result_source->column_info($method)->{accessor} }) {
+            sub { shift->_user->$accessor }
+        } else {
+            undef;
+        }
+    };
+}
+
 sub AUTOLOAD {
     my $self = shift;
     (my $method) = (our $AUTOLOAD =~ /([^:]+)$/);
@@ -354,9 +369,13 @@
 
 Jason Kuri (jayk at cpan.org)
 
+=head1 CONTRIBUTORS
+
+Matt S Trout (mst) <mst at shadowcat.co.uk>
+
 =head1 LICENSE
 
-Copyright (c) 2007 the aforementioned authors. All rights
+Copyright (c) 2007-2010 the aforementioned authors. All rights
 reserved. This program is free software; you can redistribute
 it and/or modify it under the same terms as Perl itself.