[Bio] / FigWebServices / Attributes.cgi Repository:
ViewVC logotype

View of /FigWebServices/Attributes.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (download) (annotate)
Tue Apr 29 07:59:22 2008 UTC (11 years, 9 months ago) by parrello
Branch: MAIN
CVS Tags: rast_rel_2008_06_18, rast_rel_2008_06_16, rast_rel_2008_07_21, mgrast_rel_2008_0806
Changes since 1.12: +2 -2 lines
Fixed. Deprecated ScriptSetup methods are no longer exported by Tracer.

#!/usr/bin/perl -w

BEGIN {
    # Print the HTML header.
    print "CONTENT-TYPE: text/html\n\n";
}

=head1 Custom Attribute Control Panel

This script allows people to explore and modify custom attributes. Two forms
are used. The Main Form allows the user to display and modify data for attribute
keys. The Group Form allows the user to display selected attribute keys.

Activity on this form that modifies the attributes requires specification of a user
name so that it can be properly logged.

It uses the following CGI form parameters.

=over 4

=item fieldName

Name of the custom attribute, in the form of an entity name, a slash,
and an attribute name. For a new attribute, it contains just the
entity name.

=item dataType

Data type of the field.

=item notes

Descriptive text about the field.

=item newName

New field name. For a new field, this is the name it will be given. For an old
field, this will be a new name to give to it. If this parameter is blank for an
old field, then the field will not be renamed.

=item newValueFile

A file from which the new attribute values should be uploaded.

=item user

Name of the user making the request. This is put into the output log.

=item Delete

If specified, indicates the field is to be deleted.

=item Store

If specified, indicates the field is to be created/updated/uploaded.

=item Show

If specified, indicates the field is to be displayed.

=item showGroup

Name of the group to display.

=item List

If specified, indicates the group's attribute keys should be displayed on a control form.

=item newGroup

Name of a new group to add.

=item Add

If specified, indicates we are to add a new group to the group list.

=item Upload

If specified, indicates attribute data is to be uploaded from the upload file.

=item Erase

If specified, indicates the current attribute is to have its values erased.

=back

=head2 Notes on Using this Page

Each attribute key is divided into two parts: the I<real key> and the I<sub key>, each separated by a
double colon (C<::>). This web page allows the user to manipulate real keys. The real portion of an
attribute key must be defined in advance. If it is not found in the database, any attempt to use the
key will fail.

To create a key, you must specify the key name, its data type, and a text description of what the key
does. The data type and text description function only as comments, but they are important tools for
users who wish to understand the attribute data.

This page also allows the user to create and delete groups. An attribute key can belong to many groups or
no groups at all. Some groups are used by the NMPDR when constructing its search database. Others may
indicate the type of object to which an attribute can be attached. These are used to implement some of
the legacy methods from the old attribute system.

The number of attribute keys may potentially run into the thousands, so when the page initially comes up,
no attribute keys are displayed except for C<(new)> (which is used to add new attributes). To display attributes,
use the group form at the bottom to either specify a group to display (B<SHOW>) or to find all attribute keys that
begin with a certain string (B<FIND>). If you press the B<FIND> button without entering a character string
in the text box next to it, all attributes will be displayed.

=head3 Logging

All updates from this page are logged in the attribute log. If you attempt an update operation, you will
get an error unless you've entered your name at the top of the page.

In addition, any file you upload will be saved on the attribute server. This saved file can be used
later to resubmit the operation from the command line using the C<AttrDBRefresh> script.

=head3 Common Tasks

To update an attribute key, select the attribute key in the top form, update its description, and click B<STORE>.

To add a new attribute key, select the C<(new)> entry in the top form, specify the key name in the
B<New Field Name> box, specify a description of at least 10 words and a type, and click B<STORE>.

To delete an attribute key, select the attribute key in the top form and click B<DELETE>.

To erase all the values of an attribute key, select the attribute key in the top form and click B<ERASE>.

To display all the values of an attribute key, select the attribute key in the top form and click B<SHOW>.

=head3 Uploading

