[Bast-commits] r5177 - in trunk/DBIx-Class-Schema-RestrictWithObject: . lib/DBIx/Class/Schema/RestrictWithObject/RestrictComp t/var

[groditi at dev.catalyst.perl.org]

Author: groditi
Date: 2008-11-22 00:06:46 +0000 (Sat, 22 Nov 2008)
New Revision: 5177

Modified:
   trunk/DBIx-Class-Schema-RestrictWithObject/Changes
   trunk/DBIx-Class-Schema-RestrictWithObject/lib/DBIx/Class/Schema/RestrictWithObject/RestrictComp/Source.pm
   trunk/DBIx-Class-Schema-RestrictWithObject/t/var/RestrictByUserTest.db
Log:
reuse code refs from ->can

Modified: trunk/DBIx-Class-Schema-RestrictWithObject/Changes
===================================================================
--- trunk/DBIx-Class-Schema-RestrictWithObject/Changes	2008-11-21 16:35:13 UTC (rev 5176)
+++ trunk/DBIx-Class-Schema-RestrictWithObject/Changes	2008-11-22 00:06:46 UTC (rev 5177)
@@ -1,2 +1,5 @@
-0.00001_01 NODATEYET
-        -initial release
+0.00002 
+  -reuse coderefs from can
+
+0.00001
+  -initial release

Modified: trunk/DBIx-Class-Schema-RestrictWithObject/lib/DBIx/Class/Schema/RestrictWithObject/RestrictComp/Source.pm
===================================================================
--- trunk/DBIx-Class-Schema-RestrictWithObject/lib/DBIx/Class/Schema/RestrictWithObject/RestrictComp/Source.pm	2008-11-21 16:35:13 UTC (rev 5176)
+++ trunk/DBIx-Class-Schema-RestrictWithObject/lib/DBIx/Class/Schema/RestrictWithObject/RestrictComp/Source.pm	2008-11-22 00:06:46 UTC (rev 5177)
@@ -18,22 +18,29 @@
 
 =cut
 
+#TODO:
+# - We should really be caching method name hits to avoid the can()
+#   unless it really is necessary. This would be done at the restrictor
+#   class level. {$source_name} => $restricting_method (undef if n/a)
+
 sub resultset {
   my $self = shift;
   my $rs = $self->next::method(@_);
-  if (my $obj = $self->schema->restricting_object) {
-    my $s = $self->source_name;
-    $s =~ s/::/_/g;
-    my $pre = $self->schema->restricted_prefix;
-    my $meth = "restrict_${s}_resultset";
+  my $obj = $self->schema->restricting_object;
+  return $rs unless $obj;
 
-    #if a prefix was set, try that first
-    if($pre){
-      my $meth_pre = "restrict_${pre}_${s}_resultset";
-      return $obj->$meth_pre($rs) if $obj->can($meth_pre);
+  my $s = $self->source_name;
+  $s =~ s/::/_/g;
+  #if a prefix was set, try that first
+  if(my $pre = $self->schema->restricted_prefix) {
+    if(my $coderef = $obj->can("restrict_${pre}_${s}_resultset")) {
+      return $obj->$coderef($rs);
     }
-    $rs = $obj->$meth($rs) if $obj->can($meth);
   }
+  #should this be an elsif?!
+  if(my $coderef = $obj->can("restrict_${s}_resultset")) {
+    return $obj->$coderef($rs);
+  }
   return $rs;
 }
 

Modified: trunk/DBIx-Class-Schema-RestrictWithObject/t/var/RestrictByUserTest.db
===================================================================
(Binary files differ)