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

Annotation of /FigKernelPackages/UserData.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package UserData;
4 :    
5 :     require Exporter;
6 :     @ISA = ('Exporter');
7 :     @EXPORT = qw();
8 :     @EXPORT_OK = qw();
9 :    
10 :     use strict;
11 :     use Tracer;
12 :     use PageBuilder;
13 :    
14 :     =head1 FIG User Configuration Module
15 :    
16 :     =head2 Introduction
17 :    
18 :     The user data object allows the SEED to determine the privileges and
19 :     preferences of SEED users. This is not intended as an ironclad security
20 :     system; rather, its goal is to prevent one group stepping on another group's
21 :     work and to allow individual users to customize the look and feel of the
22 :     SEED.
23 :    
24 :     =head3 Capabilities
25 :    
26 :     Capabilities provide three access levels-- C<RW> (read-write), C<RO> (read-only),
27 :     and C<NO> (no access). Capabilities are managed using arbitrary classes of genomes
28 :     and subsystems called I<groups>. Groups are stored globally. Each group has a
29 :     name and a default access level. The default group is called C<normal> and has
30 :     a default access level of C<RW>.
31 :    
32 :     Each user has a list of capabilities, each consisting of a group name and an
33 :     access level. A group name / access level pair is called a I<subscription>.
34 :     When a user attempts to access a subsystem or genome, we get the genome or
35 :     subsystem's group name and ask if the user has a subscription to the group.
36 :     If he does, the access level in the subscription is used. If he does not, the
37 :     default access level for the group is used.
38 :    
39 :     If the user name is not known, the default user-- C<basic>-- will be used.
40 :     Initially, this default user will have no subscriptions, and as a result
41 :     will have default access to all genome and subsystem groups; however, if this
42 :     is not desirable it can be changed by adding subscriptions to the basic user
43 :     record.
44 :    
45 :     =head3 Preferences
46 :    
47 :     Preferences are simple key-value pairs. For each key, there is a single string
48 :     value. The key name cannot contain any white space. The keys are treated like
49 :     simple unformatted keys; however, it is highly recommened that the colon
50 :     character (C<:>) be used to separate the name into a category and a subkey
51 :     name. For example, C<genomes:columnList> would indicate the column-list
52 :     preference for the B<genomes> category. If the number of keys becomes
53 :     large, the category concept will enable us to restructure the data to reduce
54 :     the memory footprint.
55 :    
56 : parrello 1.2 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 : parrello 1.1 =head2 Access Objects
61 :    
62 :     This module does not access the actual data. Instead, it accepts as input
63 :     an I<access object>. The access object hides the details of data access
64 :     from the User Data object so that different data stores can be plugged
65 :     in. Currently, the access objects used by most of the SEED are the
66 :     B<FIG> and B<SFXlate> objects. FIG uses a combination of flat files and
67 :     database tables and supports both reads and updates. The SFXlate object
68 :     uses a pure database scheme and is mostly read-only.
69 :    
70 :     =head3 GetDefault
71 :    
72 :     C<< my ($group, $level) = $fig->GetDefault($objectID, $objectType); >>
73 :    
74 :     Return the group name and default access level for the specified object.
75 :    
76 :     =over 4
77 :    
78 :     =item objectID
79 :    
80 :     ID of the object whose capabilities data is desired.
81 :    
82 :     =item objectType
83 :    
84 :     Type of the object whose capabilities data is desired. This should be expressed
85 :     as a Sprout entity name. Currently, the only types supported are C<Genome>
86 :     and C<Subsystem>.
87 :    
88 :     =item RETURN
89 :    
90 :     Returns a two-element list. The first element is the name of the group
91 :     to witch the object belongs; the second is the default access level
92 :     (C<RW>, C<RO>, or C<NO>). If the object is not found, an empty list
93 :     should be returned.
94 :    
95 :     =back
96 :    
97 :     =head3 GetPreferences
98 :    
99 :     C<< my $preferences = $fig->GetPreferences($userID, $category); >>
100 :    
101 :     Return a map of preference keys to values for the specified user in the
102 :     specified category.
103 :    
104 :     =over 4
105 :    
106 :     =item userID
107 :    
108 :     ID of the user whose preferences are desired.
109 :    
110 :     =item category (optional)
111 :    
112 :     Name of the category whose preferences are desired. If omitted, all
113 :     preferences should be returned.
114 :    
115 :     =item RETURN
116 :    
117 :     Returns a reference to a hash mapping each preference key to a value. The
118 :     keys are fully-qualified; in other words, the category name is included.
119 :     It is acceptable for the hash to contain key-value pairs outside the
120 :     category. In other words, if it's easier for you to read the entire
121 :     preference set into memory, you can return that one set every time
122 :     this method is called without worrying about the extra keys.
123 :    
124 :     =back
125 :    
126 : parrello 1.2 =head3 GetCapabilities
127 : parrello 1.1
128 : parrello 1.2 C<< my $level = $fig->GetCapabilities($userID); >>
129 : parrello 1.1
130 : parrello 1.2 Return a map of group names to access levels (C<RW>, C<RO>, or C<NO>) for the
131 :     specified user.
132 : parrello 1.1
133 :     =over 4
134 :    
135 :     =item userID
136 :    
137 :     ID of the user whose access level is desired.
138 :    
139 :     =item RETURN
140 :    
141 : parrello 1.2 Returns a reference to a hash mapping group names to the user's access level
142 :     for that group.
143 : parrello 1.1
144 :     =back
145 :    
146 :     =head3 AllowsUpdates
147 :    
148 :     C<< my $flag = $fig->AllowsUpdates(); >>
149 :    
150 :     Return TRUE if this access object supports updates, else FALSE. If the access object
151 :     does not support updates, none of the B<SetXXXX> methods will be called.
152 :    
153 :     =head3 SetDefault
154 :    
155 :     C<< $fig->SetDefault($objectID, $objectType, $group, $level); >>
156 :    
157 :     Set the group and default access level for the specified object.
158 :    
159 :     =over 4
160 :    
161 :     =item objectID
162 :    
163 :     ID of the object whose access level and group are to be set.
164 :    
165 :     =item objectType
166 :    
167 :     Type of the relevant object. This should be expressed as a Sprout entity name.
168 :     Currently, only C<Genome> and C<Subsystem> are supported.
169 :    
170 :     =item group
171 :    
172 :     Name of the group to which the object will belong. A user's access level for
173 :     this group will override the default access level.
174 :    
175 :     =item level
176 :    
177 :     Default access level. This is the access level used for user's who do not have
178 :     an explicit capability specified for the object's group.
179 :    
180 :     =back
181 :    
182 :     =head3 SetCapabilities
183 :    
184 :     C<< $fig->SetCapabilities($userID, \%groupLevelMap); >>
185 :    
186 :     Set the access levels by the specified user for the specified groups.
187 :    
188 :     =over 4
189 :    
190 :     =item userID
191 :    
192 :     ID of the user whose capabilities are to be updated.
193 :    
194 :     =item groupLevelMap
195 :    
196 :     Reference to a hash that maps group names to access levels. The legal
197 :     access levels are C<RW> (read-write), C<RO> (read-only), and C<NO> (no
198 :     access). An undefined value for the access level indicates the default
199 :     level should be used for that group. The map will not replace all of
200 :     the user's capability date; instead, it overrides existing data, with
201 :     the undefined values indicating the specified group should be deleted
202 :     from the list.
203 :    
204 :     =back
205 :    
206 : parrello 1.2 =head3 SetPreferences
207 :    
208 :     C<< $fig->SetPreferences($userID, \%preferenceMap); >>
209 : parrello 1.1
210 :     Set the preferences for the specified user.
211 :    
212 :     =over 4
213 :    
214 :     =item userID
215 :    
216 :     ID of the user whose preferences are to be udpated.
217 :    
218 :     =item preferenceMap
219 :    
220 : parrello 1.2 Reference to a hash that maps each preference key to its value. The
221 : parrello 1.1 keys should be fully-qualified (that is, they should include the
222 :     category name). A preference key mapped to an undefined value will
223 :     use the default preference value for that key. The map will not
224 :     replace all of the user's preference data; instead, it overrides
225 :     existing data, with the undefined values indicating the specified
226 :     preference should be deleted from the list.
227 :    
228 :     =back
229 :    
230 : parrello 1.2 =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 : parrello 1.1 =cut
271 :    
272 :     #: Constructor Capabilities->new();
273 :    
274 :     =head2 Public Methods
275 :    
276 :     =head3 new
277 :    
278 : parrello 1.2 C<< my $userData = Capabilities->new($user, $fig); >>
279 : parrello 1.1
280 :     Construct the capabilities object for a specified user.
281 :    
282 :     =over 4
283 :    
284 :     =item user
285 :    
286 :     Name of the current user.
287 :    
288 :     =item fig
289 :    
290 :     Access object for retrieving user data.
291 :    
292 :     =back
293 :    
294 :     =cut
295 :    
296 :     sub new {
297 :     # Get the parameters.
298 :     my ($class, $user, $fig) = @_;
299 : parrello 1.2 # Get the user's capabilities.
300 :     my $capable = $fig->GetCapabilities($user);
301 : parrello 1.1 # Create the userdata object.
302 :     my $retVal = {
303 : parrello 1.2 capable => $capable,
304 :     newCapable => { },
305 :     user => $user,
306 :     preferences => { },
307 :     newPreferences => { },
308 :     fig => $fig
309 : parrello 1.1 };
310 :     # Bless and return it.
311 : parrello 1.2 bless $retVal, $class;
312 : parrello 1.1 return $retVal;
313 :     }
314 :    
315 :     =head3 GetCapability
316 :    
317 : parrello 1.2 C<< my $level = $userData->GetCapability($objectID, $objectType); >>
318 : parrello 1.1
319 :     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).
321 :    
322 :     =over 4
323 :    
324 :     =item objectID
325 :    
326 :     ID of the relevant object.
327 :    
328 :     =item objectType
329 :    
330 :     Type of the relevant object. This should be the Sprout entity name for the
331 :     object type. Currently, only C<Subsystem> and C<Genome> are supported.
332 :    
333 :     =item RETURN
334 :    
335 : parrello 1.2 Returns C<RW> if the user has full access, C<RO> if the user has read-only
336 : parrello 1.1 access, and C<NO> if the user should not have any access to the object.
337 :    
338 :     =back
339 :    
340 :     =cut
341 :    
342 :     sub GetCapability {
343 : parrello 1.2 # 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 : parrello 1.1 }
359 :    
360 :     =head3 GetPreference
361 :    
362 : parrello 1.2 C<< my $value = $userData->GetPreference($key); >>
363 : parrello 1.1
364 :     Return the user's preference value for the specified key.
365 :    
366 :     =over 4
367 :    
368 :     =item key
369 :    
370 :     Fully-qualified key for the preference value.
371 :    
372 :     =item RETURN
373 :    
374 :     Returns the preference value for the key. If the user has no explicit preference
375 :     value for that key, returns the corresponding value for the default user.
376 :    
377 :     =back
378 :    
379 :     =cut
380 :    
381 :     sub GetPreference {
382 : parrello 1.2 # 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 : parrello 1.1 }
392 :    
393 :     =head3 SetCapabilities
394 :    
395 : parrello 1.2 C<< $userData->SetCapabilities(\%groupMap); >>
396 : parrello 1.1
397 :     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,
399 : parrello 1.2 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 : parrello 1.1
403 :     =over 4
404 :    
405 :     =item groupMap
406 :    
407 :     Reference to a hash mapping group names to access levels (C<RW> full access,
408 :     C<RO> read-only access, C<NO> no access) or an undefined value if the user
409 :     is to have default access to the specified group.
410 :    
411 :     =back
412 :    
413 :     =cut
414 :    
415 :     sub SetCapabilities {
416 : parrello 1.2 # 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 : parrello 1.1 }
429 :    
430 : parrello 1.2 =head3 SetPreferences
431 :    
432 :     C<< $userData->SetPreferences(\%preferences); >>
433 : parrello 1.1
434 :     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
436 : parrello 1.2 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 : parrello 1.1
440 :     =over 4
441 :    
442 :     =item preferences
443 :    
444 :     Reference to a hash mapping key names to preference values. Mapping a key
445 :     name to an undefined value indicates that the default preference value
446 :     should be used.
447 :    
448 :     =back
449 :    
450 :     =cut
451 :    
452 :     sub SetPreferences {
453 : parrello 1.2 # 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 : parrello 1.1 }
469 :    
470 :     =head3 SetDefault
471 :    
472 : parrello 1.2 C<< $userData->SetDefault($objectID, $objectType, $group, $level); >>
473 : parrello 1.1
474 : parrello 1.2 Set the group and default access level for the specified object. This update
475 :     takes place immediately.
476 : parrello 1.1
477 :     =over 4
478 :    
479 :     =item objectID
480 :    
481 :     ID of the object whose access level and group are to be set.
482 :    
483 :     =item objectType
484 :    
485 :     Type of the relevant object. This should be expressed as a Sprout entity name.
486 :     Currently, only C<Genome> and C<Subsystem> are supported.
487 :    
488 :     =item group
489 :    
490 :     Name of the group to which the object will belong. A user's access level for
491 :     this group will override the default access level.
492 :    
493 :     =item level
494 :    
495 :     Default access level. This is the access level used for user's who do not have
496 :     an explicit capability specified for the object's group.
497 :    
498 :     =back
499 :    
500 :     =cut
501 :    
502 :     sub SetDefault {
503 : parrello 1.2 # 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 :     =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 : parrello 1.1 }
531 :    
532 : parrello 1.2 =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 : parrello 1.1
622 : parrello 1.2 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3