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

Diff of /FigKernelPackages/FIG.pm

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

revision 1.393, Tue Nov 22 14:57:50 2005 UTC revision 1.394, Wed Nov 23 17:49:12 2005 UTC
# Line 9  Line 9 
9  use MIME::Base64;  use MIME::Base64;
10  use File::Basename;  use File::Basename;
11  use FileHandle;  use FileHandle;
12    use File::Copy;
13    
14  use DBrtns;  use DBrtns;
15  use Sim;  use Sim;
# Line 8702  Line 8703 
8703      $term =~ s/^\s*//g;      $term =~ s/^\s*//g;
8704      $term =~ s/\s*$//g;      $term =~ s/\s*$//g;
8705    
     my %key_info_hash;  
8706    
8707      if ( ! ($user && $peg && $vocab && $term_id && $term) ) {      if ( ! ($user && $peg && $vocab && $term_id && $term) ) {
8708          #print STDERR "add_cv_term: invalid arguments. All required, no empty strings\n";          #print STDERR "add_cv_term: invalid arguments. All required, no empty strings\n";
# Line 13291  Line 13291 
13291      return 0;      return 0;
13292  }  }
13293    
13294    =head2 UserData Helper Methods
13295    
13296    This section contains the methods used to implement UserData access. User data is
13297    stored in a subdirectory given by the user's name under the C<Users> directory
13298    in the Global directory tree. In other words, the data for the default user
13299    C<basic> would be at C<$FIG_Config::global/Users/basic>.
13300    
13301    In each directory, the C<capabilities.tbl> file contains the capability data and
13302    the C<preferences.tbl> file contains the preferences. Currently, preferences are
13303    stored in a single file, but if performance becomes a problem we may split them
13304    by category.
13305    
13306    Each of these files has two columns of data-- a key and a value. In the preferences
13307    file the key is a hierarchical construct with the pieces separated by colons, and
13308    the value is essentially a free-format string understood only by the application. In
13309    the capabilities file the key is a group name, and the value is an access level--
13310    C<RW> (full access), C<RO> (read-only access), or C<NO> (no access).
13311    
13312    Group names and key names are not allowed to contain white space. Tabs are used to
13313    separate them from the value strings or access levels. The value strings for
13314    preferences cannot contain tabs or new-lines. A backslash escape mechanism
13315    will be used to allow tabs and new-lines to be specified in the preference values.
13316    
13317    The files are sorted by key, to make updates easier.
13318    
13319    The special C<Security_Default> subdirectory is used to track the default security
13320    options for each secure object. The object's security group and default level
13321    are specified in a file whose name is formed by appending the object ID to the
13322    object type with an extension of "tbl". So, for example, the file containing the
13323    security default information for Genome 83333.1 would be
13324    
13325        $FIG_Config::global/Users/Security_Default/Genome_83333.1.tbl
13326    
13327    Each of these is a tiny file with the group name and default access level for that
13328    organism or subsystem. The two fields of the file are tab-separated, and any new-line
13329    character at the end is ignored.
13330    
13331    =head3 GetDefault
13332    
13333    C<< my ($group, $level) = $fig->GetDefault($objectID, $objectType); >>
13334    
13335    Return the group name and default access level for the specified object.
13336    
13337    =over 4
13338    
13339    =item objectID
13340    
13341    ID of the object whose capabilities data is desired.
13342    
13343    =item objectType
13344    
13345    Type of the object whose capabilities data is desired. This should be expressed
13346    as a Sprout entity name. Currently, the only types supported are C<Genome>
13347    and C<Subsystem>.
13348    
13349    =item RETURN
13350    
13351    Returns a two-element list. The first element is the name of the group
13352    to witch the object belongs; the second is the default access level
13353    (C<RW>, C<RO>, or C<NO>). If the object is not found, an empty list
13354    should be returned.
13355    
13356    =back
13357    
13358    =cut
13359    
13360    sub GetDefault {
13361        # Get the parameters.
13362        my ($self, $objectID, $objectType) = @_;
13363        # Declare the return variable.
13364        my @retVal = ();
13365        # Compute the file name for this object.
13366        my $fileName = _GetObjectCapabilityFile($objectType, $objectID);
13367        # Only proceed if the file exists and has data.
13368        if ($fileName && -e $fileName) {
13369            # Open the file and read the first line.
13370            Open(\*DEFAULTIN, "<$fileName");
13371            # Read the first (and only) line of the file.
13372            @retVal = _GetInputKVRecord(\*DEFAULTIN);
13373            # Close the file.
13374            close DEFAULTIN;
13375        }
13376        # Return the result.
13377        return @retVal;
13378    }
13379    
13380    =head3 GetPreferences
13381    
13382    C<< my $preferences = $fig->GetPreferences($userID, $category); >>
13383    
13384    Return a map of preference keys to values for the specified user in the
13385    specified category.
13386    
13387    =over 4
13388    
13389    =item userID
13390    
13391    ID of the user whose preferences are desired.
13392    
13393    =item category (optional)
13394    
13395    Name of the category whose preferences are desired. If omitted, all
13396    preferences should be returned.
13397    
13398    =item RETURN
13399    
13400    Returns a reference to a hash mapping each preference key to a value. The
13401    keys are fully-qualified; in other words, the category name is included.
13402    It is acceptable for the hash to contain key-value pairs outside the
13403    category. In other words, if it's easier for you to read the entire
13404    preference set into memory, you can return that one set every time
13405    this method is called without worrying about the extra keys.
13406    
13407    =back
13408    
13409    =cut
13410    
13411    sub GetPreferences {
13412        # Get the parameters.
13413        my ($self, $userID, $category) = @_;
13414        # Get the preferences. Note we use the category name followed by a colon
13415        # (the official separator character) to restrict the preferences to the
13416        # ones we want.
13417        my %retVal = _GetUserDataFile($userID, 'preferences', "$category:");
13418        # Return the data.
13419        return \%retVal;
13420    }
13421    
13422    =head3 GetCapabilities
13423    
13424    C<< my $level = $fig->GetCapabilities($userID); >>
13425    
13426    Return a map of group names to access levels (C<RW>, C<RO>, or C<NO>) for the
13427    specified user.
13428    
13429    =over 4
13430    
13431    =item userID
13432    
13433    ID of the user whose access level is desired.
13434    
13435    =item RETURN
13436    
13437    Returns a reference to a hash mapping group names to the user's access level
13438    for that group.
13439    
13440    =back
13441    
13442    =cut
13443    
13444    sub GetCapabilities {
13445        # Get the parameters.
13446        my ($self, $userID, $category) = @_;
13447        # Get the complete list of capabilities.
13448        my %retVal = _GetUserDataFile($userID, 'capabilities');
13449        # Return the data.
13450        return \%retVal;
13451    }
13452    
13453    =head3 AllowsUpdates
13454    
13455    C<< my $flag = $fig->AllowsUpdates(); >>
13456    
13457    Return TRUE if this access object supports updates, else FALSE. If the access object
13458    does not support updates, none of the B<SetXXXX> methods will be called.
13459    
13460    =cut
13461    
13462    sub AllowsUpdates {
13463        return 1;
13464    }
13465    
13466    =head3 SetDefault
13467    
13468    C<< $fig->SetDefault($objectID, $objectType, $group, $level); >>
13469    
13470    Set the group and default access level for the specified object.
13471    
13472    =over 4
13473    
13474    =item objectID
13475    
13476    ID of the object whose access level and group are to be set.
13477    
13478    =item objectType
13479    
13480    Type of the relevant object. This should be expressed as a Sprout entity name.
13481    Currently, only C<Genome> and C<Subsystem> are supported.
13482    
13483    =item group
13484    
13485    Name of the group to which the object will belong. A user's access level for
13486    this group will override the default access level.
13487    
13488    =item level
13489    
13490    Default access level. This is the access level used for user's who do not have
13491    an explicit capability specified for the object's group.
13492    
13493    =back
13494    
13495    =cut
13496    
13497    sub SetDefault {
13498        # Get the parameters.
13499        my ($self, $objectID, $objectType, $group, $level) = @_;
13500        # Find the target file.
13501        my $fileName = _GetObjectCapabilityFile($objectType, $objectID);
13502        if (! $fileName) {
13503            Confess("Invalid object $objectType ($objectID) specified in SetDefault.");
13504        } else {
13505            # Write out the new default data.
13506            Open(\*DEFAULTOUT, ">$fileName");
13507            _PutOutputKVRecord(\*DEFAULTOUT, $group, $level);
13508            close DEFAULTOUT;
13509        }
13510    }
13511    
13512    =head3 SetCapabilities
13513    
13514    C<< $fig->SetCapabilities($userID, \%groupLevelMap); >>
13515    
13516    Set the access levels by the specified user for the specified groups.
13517    
13518    =over 4
13519    
13520    =item userID
13521    
13522    ID of the user whose capabilities are to be updated.
13523    
13524    =item groupLevelMap
13525    
13526    Reference to a hash that maps group names to access levels. The legal
13527    access levels are C<RW> (read-write), C<RO> (read-only), and C<NO> (no
13528    access). An undefined value for the access level indicates the default
13529    level should be used for that group. The map will not replace all of
13530    the user's capability date; instead, it overrides existing data, with
13531    the undefined values indicating the specified group should be deleted
13532    from the list.
13533    
13534    =back
13535    
13536    =cut
13537    
13538    sub SetCapabilities {
13539        # Get the parameters.
13540        my ($self, $userID, $groupLevelMap) = @_;
13541        # Get the relevant file name.
13542        my $fileName = _GetUserDataDirectory($userID);
13543        # Insure this used is real.
13544        if (! $fileName) {
13545            Confess("Invalid user $userID specified when updating capabilities.");
13546        } else {
13547            # Process the updates.
13548            _ProcessUpdates("$fileName/capabilities.tbl", $groupLevelMap);
13549        }
13550    }
13551    
13552    =head3 SetPreferences
13553    
13554    C<< $fig->SetPreferences($userID, \%preferenceMap); >>
13555    
13556    Set the preferences for the specified user.
13557    
13558    =over 4
13559    
13560    =item userID
13561    
13562    ID of the user whose preferences are to be udpated.
13563    
13564    =item preferenceMap
13565    
13566    Reference to a hash that maps each preference key to its value. The
13567    keys should be fully-qualified (that is, they should include the
13568    category name). A preference key mapped to an undefined value will
13569    use the default preference value for that key. The map will not
13570    replace all of the user's preference data; instead, it overrides
13571    existing data, with the undefined values indicating the specified
13572    preference should be deleted from the list.
13573    
13574    =back
13575    
13576    =cut
13577    
13578    sub SetPreferences {
13579        # Get the parameters.
13580        my ($self, $userID, $preferencesMap) = @_;
13581        # Get the relevant file name.
13582        my $fileName = _GetUserDataDirectory($userID);
13583        # Insure this used is real.
13584        if (! $fileName) {
13585            Confess("Invalid user $userID specified when updating capabilities.");
13586        } else {
13587            # Process the updates.
13588            _ProcessUpdates("$fileName/preferences.tbl", $preferencesMap);
13589        }
13590    }
13591    
13592    =head3 CleanupUserData
13593    
13594    C<< $fig->CleanupUserData(); >>
13595    
13596    Release any data being held in memory for use by the UserData object.
13597    
13598    =cut
13599    
13600    sub CleanupUserData {
13601        # There is no data to clean up.
13602    }
13603    
13604    =head2 UserData Utilities
13605    
13606    =head3 GetObjectCapabilityFile
13607    
13608    C<< my $fileName = FIG::_GetObjectCapabilityFile($objectType, $objectID); >>
13609    
13610    This is an internal method that computed the name of the file containing the
13611    default group and access data for a specified object. It returns the file
13612    name.
13613    
13614    =cut
13615    
13616    sub _GetObjectCapabilityFile {
13617        # Get the parameters.
13618        my ($objectType, $objectID) = @_;
13619        # Clean name to insure it's valid.
13620        my $cleanObject = $objectID;
13621        $cleanObject =~ tr/: /__/;
13622        # Form the file name.
13623        my $retVal = "$FIG_Config::global/Users/Security_Default/${objectType}_$cleanObject.tbl";
13624        # Return the result.
13625        return $retVal;
13626    }
13627    
13628    =head3 GetUserDataDirectory
13629    
13630    C<< my $directoryName = FIG::_GetUserDataDirectory($userName); >>
13631    
13632    Return the name of the directory containing the user's preference and capability
13633    data. If the user does not have a directory, return C<undef>.
13634    
13635    =over 4
13636    
13637    =item userName
13638    
13639    Name of the user whose directory is desired.
13640    
13641    =item RETURN
13642    
13643    Returns the name of the user's preference/capability directory. If the user does
13644    not exist, will return C<undef>.
13645    
13646    =back
13647    
13648    =cut
13649    
13650    sub _GetUserDataDirectory {
13651        # Get the parameters.
13652        my ($userName) = @_;
13653        # Compute the directory name.
13654        my $directory = "$FIG_Config::global/Users/$userName";
13655        # Return it if it exists.
13656        my $retVal = ( -d $directory ? $directory : undef);
13657        return $retVal;
13658    }
13659    
13660    =head3 GetUserDataFile
13661    
13662    C<< my %userData = FIG::_GetUserDataFile($userID, $type, $prefix); >>
13663    
13664    Create a hash from the user data file of the specified type. The user data file
13665    contains two tab-delimited fields. The first field will be read in as the key
13666    of the hash and the second as the data value. The file must be sorted, and
13667    only records beginning with the character string in I<$prefix> will be put
13668    in the hash.
13669    
13670    =over 4
13671    
13672    =item userID
13673    
13674    Name of the user whose preference or capability data is desired.
13675    
13676    =item type
13677    
13678    Type of file desired: C<preferences> or C<capabilities>.
13679    
13680    =item RETURN
13681    
13682    Returns a hash containing all the key/value pairs in the user file of the
13683    specified type. If the file is not found, will return an empty hash.
13684    
13685    =back
13686    
13687    =cut
13688    
13689    sub _GetUserDataFile {
13690        # Get the parameters.
13691        my ($userID, $type, $prefix) = @_;
13692        # Declare the return value.
13693        my %retVal = ();
13694        # Try to find the user's directory.
13695        my $directory = _GetUserDataDirectory($userID);
13696        # Only proceed if it exists.
13697        if ($directory) {
13698            # Create the input file name.
13699            my $fileName = "$directory/$type.tbl";
13700            # If the file exists, we open it.
13701            if (-e $fileName) {
13702                Open(\*USERDATA, "<$fileName");
13703                # Use a null string for an undefined prefix, then compute the
13704                # minimum and maximum permissible key values. The EOF trick
13705                # works because keys should not contain non-ASCII characters.
13706                my $minKey = (defined $prefix ? $prefix : "");
13707                my $maxKey = $minKey . Tracer::EOF;
13708                # Read until we're done.
13709                my $done = 0;
13710                while (! $done) {
13711                    # Get the next record.
13712                    my ($key, $value) = _GetInputKVRecord(\*USERDATA);
13713                    # Process according to the nature of the data on the line.
13714                    if (! defined $key || $key ge $maxKey) {
13715                        # Here we're done. We've either hit end-of-file or
13716                        # the current line's key is too big.
13717                        $done = 1;
13718                    } elsif ($key ge $minKey) {
13719                        # Here we want to keep the line.
13720                        $retVal{$key} = $value;
13721                    }
13722                }
13723                # Close the file.
13724                close USERDATA;
13725            }
13726        }
13727        # Return the hash.
13728        return %retVal;
13729    }
13730    
13731    =head3 ProcessUpdates
13732    
13733    C<< FIG::_ProcessUpdates($fileName, \%map); >>
13734    
13735    Apply the specified updates to a key-value file. The records in the key-value file must
13736    be sorted. If a key in the map matches a key in the file, the file's key value is
13737    replaced. If a key in the map is not found in the file, it is added. If a key in the
13738    map is found in the file and it has an undefined value in the map, then the key
13739    is deleted.
13740    
13741    =over 4
13742    
13743    =item fileName
13744    
13745    Name of the file to be updated.
13746    
13747    =item map
13748    
13749    Reference to a hash mapping keys to values. The keys may not contain any whitespace.
13750    The value will be escaped before it is written.
13751    
13752    =back
13753    
13754    =cut
13755    
13756    sub _ProcessUpdates {
13757        # Get the parameters.
13758        my ($fileName, $map) = @_;
13759        # Create a temporary file for the update.
13760        my $tmpFileName = "$fileName$$.tmp";
13761        # Get the map keys in lexical order.
13762        my @keys = sort keys %{$map};
13763        # Push on the EOF constant.
13764        push @keys, Tracer::EOF;
13765        # These variable will contain the key and value fields of the current
13766        # record of the input file.
13767        my ($lineKey, $lineValue) = (Tracer::EOF, undef);
13768        # If the input file does not exist, we pretend it's empty. Otherwise,
13769        # we read the first line.
13770        if (-e $fileName) {
13771            Open(\*USERDATAIN, "<$fileName");
13772            ($lineKey, $lineValue) = _GetInputKVRecord(\*USERDATAIN);
13773        }
13774        # Finally, we open the temp file for output.
13775        Open(\*USERDATAOUT, ">$tmpFileName");
13776        # Get the first key.
13777        my $key = shift @keys;
13778        # Loop until we reach the end of both lists.
13779        while ($key lt Tracer::EOF || $lineKey lt Tracer::EOF) {
13780            # Compare the keys to determine what to do next.
13781            if ($lineKey lt $key) {
13782                # Here we must read the next record. First we have to write
13783                # the previous one. Note that if $lineValue is undefined,
13784                # the record is discarded automatically.
13785                _PutOutputKVRecord(\*USERDATAOUT, $lineKey, $lineValue);
13786                my ($lineKey, $lineValue) = _GetNextKVRecord(\*USERDATAIN);
13787            } elsif ($lineKey eq $key) {
13788                # Here we have a match. We select the new key's value as the
13789                # value of the line key and let the loop spin. When the key
13790                # is written to the output file, the new value will be used.
13791                # if the new value is undefined, the record is thrown away,
13792                # which is exactly what we want.
13793                $lineValue = $map->{$key};
13794                $key = shift @keys;
13795            } else {
13796                # Here the key in the map is new, so we write it to the
13797                # output file and get the next key.
13798                _PutOutputKVRecord(\*USERDATAOUT, $key, $map->{$key});
13799                $key = shift @keys;
13800            }
13801        }
13802        # Close the files.
13803        close USERDATAOUT;
13804        close USERDATAIN;
13805        # Replace the old file with the temporary. We delete the old file first so
13806        # that a rename is used for the move, which is safer.
13807        unlink $fileName;
13808        move($tmpFileName, $fileName);
13809    }
13810    
13811    =head3 GetInputKVRecord
13812    
13813    C<< my ($key, $value) = FIG::_GetInputKVRecord($handle); >>
13814    
13815    Read a key/value pair from the specified input file. If we are at end-of-file
13816    the key returned will be the C<Tracer::EOF> constant. The key and value are
13817    separated by a tab. The value will be unescaped if it exists.
13818    
13819    =over 4
13820    
13821    =item handle
13822    
13823    Open handle for the input file.
13824    
13825    =item RETURN
13826    
13827    Returns a two-element list. The first element will be the first field of the
13828    input record; the second element will be the second field. If we are at
13829    end-of-file, the first element will be the C<Tracer::EOF> constant.
13830    
13831    =back
13832    
13833    =cut
13834    
13835    sub _GetInputKVRecord {
13836        # Get the parameters.
13837        my ($handle) = @_;
13838        # Declare the return variables.
13839        my ($key, $value);
13840        # Read from the file.
13841        my $line = <$handle>;
13842        # Check to see if we got something.
13843        if (defined $line) {
13844            # Parse and return what we got. Note we strip the line terminator first.
13845            my $stripped = Tracer::Strip($line);
13846            ($key, $value) = split /\t/, $stripped, 2;
13847            # Insure the value is defined. If it is, we un-escape it.
13848            if (! defined $value) {
13849                $value = "";
13850            } else {
13851                $value = Tracer::UnEscape($value);
13852            }
13853        } else {
13854            # Here we've hit end-of-file, so we stuff in a trailer.
13855            ($key, $value) = (Tracer::EOF, "");
13856        }
13857        # Return the key and value.
13858        return ($key, $value);
13859    }
13860    
13861    =head3 PutOutputKVRecord
13862    
13863    C<< FIG::_PutOutputKVRecord($handle, $key, $value); >>
13864    
13865    Write a key-value pair to the output file. The value will automatically be
13866    escaped. A tab will be used to separate the fields.
13867    
13868    =over 4
13869    
13870    =item handle
13871    
13872    Open output file handle.
13873    
13874    =item key
13875    
13876    First field to put in the output record.
13877    
13878    =item value
13879    
13880    Value field to put in the output record. It will automatically be escaped. If it
13881    is undefined, the method will have no effect. An undefined value therefore serves
13882    as a deleted-line marker.
13883    
13884    =back
13885    
13886    =cut
13887    
13888    sub _PutOutputKVRecord {
13889        # Get the parameters.
13890        my ($handle, $key, $value) = @_;
13891        # Only proceed if we have a value.
13892        if (defined $value) {
13893            # Escape the value.
13894            my $trueValue = Tracer::Escape($value);
13895            # Write the output record.
13896            print $handle "$key\t$trueValue\n";
13897        }
13898    }
13899    
13900  =head2 FIG::Job module  =head2 FIG::Job module
13901    
13902  =cut  =cut

Legend:
Removed from v.1.393  
changed lines
  Added in v.1.394

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3