[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.354, Tue Aug 30 18:04:55 2005 UTC revision 1.355, Thu Sep 1 09:30:07 2005 UTC
# Line 110  Line 110 
110  also be invoked dynamically. This is a general artifact of the  also be invoked dynamically. This is a general artifact of the
111  way PERL implements object-oriented programming.  way PERL implements object-oriented programming.
112    
113    =head2 Tracing
114    
115    The FIG object supports tracing using the B<Tracer> module. If tracing is
116    inactive when the FIG object is constructed, it will call B<TSetup> using
117    parameters specified either in the environment variables or in the
118    C<FIG_Config> module. Most command-line tools should call B<TSetup> before
119    constructing a FIG object so that the tracing configuration can be specified
120    as command-line options. If the prior call to B<TSetup> has not occurred,
121    then the environment variables C<Trace> and C<TraceType> will be examined.
122    If those do not exist, the global variables I<$FIG_Config::trace_levels> and
123    I<$FIG_Config::trace_type> will be used.
124    
125    C<Trace> and I<$FIG_Config::trace_type> specify the tracing level and categories.
126    Only tracing calls for the specified categories with a level less than or equal
127    to the trace level will be displayed. The higher the trace level or the more
128    the categories, the more messages will be displayed. For example, the
129    following Unix command will set up for tracing at level 3 for the categories
130    C<SQL> and C<Sprout>.
131    
132        env Trace="3 SQL Sprout"
133    
134    In most cases, the category names is the same as the name of the Perl package
135    from which the trace call was made. An asterisk (C<*>) can be used to turn on
136    tracing for all categories.
137    
138        env Trace="2 *"
139    
140    turns on tracing at level 2 for everything.
141    
142    C<TraceType> and C<$FIG_Config::trace_type> determine where the tracing is going
143    to show up. A full treatment of all the options can be found in the documentation
144    for the B<Tracer> module. The most common options, however, are C<WARN>, which
145    converts all trace messages to warnings, and C<TEXT>, which writes them to the
146    standard output. The default is C<WARN>, the theory being that this is the best
147    option during web page construction.
148    
149  =head2 Hiding/Caching in a FIG object  =head2 Hiding/Caching in a FIG object
150    
151  We save the DB handle, cache taxonomies, and put a few other odds and ends in the  We save the DB handle, cache taxonomies, and put a few other odds and ends in the
# Line 153  Line 189 
189      # If we do, don't actually create a FIG object, but rather      # If we do, don't actually create a FIG object, but rather
190      # create a FIGrpc and return that as the return from this constructor.      # create a FIGrpc and return that as the return from this constructor.
191      #      #
   
192      if ($ENV{FIG_URL} ne "" && $xmlrpc_available) {      if ($ENV{FIG_URL} ne "" && $xmlrpc_available) {
         Trace("Creating figrpc for '$ENV{FIG_URL}'") if T(0);  
193          my $figrpc = new FIGrpc($ENV{FIG_URL});          my $figrpc = new FIGrpc($ENV{FIG_URL});
194          return $figrpc;          return $figrpc;
195      }      }
196      # Here we have the normal case. Check for default tracing. We only do this if      # Here we have the normal case. Check for default tracing. We only do this if
197      # the proper parameters are present and nobody else has set up tracing yet.      # the proper parameters are present and nobody else has set up tracing yet.
198      if ((defined $FIG_Config::trace_levels || exists $ENV{Trace})) {      if (Tracer::Setups() == 0 && (defined $FIG_Config::trace_levels || exists $ENV{Trace})) {
 #    if (Tracer::Setups() == 0 && (defined $FIG_Config::trace_levels || exists $ENV{Trace})) {  
199          # Tracing is not active and the user has specified tracing levels, so it's safe for          # Tracing is not active and the user has specified tracing levels, so it's safe for
200          # us to set it up using our own rules. First, the trace type: the default is WARN.          # us to set it up using our own rules. First, the trace type: the default is WARN.
201          my $trace_type;          my $trace_type;
# Line 177  Line 210 
210          my $trace_levels = (exists($ENV{Trace}) ? $ENV{Trace} : $FIG_Config::trace_levels);          my $trace_levels = (exists($ENV{Trace}) ? $ENV{Trace} : $FIG_Config::trace_levels);
211          TSetup($trace_levels, $trace_type);          TSetup($trace_levels, $trace_type);
212      }      }
213        Trace("Connecting to the database.") if T(2);
214      # Connect to the database, then return ourselves.      # Connect to the database, then return ourselves.
215      my $rdbH = new DBrtns;      my $rdbH = new DBrtns;
216      bless {      bless {
# Line 270  Line 304 
304      }      }
305  }  }
306    
307    =head3 same_seqs
308    
309    C<< my $sameFlag = FIG::same_seqs($s1, $s2); >>
310    
311    Return TRUE if the specified protein sequences are considered equivalent and FALSE
312    otherwise. The sequences should be presented in I<nr-analysis> form, which is in
313    reverse order and upper case with the stop codon omitted.
314    
315    The sequences will be considered equivalent if the shorter matches the initial
316    portion of the long one and is no more than 30% smaller. Since the sequences are
317    in nr-analysis form, the equivalent start potions means that the sequences
318    have the same tail. The importance of the tail is that the stop point of a PEG
319    is easier to find than the start point, so a same tail means that the two
320    sequences are equivalent except for the choice of start point.
321    
322    =over 4
323    
324    =item s1
325    
326    First protein sequence, reversed and with the stop codon removed.
327    
328    =item s2
329    
330    Second protein sequence, reversed and with the stop codon removed.
331    
332    =item RETURN
333    
334    Returns TRUE if the two protein sequences are equivalent, else FALSE.
335    
336    =back
337    
338    =cut
339    
340    sub same_seqs {
341        my ($s1,$s2) = @_;
342    
343        my $ln1 = length($s1);
344        my $ln2 = length($s2);
345    
346        return ((abs($ln1-$ln2) < (0.3 * (($ln1 < $ln2) ? $ln1 : $ln2))) &&
347                ((($ln1 <= $ln2) && (index($s2,$s1) == 0)) ||
348                 (($ln1 > $ln2)  && (index($s1,$s2) == 0))));
349    }
350    
351  =head3 delete_genomes  =head3 delete_genomes
352    
353  C<< $fig->delete_genomes(\@genomes); >>  C<< $fig->delete_genomes(\@genomes); >>
# Line 2370  Line 2448 
2448    
2449  or  or
2450    
2451  C<< $fig->display_id_and_seq($id_and_comment, $seqP, $fh); >>  C<< $fig->display_id_and_seq($id_and_comment, \$seqP, $fh); >>
2452    
2453  Display a fasta ID and sequence to the specified open file. This method is designed  Display a fasta ID and sequence to the specified open file. This method is designed
2454  to work well with L</read_fasta_sequence> and L</rev_comp>, because it takes as  to work well with L</read_fasta_sequence> and L</rev_comp>, because it takes as
# Line 2397  Line 2475 
2475  =item fh  =item fh
2476    
2477  Open file handle to which the ID and sequence should be output. If omitted,  Open file handle to which the ID and sequence should be output. If omitted,
2478  C<STDOUT> is assumed.  C<\*STDOUT> is assumed.
2479    
2480  =back  =back
2481    
# Line 2415  Line 2493 
2493      &display_seq($seqP, $fh);      &display_seq($seqP, $fh);
2494  }  }
2495    
2496  =head3 display_id_and_seq  =head3 display_seq
2497    
2498  C<< FIG::display_seq($seqP, $fh); >>  C<< FIG::display_seq(\$seqP, $fh); >>
2499    
2500  or  or
2501    
2502  C<< $fig->display_seq($seqP, $fh); >>  C<< $fig->display_seq(\$seqP, $fh); >>
2503    
2504  Display a fasta sequence to the specified open file. This method is designed  Display a fasta sequence to the specified open file. This method is designed
2505  to work well with L</read_fasta_sequence> and L</rev_comp>, because it takes as  to work well with L</read_fasta_sequence> and L</rev_comp>, because it takes as
# Line 6602  Line 6680 
6680    
6681  =head3 add_annotation  =head3 add_annotation
6682    
6683  usage: $fig->add_annotation($fid,$user,$annotation,$time_made)  C<< my $okFlag = $fig->add_annotation($fid, $user, $annotation, $time_made); >>
6684    
6685    Add an annotation to a feature.
6686    
6687    =over 4
6688    
6689    =item fid
6690    
6691    ID of the feature to be annotated.
6692    
6693    =item user
6694    
6695    Name of the user making the annotation.
6696    
6697    =item annotation
6698    
6699  $annotation is added as a time-stamped annotation to $peg showing $user as the  Text of the annotation.
 individual who added the annotation.  