You can upload new attribute values via the B<UPLOAD> button. The file you upload must exist on the same
machine that is running the web browser. If you wish to upload from a file on the attribute server, you
need to go to the attribute server itself and execute the C<AttrDBRefresh> command.

The file being uploaded must be in tab-delimited format with three or more fields on each line. The
first field is the ID of the object that has the attribute, the second field is the attribute key
(either the real key or a real key attached to a sub key), and all remaining fields are concatenated
together to form the value. Blank lines in the file, as well as lines beginning with a pound sign (C<#>),
are treated as comments.

With the exception of genome numbers, feature IDs, and subsystem names, the object IDs must have a type
indication. So, while a genome can be specified as C<100226.1>, a family must be specified as
C<Family:aclame|cluster10>. If all of the keys in an upload file are of the same type and the type is
not specified in the file, then you can specify the object type in the B<Object Type> box. So, if your
file contains family IDs like

    aclame|cluster10
    aclame|cluster12

and so forth, you can specify an object type of C<Family>, and the IDs will be corrected before being
put into the attribute database.

The default process for uploading data automatically erases the values currently attached to any real
keys encountered in the upload file. This behavior can be changed using the B<Upload Type> box. Set
it to C<insert> to add the new values to existing values in the database. Set it to C<replace> for
normal operation.

=cut

use strict;
use Tracer;
use CGI;
use FIG;
use CustomAttributes;

my ($cgi, $varHash) = Tracer::ScriptSetup();
# This is a useful hash that maps legal data types to object type prefixes used in attribute
# object IDs.
my %typeHash = (Genome => '',
                Feature => '',
                Subsystem => '',
                Contig => 'Contig',
                Coupling => 'Coupling',
                Role => 'Role',
                Compound => 'Compound',
                Reaction => 'Reaction',
                Family => 'Family',
                Diagram => 'Diagram',
                '<mixed>' => ''
               );
eval {
    # Get the display group and user name (if any).
    my $group = $cgi->param("showGroup");
    my $user = $cgi->param('user') || '';
    # Get the attribute object, passing in the user name.
    my $ca = CustomAttributes->new(user => $user);
    # Get the field name (if any).
    my $fieldName = $cgi->param('fieldName');
    # Get the mode, user, and filter strings (if any).
    my $mode = $cgi->param('mode') || 'group';
    my $filter = $cgi->param('filter') || '';
    # Create a storage unit for attribute data.
    my %keys = ();
    # Check to see if we're doing something.
    if ($cgi->param('Delete')) {
        # Only proceed if this user is allowed to modify attributes.
        if (CheckUser($user)) {
            $varHash->{results} = DeleteAttribute($ca, $cgi, $fieldName);
            # Get the keys for the current data set.
            %keys = $ca->GetAttributeData($mode, $filter);
            # Display a message.
            $varHash->{message} = "Attribute deleted.";
        }
    } elsif ($cgi->param('Erase')) {
        # Only proceed if this user is allowed to modify attributes.
        if (CheckUser($user)) {
            $varHash->{results} = EraseAttribute($ca, $cgi, $fieldName);
            # Get the keys for the current data set.
            %keys = $ca->GetAttributeData($mode, $filter);
            # Display a message.
            $varHash->{message} = "Attribute erased.";
        }
    } elsif ($cgi->param('Upload')) {
        # Only proceed if this user is allowed to modify attributes.
        if (CheckUser($user)) {
            $varHash->{results} = UploadAttribute($ca, $cgi);
            # Get the keys for the current data set.
            %keys = $ca->GetAttributeData($mode, $filter);
            # Display a message.
            $varHash->{message} = "Attribute data uploaded.";
        }
    } elsif ($cgi->param('Store')) {
        # Only proceed if this user is allowed to modify attributes.
        if (CheckUser($user)) {
            $varHash->{results} = StoreAttribute($ca, $cgi, $fieldName);
            # Get the keys for the current data set.
            %keys = $ca->GetAttributeData($mode, $filter);
            # Display a message.
            $varHash->{message} = "Attribute stored.";
        }
    } elsif ($cgi->param('Show')) {
            $varHash->{results} = ShowAttribute($ca, $cgi, $fieldName);
            # Get the keys for the current data set.
            %keys = $ca->GetAttributeData($mode, $filter);
            # Display a message.
            $varHash->{message} = "Attribute displayed.";
    } elsif ($cgi->param('DelGroup')) {
        # Only proceed if this user is allowed to modify attributes.
        if (CheckUser($user)) {
            # Get the keys for this group before we delete the group.
            %keys = $ca->GetAttributeData(group => $group);
            # Delete the group.
            $varHash->{results} = DeleteGroup($ca, $cgi, $group);
            # Display a message.
            $varHash->{message} = "Group deleted.";
        }
    } elsif ($cgi->param('List')) {
        # Here we're putting selected attributes into the form. There are two ways we can get an attribute
        # list, depending on the value of the list parm.
        my $listMode = $cgi->param('List');
        if ($listMode eq 'FIND') {
            # Here we want the keys that begin with the text in the field "keyString".
            $filter = $cgi->param('keyString');
            %keys = $ca->GetAttributeData(name => $filter);
            $mode = 'name';
        } else {
            # Here we want the keys that belong to the group specified in the field "showGroup".
            $filter = $cgi->param('showGroup');
            %keys = $ca->GetAttributeData(group => $filter);
            $mode = 'group';
        }
        # Tell the user what we just did, in case the results are not what was expected.
        my $count = scalar(keys %keys);
        $varHash->{message} = $cgi->p("$count attribute keys found using method $listMode with data \"$filter\".");
    } elsif ($cgi->param( 'Add')) {
        # Only proceed if this user is allowed to modify attributes.
        if (CheckUser($user)) {
            # Here the user wants to add a new group.
            $varHash->{results} = AddGroup($ca, $cgi);
            # Denote we have no keys to display.
            %keys = ();
            # Display a message.
            $varHash->{message} = "Group added.";
        }
    }
    # Display the control form, upload form, and group form for the selected attributes.
    $varHash->{form} = DisplayForm($ca, $cgi, \%keys, $mode, $filter, $user);
};
if ($@) {
    $varHash->{message} = $cgi->h3("Script Error: $@");
}
Tracer::ScriptFinish("Html/Attributes_tmpl.html", $varHash);

=head2 Script Methods

=head3 DeleteGroup

    my $html = DeleteGroup($ca, $cgi, $groupName);

Delete the specified attribute group.

=over 4

=item ca

B<CustomAttribute> object for the attribute data.

=item cgi

CGI query object for generating the HTML.

=item groupName

Name of the group to delete.

=item RETURN

Returns HTML describing the results of the deletion.

=back

=cut

sub DeleteGroup {
    # Get the parameters.
    my ($ca, $cgi, $groupName) = @_;
    # Delete the group.
    my $stats = $ca->Delete('AttributeGroup', $groupName);
    # Describe the result.
    my $retVal = $cgi->p("Group $groupName deleted from attribute database.") . "\n";
                 $cgi->pre($stats->Show());
    # Return it.
    return $retVal;
}

=head3 DisplayForm

    my $html = DisplayForm($ca, $cgi, \%keys, $mode, $filter, $user);

Display a form for modifying or updating the specified list of attribute
keys.

=over 4

=item varHash

=item ca

Current B<CustomAttributes> object.

=item cgi

CGI query object containing the active form parameters.

=item keys

Reference to a hash of attribute keys. Each key is mapped to an n-tuple consisting
of the data type, description, and parent groups.

=item mode

Retrieval mode used to get the current list of attributes.

=item filter

Filter string used to get the current list of attributes.

=item user (optional)

Name of the current user.

=item RETURN

Returns the HTML for the display form, which includes a section for attribute control and
a section for group management and searching.

=back

=cut

sub DisplayForm {
    # Get the parameters.
    my ($ca, $cgi, $keys, $mode, $filter, $user) = @_;
    # Compute the group to pre-select. We start with the last group selected.
    # If there is none, we look for the new group just created.
    my $group = $cgi->param('showGroup') || $cgi->param('newGroup');
    # If THAT failed, we look for the first group to which the last attribute key belonged.
    if (! $group) {
        my @groups = $cgi->param('groups');
        $group = $groups[0];
    }
    # Create an array to hold the lines of text.
    my @retVal = ();
    # Create the attribute form. Note that because we use an upload control it has to be
    # multi-part.
    push @retVal,
                $cgi->start_multipart_form(-name => 'custom'),
                $cgi->p("Your Name: " . $cgi->textfield(-name => 'user', value => $user, size => 40)),
                $ca->ControlForm($cgi, 'custom', $keys),
                $cgi->hidden(-name => 'mode', -value => $mode),
                $cgi->hidden(-name => 'filter', -value => $filter),
                $cgi->p('&nbsp;');
    # Add the upload form.
    push @retVal,
                $cgi->table({ border => 2 },
                            $cgi->Tr($cgi->th("Upload Attributes From File"),
                                     $cgi->td($cgi->filefield(-name => 'newValueFile',
                                                              -size => 20))),
                            $cgi->Tr($cgi->th("Object Type"),
                                     $cgi->td($cgi->popup_menu(-name => 'objectType',
                                                               -values => [sort keys %typeHash],
                                                               -default => '<mixed>'))),
                            $cgi->Tr($cgi->th("Upload Type"),
                                     $cgi->td($cgi->popup_menu(-name => 'uploadType',
                                                               -values => ['insert', 'replace'],
                                                               -default => 'replace'))),
                            $cgi->Tr($cgi->th('&nbsp;'),
                                     $cgi->td({align => 'center' },
                                              $cgi->submit(-name => 'Upload',
                                                           -value => 'UPLOAD')))
                           ),
                $cgi->p('&nbsp;');
    # Set up the group form. We do this at the end in case a new group was
    # added.
    my @groups = $ca->GetGroups();
    push @retVal,
                $cgi->table({ border => 2 },
                    $cgi->Tr($cgi->th("Select Group"),
                        $cgi->td($cgi->popup_menu(-name => 'showGroup',
                                                  -values => \@groups,
                                                  -default => $group)),
                        $cgi->td($cgi->submit(-name => 'List',
                                              -value => 'SHOW') .
                                 $cgi->br .
                                 $cgi->submit(-name => 'DelGroup',
                                               -value => 'DELETE')),
                        ),
                    $cgi->Tr($cgi->th("Add New Group"),
                        $cgi->td($cgi->textfield(-name => 'newGroup',
                                                 -size => 40,
                                                 -maxlength => 60)),
                        $cgi->td($cgi->submit(-name => 'Add',
                                               -value => 'CREATE')),
                        ),
                    $cgi->Tr($cgi->th("Find Keys that start with"),
                        $cgi->td($cgi->textfield(-name => 'keyString',
                                                 -size => 30,
                                                 -maxlength => 64)),
                        $cgi->td($cgi->submit(-name => 'List',
                                              -value => 'FIND')),
                        ),
                    ),
                $cgi->end_form();
    # Return the result.
    return join("\n", @retVal, "");
}

=head3 UploadAttribute

    my $html = UploadAttribute($ca, $cgi);

Upload attribute data from a tab-delimited file.

=over 4

=item ca

B<CustomAttributes> object used to connect to the attribute database.

=item cgi

CGI object containing the query parameters.

=item RETURN

Returns HTML text describing the upload operation.

=back

=cut

sub UploadAttribute {
    # Get the parameters.
    my ($ca, $cgi) = @_;
    # We'll accumulate HTML in here.
    my @retVal = ();
    # Get the parameters. First we have the type prefix for the object IDs.
    my $objectType = $typeHash{$cgi->param('objectType')};
    # Next is the mode: append or replace.
    my $append = ($cgi->param('uploadType') eq 'insert');
    # Finally, we get the upload file handle.
    my $uh = $cgi->upload('newValueFile');
    if (! defined $uh) {
        push @retVal, $cgi->p("No file specified for upload.");
    } else {
        Trace("Upload file handle type is " . ref($uh) . ".") if T(3);
        # Get an archive file name.
        my $fileName = $ca->ArchiveFileName();
        # Here we have all we need to upload.
        my $stats = $ca->LoadAttributesFrom($uh, archive => $fileName,
                                                 objectType => $objectType,
                                                 append => $append);
        # Display the results.
        push @retVal, $cgi->p("Attribute upload data saved in $fileName.");
        push @retVal, $cgi->p("Statistics from new values upload.");
        push @retVal, $cgi->pre($stats->Show());
    }
    # Return the HTML string.
    return join("\n", @retVal, "");
}

=head3 EraseAttribute

    my $html = EraseAttribute($ca, $cgi, $fieldName);

Erase all values for the specified attribute key. The key specified is a real key, without an attached
subkey.

=over 4

=item ca

B<CustomAttributes> object used to access the attribute database.

=item cgi

CGI query object containing the form parameters.

=item fieldName

Name of the attribute key to erase.

=item RETURN

Returns html text describing the operation.

=back

=cut

sub EraseAttribute {
    # Get the parameters.
    my ($ca, $cgi, $fieldName) = @_;
    # Declare the return variable. We'll stuff lines of HTML in here.
    my @retVal = ();
    # Insure the field name is valid.
    if ($fieldName eq CustomAttributes::NewName()) {
        push @retVal, $cgi->h3("Select an existing attribute key.");
    } else {
        # Erase the values.
        $ca->EraseAttribute($fieldName);
        push @retVal, $cgi->p("Attribute key $fieldName erased.");
    }
    # Return the result.
    return join("\n", @retVal, "");
}

=head3 DeleteAttribute

    my $html = DeleteAttribute($ca, $cgi, $fieldName);

Delete the specified attribute and return HTML describing the results.

=over 4

=item ca

CustomAttributes object used to access the attribute data.

=item cgi

CGI query object containing the parameters.

=item fieldName

Name of the attribute key to delete.

=item RETURN

Returns HTML describing the results of the deletion.

=back

=cut

sub DeleteAttribute {
    # Get the parameters.
    my ($ca, $cgi, $fieldName) = @_;
    # Declare the return variable.
    my @retVal = ();
    # Insure the field name is valid.
    if ($fieldName eq CustomAttributes::NewName()) {
        push @retVal, $cgi->h3("Select an existing attribute key.");
    } else {
        # Delete the field.
        $ca->DeleteAttributeKey($fieldName);
        push @retVal, $cgi->p("Attribute key $fieldName deleted.");
    }
    # Return the result.
    return join("\n", @retVal, "");
}

=head3 ShowAttribute

    my $html = ShowAttribute($ca, $cgi, $fieldName);

Return HTML to display the values of the specified attributes.

=over 4

=item ca

CustomAttributes object used to access the attribute data.

=item cgi

CGI query object containing the parameters.

=item fieldName

Name of the attribute key to display.

=item RETURN

Returns HTML displaying the values of the specified attribute for each object
to which it is attached.

=back

=cut

sub ShowAttribute {
    # Get the parameters.
    my ($ca, $cgi, $fieldName) = @_;
    # Declare the return variable. We'll generate rows of text and form them up
    # when we're done.
    my @retVal = ();
    # Attempt to find attributes.
    Trace("Retrieving attribute key $fieldName.") if T(3);
    my @attrList = $ca->GetAttributes(undef, "$fieldName$ca->{splitter}%");
    # Check for the null case.
    if (! @attrList) {
        Trace("No values found.") if T(3);
        push @retVal, $cgi->h3("No values found for $fieldName.");
    } else {
        my @sorted = sort { $a->[0] cmp $b->[0] } @attrList;
        Trace("Building the table. " . scalar(@attrList) . " values found.") if T(3);
        # Start the table.
        push @retVal, $cgi->start_table({ border => 2, cellpadding => 2 });
        push @retVal, $cgi->Tr($cgi->th(['ID', 'Key', 'Values']));
        # Loop through the attribute list, showing the attributes.
        for my $row (@sorted) {
            push @retVal, $cgi->Tr($cgi->td($row));
        }
        # Close the table.
        push @retVal, $cgi->end_table();
    }
    # Return the result.
    return join("\n", @retVal, "");
}

=head3 StoreAttribute

    my $html = StoreAttribute($ca, $cgi, $fieldName);

Update or create an attribute using information from a form.

=over 4

=item ca

CustomAttributes object used to access the attribute data.

=item cgi

CGI query object describing the attribute and the actions to be taken.

=item fieldName

Name of the attribute key to update, or "(new)" for a new attribute key.

=item RETURN

Returns HTML text describing the results of the update.

=back

=cut

sub StoreAttribute {
    # Get the parameters.
    my ($ca, $cgi, $fieldName) = @_;
    # Declare a variable into which we'll assemble lines of HTML.
    my @retVal = ();
    # Set this to 0 if we have an error.
    my $okFlag = 1;
    # First we need to do a little validation. If we're creating, there
    # absolutely must be a new name.
    my $newName = $cgi->param('newName');
    if ($fieldName eq CustomAttributes::NewName()) {
        if (! $newName) {
            push @retVal, $cgi->h3("No new name specified while creating a new key.");
            $okFlag = 0;
        } elsif (! ERDB::ValidateFieldName($newName)) {
            push @retVal, $cgi->h3("Invalid key name \"$newName\" specified.");
            $okFlag = 0;
        }
    }
    if ($okFlag) {
        # Okay, now we're ready to go. We will do a store-attribute operation and
        # an upload if requested.
        if ($fieldName eq CustomAttributes::NewName()) {
            # Here we have a new field.
            $fieldName = $newName;
        }
        # Store the new field information in the database.
        my @groups = $cgi->param('groups');
        $ca->StoreAttributeKey($fieldName, $cgi->param('dataType'), $cgi->param('notes'),
                               \@groups);
        push @retVal, $cgi->p("Key definition for $fieldName stored.");
    }
    # Return the result.
    return join("\n", @retVal, "");
}

=head3 AddGroup

    my $html = AddGroup($ca, $cgi);

Add a new group to the attribute database.

=over 4

=item ca

CustomAttributes object.

=item cgi

CGI query object containing the form data.

=item RETURN

Returns HTML describing the results of the update.

=back

=cut

sub AddGroup {
    # Get the parameters.
    my ($ca, $cgi) = @_;
    # Declare the return variable. We'll accumulate lines of HTML and then
    # assemble them when we're done.
    my @retVal = ();
    # Get the proposed new group name.
    my $newGroup = $cgi->param('newGroup');
    # Verify that it's valid.
    if (! $newGroup) {
        push @retVal, $cgi->h3("Please specify a new group name.");
    } elsif ($newGroup =~ /(\W+)/) {
        push @retVal, $cgi->h3("Illegal characters \"$1\" found in proposed new group name.");
    } elsif ($newGroup =~ /^(\d|_)/) {
        push @retVal, $cgi->h3("Group names cannot start with \"$1\".");
    } else {
        $ca->InsertObject('AttributeGroup', { id => $newGroup });
        push @retVal, $cgi->p("New group \"$newGroup\" added to database.");
    }
    # Return the result.
    return join("\n", @retVal, "");
}

=head3 CheckUser

    my $okFlag = CheckUser($user);

Returns TRUE if the specified user can update attributes, otherwise it dies with an error
message. In the current implementation, any nonblank user name will work.

=over 4

=item user

Name of the user who is proposing to update

=item RETURN

TRUE if the user can update attributes.

=back

=cut

sub CheckUser {
    # Get the parameters.
    my ($user) = @_;
    # Check the user name.
    if (! $user) {
        # No user name, so we generate an error.
        Confess("A user name must be specified to support this operation.");
    }
    # Return a success indication.
    return 1;
}

1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3