[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.559, Fri Jan 19 17:42:43 2007 UTC revision 1.560, Mon Jan 22 20:03:42 2007 UTC
# Line 9929  Line 9929 
9929      }      }
9930  }  }
9931    
   
9932  =head3 get_cv_attributes  =head3 get_cv_attributes
9933    
9934  A simple wrapper around get_attriubtes to return only those attributes  A simple wrapper around get_attriubtes to return only those attributes
# Line 9943  Line 9942 
9942      return ();      return ();
9943  }  }
9944    
   
9945  =head3 add_attribute  =head3 add_attribute
9946    
9947  Add a new key/value pair to something. Something can be a genome id, a peg, an rna, prophage, whatever.  Add a new key/value pair to something. Something can be a genome id, a peg, an rna, prophage, whatever.
# Line 9988  Line 9986 
9986      }      }
9987  }  }
9988    
9989    =head3 find_attributes
9990    
9991    C<< my @attributeList = $fig->find_attributes($keywordString); >>
9992    
9993    Locate attributes containing specified keywords in the key name or value.
9994    
9995    =over 4
9996    
9997    =item keywordString
9998    
9999    String of keywords, space-delimited. Case does not matter. Normally, this
10000    will be a single word, but the full range of ERDB keyword search operators
10001    is supported.
10002    
10003    =item RETURN
10004    
10005    Returns a list of tuples, as is the case with L</get_attributes>.
10006    
10007    =back
10008    
10009    =cut
10010    
10011    sub find_attributes {
10012        # Get the parameters.
10013        my ($self, $keywordString) = @_;
10014        my @retVal;
10015        # Declare the return variable.
10016        if (exists $self->{_ca}) {
10017            # Here we can use the new system.
10018            @retVal = $self->{_ca}->FindAttributes($keywordString);
10019        } else {
10020            Confess("find_attributes not supported in old code.");
10021        }
10022        # Return the result.
10023        return @retVal;
10024    }
10025    
10026  =head3 delete_attribute  =head3 delete_attribute
10027    
10028  Remove a key from a feature.  Remove a key from a feature.
# Line 10943  Line 10978 
10978      #      #
10979      my($self,$searchTerm)=@_;      my($self,$searchTerm)=@_;
10980      return unless( $searchTerm);      return unless( $searchTerm);
10981        my @results;
10982        if ($self->{_ca}) {
10983            # Here we're using the new attribute system.
10984        } else {
10985      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
10986    
10987      # An error check to make sure that we are operating on the new version of attributes      # An error check to make sure that we are operating on the new version of attributes
# Line 10966  Line 11005 
11005          #the prior way - modified to accomodate consistent format of downloaded results          #the prior way - modified to accomodate consistent format of downloaded results
11006          #push (@results, [$fid, $org, "[attribute $tag] $value",""] );          #push (@results, [$fid, $org, "[attribute $tag] $value",""] );
11007      }      }
11008        }
11009      return @results;      return @results;
11010  }  }
11011    
# Line 11036  Line 11076 
11076    
11077  =head3 search_index  =head3 search_index
11078    
11079  usage: ($pegs,$roles) = $fig->search_pattern($pattern)  C<< my ($pegs,$roles) = fig->search_index($pattern, $non_word_search, $user); >>
11080    
11081    Find all pegs and roles that match a search pattern. The syntax of I<$pattern>
11082    is deliberately left undefined so that we can change the underlying technology, but
11083    a single word or phrase should work.
11084    
11085    =over 4
11086    
11087    =item pattern
11088    
11089    A search pattern. In general, the pattern is a single word or phrase that is expected
11090    to occur somewhere in a functional role, attribute key, or attribute value.
11091    
11092    =item non_word_search (optional)
11093    
11094    If specified, the pattern will be interpreted as a string instead of a series of
11095    words.
11096    
11097    =item user (optional)
11098    
11099  All pegs that "match" $pattern are put into a list, and $pegs will be a  If specified, the name of the current user. That user's annotation will be given precedence
11100  pointer to that list.  when the functional role is determined.
11101    
11102  All roles that "match" $pattern are put into a list, and $roles will be a  =item RETURN
11103  pointer to that list.  
11104    Returns a 2-tuple. The first element is a reference to a list of features. For each
11105    feature, there is a tuple consisting of the (0) feature ID, (1) the organism name (genus
11106    and species), (2) the aliases, (3) the functional role, and (4) the relevant annotator. The
11107    second element in the returned tuple is a reference to a list of functional roles. All
11108    the roles and features in the lists must match the pattern in some way.
11109    
11110  The notion of "match $pattern" is intentionally left undefined.  For now, you  =back
 will probably get only entries in which each word id $pattern occurs exactly,  
 but that is not a long term commitment.  
