Commit | Line | Data |
772c89c1 |
1 | package DBIx::Class::Schema::RestrictByUser; |
2 | |
3 | our $VERSION = '0.0001_01'; |
4 | |
5 | use DBIx::Class::Schema::RestrictByUser::RestrictComp::Schema; |
6 | use DBIx::Class::Schema::RestrictByUser::RestrictComp::Source; |
7 | |
8 | # (c) Matt S Trout 2006, all rights reserved |
9 | # this is free software under the same license as perl itself |
10 | |
11 | =head1 NAME |
12 | |
13 | DBIx::Class::Schema::RestrictByUser - Automatically restrict resultsets by user |
14 | |
15 | =head1 SYNOPSYS |
16 | |
17 | In your L<DBIx::Class::Schema> class: |
18 | |
19 | __PACKAGE__->load_components(qw/Schema::RestrictByUser/); |
20 | |
21 | In the L<DBIx::Class> table class for your users: |
22 | |
23 | #let's pretend a user has_many notes, which are in ResultSet 'Notes' |
24 | sub restrict_Notes_resultset { |
25 | my $self = shift; #the User object |
26 | my $unrestricted_rs = shift; |
27 | |
28 | #restrict the notes viewable to only those that belong to this user |
29 | #this will, in effect make the following 2 equivalent |
30 | # $user->notes $schema->resultset('Notes') |
31 | return $self->related_resultset('notes'); |
32 | } |
33 | |
34 | #it could also be written like this |
35 | sub restrict_Notes_resultset { |
36 | my $self = shift; #the User object |
37 | my $unrestricted_rs = shift; |
38 | return $unrestricted_rs->search_rs( { user_id => $self->id } ); |
39 | } |
40 | |
41 | Wherever you connect to your database |
42 | |
43 | my $schema = MyApp::Schema->connect(...); |
44 | my $user = $schema->resultset('User')->find( { id => $user_id } ); |
45 | $resticted_schema = $schema->restrict_by_user( $user, $optional_prefix); |
46 | |
47 | =cut |
48 | |
49 | =head1 DESCRIPTION |
50 | |
51 | This L<DBIx::Class::Schema> component can be used to restrict all resultsets through |
52 | an appropriately-named method in a user's result_class. This can be done to |
53 | automatically prevent data from being accessed by a user, effectively enforcing |
54 | security by limiting any access to the data store. |
55 | |
56 | =head1 PUBLIC METHODS |
57 | |
58 | =head2 restrict_by_user $user_obj, $optional_prefix |
59 | |
60 | Will restrict resultsets according to the methods available in $user_obj and |
61 | return a restricted copy of itself. ResultSets will be restricted if methods |
62 | in the form of C<restrict_${ResultSet_Name}_resultset> are found in $user_obj. |
63 | If the optional prefix is included it will attempt to use |
64 | C<restrict_${prefix}_${ResultSet_Name}_resultset>, if that does not exist, it |
65 | will try again without the prefix, and if that's not available the resultset |
66 | will not be restricted. |
67 | |
68 | =cut |
69 | |
70 | sub restrict_by_user { |
71 | my ($self, $user, $prefix) = @_; |
72 | my $copy = $self->clone; |
73 | $copy->make_restricted; |
74 | $copy->user($user); |
75 | $copy->restricted_prefix($prefix) if $prefix; |
76 | return $copy; |
77 | } |
78 | |
79 | =head1 PRIVATE METHODS |
80 | |
81 | =head2 make_restricted |
82 | |
83 | Restrict the Schema class and ResultSources associated with this Schema |
84 | |
85 | =cut |
86 | |
87 | sub make_restricted { |
88 | my ($self) = @_; |
89 | my $class = ref($self); |
90 | my $r_class = $self->_get_restricted_schema_class($class); |
91 | bless($self, $r_class); |
92 | foreach my $moniker ($self->sources) { |
93 | my $source = $self->source($moniker); |
94 | my $class = ref($source); |
95 | my $r_class = $self->_get_restricted_source_class($class); |
96 | bless($source, $r_class); |
97 | } |
98 | } |
99 | |
100 | =head2 _get_restricted_schema_class $target_schema |
101 | |
102 | Return the class name for the restricted schema class; |
103 | |
104 | =cut |
105 | |
106 | sub _get_restricted_schema_class { |
107 | my ($self, $target) = @_; |
108 | return $self->_get_restricted_class(Schema => $target); |
109 | } |
110 | |
111 | =head2 _get_restricted_source_class $target_source |
112 | |
113 | Return the class name for the restricted ResultSource class; |
114 | |
115 | =cut |
116 | |
117 | sub _get_restricted_source_class { |
118 | my ($self, $target) = @_; |
119 | return $self->_get_restricted_class(Source => $target); |
120 | } |
121 | |
122 | =head2 _get_restrictedclass $type, $target |
123 | |
124 | Return an appropriate class name for a restricted class of type $type. |
125 | |
126 | =cut |
127 | |
128 | sub _get_restricted_class { |
129 | my ($self, $type, $target) = @_; |
130 | my $r_class = join('::', $target, '__RestrictedByUser'); |
131 | unless (eval { $r_class->can('can') }) { |
132 | my $r_comp = join( |
133 | '::', 'DBIx::Class::Schema::RestrictByUser::RestrictComp', $type |
134 | ); |
135 | $self->inject_base($r_class, $r_comp, $target); |
136 | } |
137 | return $r_class; |
138 | } |
139 | |
140 | 1; |
141 | |
142 | __END__; |
143 | |
144 | =head1 SEE ALSO |
145 | |
146 | L<DBIx::Class>, L<DBIx::Class::Schema::RestrictByUser::RestrictComp::Schema>, |
147 | L<DBIx::Class::Schema::RestrictByUser::RestrictComp::Source>, |
148 | |
149 | =head1 AUTHORS |
150 | |
151 | Matt S Trout (mst) <mst@shadowcatsystems.co.uk> |
152 | |
153 | With contributions from |
154 | Guillermo Roditi (groditi) <groditi@cpan.org> |
155 | |
156 | =head1 LICENSE |
157 | |
158 | You may distribute this code under the same terms as Perl itself. |
159 | |
160 | =cut |