6700    
6701  If $time_made is set, it will be used as the time of annotation instead  =item time_made (optional)
6702  of the current time. It is a numeric time in seconds-since-the-epoch.  
6703    Time of the annotation, in seconds since the epoch. If omitted, the
6704    current time is used.
6705    
6706    =item RETURN
6707    
6708    Returns 1 if successful, 0 if any of the parameters are invalid or an
6709    error occurs.
6710    
6711    =back
6712    
6713  =cut  =cut
6714    
# Line 6633  Line 6733 
6733              flock(TMP,LOCK_EX) || confess "cannot lock assigned_functions";              flock(TMP,LOCK_EX) || confess "cannot lock assigned_functions";
6734              seek(TMP,0,2)      || confess "failed to seek to the end of the file";              seek(TMP,0,2)      || confess "failed to seek to the end of the file";
6735    
6736                # Tweaked this section for Windows compatability. The size on disk of
6737                # "\n" is not constant.
6738              my $seek1 = tell TMP;              my $seek1 = tell TMP;
6739              print TMP "$feature_id\n$time_made\n$user\n$annotation", (substr($annotation,-1) eq "\n") ? "" : "\n","//\n";              my $dataLine = "$feature_id\n$time_made\n$user\n$annotation" . ((substr($annotation,-1) eq "\n") ? "" : "\n");
6740              my $seek2 = tell TMP;              print TMP $dataLine . "//\n";
6741              close(TMP);              close(TMP);
6742              chmod 0777, $file;              chmod 0777, $file;
6743              my $ln = ($seek2 - $seek1) - 3;              my $ln = length($dataLine);
6744              my $rdbH = $self->db_handle;              my $rdbH = $self->db_handle;
6745              if ($rdbH->SQL("INSERT INTO annotation_seeks ( fid, dateof, who, ma, fileno, seek, len ) VALUES ( \'$feature_id\', $time_made, \'$user\', \'$ma\', $fileno, $seek1, $ln )"))              if ($rdbH->SQL("INSERT INTO annotation_seeks ( fid, dateof, who, ma, fileno, seek, len ) VALUES ( \'$feature_id\', $time_made, \'$user\', \'$ma\', $fileno, $seek1, $ln )"))
6746              {              {
# Line 6672  Line 6774 
6774    
6775  =head3 feature_annotations  =head3 feature_annotations
6776    
6777  usage: @annotations = $fig->feature_annotations($fid)  C<< my @annotations = $fig->feature_annotations($fid, $rawtime); >>
6778    
6779  The set of annotations of $fid is returned as a list of 4-tuples.  Each entry in the list  Return a list of the specified feature's annotations. Each entry in the list
6780  is of the form [$fid,$timestamp,$user,$annotation].  returned is a 4-tuple containing the feature ID, time stamp, user ID, and
6781    annotation text. These are exactly the values needed to add the annotation
6782    using L</add_annotation>, though in a different order.
6783    
6784  =cut  =over 4
6785    
6786    =item fid
6787    
6788    ID of the features whose annotations are to be listed.
6789    
6790    =item rawtime (optional)
6791    
6792    If TRUE, the times will be returned as PERL times (seconds since the epoch);
6793    otherwise, they will be returned as formatted time strings.
6794    
6795    =item RETURN
6796    
6797    Returns a list of 4-tuples, one per annotation. Each tuple is of the form
6798    I<($fid, $timeStamp, $user, $annotation)> where I<$fid> is the feature ID,
6799    I<$timeStamp> is the time the annotation was made, I<$user> is the name of
6800    the user who made the annotation, and I<$annotation> is the text of the
6801    annotation.
6802    
6803    =back
6804    
6805    =cut
6806    
6807  sub feature_annotations {  sub feature_annotations {
6808      my($self,$feature_id,$rawtime) = @_;      my($self,$feature_id,$rawtime) = @_;
# Line 6737  Line 6861 
6861      }      }
6862      seek($fh,$seek,0);      seek($fh,$seek,0);
6863      $readN = read($fh,$readC,$ln);      $readN = read($fh,$readC,$ln);
6864        my $len2 = length $readC;
6865      ($readN == $ln)      ($readN == $ln)
6866          || confess "could not read the block of annotations at $seek for $ln characters; $readN actually read from $file\n$readC";          || confess "could not read the block of annotations at $seek for $ln characters; $readN actually read from $file\n$readC";
6867      return $readC;      return $readC;
# Line 11467  Line 11592 
11592    
11593  Returns the new feature's ID if successful,or C<undef> if an error occurred.  Returns the new feature's ID if successful,or C<undef> if an error occurred.
11594    
11595    =back
11596    
11597  =cut  =cut
11598    
11599  sub add_feature {  sub add_feature {

Legend:
Removed from v.1.354  
changed lines
  Added in v.1.355

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3