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

Annotation of /FigKernelPackages/UserData.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 : olson 1.3 #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 : parrello 1.1
20 :     package UserData;
21 :    
22 :     require Exporter;
23 :     @ISA = ('Exporter');
24 :     @EXPORT = qw();
25 :     @EXPORT_OK = qw();
26 :    
27 :     use strict;
28 :     use Tracer;
29 :     use PageBuilder;
30 :    
31 :     =head1 FIG User Configuration Module
32 :    
33 :     =head2 Introduction
34 :    
35 :     The user data object allows the SEED to determine the privileges and
36 :     preferences of SEED users. This is not intended as an ironclad security
37 :     system; rather, its goal is to prevent one group stepping on another group's
38 :     work and to allow individual users to customize the look and feel of the
39 :     SEED.
40 :    
41 :     =head3 Capabilities
42 :    
43 :     Capabilities provide three access levels-- C<RW> (read-write), C<RO> (read-only),
44 :     and C<NO> (no access). Capabilities are managed using arbitrary classes of genomes
45 :     and subsystems called I<groups>. Groups are stored globally. Each group has a
46 :     name and a default access level. The default group is called C<normal> and has
47 :     a default access level of C<RW>.
48 :    
49 :     Each user has a list of capabilities, each consisting of a group name and an
50 :     access level. A group name / access level pair is called a I<subscription>.
51 :     When a user attempts to access a subsystem or genome, we get the genome or
52 :     subsystem's group name and ask if the user has a subscription to the group.
53 :     If he does, the access level in the subscription is used. If he does not, the
54 :     default access level for the group is used.
55 :    
56 :     If the user name is not known, the default user-- C<basic>-- will be used.
57 :     Initially, this default user will have no subscriptions, and as a result
58 :     will have default access to all genome and subsystem groups; however, if this
59 :     is not desirable it can be changed by adding subscriptions to the basic user
60 :     record.
61 :    
62 :     =head3 Preferences
63 :    
64 :     Preferences are simple key-value pairs. For each key, there is a single string
65 :     value. The key name cannot contain any white space. The keys are treated like
66 :     simple unformatted keys; however, it is highly recommened that the colon
67 :     character (C<:>) be used to separate the name into a category and a subkey
68 :     name. For example, C<genomes:columnList> would indicate the column-list
69 :     preference for the B<genomes> category. If the number of keys becomes
70 :     large, the category concept will enable us to restructure the data to reduce
71 :     the memory footprint.
72 :    
73 : parrello 1.2 Every user has his own set of preferences. The default user C<basic> should
74 :     have a complete set of preferences; if a preference is not specified for a
75 :     particular user, the basic user's value will be used instead.
76 :    
77 : parrello 1.1 =head2 Access Objects
78 :    
79 :     This module does not access the actual data. Instead, it accepts as input
80 :     an I<access object>. The access object hides the details of data access
81 :     from the User Data object so that different data stores can be plugged
82 :     in. Currently, the access objects used by most of the SEED are the
83 :     B<FIG> and B<SFXlate> objects. FIG uses a combination of flat files and
84 :     database tables and supports both reads and updates. The SFXlate object
85 :     uses a pure database scheme and is mostly read-only.
86 :    
87 :     =head3 GetDefault
88 :    
89 :     C<< my ($group, $level) = $fig->GetDefault($objectID, $objectType); >>
90 :    
91 :     Return the group name and default access level for the specified object.
92 :    
93 :     =over 4
94 :    
95 :     =item objectID
96 :    
97 :     ID of the object whose capabilities data is desired.
98 :    
99 :     =item objectType
100 :    
101 :     Type of the object whose capabilities data is desired. This should be expressed
102 :     as a Sprout entity name. Currently, the only types supported are C<Genome>
103 :     and C<Subsystem>.
104 :    
105 :     =item RETURN
106 :    
107 :     Returns a two-element list. The first element is the name of the group
108 :     to witch the object belongs; the second is the default access level
109 :     (C<RW>, C<RO>, or C<NO>). If the object is not found, an empty list
110 :     should be returned.
111 :    
112 :     =back
113 :    
114 :     =head3 GetPreferences
115 :    
116 :     C<< my $preferences = $fig->GetPreferences($userID, $category); >>
117 :    
118 :     Return a map of preference keys to values for the specified user in the
119 :     specified category.
120 :    
121 :     =over 4
122 :    
123 :     =item userID
124 :    
125 :     ID of the user whose preferences are desired.
126 :    
127 :     =item category (optional)
128 :    
129 :     Name of the category whose preferences are desired. If omitted, all
130 :     preferences should be returned.
131 :    
132 :     =item RETURN
133 :    
134 :     Returns a reference to a hash mapping each preference key to a value. The
135 :     keys are fully-qualified; in other words, the category name is included.
136 :     It is acceptable for the hash to contain key-value pairs outside the
137 :     category. In other words, if it's easier for you to read the entire
138 :     preference set into memory, you can return that one set every time
139 :     this method is called without worrying about the extra keys.
140 :    
141 :     =back
142 :    
143 : parrello 1.2 =head3 GetCapabilities
144 : parrello 1.1
145 : parrello 1.2 C<< my $level = $fig->GetCapabilities($userID); >>
146 : parrello 1.1
147 : parrello 1.2 Return a map of group names to access levels (C<RW>, C<RO>, or C<NO>) for the
148 :     specified user.
149 : parrello 1.1
150 :     =over 4
151 :    
152 :     =item userID
153 :    
154 :     ID of the user whose access level is desired.
155 :    
156 :     =item RETURN
157 :    
158 : parrello 1.2 Returns a reference to a hash mapping group names to the user's access level
159 :     for that group.
160 : parrello 1.1
161 :     =back
162 :    
163 :     =head3 AllowsUpdates
164 :    
165 :     C<< my $flag = $fig->AllowsUpdates(); >>
166 :    
167 :     Return TRUE if this access object supports updates, else FALSE. If the access object
168 :     does not support updates, none of the B<SetXXXX> methods will be called.
169 :    
170 :     =head3 SetDefault
171 :    
172 :     C<< $fig->SetDefault($objectID, $objectType, $group, $level); >>
173 :    
174 :     Set the group and default access level for the specified object.
175 :    
176 :     =over 4
177 :    
178 :     =item objectID
179 :    
180 :     ID of the object whose access level and group are to be set.
181 :    
182 :     =item objectType
183 :    
184 :     Type of the relevant object. This should be expressed as a Sprout entity name.
185 :     Currently, only C<Genome> and C<Subsystem> are supported.
186 :    
187 :     =item group
188 :    
189 :     Name of the group to which the object will belong. A user's access level for
190 :     this group will override the default access level.
191 :    
192 :     =item level
193 :    
194 :     Default access level. This is the access level used for user's who do not have
195 :     an explicit capability specified for the object's group.
196 :    
197 :     =back
198 :    
199 :     =head3 SetCapabilities
200 :    
201 :     C<< $fig->SetCapabilities($userID, \%groupLevelMap); >>
202 :    
203 :     Set the access levels by the specified user for the specified groups.
204 :    
205 :     =over 4
206 :    
207 :     =item userID
208 :    
209 :     ID of the user whose capabilities are to be updated.
210 :    
211 :     =item groupLevelMap
212 :    
213 :     Reference to a hash that maps group names to access levels. The legal
214 :     access levels are C<RW> (read-write), C<RO> (read-only), and C<NO> (no
215 :     access). An undefined value for the access level indicates the default
216 :     level should be used for that group. The map will not replace all of
217 :     the user's capability date; instead, it overrides existing data, with
218 :     the undefined values indicating the specified group should be deleted
219 :     from the list.
220 :    
221 :     =back
222 :    
223 : parrello 1.2 =head3 SetPreferences
224 :    
225 :     C<< $fig->SetPreferences($userID, \%preferenceMap); >>
226 : parrello 1.1
227 :     Set the preferences for the specified user.
228 :    
229 :     =over 4
230 :    
231 :     =item userID
232 :    
233 :     ID of the user whose preferences are to be udpated.
234 :    
235 :     =item preferenceMap
236 :    
237 : parrello 1.2 Reference to a hash that maps each preference key to its value. The
238 : parrello 1.1 keys should be fully-qualified (that is, they should include the
239 :     category name). A preference key mapped to an undefined value will
240 :     use the default preference value for that key. The map will not
241 :     replace all of the user's preference data; instead, it overrides
242 :     existing data, with the undefined values indicating the specified
243 :     preference should be deleted from the list.
244 :    
245 :     =back
246 :    
247 : parrello 1.2 =head3 CleanupUserData
248 :    
249 :     C<< $fig->CleanupUserData(); >>
250 :    
251 :     Release any data being held in memory for use by the UserData object.
252 :    
253 :     =head2 Fields
254 :    
255 :     The user data object contains the following fields.
256 :    
257 :     =over 4
258 :    
259 :     =item capable
260 :    
261 :     Reference to a hash containing all the user's capability data.
262 :    
263 :     =item preferences
264 :    
265 :     Reference to a hash of hashes. The key of the large hash is the preference
266 :     category, and the value is a small hash mapping preferences from that
267 :     category to values.
268 :    
269 :     =item userID
270 :    
271 :     Current user's ID.
272 :    
273 :     =item fig
274 :    
275 :     Fig-like object for accessing the data.
276 :    
277 :     =item newCapable
278 :    
279 :     Hash containing updated capabilities.
280 :    
281 :     =item newPreferences
282 :    
283 :     Hash containing updated preferences.
284 :    
285 :     =back
286 :    
287 : parrello 1.1 =cut
288 :    
289 :     #: Constructor Capabilities->new();
290 :    
291 :     =head2 Public Methods
292 :    
293 :     =head3 new
294 :    
295 : parrello 1.2 C<< my $userData = Capabilities->new($user, $fig); >>
296 : parrello 1.1
297 :     Construct the capabilities object for a specified user.
298 :    
299 :     =over 4
300 :    
301 :     =item user
302 :    
303 :     Name of the current user.
304 :    
305 :     =item fig
306 :    
307 :     Access object for retrieving user data.
308 :    
309 :     =back
310 :    
311 :     =cut
312 :    
313 :     sub new {
314 :     # Get the parameters.
315 :     my ($class, $user, $fig) = @_;
316 : parrello 1.2 # Get the user's capabilities.
317 :     my $capable = $fig->GetCapabilities($user);
318 : parrello 1.1 # Create the userdata object.
319 :     my $retVal = {
320 : parrello 1.2 capable => $capable,
321 :     newCapable => { },
322 :     user => $user,
323 :     preferences => { },
324 :     newPreferences => { },
325 :     fig => $fig
326 : parrello 1.1 };
327 :     # Bless and return it.
328 : parrello 1.2 bless $retVal, $class;
329 : parrello 1.1 return $retVal;
330 :     }
331 :    
332 :     =head3 GetCapability
333 :    
334 : parrello 1.2 C<< my $level = $userData->GetCapability($objectID, $objectType); >>
335 : parrello 1.1
336 :     Get this user's access level for the specified object-- either C<RW> (full access),
337 :     C<RO> (read-only), or C<NO> (no access).
338 :    
339 :     =over 4
340 :    
341 :     =item objectID
342 :    
343 :     ID of the relevant object.
344 :    
345 :     =item objectType
346 :    
347 :     Type of the relevant object. This should be the Sprout entity name for the
348 :     object type. Currently, only C<Subsystem> and C<Genome> are supported.
349 :    
350 :     =item RETURN
351 :    
352 : parrello 1.2 Returns C<RW> if the user has full access, C<RO> if the user has read-only
353 : parrello 1.1 access, and C<NO> if the user should not have any access to the object.
354 :    
355 :     =back
356 :    
357 :     =cut
358 :    
359 :     sub GetCapability {
360 : parrello 1.2 # Get the parameters.
361 :     my ($self, $objectID, $objectType) = @_;
362 :     # Look for the group and default access level of the target object.
363 :     my ($group, $level) = $self->{fig}->GetDefault($objectID, $objectType);
364 :     # If it wasn't found, the group is 'normal' and the access level is RW.
365 :     if (! $group) {
366 :     ($group, $level) = ('normal', 'RW');
367 :     }
368 :     # If this group is in the user's capability hash, we use the result to
369 :     # override the level.
370 :     if (exists $self->{capable}->{$group}) {
371 :     $level = $self->{capable}->{$group};
372 :     }
373 :     # Return the level.
374 :     return $level;
375 : parrello 1.1 }
376 :    
377 :     =head3 GetPreference
378 :    
379 : parrello 1.2 C<< my $value = $userData->GetPreference($key); >>
380 : parrello 1.1
381 :     Return the user's preference value for the specified key.
382 :    
383 :     =over 4
384 :    
385 :     =item key
386 :    
387 :     Fully-qualified key for the preference value.
388 :    
389 :     =item RETURN
390 :    
391 :     Returns the preference value for the key. If the user has no explicit preference
392 :     value for that key, returns the corresponding value for the default user.
393 :    
394 :     =back
395 :    
396 :     =cut
397 :    
398 :     sub GetPreference {
399 : parrello 1.2 # Get the parameters.
400 :     my ($self, $key) = @_;
401 :     # Extract the category name.
402 :     my $category = ParseCategory($key);
403 :     # Insure this category is in memory.
404 :     my $categoryHash = $self->GetCategoryHash($category);
405 :     # Return the value for the specified preference key.
406 :     my $retVal = $categoryHash->{$key};
407 :     return $retVal;
408 : parrello 1.1 }
409 :    
410 :     =head3 SetCapabilities
411 :    
412 : parrello 1.2 C<< $userData->SetCapabilities(\%groupMap); >>
413 : parrello 1.1
414 :     Set capabilities for this user. This does not replace all existing capabilities.
415 :     Instead, the capabilities specified in the group map are updated or deleted,
416 : parrello 1.2 and any capabilities not specified are unchanged. Note that the actual changes
417 :     are cached in memory, and are not written until the L</SaveChanges> method is
418 :     called.
419 : parrello 1.1
420 :     =over 4
421 :    
422 :     =item groupMap
423 :    
424 :     Reference to a hash mapping group names to access levels (C<RW> full access,
425 :     C<RO> read-only access, C<NO> no access) or an undefined value if the user
426 :     is to have default access to the specified group.
427 :    
428 :     =back
429 :    
430 :     =cut
431 :    
432 :     sub SetCapabilities {
433 : parrello 1.2 # Get the parameters.
434 :     my ($self, $groupMap) = @_;
435 :     # Loop through the settings, adding them to the update hash and the actual
436 :     # hash. The update hash is used when we save changes. The actual hash
437 :     # needs to be updated as well so that the new values are retrieved when
438 :     # the client asks for capability data.
439 :     my $accessMap = $self->{capable};
440 :     my $changeMap = $self->{newCapable};
441 :     for my $group (keys %{$groupMap}) {
442 :     $accessMap->{$group} = $groupMap->{$group};
443 :     $changeMap->{$group} = $groupMap->{$group};
444 :     }
445 : parrello 1.1 }
446 :    
447 : parrello 1.2 =head3 SetPreferences
448 :    
449 :     C<< $userData->SetPreferences(\%preferences); >>
450 : parrello 1.1
451 :     Set preferences for this user. This does not replace all existing preferences.
452 :     Instead, the preferences specified in the map are updated or deleted, and any
453 : parrello 1.2 preferences not specified are unchanged. Note that the settings are not changed.
454 :     Instead, the changes are cached in memory until the L</SaveChanges> method is
455 :     called.
456 : parrello 1.1
457 :     =over 4
458 :    
459 :     =item preferences
460 :    
461 :     Reference to a hash mapping key names to preference values. Mapping a key
462 :     name to an undefined value indicates that the default preference value
463 :     should be used.
464 :    
465 :     =back
466 :    
467 :     =cut
468 :    
469 :     sub SetPreferences {
470 : parrello 1.2 # Get the parameters.
471 :     my ($self, $preferences) = @_;
472 :     # Loop through the settings. Each one is added to the main hash and then
473 :     # cached in the update hash.
474 :     my $changeMap = $self->{newPreferences};
475 :     for my $key (keys %{$preferences}) {
476 :     # Extract the category name from the key.
477 :     my $category = ParseCategory($key);
478 :     # Insure we have the category in memory.
479 :     my $hash = $self->GetCategoryHash($category);
480 :     # Add the new value to the category hash.
481 :     $hash->{$key} = $preferences->{$key};
482 :     # Add it to the update hash.
483 :     $changeMap->{$key} = $preferences->{$key};
484 :     }
485 : parrello 1.1 }
486 :    
487 :     =head3 SetDefault
488 :    
489 : parrello 1.2 C<< $userData->SetDefault($objectID, $objectType, $group, $level); >>
490 : parrello 1.1
491 : parrello 1.2 Set the group and default access level for the specified object. This update
492 :     takes place immediately.
493 : parrello 1.1
494 :     =over 4
495 :    
496 :     =item objectID
497 :    
498 :     ID of the object whose access level and group are to be set.
499 :    
500 :     =item objectType
501 :    
502 :     Type of the relevant object. This should be expressed as a Sprout entity name.
503 :     Currently, only C<Genome> and C<Subsystem> are supported.
504 :    
505 :     =item group
506 :    
507 :     Name of the group to which the object will belong. A user's access level for
508 :     this group will override the default access level.
509 :    
510 :     =item level
511 :    
512 :     Default access level. This is the access level used for user's who do not have
513 :     an explicit capability specified for the object's group.
514 :    
515 :     =back
516 :    
517 :     =cut
518 :    
519 :     sub SetDefault {
520 : parrello 1.2 # Get the parameters.
521 :     my ($self, $objectID, $objectType, $group, $level) = @_;
522 :     # Call the access method.
523 :     $self->{fig}->SetDefault($objectID, $objectType, $group, $level);
524 :     }
525 :    
526 :     =head3 SaveChanges
527 :    
528 :     C<< $userData->SaveChanges(); >>
529 :    
530 :     Store accumulated preference and capability changes.
531 :    
532 :     =cut
533 :    
534 :     sub SaveChanges {
535 :     # Get the parameters.
536 :     my ($self) = @_;
537 :     # Check for capability updates.
538 :     my $capabilityUpdates = $self->{newCapable};
539 :     if (keys %{$capabilityUpdates}) {
540 :     $self->{fig}->SetCapabilities($self->{user}, $capabilityUpdates);
541 :     }
542 :     # Check for preference updates.
543 :     my $preferenceUpdates = $self->{newPreferences};
544 :     if (keys %{$preferenceUpdates}) {
545 :     $self->{fig}->SetPreferences($self->{user}, $preferenceUpdates);
546 :     }
547 : parrello 1.1 }
548 :    
549 : parrello 1.2 =head3 ParseCategory
550 :    
551 :     C<< my $category = UserData::ParseCategory($key); >>
552 :    
553 :     Return the category name from the specified preference key. If no category is
554 :     specified, an error will occur.
555 :    
556 :     =over 4
557 :    
558 :     =item key
559 :    
560 :     Preference key, which consists of alphanumeric characters with colons separating
561 :     the sections.
562 :    
563 :     =item RETURN
564 :    
565 :     Returns the category name from the specified key.
566 :    
567 :     =back
568 :    
569 :     =cut
570 :    
571 :     sub ParseCategory {
572 :     # Get the parameters.
573 :     my ($key) = @_;
574 :     # Declare the return variable.
575 :     my $retVal;
576 :     # Try to parse out the category.
577 :     if ($key =~ /([^:]+):/) {
578 :     # Return the category.
579 :     $retVal = $1;
580 :     } else {
581 :     # Here we have no category, so it's an error.
582 :     Confess("No category specified on preference key \"$key\".");
583 :     }
584 :     return $retVal;
585 :     }
586 :    
587 :     =head3 GetCategoryHash
588 :    
589 :     C<< my $categoryHash = $self->GetCategoryHash($category); >>
590 :    
591 :     Return the hash for the specified category. If it is not in memory, it
592 :     will be read in.
593 :    
594 :     =over 4
595 :    
596 :     =item key
597 :    
598 :     Preference key, which consists of alphanumeric characters with colons separating
599 :     the sections.
600 :    
601 :     =item RETURN
602 :    
603 :     Returns the category name from the specified key.
604 :    
605 :     =back
606 :    
607 :     =cut
608 :    
609 :     sub GetCategoryHash {
610 :     # Get the parameters.
611 :     my ($self, $category) = @_;
612 :     # Declare the return variable.
613 :     my $retVal;
614 :     # Check to see if we have preferences for this category. If not, we need
615 :     # to read them in.
616 :     if (! exists $self->{preferences}->{$category}) {
617 :     # Get the default preferences if this is not the default user.
618 :     my $defaults = {};
619 :     if ($self->{user} ne 'basic') {
620 :     $defaults = $self->{fig}->GetPreferences('basic', $category);
621 :     }
622 :     # Get the user's preferences and merge them in.
623 :     my $overrides = $self->{fig}->GetPreferences($self->{user}, $category);
624 :     for my $key0 (%{$overrides}) {
625 :     $defaults->{$key0} = $overrides->{$key0};
626 :     }
627 :     # Add the new hash to the preferences hash.
628 :     $self->{preferences}->{$category} = $defaults;
629 :     # Return it.
630 :     $retVal = $defaults;
631 :     } else {
632 :     # Here the hash is already in memory.
633 :     $retVal = $self->{preferences}->{$category};
634 :     }
635 :     # Return the category hash.
636 :     return $retVal;
637 :     }
638 : parrello 1.1
639 : golsen 1.4 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3