inc/Module/Install/Metadata.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
-lib/DBIx/Class/Schema/RestrictByUser.pm
-lib/DBIx/Class/Schema/RestrictByUser/RestrictComp/Schema.pm
-lib/DBIx/Class/Schema/RestrictByUser/RestrictComp/Source.pm
+lib/DBIx/Class/Schema/RestrictWithObject.pm
+lib/DBIx/Class/Schema/RestrictWithObject/RestrictComp/Schema.pm
+lib/DBIx/Class/Schema/RestrictWithObject/RestrictComp/Source.pm
Makefile.PL
MANIFEST This list of files
META.yml
README
t/02pod.t
t/03podcoverage.t.disabled
-t/04basic.t
t/05restrict.t
t/lib/RestrictByUserTest.pm
t/lib/RestrictByUserTest/Schema.pm
+++ /dev/null
-package DBIx::Class::Schema::RestrictByUser;
-
-our $VERSION = '0.0001_01';
-
-use DBIx::Class::Schema::RestrictByUser::RestrictComp::Schema;
-use DBIx::Class::Schema::RestrictByUser::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::RestrictByUser - Automatically restrict resultsets by user
-
-=head1 SYNOPSYS
-
-In your L<DBIx::Class::Schema> class:
-
- __PACKAGE__->load_components(qw/Schema::RestrictByUser/);
-
-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_by_user( $user, $optional_prefix);
-
-=cut
-
-=head1 DESCRIPTION
-
-This L<DBIx::Class::Schema> component can be used to restrict all resultsets through
-an appropriately-named method in a user's result_class. This can be done to
-automatically prevent data from being accessed by a user, effectively enforcing
-security by limiting any access to the data store.
-
-=head1 PUBLIC METHODS
-
-=head2 restrict_by_user $user_obj, $optional_prefix
-
-Will restrict resultsets according to the methods available in $user_obj and
-return a restricted copy of itself. ResultSets will be restricted if methods
-in the form of C<restrict_${ResultSet_Name}_resultset> are found in $user_obj.
-If the optional prefix is included it will attempt to use
-C<restrict_${prefix}_${ResultSet_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_by_user {
- my ($self, $user, $prefix) = @_;
- my $copy = $self->clone;
- $copy->make_restricted;
- $copy->user($user);
- $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, '__RestrictedByUser');
- unless (eval { $r_class->can('can') }) {
- my $r_comp = join(
- '::', 'DBIx::Class::Schema::RestrictByUser::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::RestrictByUser::RestrictComp::Schema>,
-L<DBIx::Class::Schema::RestrictByUser::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
--- /dev/null
+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
-package DBIx::Class::Schema::RestrictByUser::RestrictComp::Schema;
+package DBIx::Class::Schema::RestrictWithObject::RestrictComp::Schema;
use strict;
use warnings;
=head1 DESCRIPTION
-For general usage please see L<DBIx::Class::Schema::RestrictByUser>, the information
+For general usage please see L<DBIx::Class::Schema::RestrictWithObject>, the information
provided here is not meant for general use and is subject to change. In the interest
of transparency the functionality presented is documented, but all methods should be
considered private and, as such, subject to incompatible changes and removal.
-=head1 ADDITIONAL ACCESSORS
+=head1 ADDITIONAL ACCESSORS
-=head2 user
+=head2 restricting_object
-Store the user object used to restict resultsets
+Store the object used to restict resultsets
=head2 restricted_prefix
-Store the prefix, if any, to use when looking for the appropriate resstrict
-methods in the user object
+Store the prefix, if any, to use when looking for the appropriate restrict
+methods in the C<restricting_object>
=cut
-__PACKAGE__->mk_group_accessors('simple' => 'user');
+__PACKAGE__->mk_group_accessors('simple' => 'restricting_object');
__PACKAGE__->mk_group_accessors('simple' => 'restricted_prefix');
1;
=head1 SEE ALSO
-L<DBIx::Class::Schema::RestrictByUser>,
+L<DBIx::Class::Schema::RestrictWithObject>,
=cut
-package DBIx::Class::Schema::RestrictByUser::RestrictComp::Source;
+package DBIx::Class::Schema::RestrictWithObject::RestrictComp::Source;
use strict;
use warnings;
=head1 DESCRIPTION
-For general usage please see L<DBIx::Class::Schema::RestrictByUser>, the information
+For general usage please see L<DBIx::Class::Schema::RestrictWithObject>, the information
provided here is not meant for general use and is subject to change. In the interest
of transparency the functionality presented is documented, but all methods should be
considered private and, as such, subject to incompatible changes and removal.
Intercept call to C<resultset> and return restricted resultset
=cut
-
+
sub resultset {
my $self = shift;
my $rs = $self->next::method(@_);
- if (my $user = $self->schema->user) {
+ 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";
-
+
+ #if a prefix was set, try that first
if($pre){
my $meth_pre = "restrict_${pre}_${s}_resultset";
- return $user->$meth_pre($rs) if $user->can($meth_pre);
- }
- $rs = $user->$meth($rs) if $user->can($meth);
+ return $obj->$meth_pre($rs) if $obj->can($meth_pre);
+ }
+ $rs = $obj->$meth($rs) if $obj->can($meth);
}
return $rs;
}
=head1 SEE ALSO
-L<DBIx::Class::Schema::RestrictByUser>,
+L<DBIx::Class::Schema::RestrictWithObject>,
=cut
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 1 );
-}
-
-use lib qw(t/lib);
-
-use_ok('DBIx::Class::Schema::RestrictByUser');
use Scalar::Util;
-plan (tests => 17);
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? ( skip_all => 'needs DBD::SQLite for testing' )
+ : ( tests => 19 );
+}
+
use lib qw(t/lib);
-use RestrictByUserTest;
+use_ok('DBIx::Class::Schema::RestrictWithObject');
+use_ok('RestrictByUserTest');
my $schema = RestrictByUserTest->init_schema;
ok($schema, "Connected successfully");
ok($user2->notes->create({name => 'note 2-3'}), "Successfully created 2-3 note");
ok($user2->notes->create({name => 'note 2-4'}), "Successfully created 2-4 note");
-my $u1_schema = $schema->restrict_by_user($user1);
-my $u2_schema = $schema->restrict_by_user($user2, "MY");
-my $u3_schema = $schema->restrict_by_user($user2, "BUNK");
+my $u1_schema = $schema->restrict_with_object($user1);
+my $u2_schema = $schema->restrict_with_object($user2, "MY");
+my $u3_schema = $schema->restrict_with_object($user2, "BUNK");
-is($u1_schema->user->id, $user1->id, "Correct restriction for user 1");
-is($u2_schema->user->id, $user2->id, "Correct restriction for user 2");
+is($u1_schema->restricting_object->id, $user1->id, "Correct restriction for user 1");
+is($u2_schema->restricting_object->id, $user2->id, "Correct restriction for user 2");
is($u2_schema->restricted_prefix, "MY", "Correct prefix for user 2");
-ok(Scalar::Util::refaddr($u1_schema) ne Scalar::Util::refaddr($u2_schema),
+ok(Scalar::Util::refaddr($u1_schema) ne Scalar::Util::refaddr($u2_schema),
"Successful clones");
is($schema->resultset('Notes')->count, 6, 'Correct un resticted count');
is($u1_schema->resultset('Notes')->count, 2, 'Correct resticted count');
is($u2_schema->resultset('Notes')->count, 4, 'Correct resticted count using prefix');
-is($u2_schema->resultset('Notes')->count, 4,
+is($u2_schema->resultset('Notes')->count, 4,
'Correct resticted count using prefix and fallback');
is($u2_schema->resultset('Users')->count, 2, 'Unrestricted resultsets work');
-package # hide from PAUSE
+package # hide from PAUSE
RestrictByUserTest;
use strict;
use RestrictByUserTest::Schema;
sub init_schema {
- my $self = shift;
- my $db_file = "t/var/RestrictByUserTest.db";
+ my $self = shift;
+ my $db_file = "t/var/RestrictByUserTest.db";
- unlink($db_file) if -e $db_file;
- unlink($db_file . "-journal") if -e $db_file . "-journal";
- mkdir("t/var") unless -d "t/var";
+ unlink($db_file) if -e $db_file;
+ unlink($db_file . "-journal") if -e $db_file . "-journal";
+ mkdir("t/var") unless -d "t/var";
- my $schema = RestrictByUserTest::Schema->connect( "dbi:SQLite:${db_file}");
- $schema->deploy();
- return $schema;
+ my $schema = RestrictByUserTest::Schema->connect( "dbi:SQLite:${db_file}");
+ $schema->deploy();
+ return $schema;
}
1;
-package # hide from PAUSE
+package # hide from PAUSE
RestrictByUserTest::Schema;
use base qw/DBIx::Class::Schema/;
__PACKAGE__->load_classes(qw/ Users Notes /);
-__PACKAGE__->load_components('Schema::RestrictByUser');
+__PACKAGE__->load_components('Schema::RestrictWithObject');
1;
-package # hide from PAUSE
+package # hide from PAUSE
RestrictByUserTest::Schema::Notes;
use base 'DBIx::Class';
__PACKAGE__->add_columns(
'id' => {
data_type => 'int',
- is_nullable => 0,
+ is_nullable => 0,
is_auto_increment => 1,
},
'user_id' => {
-package # hide from PAUSE
+package # hide from PAUSE
RestrictByUserTest::Schema::Users;
use base 'DBIx::Class';
__PACKAGE__->add_columns(
'id' => {
data_type => 'int',
- is_nullable => 0,
+ is_nullable => 0,
is_auto_increment => 1,
},
'name' => {
sub restrict_Notes_resultset {
my $self = shift; #the User object
my $unrestricted_rs = shift;
-
+
return $self->related_resultset('notes');
}
sub restrict_MY_Notes_resultset {
my $self = shift; #the User object
my $unrestricted_rs = shift;
-
+
return $unrestricted_rs->search_rs( { user_id => $self->id } );
}
projects / dbsrgits/DBIx-Class-Schema-RestrictWithObject.git / commitdiff