[Bio] / FigKernelPackages / UserData.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/UserData.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Mon Nov 7 20:26:40 2005 UTC revision 1.2, Wed Nov 23 17:55:49 2005 UTC
# Line 53  Line 53 
53  large, the category concept will enable us to restructure the data to reduce  large, the category concept will enable us to restructure the data to reduce
54  the memory footprint.  the memory footprint.
55    
56    Every user has his own set of preferences. The default user C<basic> should
57    have a complete set of preferences; if a preference is not specified for a
58    particular user, the basic user's value will be used instead.
59    
60  =head2 Access Objects  =head2 Access Objects
61    
62  This module does not access the actual data. Instead, it accepts as input  This module does not access the actual data. Instead, it accepts as input
# Line 119  Line 123 
123    
124  =back  =back
125    
126  =head3 GetCapability  =head3 GetCapabilities
127    
128  C<< my $level = $fig->GetCapability($group, $userID); >>  C<< my $level = $fig->GetCapabilities($userID); >>
129    
130  Return the access level (C<RW>, C<RO>, or C<NO>) for the specified user  Return a map of group names to access levels (C<RW>, C<RO>, or C<NO>) for the
131  and the specified group, or C<undef> if the user wants the default  specified user.
 access for the group.  
132    
133  =over 4  =over 4
134    
 =item group  
   
 Name of the group relevant to the desired user's activity.  
   
135  =item userID  =item userID
136    
137  ID of the user whose access level is desired.  ID of the user whose access level is desired.
138    
139  =item RETURN  =item RETURN
140    
141  Returns C<RW> if the user has full access, C<RO> if the user has read-only  Returns a reference to a hash mapping group names to the user's access level
142  access, C<NO> if the user is not allowed to even see items belonging  for that group.
 to the group, and C<undef> if the user should go with default access.  
