[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.119, Wed Jun 16 16:52:10 2004 UTC revision 1.120, Wed Jun 23 21:33:43 2004 UTC
# Line 3407  Line 3407 
3407      return "$mm-$dd-$yr:$hr:$min:$sec";      return "$mm-$dd-$yr:$hr:$min:$sec";
3408  }  }
3409    
3410  sub assignments_made {  #
3411    # This now calls assignments_made_full and remaps the output.
3412    #
3413    sub assignments_made
3414    {
3415        my($self,$genomes,$who,$date) = @_;
3416    
3417        my @a = $self->assignments_made_full($genomes, $who, $date);
3418    
3419        return map { [ @{$_}[0,1]] } @a;
3420    }
3421    
3422    #
3423    # Looks up and returns assignments made; return is a list of
3424    # tuples [peg, date, assignment, who]
3425    #
3426    
3427    sub assignments_made_full {
3428      my($self,$genomes,$who,$date) = @_;      my($self,$genomes,$who,$date) = @_;
3429      my($relational_db_response,$entry,$fid,$fileno,$seek,$len,$ann);      my($relational_db_response,$entry,$fid,$fileno,$seek,$len,$ann);
3430      my($epoch_date,$when,%sofar,$x);      my($epoch_date,$when,%sofar,$x);
# Line 3460  Line 3477 
3477                  {                  {
3478                      if ((! $sofar{$1}) || (($x = $sofar{$1}) && ($when > $x->[0])))                      if ((! $sofar{$1}) || (($x = $sofar{$1}) && ($when > $x->[0])))
3479                      {                      {
3480                          $sofar{$1} = [$when,$5];                          $sofar{$1} = [$when, $5, $3];
3481                      }                      }
3482                  }                  }
3483              }              }
3484          }          }
3485      }      }
3486      @assignments = map { $x = $sofar{$_}; [$_,$x->[1]] } keys(%sofar);      @assignments = map { $x = $sofar{$_}; [$_,$x->[1], $x->[0], $x->[2]] } keys(%sofar);
3487      return @assignments;      return @assignments;
3488  }  }
3489    
3490    =pod
3491    
3492    =head1 annotations_made
3493    
3494    usage: @annotations = $fig->annotations_made($genomes, $who, $date)
3495    
3496    Return the list of annotations on the genomes in @$genomes  made by $who
3497    after $date.
3498    
3499    Each returned annotation is of the form [$fid,$timestamp,$user,$annotation].
3500    
3501    =cut
3502    
3503  sub annotations_made {  sub annotations_made {
3504      my($self,$genomes,$who,$date) = @_;      my($self,$genomes,$who,$date) = @_;
3505      my($relational_db_response,$entry,$fid,$fileno,$seek,$len,$ann);      my($relational_db_response,$entry,$fid,$fileno,$seek,$len,$ann);
# Line 5615  Line 5645 
5645    
5646      foreach $peg (keys(%$pegs))      foreach $peg (keys(%$pegs))
5647      {      {
5648            #
5649            # First, see if the peg of the same name locally has the same
5650            # last 10 chars.
5651            #
5652          if (($seq = $self->get_translation($peg)) &&          if (($seq = $self->get_translation($peg)) &&
5653              (length($seq) > 10) && (length($seq_of->{$peg}) > 10) &&              (length($seq) > 10) && (length($seq_of->{$peg}) > 10) &&
5654              (uc substr($seq,-10) eq substr($seq_of->{$peg},-10)))              (uc substr($seq,-10) eq substr($seq_of->{$peg},-10)))
# Line 5623  Line 5657 
5657          }          }
5658          else          else
5659          {          {
5660                #
5661                # Otherwise, search for a local peg that has the same alias
5662                # as this peg. (Canonicalize based on the original source)
5663                #
5664              ($aliases,undef,undef) = @{$pegs->{$peg}};              ($aliases,undef,undef) = @{$pegs->{$peg}};
5665              undef %to;              undef %to;
5666              foreach $alias (split(/,/,$aliases))              foreach $alias (split(/,/,$aliases))
# Line 5633  Line 5671 
5671                  }                  }
5672              }              }
5673    
5674                #
5675                # If we have a unique answer, we are done.
5676                # Otherwise mark this one as needing more search.
5677                #
5678              if ((@keys = keys(%to)) == 1)              if ((@keys = keys(%to)) == 1)
5679              {              {
5680                  $tran_peg->{$peg} = $keys[0];                  $tran_peg->{$peg} = $keys[0];
# Line 5655  Line 5697 
5697      my($self,$pegs,$seq_of,$tran_peg,$sought) = @_;      my($self,$pegs,$seq_of,$tran_peg,$sought) = @_;
5698      my($peg,$seq,%needH,%needT,%poss,$id,$sub,$to,$x,$genome);      my($peg,$seq,%needH,%needT,%poss,$id,$sub,$to,$x,$genome);
5699    
5700        #
5701        # Construct %needT, key is 50-bases from tail of sequence, values are pegs from
5702        # the list of pegs we're seeking.
5703        #
5704        # %needH is the same, but keyed on 50 bases from the head of the sequence.
5705        #
5706      foreach $peg (keys(%$sought))      foreach $peg (keys(%$sought))
5707      {      {
5708          if (($seq = $seq_of->{$peg}) && (length($seq) > 50))          if (($seq = $seq_of->{$peg}) && (length($seq) > 50))

Legend:
Removed from v.1.119  
changed lines
  Added in v.1.120

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3