reuse code refs from ->can
[dbsrgits/DBIx-Class-Schema-RestrictWithObject.git] / lib / DBIx / Class / Schema / RestrictWithObject / RestrictComp / Source.pm
1 package DBIx::Class::Schema::RestrictWithObject::RestrictComp::Source;
2
3 use strict;
4 use warnings;
5
6 =head1 DESCRIPTION
7
8 For general usage please see L<DBIx::Class::Schema::RestrictWithObject>, the information
9 provided here is not meant for general use and is subject to change. In the interest
10 of transparency the functionality presented is documented, but all methods should be
11 considered private and, as such, subject to incompatible changes and removal.
12
13 =head1 PRIVATE METHODS
14
15 =head2 resultset
16
17 Intercept call to C<resultset> and return restricted resultset
18
19 =cut
20
21 #TODO:
22 # - We should really be caching method name hits to avoid the can()
23 #   unless it really is necessary. This would be done at the restrictor
24 #   class level. {$source_name} => $restricting_method (undef if n/a)
25
26 sub resultset {
27   my $self = shift;
28   my $rs = $self->next::method(@_);
29   my $obj = $self->schema->restricting_object;
30   return $rs unless $obj;
31
32   my $s = $self->source_name;
33   $s =~ s/::/_/g;
34   #if a prefix was set, try that first
35   if(my $pre = $self->schema->restricted_prefix) {
36     if(my $coderef = $obj->can("restrict_${pre}_${s}_resultset")) {
37       return $obj->$coderef($rs);
38     }
39   }
40   #should this be an elsif?!
41   if(my $coderef = $obj->can("restrict_${s}_resultset")) {
42     return $obj->$coderef($rs);
43   }
44   return $rs;
45 }
46
47 1;
48
49 =head1 SEE ALSO
50
51 L<DBIx::Class::Schema::RestrictWithObject>,
52
53 =cut