143    
144  =back  =back
145    
# Line 205  Line 203 
203    
204  =back  =back
205    
206  =head3 SetPreferences($userID, \%preferenceMap); >>  =head3 SetPreferences
207    
208    C<< $fig->SetPreferences($userID, \%preferenceMap); >>
209    
210  Set the preferences for the specified user.  Set the preferences for the specified user.
211    
# Line 217  Line 217 
217    
218  =item preferenceMap  =item preferenceMap
219    
220  Reference to a hasn that maps each preference key to its value. The  Reference to a hash that maps each preference key to its value. The
221  keys should be fully-qualified (that is, they should include the  keys should be fully-qualified (that is, they should include the
222  category name). A preference key mapped to an undefined value will  category name). A preference key mapped to an undefined value will
223  use the default preference value for that key. The map will not  use the default preference value for that key. The map will not
# Line 227  Line 227 
227    
228  =back  =back
229    
230    =head3 CleanupUserData
231    
232    C<< $fig->CleanupUserData(); >>
233    
234    Release any data being held in memory for use by the UserData object.
235    
236    =head2 Fields
237    
238    The user data object contains the following fields.
239    
240    =over 4
241    
242    =item capable
243    
244    Reference to a hash containing all the user's capability data.
245    
246    =item preferences
247    
248    Reference to a hash of hashes. The key of the large hash is the preference
249    category, and the value is a small hash mapping preferences from that
250    category to values.
251    
252    =item userID
253    
254    Current user's ID.
255    
256    =item fig
257    
258    Fig-like object for accessing the data.
259    
260    =item newCapable
261    
262    Hash containing updated capabilities.
263    
264    =item newPreferences
265    
266    Hash containing updated preferences.
267    
268    =back
269    
270  =cut  =cut
271    
272  #: Constructor Capabilities->new();  #: Constructor Capabilities->new();
# Line 235  Line 275 
275    
276  =head3 new  =head3 new
277    
278  C<< my $userdata = Capabilities->new($user, $fig); >>  C<< my $userData = Capabilities->new($user, $fig); >>
279    
280  Construct the capabilities object for a specified user.  Construct the capabilities object for a specified user.
281    
# Line 256  Line 296 
296  sub new {  sub new {
297      # Get the parameters.      # Get the parameters.
298      my ($class, $user, $fig) = @_;      my ($class, $user, $fig) = @_;
299      ## TODO ##      # Get the user's capabilities.
300        my $capable = $fig->GetCapabilities($user);
301      # Create the userdata object.      # Create the userdata object.
302      my $retVal = {      my $retVal = {
303                    ##TODO                    capable => $capable,
304                      newCapable => { },
305                      user => $user,
306                      preferences => { },
307                      newPreferences => { },
308                      fig => $fig
309                   };                   };
310      # Bless and return it.      # Bless and return it.
311      bless $retVal;      bless $retVal, $class;
312      return $retVal;      return $retVal;
313  }  }
314    
315  =head3 GetCapability  =head3 GetCapability
316    
317  C<< my $level = $fig->GetCapability($objectID, $objectType); >>  C<< my $level = $userData->GetCapability($objectID, $objectType); >>
318    
319  Get this user's access level for the specified object-- either C<RW> (full access),  Get this user's access level for the specified object-- either C<RW> (full access),
320  C<RO> (read-only), or C<NO> (no access).  C<RO> (read-only), or C<NO> (no access).
# Line 286  Line 332 
332    
333  =item RETURN  =item RETURN
334    
335  Returns C<RW> if the user has full-acess, C<RO> if the user has read-only  Returns C<RW> if the user has full access, C<RO> if the user has read-only
336  access, and C<NO> if the user should not have any access to the object.  access, and C<NO> if the user should not have any access to the object.
337    
338  =back  =back
# Line 294  Line 340 
340  =cut  =cut
341    
342  sub GetCapability {  sub GetCapability {
343      #TODO      # Get the parameters.
344        my ($self, $objectID, $objectType) = @_;
345        # Look for the group and default access level of the target object.
346        my ($group, $level) = $self->{fig}->GetDefault($objectID, $objectType);
347        # If it wasn't found, the group is 'normal' and the access level is RW.
348        if (! $group) {
349            ($group, $level) = ('normal', 'RW');
350        }
351        # If this group is in the user's capability hash, we use the result to
352        # override the level.
353        if (exists $self->{capable}->{$group}) {
354            $level = $self->{capable}->{$group};
355        }
356        # Return the level.
357        return $level;
358  }  }
359    
360  =head3 GetPreference  =head3 GetPreference
361    
362  C<< my $value = $fig->GetPreference($key); >>  C<< my $value = $userData->GetPreference($key); >>
363    
364  Return the user's preference value for the specified key.  Return the user's preference value for the specified key.
365    
# Line 319  Line 379 
379  =cut  =cut
380    
381  sub GetPreference {  sub GetPreference {
382      #TODO      # Get the parameters.
383        my ($self, $key) = @_;
384        # Extract the category name.
385        my $category = ParseCategory($key);
386        # Insure this category is in memory.
387        my $categoryHash = $self->GetCategoryHash($category);
388        # Return the value for the specified preference key.
389        my $retVal = $categoryHash->{$key};
390        return $retVal;
391  }  }
392    
393  =head3 SetCapabilities  =head3 SetCapabilities
394    
395  C<< $fig->SetCapabilities(\%groupMap); >>  C<< $userData->SetCapabilities(\%groupMap); >>
396    
397  Set capabilities for this user. This does not replace all existing capabilities.  Set capabilities for this user. This does not replace all existing capabilities.
398  Instead, the capabilities specified in the group map are updated or deleted,  Instead, the capabilities specified in the group map are updated or deleted,
399  and any capabilities not specified are unchanged.  and any capabilities not specified are unchanged. Note that the actual changes
400    are cached in memory, and are not written until the L</SaveChanges> method is
401    called.
402    
403  =over 4  =over 4
404    
# Line 343  Line 413 
413  =cut  =cut
414    
415  sub SetCapabilities {  sub SetCapabilities {
416      #TODO      # Get the parameters.
417        my ($self, $groupMap) = @_;
418        # Loop through the settings, adding them to the update hash and the actual
419        # hash. The update hash is used when we save changes. The actual hash
420        # needs to be updated as well so that the new values are retrieved when
421        # the client asks for capability data.
422        my $accessMap = $self->{capable};
423        my $changeMap = $self->{newCapable};
424        for my $group (keys %{$groupMap}) {
425            $accessMap->{$group} = $groupMap->{$group};
426            $changeMap->{$group} = $groupMap->{$group};
427        }
428  }  }
429    
430  =head3 SetPreferences(\%preferences); >>  =head3 SetPreferences
431    
432    C<< $userData->SetPreferences(\%preferences); >>
433    
434  Set preferences for this user. This does not replace all existing preferences.  Set preferences for this user. This does not replace all existing preferences.
435  Instead, the preferences specified in the map are updated or deleted, and any  Instead, the preferences specified in the map are updated or deleted, and any
436  preferences not specified are unchanged.  preferences not specified are unchanged. Note that the settings are not changed.
437    Instead, the changes are cached in memory until the L</SaveChanges> method is
438    called.
439    
440  =over 4  =over 4
441    
# Line 365  Line 450 
450  =cut  =cut
451    
452  sub SetPreferences {  sub SetPreferences {
453      #TODO      # Get the parameters.
454        my ($self, $preferences) = @_;
455        # Loop through the settings. Each one is added to the main hash and then
456        # cached in the update hash.
457        my $changeMap = $self->{newPreferences};
458        for my $key (keys %{$preferences}) {
459            # Extract the category name from the key.
460            my $category = ParseCategory($key);
461            # Insure we have the category in memory.
462            my $hash = $self->GetCategoryHash($category);
463            # Add the new value to the category hash.
464            $hash->{$key} = $preferences->{$key};
465            # Add it to the update hash.
466            $changeMap->{$key} = $preferences->{$key};
467        }
468  }  }
469    
470  =head3 SetDefault  =head3 SetDefault
471    
472  C<< $fig->SetDefault($objectID, $objectType, $group, $level); >>  C<< $userData->SetDefault($objectID, $objectType, $group, $level); >>
473    
474  Set the group and default access level for the specified object.  Set the group and default access level for the specified object. This update
475    takes place immediately.
476    
477  =over 4  =over 4
478    
# Line 400  Line 500 
500  =cut  =cut
501    
502  sub SetDefault {  sub SetDefault {
503      #TODO      # Get the parameters.
504        my ($self, $objectID, $objectType, $group, $level) = @_;
505        # Call the access method.
506        $self->{fig}->SetDefault($objectID, $objectType, $group, $level);
507  }  }
508    
509  1;  =head3 SaveChanges
510    
511    C<< $userData->SaveChanges(); >>
512    
513    Store accumulated preference and capability changes.
514    
515    =cut
516    
517    sub SaveChanges {
518        # Get the parameters.
519        my ($self) = @_;
520        # Check for capability updates.
521        my $capabilityUpdates = $self->{newCapable};
522        if (keys %{$capabilityUpdates}) {
523            $self->{fig}->SetCapabilities($self->{user}, $capabilityUpdates);
524        }
525        # Check for preference updates.
526        my $preferenceUpdates = $self->{newPreferences};
527        if (keys %{$preferenceUpdates}) {
528            $self->{fig}->SetPreferences($self->{user}, $preferenceUpdates);
529        }
530    }
531    
532    =head3 ParseCategory
533    
534    C<< my $category = UserData::ParseCategory($key); >>
535    
536    Return the category name from the specified preference key. If no category is
537    specified, an error will occur.
538    
539    =over 4
540    
541    =item key
542    
543    Preference key, which consists of alphanumeric characters with colons separating
544    the sections.
545    
546    =item RETURN
547    
548    Returns the category name from the specified key.
549    
550    =back
551    
552    =cut
553    
554    sub ParseCategory {
555        # Get the parameters.
556        my ($key) = @_;
557        # Declare the return variable.
558        my $retVal;
559        # Try to parse out the category.
560        if ($key =~ /([^:]+):/) {
561            # Return the category.
562            $retVal = $1;
563        } else {
564            # Here we have no category, so it's an error.
565            Confess("No category specified on preference key \"$key\".");
566        }
567        return $retVal;
568    }
569    
570    =head3 GetCategoryHash
571    
572    C<< my $categoryHash = $self->GetCategoryHash($category); >>
573    
574    Return the hash for the specified category. If it is not in memory, it
575    will be read in.
576    
577    =over 4
578    
579    =item key
580    
581    Preference key, which consists of alphanumeric characters with colons separating
582    the sections.
583    
584    =item RETURN
585    
586    Returns the category name from the specified key.
587    
588    =back
589    
590    =cut
591    
592    sub GetCategoryHash {
593        # Get the parameters.
594        my ($self, $category) = @_;
595        # Declare the return variable.
596        my $retVal;
597        # Check to see if we have preferences for this category. If not, we need
598        # to read them in.
599        if (! exists $self->{preferences}->{$category}) {
600            # Get the default preferences if this is not the default user.
601            my $defaults = {};
602            if ($self->{user} ne 'basic') {
603                $defaults = $self->{fig}->GetPreferences('basic', $category);
604            }
605            # Get the user's preferences and merge them in.
606            my $overrides = $self->{fig}->GetPreferences($self->{user}, $category);
607            for my $key0 (%{$overrides}) {
608                $defaults->{$key0} = $overrides->{$key0};
609            }
610            # Add the new hash to the preferences hash.
611            $self->{preferences}->{$category} = $defaults;
612            # Return it.
613            $retVal = $defaults;
614        } else {
615            # Here the hash is already in memory.
616            $retVal = $self->{preferences}->{$category};
617        }
618        # Return the category hash.
619        return $retVal;
620    }
621    
622    1;

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3