Commit | Line | Data |
d87edac9 |
1 | package DBIx::Class::Schema::RestrictWithObject; |
2 | |
f0689d39 |
3 | our $VERSION = '0.0001'; |
d87edac9 |
4 | |
5 | use DBIx::Class::Schema::RestrictWithObject::RestrictComp::Schema; |
6 | use DBIx::Class::Schema::RestrictWithObject::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::RestrictWithObject - Automatically restrict resultsets |
14 | |
15 | =head1 SYNOPSYS |
16 | |
17 | In your L<DBIx::Class::Schema> class: |
18 | |
19 | __PACKAGE__->load_components(qw/Schema::RestrictWithObject/); |
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_with_object( $user, $optional_prefix); |
46 | |
47 | In this example we used the User object as the restricting object, but please |
48 | note that the restricting object need not be a DBIC class, it can be any kind of |
49 | object that provides the adequate methods. |
50 | |
51 | =cut |
52 | |
53 | =head1 DESCRIPTION |
54 | |
55 | This L<DBIx::Class::Schema> component can be used to restrict all resultsets through |
56 | an appropriately-named method in a user-supplied object. This allows you to |
57 | automatically prevent data from being accessed, or automatically predefine options |
58 | and search clauses on a schema-wide basis. When used to limit data sets, it allows |
59 | simplified security by limiting any access to the data at the schema layer. Please |
60 | note however that this is not a silver bullet and without careful programming it is |
61 | still possible to expose unwanted data, so this should not be regarded as a |
62 | replacement for application level security. |
63 | |
64 | =head1 PUBLIC METHODS |
65 | |
66 | =head2 restrict_with_object $restricting_obj, $optional_prefix |
67 | |
68 | Will restrict resultsets according to the methods available in $restricting_obj and |
69 | return a restricted copy of itself. ResultSets will be restricted if methods |
70 | in the form of C<restrict_${ResultSource_Name}_resultset> are found in |
71 | $restricting_obj. If the optional prefix is included it will attempt to use |
72 | C<restrict_${prefix}_${ResultSource_Name}_resultset>, if that does not exist, it |
73 | will try again without the prefix, and if that's not available the resultset |
74 | will not be restricted. |
75 | |
76 | =cut |
77 | |
78 | sub restrict_with_object { |
79 | my ($self, $obj, $prefix) = @_; |
80 | my $copy = $self->clone; |
81 | $copy->make_restricted; |
82 | $copy->restricting_object($obj); |
83 | $copy->restricted_prefix($prefix) if $prefix; |
84 | return $copy; |
85 | } |
86 | |
87 | =head1 PRIVATE METHODS |
88 | |
89 | =head2 make_restricted |
90 | |
91 | Restrict the Schema class and ResultSources associated with this Schema |
92 | |
93 | =cut |
94 | |
95 | sub make_restricted { |
96 | my ($self) = @_; |
97 | my $class = ref($self); |
98 | my $r_class = $self->_get_restricted_schema_class($class); |
99 | bless($self, $r_class); |
100 | foreach my $moniker ($self->sources) { |
101 | my $source = $self->source($moniker); |
102 | my $class = ref($source); |
103 | my $r_class = $self->_get_restricted_source_class($class); |
104 | bless($source, $r_class); |
105 | } |
106 | } |
107 | |
108 | =head2 _get_restricted_schema_class $target_schema |
109 | |
110 | Return the class name for the restricted schema class; |
111 | |
112 | =cut |
113 | |
114 | sub _get_restricted_schema_class { |
115 | my ($self, $target) = @_; |
116 | return $self->_get_restricted_class(Schema => $target); |
117 | } |
118 | |
119 | =head2 _get_restricted_source_class $target_source |
120 | |
121 | Return the class name for the restricted ResultSource class; |
122 | |
123 | =cut |
124 | |
125 | sub _get_restricted_source_class { |
126 | my ($self, $target) = @_; |
127 | return $self->_get_restricted_class(Source => $target); |
128 | } |
129 | |
130 | =head2 _get_restrictedclass $type, $target |
131 | |
132 | Return an appropriate class name for a restricted class of type $type. |
133 | |
134 | =cut |
135 | |
136 | sub _get_restricted_class { |
137 | my ($self, $type, $target) = @_; |
138 | my $r_class = join('::', $target, '__RestrictedWithObject'); |
2390a52b |
139 | my $r_comp = join( |
140 | '::', 'DBIx::Class::Schema::RestrictWithObject::RestrictComp', $type |
141 | ); |
142 | unless ($r_class->isa($r_comp)) { |
d87edac9 |
143 | $self->inject_base($r_class, $r_comp, $target); |
144 | } |
145 | return $r_class; |
146 | } |
147 | |
148 | 1; |
149 | |
150 | __END__; |
151 | |
152 | =head1 SEE ALSO |
153 | |
154 | L<DBIx::Class>, L<DBIx::Class::Schema::RestrictWithObject::RestrictComp::Schema>, |
155 | L<DBIx::Class::Schema::RestrictWithObject::RestrictComp::Source>, |
156 | |
157 | =head1 AUTHORS |
158 | |
159 | Matt S Trout (mst) <mst@shadowcatsystems.co.uk> |
160 | |
161 | With contributions from |
162 | Guillermo Roditi (groditi) <groditi@cpan.org> |
163 | |
164 | =head1 LICENSE |
165 | |
166 | You may distribute this code under the same terms as Perl itself. |
167 | |
168 | =cut |