X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FRestrictWithObject.pm;fp=lib%2FDBIx%2FClass%2FSchema%2FRestrictWithObject.pm;h=0143c9c02e5780cac2f618f8203f51279b909393;hb=d87edac900b7430e435d828aa8deab5a2dd8495e;hp=0000000000000000000000000000000000000000;hpb=772c89c170f979890e5f8d7e7522d50e8dc0323e;p=dbsrgits%2FDBIx-Class-Schema-RestrictWithObject.git

diff --git a/lib/DBIx/Class/Schema/RestrictWithObject.pm b/lib/DBIx/Class/Schema/RestrictWithObject.pm
new file mode 100644
index 0000000..0143c9c
--- /dev/null
+++ b/lib/DBIx/Class/Schema/RestrictWithObject.pm
@@ -0,0 +1,168 @@
+package DBIx::Class::Schema::RestrictWithObject;
+
+our $VERSION = '0.0001_01';
+
+use DBIx::Class::Schema::RestrictWithObject::RestrictComp::Schema;
+use DBIx::Class::Schema::RestrictWithObject::RestrictComp::Source;
+
+# (c) Matt S Trout 2006, all rights reserved
+# this is free software under the same license as perl itself
+
+=head1 NAME
+
+DBIx::Class::Schema::RestrictWithObject - Automatically restrict resultsets
+
+=head1 SYNOPSYS
+
+In your L<DBIx::Class::Schema> class:
+
+    __PACKAGE__->load_components(qw/Schema::RestrictWithObject/);
+
+In the L<DBIx::Class> table class for your users:
+
+    #let's pretend a user has_many notes, which are in ResultSet 'Notes'
+    sub restrict_Notes_resultset {
+      my $self = shift; #the User object
+      my $unrestricted_rs = shift;
+
+      #restrict the notes viewable to only those that belong to this user
+      #this will, in effect make the following 2 equivalent
+      # $user->notes $schema->resultset('Notes')
+      return $self->related_resultset('notes');
+    }
+
+     #it could also be written like this
+    sub restrict_Notes_resultset {
+      my $self = shift; #the User object
+      my $unrestricted_rs = shift;
+      return $unrestricted_rs->search_rs( { user_id => $self->id } );
+    }
+
+Wherever you connect to your database
+
+    my $schema = MyApp::Schema->connect(...);
+    my $user = $schema->resultset('User')->find( { id => $user_id } );
+    $resticted_schema = $schema->restrict_with_object( $user, $optional_prefix);
+
+In this example we used the User object as the restricting object, but please
+note that the restricting object need not be a DBIC class, it can be any kind of
+object that provides the adequate methods.
+
+=cut
+
+=head1 DESCRIPTION
+
+This L<DBIx::Class::Schema> component can be used to restrict all resultsets through
+an appropriately-named method in a user-supplied object. This allows you to
+automatically prevent data from being accessed, or automatically predefine options
+and search clauses on a schema-wide basis. When used to limit data sets, it allows
+simplified security by limiting any access to the data at the schema layer. Please
+note however that this is not a silver bullet and without careful programming it is
+still possible to expose unwanted data, so this should not be regarded as a
+replacement for application level security.
+
+=head1 PUBLIC METHODS
+
+=head2 restrict_with_object $restricting_obj, $optional_prefix
+
+Will restrict resultsets according to the methods available in $restricting_obj and
+return a restricted copy of itself. ResultSets will be restricted if methods
+in the form  of C<restrict_${ResultSource_Name}_resultset> are found in
+$restricting_obj. If the optional prefix is included it will attempt to use
+C<restrict_${prefix}_${ResultSource_Name}_resultset>, if that does not exist, it
+will try again without the prefix, and if that's not available the resultset
+will not be restricted.
+
+=cut
+
+sub restrict_with_object {
+  my ($self, $obj, $prefix) = @_;
+  my $copy = $self->clone;
+  $copy->make_restricted;
+  $copy->restricting_object($obj);
+  $copy->restricted_prefix($prefix) if $prefix;
+  return $copy;
+}
+
+=head1 PRIVATE METHODS
+
+=head2 make_restricted
+
+Restrict the Schema class and ResultSources associated with this Schema
+
+=cut
+
+sub make_restricted {
+  my ($self) = @_;
+  my $class = ref($self);
+  my $r_class = $self->_get_restricted_schema_class($class);
+  bless($self, $r_class);
+  foreach my $moniker ($self->sources) {
+    my $source = $self->source($moniker);
+    my $class = ref($source);
+    my $r_class = $self->_get_restricted_source_class($class);
+    bless($source, $r_class);
+  }
+}
+
+=head2 _get_restricted_schema_class $target_schema
+
+Return the class name for the restricted schema class;
+
+=cut
+
+sub _get_restricted_schema_class {
+  my ($self, $target) = @_;
+  return $self->_get_restricted_class(Schema => $target);
+}
+
+=head2 _get_restricted_source_class $target_source
+
+Return the class name for the restricted ResultSource class;
+
+=cut
+
+sub _get_restricted_source_class {
+  my ($self, $target) = @_;
+  return $self->_get_restricted_class(Source => $target);
+}
+
+=head2 _get_restrictedclass $type, $target
+
+Return an appropriate class name for a restricted class of type $type.
+
+=cut
+
+sub _get_restricted_class {
+  my ($self, $type, $target) = @_;
+  my $r_class = join('::', $target, '__RestrictedWithObject');
+  unless (eval { $r_class->can('can') }) {
+    my $r_comp = join(
+      '::', 'DBIx::Class::Schema::RestrictWithObject::RestrictComp', $type
+    );
+    $self->inject_base($r_class, $r_comp, $target);
+  }
+  return $r_class;
+}
+
+1;
+
+__END__;
+
+=head1 SEE ALSO
+
+L<DBIx::Class>, L<DBIx::Class::Schema::RestrictWithObject::RestrictComp::Schema>,
+L<DBIx::Class::Schema::RestrictWithObject::RestrictComp::Source>,
+
+=head1 AUTHORS
+
+Matt S Trout (mst) <mst@shadowcatsystems.co.uk>
+
+With contributions from
+Guillermo Roditi (groditi) <groditi@cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut