[Jifty-commit] r3558 - in apps/CASPlus/trunk: lib lib/CASPlus lib/CASPlus/Model t

jifty-commit at lists.jifty.org jifty-commit at lists.jifty.org
Tue Jun 26 09:15:24 EDT 2007


Author: sterling
Date: Tue Jun 26 09:15:24 2007
New Revision: 3558

Added:
   apps/CASPlus/trunk/lib/CASPlus/Model/RoleMemberPathCache.pm
   apps/CASPlus/trunk/lib/CASPlus/ProfileMixin.pm
   apps/CASPlus/trunk/lib/CASPlus/ProfileRelationshipBase.pm
   apps/CASPlus/trunk/lib/CASPlus/ProfileRelationshipMixin.pm
   apps/CASPlus/trunk/t/benchmark_roles.pl
Modified:
   apps/CASPlus/trunk/   (props changed)
   apps/CASPlus/trunk/lib/CASPlus.pm
   apps/CASPlus/trunk/lib/CASPlus/Model/Profile.pm
   apps/CASPlus/trunk/lib/CASPlus/Model/ProfileRelationship.pm
   apps/CASPlus/trunk/lib/CASPlus/Model/RoleMember.pm
   apps/CASPlus/trunk/lib/CASPlus/Model/User.pm
   apps/CASPlus/trunk/lib/CASPlus/ProfileBase.pm
   apps/CASPlus/trunk/t/40-is_mine.t

Log:
 r7776 at dynpc145:  andrew | 2007-06-23 20:34:18 -0500
  * Added a mixin class to add triggers to Profile object classes.
  * Improved load_by_profile_object() to lookup by class name rather than just
    object.
  * Added the child_relationships() and parent_relationships() methods to list
    the various relationships of a profile.
  * Added a special profile relationship base and mixin class to profile
    relationship link tables.
  * Updated the before_create() and added an after_create() trigger to handle
    adding role caching triggesr to profile relationship link tables. (Role
    caching triggers for relationships not requiring a link table is not yet
    implemented.
  * Added load_by_profile_relationship_object() to perform the same action for
    relationship link tables as load_by_profile_object() does for profile object
    tables.
  * Added the cache_paths column to the RoleMember model.
  * Added path cache calculations to recalculate_path_cache() method.
  * Added profile_definition() as a shortcut for load_by_profile_object().
  * Added unique_id() to return a unique numeric ID for profile objects.
  * Adding an empty (er, commented out) ProfileMixin class.
  * Added get_profile_object_by_unique_id() to load a profile by it's unique ID.
  * Updated the is_mine.t test to test relationships, which breaks right now.
  * Adding a temporary informal test benchmark_roles.pl, which I'm using to
    prototype the role caching work and benchmark the results.
 


Modified: apps/CASPlus/trunk/lib/CASPlus.pm
==============================================================================
--- apps/CASPlus/trunk/lib/CASPlus.pm	(original)
+++ apps/CASPlus/trunk/lib/CASPlus.pm	Tue Jun 26 09:15:24 2007
@@ -126,6 +126,34 @@
     }
 }
 
+=head2 get_profile_object_by_unique_id
+
+  my $profile_obj = CASPlus->get_profile_object_by_unique_id($unique_id);
+
+This method is used to load a profile object by the unique ID returned by the L<CASPlus::ProfileBase/unique_id> method. Returns an object if one is found matching the ID. Return C<undef> otherwise.
+
+=cut
+
+sub get_profile_object_by_unique_id {
+    my ($self, $unique_id) = @_;
+
+    # Load the UniqueProfileIdentifier object for the ID
+    my $unique_profile_link = CASPlus::Model::UniqueProfileIdentifier->new;
+    $unique_profile_link->load($unique_id);
+
+    return unless $unique_profile_link->id;
+
+    # Load the profile, then the profile object class, then the object
+    my $profile = $unique_profile_link->profile;
+    my $profile_obj = $profile->record_class->new;
+    $profile_obj->load($unique_profile_link->object_id);
+
+    return unless $profile_obj->id;
+
+    # Return the object found
+    return $profile_obj;
+}
+
 =head1 IMPLEMENTED FEATURES
 
 This is a list of features that CAS+ supports. CAS+ provides the same functionality as the original CAS implementation with these additional features.

Modified: apps/CASPlus/trunk/lib/CASPlus/Model/Profile.pm
==============================================================================
--- apps/CASPlus/trunk/lib/CASPlus/Model/Profile.pm	(original)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/Profile.pm	Tue Jun 26 09:15:24 2007
@@ -3,10 +3,9 @@
 
 package CASPlus::Model::Profile;
 use Jifty::DBI::Schema;
-
+ 
 use constant CLASS_UUID => '97DF6780-CCB0-11DB-963B-044A29635B38';
 
-use CASPlus::ProfileBase;
 use Class::ReturnValue;
 
 =head1 NAME
@@ -118,6 +117,7 @@
         name          => $name,
         description   => $args->{description},
         super_classes => 'CASPlus::ProfileBase',
+        mixin_classes => 'CASPlus::ProfileMixin',
     );
 
     # No create unless there's a model class
@@ -155,6 +155,7 @@
 #            mandatory       => 1,
             distinct_value  => 1,
             refers_to_class => 'CASPlus::Model::Role',
+            storage_type    => 'int',
         );
 
         # Fail unless the column was created
@@ -178,7 +179,7 @@
     my $object = shift;
     my $ret    = Class::ReturnValue->new;
 
-    my $qualified_class = ref $object;
+    my $qualified_class = ref $object || $object;
     my ($class_name) = $qualified_class =~ /(\w+)$/;
 
     my $model_class = Jifty::Model::ModelClass->new;
@@ -274,6 +275,46 @@
     return $self->model_class->qualified_class;
 }
 
+=head2 parent_relationships
+
+  my $parents = $profile->parent_relationships;
+
+Lists the relationship objects (via C<CASPlus::Model::ProfileRelationshipCollection>) that this profile belongs to as a child.
+
+=cut
+
+sub parent_relationships {
+    my $self = shift;
+
+    my $relationships = CASPlus::Model::ProfileRelationshipCollection->new;
+    $relationships->limit(
+        column => 'relation_child',
+        value  => $self,
+    );
+
+    return $relationships;
+}
+
+=head2 child_relationships
+
+  my $children = $profile->child_relationships;
+
+Returns a C<CASPlus::Model::ProfileRelationshipCollection> containing the relationships that this profile belongs to as a parent.
+
+=cut
+
+sub child_relationships {
+    my $self = shift;
+
+    my $relationships = CASPlus::Model::ProfileRelationshipCollection->new;
+    $relationships->limit(
+        column => 'relation_parent',
+        value  => $self,
+    );
+
+    return $relationships;
+}
+
 =head1 AUTHOR
 
 Andrew Sterling Hanenkamp C<<hanenkamp at cpan.org>>

Modified: apps/CASPlus/trunk/lib/CASPlus/Model/ProfileRelationship.pm
==============================================================================
--- apps/CASPlus/trunk/lib/CASPlus/Model/ProfileRelationship.pm	(original)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/ProfileRelationship.pm	Tue Jun 26 09:15:24 2007
@@ -7,6 +7,7 @@
 use constant CLASS_UUID => 'F88DC88A-FFBC-11DB-A0E9-5947F1458521';
 
 use Carp;
+use Class::ReturnValue;
 use Scalar::Util qw( looks_like_number );
 
 =head1 NAME
@@ -238,7 +239,8 @@
         my $link_table = Jifty::Model::ModelClass->new;
         $link_table->create(
             name          => $name,
-            super_classes => 'CASPlus::ProfileBase',
+            super_classes => 'CASPlus::ProfileRelationshipBase',
+            mixin_classes => 'CASPlus::ProfileRelationshipMixin',
         );
 
         # Create the link table parent column
@@ -365,16 +367,79 @@
         delete $args->{link_table_child};
     }
 
+    # Save the arguments for use by after_create
+    $self->{__relationship_create} = $args;
+
+    # Always succeed!
     return 1;
 }
 
 =head2 after_create
 
-Associate a C<before_set_column_name> trigger with the new columns to handle role caching.
+Adds triggers responsible for handling role caching the new columns and link tables associated with this relationship.
+
+=cut
+
+sub after_create {
+    my ($self, $result) = @_;
+
+    # Fetch the saved arguments since the after_create trigger doesn't give us
+    # any way of fetching them directly
+    my $args = delete $self->{__relationship_create};
+
+    # Do nothing unless both successful and the relationship transmits roles
+    if ($result and $args->{roles_propagate_to_children}) {
+        
+        # Handle many-to-many relationships
+        if ($args->{many_parents} and $args->{many_children}) {
+
+            # This has to be called specially because register_triggers gets
+            # called too early when the model class is initially created.
+            CASPlus::ProfileRelationshipMixin::register_triggers(
+                $args->{link_table}->qualified_class
+            );
+        }
+
+        # Handle one-to-one and one-to-many relationships
+        else {
+            # TODO XXX FIXME Add more triggers here...
+        }
+    }
+
+    # Return success!
+    return 1;
+}
+
+=head2 load_by_profile_relationship_object
+
+  my $profile_relationship = CASPlus::Model::ProfileRelationship->new;
+  $profile_relationship->load_by_profile_relationship_object($relation_obj);
+
+Given a link table instance, it returns the profile relationship that built that link table.
 
 =cut
 
-# XXX TODO FIXME Add after_create()
+sub load_by_profile_relationship_object {
+    my ($self, $object) = @_;
+
+    my $qualified_class = ref $object || $object;
+    my ($class_name) = $qualified_class =~ /(\w+)$/;
+
+    my $model_class = Jifty::Model::ModelClass->new;
+    $model_class->load_by_cols( name => $class_name );
+
+    if ($model_class->id) {
+        return $self->load_by_cols( link_table => $model_class );
+    }
+
+    else {
+        my $ret = Class::ReturnValue->new;
+        $ret->as_error(
+            message => "$qualified_class object does not have a model class (searched for $class_name).",
+        );
+        return ($ret->return_value);
+    }
+}
 
 =head2 record_class
 

Modified: apps/CASPlus/trunk/lib/CASPlus/Model/RoleMember.pm
==============================================================================
--- apps/CASPlus/trunk/lib/CASPlus/Model/RoleMember.pm	(original)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/RoleMember.pm	Tue Jun 26 09:15:24 2007
@@ -36,6 +36,10 @@
     column the_role =>
         refers_to CASPlus::Model::Role,
         is mandatory;
+
+    column cache_paths =>
+        refers_to CASPlus::Model::RoleMemberPathCacheCollection 
+            by 'role_member';
 };
 
 =head1 METHODS

Added: apps/CASPlus/trunk/lib/CASPlus/Model/RoleMemberPathCache.pm
==============================================================================
--- (empty file)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/RoleMemberPathCache.pm	Tue Jun 26 09:15:24 2007
@@ -0,0 +1,55 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::RoleMemberPathCache;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => '71E7BC9A-1C05-11DC-8285-D0ADE687E20F';
+
+=head1 NAME
+
+CASPlus::Model::RoleMemberPathCache - Optimizing role membership calculation
+
+=head1 DESCRIPTION
+
+This class is used internally to store a "path cache" for every role membership, which is used to help optimize role membership calculation. 
+
+=head2 THE PROBLEM
+
+Before a user performs any operation, CAS+ asks, "Can this user perform this operation?" The answer is gained by determining to which roles a user belongs and then determining if any of those roles grants the privilege requested. 
+
+Role membership is calculated by loading the profile for the user object and then traversing the relationship tree in the direction of parents (only on relationships where C<roles_propagate_to_children> is set). This is an expensive operation. As such, role membership is precalculated and stored with the user object.
+
+The next problem is that even recalculating the role cache is very expensive. This recalculation must be performed any time a relationship is added or removed in the database. Such changes can result in a huge number of recalculations being necessary. Therefore, this model is used to help make recalculation cheaper.
+
+=head2 THE SOLUTION
+
+For each role membership cached with the user object, one or more paths are cached. Each path cache record describes a path from user to role that grants that role. Whenever adding a relationship, a new path is added to the cache of each affected user object. Whenever removing a relationship, the matching paths are removed from each affected user object.
+
+The advantage is that rather than having to do an exhaustive search for every user on every relationship removal, the system can just find the matching paths in the path cache and delete them. Any role memberships in the role cache that have no paths associated with them may then be deleted.
+
+=cut
+
+use CASPlus::Record schema {
+    column role_member =>
+        refers_to CASPlus::Model::RoleMember,
+        is immutable;
+
+    column cache_path =>
+        type is 'text',
+        is mandatory,
+        is immutable;
+};
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp C<< <andrew.hanenkamp at boomer.com> >>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified and distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+

Modified: apps/CASPlus/trunk/lib/CASPlus/Model/User.pm
==============================================================================
--- apps/CASPlus/trunk/lib/CASPlus/Model/User.pm	(original)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/User.pm	Tue Jun 26 09:15:24 2007
@@ -245,33 +245,29 @@
     my $self_obj     = $self->profile;
     my $self_profile = $self_obj->profile_definition;
 
-    die "Object/Profile mismatch." unless $self_obj->isa($self_profile->record_class);
-
     # Queue used for breadth-first search
     my @open_list = ([ $self_obj, $self_profile, $self_obj->unique_id ]);
 
     # The roles that have been discovered
-    my %roles;
+    my %object_paths;
 
     # Breadth-first search of parents
     PARENT: while (my $parent = shift @open_list) {
         my ($parent_obj, $parent_profile, $parent_path) = @$parent;
+        my $unique_id = $parent_obj->unique_id;
         
-        # If it's a role profile, drop the role in place
-        if ($parent_profile->profile_type eq 'role') {
-            my $parent_role = $parent_obj->role_object;
-
-            # Don't continue if this role has already been added, the children
-            # can be ignored as well on the assumption that the role's children
-            # was already listed in @open_list
-            if ($roles{ $parent_role->id }) {
-                push @{ $roles{ $parent_role->id } }, $parent_path;
-                next PARENT;
-            }
-
-            $roles{ $parent_role->id } = [ $parent_role, $parent_path ];
+        # Don't continue if this object has already been added, the children
+        # can be ignored as well on the assumption that the object's children
+        # were already listed in @open_list
+        if ($object_paths{ $unique_id }) {
+            push @{ $object_paths{ $unique_id } }, $parent_path;
+            next PARENT;
         }
 
+        # Create a new object path list
+        $object_paths{ $unique_id } 
+            = [ $parent_obj, $parent_profile, $parent_path ];
+
         # Find all the parents of the current object that might also contribute
         # roles to the user
         my $parent_relationships = $parent_profile->parent_relationships;
@@ -336,12 +332,35 @@
         }
     }
 
+    # Find the list of orphaned cache_paths that have this user at
+    # the root, we need to delete all of these before continuing. The list will
+    # be completely rebuilt.
+    my $cache_paths = CASPlus::Model::RoleMemberPathCacheCollection->new;
+    $cache_paths->limit(
+        column   => 'role_member',
+        operator => 'IS',
+        value    => 'NULL',
+
+    );
+    $cache_paths->limit(
+        column   => 'cache_path',
+        operator => 'STARTSWITH',
+        value    => ':'.$self_obj->unique_id.':',
+    );
+
+    # Delete all the orphaned cache paths belonging to this user
+    while (my $cache_path = $cache_paths->next) {
+        $cache_path->delete;
+    }
+
     # Delete any removed roles
     my $member_roles = $self->member_roles;
     while (my $member_role = $member_roles->next) {
 
+        my $role_profile = $member_role->the_role->profile;
+
         # Only delete the removed roles
-        unless ($roles{ $member_role->id }) {
+        unless ($object_paths{ $role_profile->unique_id }) {
             my $cache_paths = $member_role->cache_paths;
             while (my $path_cache = $cache_paths->next) {
                 $path_cache->delete;
@@ -352,36 +371,55 @@
 
     # Update/add existing/new roles
     my $role_member = CASPlus::Model::RoleMember->new;
-    for my $role_info (values %roles) {
-        my $role        = shift @$role_info;
-        my %cache_paths = map { (":$_:" => 1) } @$role_info;
-
-        # Try to load it first
-        $role_member->load_by_cols( the_role => $role );
-
-        # If not found, create it
-        unless ($role_member->id) {
-            $role_member->create(
-                the_user => $self,
-                the_role => $role,
-            );
-        }
+    for my $object_info (values %object_paths) {
+        my $object      = shift @$object_info;
+        my $obj_profile = shift @$object_info;
+        my %cache_paths = map { (":$_:" => 1) } @$object_info;
+
+        # Handle roles specially by adding them to the cache
+        if ($obj_profile->profile_type eq 'role') {
+            my $role = $object->role_object;
+
+            # Try to load it first
+            $role_member->load_by_cols( the_role => $role );
+
+            # If not found, create it
+            unless ($role_member->id) {
+                $role_member->create(
+                    the_user => $self,
+                    the_role => $role,
+                );
+            }
 
-        # Delete removed cache paths
-        my $cache_paths = $role_member->cache_paths;
-        while (my $path_cache = $cache_paths->next) {
-            # Keep it if it exists, but remove it from the add list
-            $path_cache->delete 
-                unless delete $cache_paths{ $path_cache->cache_path };
+            # Delete removed cache paths
+            my $cache_paths = $role_member->cache_paths;
+            while (my $path_cache = $cache_paths->next) {
+                # Keep it if it exists, but remove it from the add list
+                $path_cache->delete 
+                    unless delete $cache_paths{ $path_cache->cache_path };
+            }
+
+            # All that should be left in %cache_paths are those to add, add'em
+            my $path_cache = CASPlus::Model::RoleMemberPathCache->new;
+            for my $cache_path (values %cache_paths) {
+                $path_cache->create(
+                    role_member => $role_member,
+                    cache_path  => $cache_path,
+                );
+            }
         }
 
-        # All that should be left in %cache_paths are those to add, add'em
-        my $path_cache = CASPlus::Model::RoleMemberPathCache->new;
-        for my $cache_path (values %cache_paths) {
-            $path_cache->create(
-                role_member => $role_member,
-                cache_path  => $cache_path,
-            );
+        # Not a role, but we remember role propagating paths in a way that can
+        # speed up adding roles in the future
+        else {
+
+            # Add all the ophaned cache paths from user to object back in
+            my $path_cache = CASPlus::Model::RoleMemberPathCache->new;
+            for my $cache_path (values %cache_paths) {
+                $path_cache->create(
+                    cache_path  => $cache_path,
+                );
+            }
         }
     }
 }

Modified: apps/CASPlus/trunk/lib/CASPlus/ProfileBase.pm
==============================================================================
--- apps/CASPlus/trunk/lib/CASPlus/ProfileBase.pm	(original)
+++ apps/CASPlus/trunk/lib/CASPlus/ProfileBase.pm	Tue Jun 26 09:15:24 2007
@@ -4,6 +4,7 @@
 package CASPlus::ProfileBase;
 use base qw/ CASPlus::Record /;
 
+use Jifty::Util;
 use List::MoreUtils qw/ any /;
 
 =head1 NAME
@@ -20,10 +21,50 @@
 
   my $mine = $object->is_mine;
 
-Returns true if the object is related to the current user. As of this writing, this only includes objects directly attached to users.
+Returns true if the object is "owned" by the current owner.
+
+As of this writing, an object is owned by current user if any of the following are true:
+
+=over
+
+=item *
+
+The C<$object> is the profile for the current user.
+
+=item *
+
+The C<$object> is a child or descendant of the profile for the current user, as defined by the relationships (L<CASPlus::Model::ProfileRelationship>) the current user may traverse.
+
+=back
 
 =cut
 
+# XXX TODO FIXME Get _is_a_descendant working
+sub _is_a_descendant {
+#    my $self        = shift;
+#    my $profile_obj = shift;
+#    my $profile     = shift;
+#
+#    # Find all the relationships toward children of this object
+#    my $relationships = CASPlus::Model::ProfileRelationshipCollection->new;
+#    $relationships->limit(
+#        column => 'relation_parent',
+#        value  => $profile,
+#    );
+#
+#    # For each, check to see if the object is a child or has a child
+#    while (my $relationship = $relationships->next) {
+#        if ($relationship->many_children) {
+#            my $method   = $relationship->child_column->name;
+#            my $children = $profile_object->$method;
+#
+#            while (my $child = $children->next) {
+#            }
+#        }
+#    }
+    return 0;
+}
+
 sub is_mine {
     my $self = shift;
     my $current_user = $self->current_user;
@@ -43,9 +84,10 @@
                 && $self->user_object->id == $current_user->id;
         }
 
-        # Otherwise, I can't determine the relationship at this time
+        # Otherwise, it might be something that's a child of my profile.
+        # Descend all relationships to see if it is.
         else {
-            return 0;
+            return $self->_is_a_descendant($current_user->profile, $profile);
         }
     }
 
@@ -77,6 +119,49 @@
     return $self->SUPER::current_user_can($right, %args);
 }
 
+=head2 profile_definition
+
+  my $profile = $profile_obj->profile_definition;
+
+Returns the L<CASPlus::Model::Profile> object that defines the structure for this profile object.
+
+=cut
+
+sub profile_definition {
+    my $self = shift;
+
+    my $profile = CASPlus::Model::Profile->new;
+    $profile->load_by_profile_object($self);
+
+    die "Object/Profile mismatch." unless $self->isa($profile->record_class);
+
+    return $profile;
+}
+
+=head2 unique_id
+
+  my $unique_id = $profile_obj->unique_id;
+
+Every profile object may be assigned a unique ID. This initializes that unique ID and returns it. This will always return the same value for a given profile object.
+
+You can then use this unique ID to load any profile object later:
+
+  my $profile_obj = CASPlus->get_profile_object_by_unique_id($unique_id);
+
+=cut
+
+sub unique_id {
+    my $self = shift;
+
+    my $unique_profile_link = CASPlus::Model::UniqueProfileIdentifier->new;
+    $unique_profile_link->load_or_create(
+        profile   => $self->profile_definition,
+        object_id => $self->id,
+    );
+
+    return $unique_profile_link->id;
+}
+
 =head1 AUTHOR
 
 Andrew Sterling Hanenkamp C<<hanenkamp at cpan.org>>

Added: apps/CASPlus/trunk/lib/CASPlus/ProfileMixin.pm
==============================================================================
--- (empty file)
+++ apps/CASPlus/trunk/lib/CASPlus/ProfileMixin.pm	Tue Jun 26 09:15:24 2007
@@ -0,0 +1,122 @@
+use strict;
+use warnings;
+
+package CASPlus::ProfileMixin;
+use base qw/ Jifty::DBI::Record::Plugin /;
+
+use Jifty::DBI::Schema;
+use CASPlus::Record schema {
+};
+
+=head1 NAME
+
+CASPlus::ProfileMixin - mixin class adding triggers to all profile objects
+
+=head1 DESCRIPTION
+
+Provides some triggers that make profile objects go.
+
+=cut
+
+# =head2 register_triggers
+# 
+# This is run automatically while the profile is being constructed. It adds a C<after_set_column_name> trigger for each relationship the profile belongs to. This trigger is used to recalculate user role caches when a relationship is added or removed.
+# 
+# =cut
+# 
+# sub register_triggers {
+#     my $self = shift;
+# 
+#     my $profile = CASPlus::Model::Profile->new;
+#     $profile->load_by_profile_object($self);
+# 
+#     my $parent_relationships = $profile->parent_relationships;
+#     while (my $relationship = $parent_relationships->next) {
+#         if ($relationship->roles_propagate_to_children 
+#                 and !$relationship->many_children) {
+# 
+#             $self->add_trigger(
+#                 name     => 'after_' . $relationship->child_column->name,
+#                 callback => \&after_set_child_relationship,
+#             );
+#         }
+#     }
+# 
+#     my $child_relationships  = $profile->child_relationships;
+#     while (my $relationship = $child_relationships->next) {
+#         if ($relationship->roles_propagate_to_children
+#                 and !$relationship->many_parents) {
+# 
+#             $self->add_trigger(
+#                 name     => 'after_' . $relationship->parent_column->name,
+#                 callback => \&after_set_parent_relationship,
+#             );
+#         }
+#     }
+# }
+# 
+# =head2 after_set_child_relationship
+# 
+# This is a hook that is called automatically before modifying a column that points to a child in a relationship. This makes sure that the roles of all children, grandchildren, great-grandchildren, etc. are modified to start inheriting from this object and it's predecessors if the relationship is being added or stop if the relationship is being set to C<undef>.
+# 
+# =cut
+# 
+# sub after_set_child_relationship {
+#     my $self = shift;
+#     my $args = shift;
+# 
+#     my $column    = $args->{column};
+#     my $new_value = $args->{value};
+#     my $old_value = $self->$column;
+# 
+#     $new_value = (ref $new_value ? $new_value->id : $new_value) || 0;
+#     $old_value = (ref $old_value ? $old_value->id : $old_value) || 0;
+# 
+#     return unless $new_value != $old_value;
+# 
+#     my $profile = CASPlus::Model::Profile->new;
+#     $profile->load_by_profile_object($self);
+# 
+#     my $relationship = CASPlus::Model::ProfileRelationship->new;
+#     $relationship->load_by_cols(
+#         relation_parent => $profile,
+#         child_column    => $column,
+#     );
+# 
+#     if ($new_value) {
+#         my $new_child = $relationship->relation_child->record_class->new;
+#         $new_child->load($new_value);
+# 
+#         $new_child->_add_roles_to_child_cache($self);
+#     }
+# 
+#     if ($old_value) {
+#         my $old_child = $relationship->relation_child->record_class->new;
+#         $old_child->load($old_value);
+# 
+#         $self->_remove_roles_from_child_cache($self);
+#     }
+# }
+# 
+# =head2 after_set_parent_relationship
+# 
+# This is a hook that is called automatically before modifying a column that points to a parent in a relationship. This makes sure that the roles of this object, it's children, grandchildren, great-grandchildren, etc. are modified to start inheriting from the parent object and it's predecessors if the relationship is being added or stop if the relationship is being set to C<undef>.
+# 
+# =cut
+# 
+# sub after_set_parent_relationship {
+#     my $self = shift;
+#     my $args = shift;
+# 
+#     my $column    = $args->{column};
+#     my $new_value = $args->{value};
+#     my $old_value = $self->$column;
+# 
+#     $new_value = (ref $new_value ? $new_value->id : $new_value) || 0;
+#     $old_value = (ref $old_value ? $old_value->id : $old_value) || 0;
+# 
+#     $self->_replace_roles_in_child_cache($old_value => $new_value)
+#         if $new_value != $old_value;
+# }
+
+1;

Added: apps/CASPlus/trunk/lib/CASPlus/ProfileRelationshipBase.pm
==============================================================================
--- (empty file)
+++ apps/CASPlus/trunk/lib/CASPlus/ProfileRelationshipBase.pm	Tue Jun 26 09:15:24 2007
@@ -0,0 +1,45 @@
+use strict;
+use warnings;
+
+package CASPlus::ProfileRelationshipBase;
+use base qw/ CASPlus::Record /;
+
+=head1 NAME
+
+CASPlus::ProfileRelationshipBase - base class of all relationship link tables
+
+=head1 DESCRIPTION
+
+These link tables have some special functionality. This is very similar to L<CASPlus::ProfileBase>, which is the base class for all profile objects.
+
+=head1 METHODS
+
+=head2 current_user_can
+
+Any user with superuser user or the manage profile objects permission assigned to at least one role may access this object.
+
+Otherwise, a user will only be able to create, read, write, or delete this object if it is granted by a profile permission associated with the user's roles. This association must be with both ends of a link. If the user is able to create
+
+=cut
+
+# XXX FIXME TODO Add triggers for the parent and child columns to handle
+# add/delete of relationships in many-to-many.
+
+=head2 profile_relationship_definition
+
+  my $profile_relationship = $relationship->profile_relationship_definition;
+
+This loads the L<CASPlus::Model::ProfileRelationship> object that was used to build this link table object.
+
+=cut
+
+sub profile_relationship_definition {
+    my $self = shift;
+
+    my $profile_relationship = CASPlus::Model::ProfileRelationship->new;
+    $profile_relationship->load_by_profile_relationship_object($self);
+
+    return $profile_relationship;
+}
+
+1;

Added: apps/CASPlus/trunk/lib/CASPlus/ProfileRelationshipMixin.pm
==============================================================================
--- (empty file)
+++ apps/CASPlus/trunk/lib/CASPlus/ProfileRelationshipMixin.pm	Tue Jun 26 09:15:24 2007
@@ -0,0 +1,276 @@
+use strict;
+use warnings;
+
+package CASPlus::ProfileRelationshipMixin;
+use base qw/ Jifty::DBI::Record::Plugin /;
+
+use Jifty::DBI::Schema;
+use CASPlus::Record schema {
+};
+
+=head1 NAME
+
+CASPlus::ProfileRelationshipMixin - mixin class adding triggers to relationships
+
+=head1 DESCRIPTION
+
+Provides triggers to link tables. These are used to keep the user-role cache up to date.
+
+=head1 METHODS
+
+=head2 register_triggers
+
+This registers an C<after_create>, a C<before_create>, and an C<after_delete> trigger, which recalculates the user-role caches for every affected user as appropriate. This does not implement C<after_set_parent> or C<after_set_child> because link tables are created such that the C<parent> and C<child> columns are immutable.
+
+See the individual trigger methods below for information on how each update the role cache.
+
+=cut
+
+sub register_triggers {
+    my $self = shift;
+
+    # Load the profile relationships
+    my $profile_relationship = $self->profile_relationship_definition;
+
+    # Only do this if relationship is fully created and the relationship
+    # propagates role
+    if ($profile_relationship->id 
+            and $profile_relationship->roles_propagate_to_children) {
+
+        $self->add_trigger(
+            name     => 'before_create',
+            callback => \&before_create_relationship,
+        );
+
+        $self->add_trigger(
+            name     => 'after_create',
+            callback => \&after_create_relationship,
+        );
+
+        $self->add_trigger(
+            name     => 'before_delete',
+            callback => \&before_delete_relationship,
+        );
+
+        $self->add_trigger(
+            name     => 'after_delete',
+            callback => \&after_delete_relationship,
+        );
+    }
+}
+
+=head2 before_create_relationship
+
+Used with L</after_create_relationship> to handle role caching.
+
+=cut
+
+sub before_create_relationship {
+    my ($self, $args) = @_;
+
+    # Save the arguments passed
+    $self->{__create_relationship} = $args;
+
+    # Always succeed!
+    return 1;
+}
+
+=head2 after_create_relationship
+
+This trigger is fired whenever a link table object is created.
+
+=cut
+
+sub after_create_relationship {
+    my ($self, $result) = @_;
+
+    my $args = delete $self->{__create_relationship};
+
+    if ($result) {
+
+        # Get the relationship definition
+        my $relationship = $self->profile_relationship_definition;
+
+        # Base case: Add the initial path of the child is a user
+        if ($relationship->relation_child->profile_type eq 'user') {
+            my $base_role_member = undef;
+            
+            # Create a role membership if this is a user-role relationship
+            if ($relationship->relation_child->profile_type eq 'role') {
+                $base_role_member = CASPlus::Model::RoleMember->new;
+                $base_role_member->create(
+                    the_user => $args->{child}->user_object,
+                    the_role => $args->{parent}->role_object,
+                );
+            }
+
+            # Create abbreviated names for the IDs in the cache path
+            my $cid = $args->{child}->unique_id;
+            my $rid = $relationship->id;
+            my $pid = $args->{parent}->unique_id;
+
+            # Build the cache path
+            my $cache_path = ":$cid:\@$rid:$pid:";
+
+            # Create the cache path record
+            my $path_cache = CASPlus::Model::RoleMemberPathCache->new;
+            $path_cache->create(
+                (defined $base_role_member 
+                    ? (role_member => $base_role_member) 
+                    : ()),
+                cache_path  => $cache_path,
+            );
+        }
+
+        # Find all cache paths ending with the child
+        my $cache_paths = CASPlus::Model::RoleMemberPathCacheCollection->new;
+        $cache_paths->limit(
+            column   => 'cache_path',
+            operator => 'ENDSWITH',
+            value    => ':'.$args->{child}->id.':',
+        );
+
+        # If this adds a role to the affected users, load that role
+        my $role
+            = $relationship->relation_parent->profile_type eq 'role'
+                ? $args->{parent}->role_object 
+                : undef;
+
+        # Add new paths that add the parent to the end of the paths with the
+        # child.
+        my $new_path_cache = CASPlus::Model::RoleMemberPathCache->new;
+        while (my $path_cache = $cache_paths->next) {
+            my $cache_path = $path_cache->cache_path;
+            my $role_member = undef;
+
+            # Has a role, we need to create a role member
+            if ($role) {
+
+                # Figure out which user to add the role to
+                my ($user_unique_id) = $cache_path =~ /^:(\d+):/;
+                my $user_profile_obj 
+                    = CASPlus->get_profile_object_by_unique_id($user_unique_id);
+
+                die "No profile for unique ID #($user_unique_id) taken from cache path ($cache_path)" unless defined $user_profile_obj;
+
+                # Create the role membership
+                $role_member = CASPlus::Model::RoleMember->new;
+                $role_member->create(
+                    the_user => $user_profile_obj->user_object,
+                    the_role => $role,
+                );
+            }
+
+            # Create the appended cache path record
+            my $rel_id = $relationship->id;
+            my $par_id = $args->{parent}->unique_id;
+            $new_path_cache->create(
+                (defined $role_member ? (role_member => $role_member) : ()),
+                cache_path  => $cache_path.'@'.$rel_id.':'.$par_id.':',
+            );
+        }
+    }
+}
+
+=head2 before_delete_relationship
+
+Just in case such information isn't available when the C<after_delete> trigger is called, this trigger runs to remember which relationship is being cleared. The L<after_delete_relationship> uses this stored information to update the role cache for each affected user.
+
+=cut
+
+sub before_delete_relationship {
+    my $self = shift;
+
+    # Remember these values while the object is still valid
+    $self->{__delete_relationship} = [ 
+        $self->child, 
+        $self->profile_relationship_definition, 
+        $self->parent,
+    ];
+
+    # Always succeed!
+    return (1);
+}
+
+=head2 after_delete_relationship
+
+This trigger is fired whenever a link table object is deleted.
+
+When a role propagating relationship is deleted, zero or more users may be losing roles they previously had. This requires removing roles from the affected user's cache.
+
+=cut
+
+sub after_delete_relationship {
+    my ($self, $result) = shift;
+
+    # Only work if the delete was carried out
+    if ($result) {
+
+        # Load the saved information about the relationship
+        my ($child, $relationship, $parent) 
+            = @{ delete $self->{__delete_relationship} };
+
+        # Create abbreviated names for the IDs in the cache path
+        my $cid = $self->child->unique_id;
+        my $rid = $relationship->id;
+        my $pid = $self->parent->unique_id;
+
+        # Build the cache path matcher
+        my $cache_path = ":$cid:\@$rid:$pid:";
+
+        # Load the cache paths that are affected
+        my $cache_paths = CASPlus::Model::RoleMemberPathCacheCollection->new;
+        $cache_paths->limit(
+            column   => 'cache_path',
+            operator => 'MATCHES',
+            value    => $cache_path,
+        );
+
+        # Delete them, these are all removed
+        while (my $path_cache = $cache_paths->next) {
+            $path_cache->delete;
+        }
+
+        # Load the role memberships that now have an empty cache path
+        my $role_members = CASPlus::Model::RoleMemberCollection->new;
+        $cache_paths = $role_members->join(
+            column1 => 'id',
+            table2  => 'CASPlus::Model::RoleMemberPathCache',
+            column2 => 'role_member',
+        );
+        $role_members->group_by({
+            column => 'id',
+        });
+        $cache_paths->limit(
+            'column'   => 'cache_path',
+            'function' => 'COUNT',
+            'value'    => 0,
+        );
+
+        # Delete these role memberships, they no longer hold
+        while (my $role_member = $role_members->next) {
+            $role_member->delete;
+        }
+    }
+
+    # Delete wasn't carried out, but still clear the cached info
+    else {
+        delete $self->{__delete_relationship};
+    }
+}
+
+=head1 SEE ALSO
+
+L<CASPlus::Model::ProfileRelationship>
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp C<< <andrew.hanenkamp at boomer.com> >>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;

Modified: apps/CASPlus/trunk/t/40-is_mine.t
==============================================================================
--- apps/CASPlus/trunk/t/40-is_mine.t	(original)
+++ apps/CASPlus/trunk/t/40-is_mine.t	Tue Jun 26 09:15:24 2007
@@ -2,19 +2,19 @@
 use strict;
 use warnings;
 
-use Jifty::Test tests => 5;
+use Jifty::Test tests => 11;
 
 # Grab a system user
 my $system_user = CASPlus::CurrentUser->superuser;
 ok($system_user, 'Found a system user');
 
 # Create a profile to test with
-my $profile = CASPlus::Model::Profile->new(current_user => $system_user);
-$profile->create(
+my $employee_profile = CASPlus::Model::Profile->new(current_user => $system_user);
+$employee_profile->create(
     name         => 'Employee',
     profile_type => 'user',
 );
-ok($profile->id, 'Created an employee profile');
+ok($employee_profile->id, 'Created an employee profile');
 
 # Create a test user
 my $user = CASPlus::Model::User->new(current_user => $system_user);
@@ -25,7 +25,7 @@
 ok($user->id, 'Created a user');
 
 # Create a test employee
-my $employee = $profile->record_class->new(current_user => $system_user);
+my $employee = $employee_profile->record_class->new(current_user => $system_user);
 $employee->create(
     user_object => $user,
 );
@@ -36,8 +36,48 @@
 Jifty->web->current_user($user);
 
 # Reload the employee 
-$employee = $profile->record_class->new;
+$employee = $employee_profile->record_class->new;
 $employee->load($employee_id);
+ok($employee->id, 'reloaded the test employee');
 
 # It must be mine!
 ok($employee->is_mine, 'employee is_mine');
+
+# Next phase: Create a child object, it also MUST BE MINE!!! Muahahahahaha
+
+# Create a address profile
+my $address_profile = CASPlus::Model::Profile->new(current_user => $system_user);
+$address_profile->create(
+    name         => 'Address',
+    profile_type => 'other',
+);
+ok($address_profile->id, 'Created an address profile');
+
+# Create relationship between employees and addresses
+my $relationship = CASPlus::Model::ProfileRelationship->new(current_user => $system_user);
+$relationship->create(
+    name                   => 'Address',
+    parent_name            => 'Employee',
+    child_name             => 'Address',
+    relation_parent        => $employee_profile,
+    relation_child         => $address_profile,
+    many_parents           => 0,
+    many_children          => 0,
+    dependent_relationship => 1,
+);
+ok($relationship->id, 'Created an employee-address relationship');
+
+# Create an address
+my $address = $address_profile->record_class->new(current_user => $system_user);
+$address->create(
+    employee => $employee,
+);
+my $address_id = $address->id;
+ok($address->id, 'Created an address to test with');
+
+# Reload it, IT MUST BE MINE!
+$address = $address_profile->record_class->new;
+$address->load($address_id);
+ok($address->id, 'Reloaded the test address');
+ok($address->is_mine, 'The address is_mine!');
+

Added: apps/CASPlus/trunk/t/benchmark_roles.pl
==============================================================================
--- (empty file)
+++ apps/CASPlus/trunk/t/benchmark_roles.pl	Tue Jun 26 09:15:24 2007
@@ -0,0 +1,225 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Benchmark::Stopwatch;
+use Jifty::Test;
+use Readonly;
+
+diag('Starting role benchmark.');
+
+Readonly my $USER_COUNT                   => 100;
+Readonly my $ROLE_COUNT                   => 100;
+Readonly my $USER_ROLE_RELATIONSHIP_COUNT => 100;
+Readonly my $ROLE_ROLE_RELATIONSHIP_COUNT => 100;
+Readonly my $USER_PERMS_PER_ROLE          => 3;
+Readonly my $ROLE_PERMS_PER_ROLE          => 3;
+
+my $watch = Benchmark::Stopwatch->new->start;
+
+my $system_user = CASPlus::CurrentUser->superuser;
+
+diag('Setting up basic test structure.');
+
+my $role_profile = CASPlus::Model::Profile->new(current_user => $system_user);
+$role_profile->create(
+    name         => 'generic role',
+    profile_type => 'role',
+);
+
+my $user_profile = CASPlus::Model::Profile->new(current_user => $system_user);
+$user_profile->create(
+    name         => 'generic user',
+    profile_type => 'user',
+);
+
+my $ur_relationship = CASPlus::Model::ProfileRelationship->new(current_user => $system_user);
+$ur_relationship->create(
+    name                        => 'user-role',
+    parent_name                 => 'my_roles',
+    child_name                  => 'my_users',
+    relation_parent             => $role_profile,
+    relation_child              => $user_profile,
+    many_parents                => 1,
+    many_children               => 1,
+    roles_propagate_to_children => 1,
+);
+
+my $rr_relationship = CASPlus::Model::ProfileRelationship->new(current_user => $system_user);
+$rr_relationship->create(
+    name                        => 'role-role',
+    parent_name                 => 'my_parent_roles',
+    child_name                  => 'my_child_roles',
+    relation_parent             => $role_profile,
+    relation_child              => $role_profile,
+    many_parents                => 1,
+    many_children               => 1,
+    roles_propagate_to_children => 1,
+);
+
+my $user = CASPlus::Model::User->new(current_user => $system_user);
+my $role = CASPlus::Model::Role->new(current_user => $system_user);
+my $permission = CASPlus::Model::ProfilePermission->new(current_user => $system_user);
+
+my $user_class = $user_profile->record_class;
+my $role_class = $role_profile->record_class;
+
+my $ur_class = $ur_relationship->record_class;
+my $rr_class = $rr_relationship->record_class;
+
+$watch->lap('general setup');
+
+diag('Creating users.');
+
+# Create a lot of users
+my @users;
+for (1 .. $USER_COUNT) {
+    $user->create(
+        username => "user-$_",
+        password => 'test',
+    );
+    my $user_obj = $user_class->new(current_user => $system_user);
+    $user_obj->create(
+        user_object => $user,
+    );
+
+    push @users, $user_obj;
+}
+
+$watch->lap('created users');
+
+diag('Creating roles.');
+
+# Create a lot of roles
+my @roles;
+for (1 .. $ROLE_COUNT) {
+    $role->create(
+        name => "role-$_",
+    );
+    my $role_obj = $role_class->new(current_user => $system_user);
+    $role_obj->create(
+        role_object => $role,
+    );
+
+    for (1 .. $USER_PERMS_PER_ROLE) {
+        $permission->create(
+            the_role          => $role,
+            profile           => $users[ int(rand($#users)) ],
+            may_create        => int(rand(1)),
+            may_create_my_own => int(rand(1)),
+            may_read          => int(rand(1)),
+            may_read_my_own   => int(rand(1)),
+            may_write         => int(rand(1)),
+            may_write_my_own  => int(rand(1)),
+            may_delete        => int(rand(1)),
+            may_delete_my_own => int(rand(1)),
+        );
+    }
+
+    push @roles, $role_obj;
+}
+
+$watch->lap('created roles');
+
+diag('Creating permissions.');
+
+for my $role (@roles) {
+    for (1 .. $ROLE_PERMS_PER_ROLE) {
+        $permission->create(
+            the_role          => $role,
+            profile           => $roles[ int(rand($#roles)) ],
+            may_create        => int(rand(1)),
+            may_create_my_own => int(rand(1)),
+            may_read          => int(rand(1)),
+            may_read_my_own   => int(rand(1)),
+            may_write         => int(rand(1)),
+            may_write_my_own  => int(rand(1)),
+            may_delete        => int(rand(1)),
+            may_delete_my_own => int(rand(1)),
+        );
+    }
+}
+
+$watch->lap('created permissions');
+
+diag('Creating user-role relationships.');
+
+# Create a lot of user-role relationships
+my @ur_relationships;
+for (1 .. $USER_ROLE_RELATIONSHIP_COUNT) {
+    my $ur_relationship = $ur_class->new(current_user => $system_user);
+    my ($role_obj, $user_obj);
+    do {
+        $role_obj = $roles[ int(rand($#roles)) ];
+        $user_obj = $users[ int(rand($#users)) ];
+        $ur_relationship->load_by_cols(
+            parent => $role_obj,
+            child  => $user_obj,
+        );
+    } while ($ur_relationship->id);
+
+    $ur_relationship->create(
+        parent => $role_obj,
+        child  => $user_obj,
+    );
+
+    push @ur_relationships, $ur_relationship;
+}
+
+$watch->lap('created user-role relationships');
+
+diag('Creating role-role relationships.');
+
+# Create a lot of role-role relationships
+my @rr_relationships;
+for (1 .. $ROLE_ROLE_RELATIONSHIP_COUNT) {
+    my $rr_relationship = $rr_class->new(current_user => $system_user);
+    my ($role1_obj, $role2_obj);
+    do {
+        do {
+            $role1_obj = $roles[ int(rand($#roles)) ];
+            $role2_obj = $roles[ int(rand($#roles)) ];
+        } while ($role1_obj->id == $role2_obj->id);
+
+        $rr_relationship->load_by_cols(
+            parent => $role1_obj,
+            child  => $role2_obj,
+        );
+    } while ($rr_relationship->id);
+
+    $rr_relationship->create(
+        parent => $role1_obj,
+        child  => $role2_obj,
+    );
+
+    push @rr_relationships, $rr_relationship;
+}
+
+$watch->lap('created role-role relationships');
+
+diag('Recalculating role cache for each user.');
+
+my $current_user = CASPlus::CurrentUser->new;
+
+#for my $user (@users) {
+#    $user->user_object->recalculate_role_cache;
+#}
+
+$watch->lap('recalculating the role cache for all users');
+
+diag('Loading roles and permissions for each user.');
+
+for my $user (@users) {
+    $current_user->user_object($user->user_object);
+
+    my @roles       = $current_user->roles;
+    my @permissions = $current_user->profile_permissions;
+#    diag($user->user_object->username." : ".scalar(@roles)." roles : ".scalar(@permissions)." permission records");
+}
+
+$watch->lap('calculated profile permissions for all users');
+
+diag('Done.');
+
+diag($watch->stop->summary);
+


More information about the Jifty-commit mailing list