11111    
11112  =cut  =cut
11113    
11114  sub search_index {  sub search_index {
11115      my($self,$pattern, $non_word_search) = @_;      # Get the parameters.
11116      my($patternQ,@raw,@pegs);      my ($self, $pattern, $non_word_search, $user) = @_;
11117        # Clean up the temporary directory to insure there's room for search results.
11118      &clean_tmp;      &clean_tmp;
11119      $patternQ = $pattern;      # Convert the search pattern to Glimpse format. First, we convert spaces to semicolons.
11120        my $patternQ = $pattern;
11121      $patternQ =~ s/\s+/;/g;      $patternQ =~ s/\s+/;/g;
11122        # Stop here to extract the search terms.
11123        my @words = split /;/, $pattern;
11124        Trace("Word list = (" . join(", ", @words) . ")") if T(Glimpse => 3);
11125        # Now escape the periods.
11126      $patternQ =~ s/\./\\./g;      $patternQ =~ s/\./\\./g;
11127        # Compute the glimpse directory. This facility is provided for testing purposes only.
11128      my $glimpse_args = "-y  -H $FIG_Config::data/Indexes -i";      # If a "glimpse" member is specified in FIG_Config, then it will be presumed to contain
11129        # glimpse indexes. Thus, we can load a test index into a separate directory and twiddle
11130        # FIG_Config so we can run against the test index.
11131        my $dirName = (defined($FIG_Config::glimpse) ? $FIG_Config::glimpse : "$FIG_Config::data/Indexes");
11132        # Format the glimpse options. This is where the "non_word_search" parameter
11133        # is incorporated.
11134        my $glimpse_args = "-y -H \"$dirName\" -i";
11135      $glimpse_args .= " -w" unless $non_word_search;      $glimpse_args .= " -w" unless $non_word_search;
11136      $glimpse_args .= " \'$patternQ\'";      $glimpse_args .= " \'$patternQ\'";
11137        Trace("Search pattern = \"$pattern\", normalized to \"$patternQ\".") if T(Glimpse => 3);
11138        Trace("Glimpse parameters are: $glimpse_args") if T(Glimpse => 3);
11139        Trace("Glimpse directory is $FIG_Config::ext_bin") if T(Glimpse => 3);
11140        # Get the raw glimpse output. We also keep the error output for tracing purposes.
11141        my $errorFile = "$FIG_Config::temp/glimpseErrors$$.log";
11142        my @raw = `$FIG_Config::ext_bin/glimpse $glimpse_args 2>$errorFile`;
11143        # my @raw = `$FIG_Config::ext_bin/glimpse $glimpse_args`;
11144        my $rawCount = @raw;
11145        if ($rawCount == 0) {
11146            # No lines returned, so trace the error lines.
11147            my $errors = Tracer::GetFile($errorFile);
11148            Trace("Error lines from Glimpse:\n$errors") if T(Glimpse => 3);
11149        } else {
11150            Trace("$rawCount lines returned from glimpse.") if T(Glimpse => 3);
11151        }
11152        # Extract the feature lines from the raw data.
11153        my @pegs  =  map { $_ =~ /^\S+:\s+(\S.*\S)/; [split(/\t/,$1)] }
11154                  grep { $_ =~ /^\S+peg.index/ } @raw;
11155        # Create a hash to hold the PEG data found so far.
11156        my %pegsFound = ();
11157        # Put the pegs found so far into the hash.
11158        for my $rawTuple (@pegs) {
11159            # Get this peg's data.
11160            my ($peg, $gs, $aliases, @funcs) = @{$rawTuple};
11161            # Only proceed if the peg exists.
11162            if (! $self->is_deleted_fid($peg)) {
11163                # Clean the glimpse markers out of the aliases. While we're at it, make
11164                # sure we have a string instead of an undef.
11165                if ($aliases) {
11166                    $aliases =~ s/^aliases://;
11167                } else {
11168                    $aliases = "";
11169                }
11170                # Process the functional assignments. Some of these will actually be
11171                # attribute key-value pairs. We'll create one list for stashing functional
11172                # assignments, and another for stashing attribute data. Note that we'll
11173                # only keep attributes that match one of the search words.
11174                my @functionList = ();
11175                my @attributeList = ();
11176                for my $func (@funcs) {
11177                    Trace("$peg Function: $func") if T(Glimpse => 4);
11178                    if ($func =~ /^function:\s*(.+)#(.+)$/) {
11179                        # Here we have a functional assignment. We push it onto the
11180                        # function list in the form (user, function).
11181                        push @functionList, [$2,$1];
11182                    } elsif ($func =~ /^attribute:\s*(.+)$/) {
11183                        # Here we have an attribute. We only care if one of our
11184                        # search terms is in it.
11185                        Trace("Attribute entry $func.") if T(Glimpse => 4);
11186                        my $attributeAssignment = $1;
11187                        my $found = grep { $attributeAssignment =~ /$_/i } @words;
11188                        if ($found) {
11189                            push @attributeList, $attributeAssignment;
11190                        }
11191                    }
11192                }
11193                # Find the desired functional role.
11194                my ($who, $function) = $self->choose_function($user, @functionList);
11195                # Store this peg in the hash.
11196                $pegsFound{$peg} = [$gs, $aliases, $function, $who, join("; ", @attributeList)];
11197            }
11198        }
11199        my $pegCount = keys %pegsFound;
11200        Trace("Raw glimpse results processed. $pegCount pegs found.") if T(Glimpse => 3);
11201        # Now form the list of PEGs from the hash.
11202        @pegs = map { [$_, @{$pegsFound{$_}}] } sort { &FIG::by_fig_id($a,$b) } keys %pegsFound;
11203        # PEGs are done, now do the roles.
11204        my @rolesT = grep { $_ =~ /^\S+role.index/ } @raw;
11205        my %roles  = map { $_ =~ /^\S+:\s+(\S.*\S)/; $1 => 1;} @rolesT;
11206        my @roles  = keys(%roles);
11207        # Return both lists.
11208        return ([@pegs],[@roles]);
11209    }
11210    
11211  #   print STDERR "pattern=$pattern patternQ=$patternQ\n";  =head3 choose_function
 #    warn "args: $glimpse_args\n";  
     @raw = `$FIG_Config::ext_bin/glimpse $glimpse_args`;  
11212    
11213      @pegs  =  map { $_ =~ /^\S+:\s+(\S.*\S)/; [split(/\t/,$1)] }  C<< my ($who, $function) = $fig->choose_function($user, @funcs); >>
               grep { $_ =~ /^\S+peg.index/ } @raw;  
 #             grep { $_ =~ /^\S+(peg|attribute).index/ } @raw;  
11214    
11215      push(@pegs, $self->search_index_by_attribute($pattern));  Choose the best functional role from a list of role/user tuples. If a user is
11216    specified, we look for one by that user. If that doesn't work, we look for one
11217    by a master user. If THAT doesn't work, we take the first one.
11218    
11219      @pegs  = grep { ! $self->is_deleted_fid($_->[0]) }  =over 4
              sort { &FIG::by_fig_id($a->[0],$b->[0]) } @pegs;  
11220    
11221    =item user
11222    
11223      my @rolesT = grep { $_ =~ /^\S+role.index/ } @raw;  The name of the current user. If no user is active, specify either C<undef> or
11224      my %roles  = map { $_ =~ /^\S+:\s+(\S.*\S)/; $1 => 1;} @rolesT;  a null string.
     my @roles  = keys(%roles);  
11225    
11226      return ([@pegs],[@roles]);  =item funcs
11227  }  
11228    List of functional roles. Each role is represented by a 2-tuple consisting of the
11229    user name followed by the role description.
11230    
11231    =back
11232    
11233    =cut
11234    
11235    sub choose_function {
11236        # Get the parameters.
11237        my ($self, $user, @funcs) = @_;
11238        # We'll store the best role in here.
11239        my $function;
11240        # This will be used as an array index.
11241        my $i;
11242        # Get the number of functions.
11243        my $funCount = @funcs;
11244        # If a user was specified, choose his first assignment.
11245        if ($user) {
11246            # Find the first functional role for this user.
11247            for ($i = 0; ($i < $funCount) && ($funcs[$i]->[0] !~ /^$user/i); $i++) {}
11248            Trace("I = $i") if T(4);
11249            if ($i < $funCount) {
11250                $function = $funcs[$i];
11251            }
11252        }
11253        # If we didn't have a user or didn't find an assignment for this user, look
11254        # for a master user.
11255        if (! $function) {
11256            for ($i = 0; ($i < $funCount) && ($funcs[$i]->[0] !~ /^master/i); $i++) {}
11257            if ($i < $funCount) {
11258                $function = $funcs[$i];
11259            }
11260        }
11261        # If we still don't have a function, and a function exists, take the first one.
11262        if (! $function) {
11263            if ($funCount > 0) {
11264                $function = $funcs[0];
11265            } else {
11266                # No hope, return an empty list.
11267                $function = [];
11268            }
11269        }
11270        # Return the function found.
11271        return @{$function};
11272    }
11273  ################################# Loading Databases  ####################################  ################################# Loading Databases  ####################################
11274  =head3 load_all_list  =head3 load_all_list
11275    

Legend:
Removed from v.1.559  
changed lines
  Added in v.1.560

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3