[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.135, Mon Aug 16 22:10:55 2004 UTC revision 1.136, Wed Aug 18 15:46:51 2004 UTC
# Line 1773  Line 1773 
1773    
1774      if ($prot_id =~ /^fig\|/)      if ($prot_id =~ /^fig\|/)
1775      {      {
1776          return $self->genus_species($self->genome_of($prot_id));          if ($self->is_deleted_fid($prot_id))
1777            {
1778                return $self->is_deleted_fid($prot_id) ? undef : $self->genus_species($self->genome_of($prot_id));
1779            }
1780            else
1781            {
1782                return "";
1783            }
1784      }      }
1785    
1786      if (($relational_db_response = $rdbH->SQL("SELECT org FROM external_orgs WHERE ( prot = \'$prot_id\' )")) &&      if (($relational_db_response = $rdbH->SQL("SELECT org FROM external_orgs WHERE ( prot = \'$prot_id\' )")) &&
# Line 2031  Line 2038 
2038              ($feature_id,undef,$b1,$e1) = @$x;              ($feature_id,undef,$b1,$e1) = @$x;
2039              if (&between($beg,&min($b1,$e1),$end) || &between(&min($b1,$e1),$beg,&max($b1,$e1)))              if (&between($beg,&min($b1,$e1),$end) || &between(&min($b1,$e1),$beg,&max($b1,$e1)))
2040              {              {
2041                    if (! $self->is_deleted_fid($feature_id))
2042                    {
2043                  push(@feat,$feature_id);                  push(@feat,$feature_id);
2044                  $l = &min($l,&min($b1,$e1));                  $l = &min($l,&min($b1,$e1));
2045                  $u = &max($u,&max($b1,$e1));                  $u = &max($u,&max($b1,$e1));
2046              }              }
2047          }          }
2048            }
2049          (@feat <= 0) || return ([@feat],$l,$u);          (@feat <= 0) || return ([@feat],$l,$u);
2050      }      }
2051      return ([],$l,$u);      return ([],$l,$u);
# Line 2082  Line 2092 
2092      my($self,$feature_id) = @_;      my($self,$feature_id) = @_;
2093      my($relational_db_response,$locations,$location);      my($relational_db_response,$locations,$location);
2094    
2095        if ($self->is_deleted_fid($feature_id)) { return undef }
2096    
2097      $locations = $self->cached('_location');      $locations = $self->cached('_location');
2098      if (! ($location = $locations->{$feature_id}))      if (! ($location = $locations->{$feature_id}))
2099      {      {
# Line 2160  Line 2172 
2172    
2173      if (@$relational_db_response > 0)      if (@$relational_db_response > 0)
2174      {      {
2175          return map { $_->[0] } @$relational_db_response;          return grep { ! $self->is_deleted_fid($_) } map { $_->[0] } @$relational_db_response;
2176      }      }
2177      return ();      return ();
2178  }  }
# Line 2218  Line 2230 
2230      my($self,$feature_id) = @_;      my($self,$feature_id) = @_;
2231      my($rdbH,$relational_db_response,@aliases,$aliases,%aliases,$x);      my($rdbH,$relational_db_response,@aliases,$aliases,%aliases,$x);
2232    
2233        if ($self->is_deleted_fid($feature_id)) { return undef }
2234    
2235      $rdbH = $self->db_handle;      $rdbH = $self->db_handle;
2236      @aliases = ();      @aliases = ();
2237      if (($relational_db_response = $rdbH->SQL("SELECT aliases FROM features WHERE ( id = \'$feature_id\' )")) &&      if (($relational_db_response = $rdbH->SQL("SELECT aliases FROM features WHERE ( id = \'$feature_id\' )")) &&
# Line 2302  Line 2316 
2316      my($self,$fid) = @_;      my($self,$fid) = @_;
2317      my($relational_db_response);      my($relational_db_response);
2318    
2319        if ($self->is_deleted_fid($fid)) { return 0 }
2320    
2321      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
2322      return (($relational_db_response = $rdbH->SQL("SELECT id FROM features WHERE ( id = \'$fid\' )")) &&      return (($relational_db_response = $rdbH->SQL("SELECT id FROM features WHERE ( id = \'$fid\' )")) &&
2323              (@$relational_db_response == 1)) ? 1 : 0;              (@$relational_db_response == 1)) ? 1 : 0;
# Line 2334  Line 2350 
2350      my($self,$feature_id,$bound,$sim_cutoff,$coupling_cutoff,$keep_record) = @_;      my($self,$feature_id,$bound,$sim_cutoff,$coupling_cutoff,$keep_record) = @_;
2351      my($neighbors,$neigh,$similar1,$similar2,@hits,$sc,$ev,$genome1);      my($neighbors,$neigh,$similar1,$similar2,@hits,$sc,$ev,$genome1);
2352    
2353        if ($self->is_deleted_fid($feature_id)) { return undef }
2354    
2355      if ($feature_id =~ /^fig\|(\d+\.\d+)/)      if ($feature_id =~ /^fig\|(\d+\.\d+)/)
2356      {      {
2357          $genome1 = $1;          $genome1 = $1;
2358      }      }
2359        else
2360        {
2361            return undef;
2362        }
2363    
2364      my($contig,$beg,$end) = &FIG::boundaries_of($self->feature_location($feature_id));      my($contig,$beg,$end) = &FIG::boundaries_of($self->feature_location($feature_id));
2365      if (! $contig) { return () }      if (! $contig) { return () }
# Line 2372  Line 2394 
2394      my($genome,$genome1,$genome2,$peg1,$peg2,$peg3,%maps,$loc,$loc1,$loc2,$loc3);      my($genome,$genome1,$genome2,$peg1,$peg2,$peg3,%maps,$loc,$loc1,$loc2,$loc3);
2395      my($pairs,$sc,%ev);      my($pairs,$sc,%ev);
2396    
2397        if ($self->is_deleted_fid($peg)) { return undef }
2398    
2399      my @ans = ();      my @ans = ();
2400    
2401      $genome = &genome_of($peg);      $genome = &genome_of($peg);
# Line 2672  Line 2696 
2696  sub translation_length {  sub translation_length {
2697      my($self,$prot) = @_;      my($self,$prot) = @_;
2698    
2699        if ($self->is_deleted_fid($prot)) { return undef }
2700    
2701      $prot =~ s/^([^\|]+\|[^\|]+)\|.*$/$1/;      $prot =~ s/^([^\|]+\|[^\|]+)\|.*$/$1/;
2702      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
2703      my $relational_db_response = $rdbH->SQL("SELECT slen FROM protein_sequence_seeks      my $relational_db_response = $rdbH->SQL("SELECT slen FROM protein_sequence_seeks
# Line 2698  Line 2724 
2724      my($self,$id) = @_;      my($self,$id) = @_;
2725      my($rdbH,$relational_db_response,$fileN,$file,$fh,$seek,$ln,$tran);      my($rdbH,$relational_db_response,$fileN,$file,$fh,$seek,$ln,$tran);
2726    
2727        if ($self->is_deleted_fid($id)) { return '' }
2728    
2729      $rdbH = $self->db_handle;      $rdbH = $self->db_handle;
2730      $id =~ s/^([^\|]+\|[^\|]+)\|.*$/$1/;      $id =~ s/^([^\|]+\|[^\|]+)\|.*$/$1/;
2731    
# Line 2735  Line 2763 
2763  sub mapped_prot_ids {  sub mapped_prot_ids {
2764      my($self,$id) = @_;      my($self,$id) = @_;
2765    
2766        if ($self->is_deleted_fid($id)) { return () }
2767    
2768      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
2769      my $relational_db_response = $rdbH->SQL("SELECT maps_to FROM peg_synonyms WHERE  syn_id = \'$id\' ");      my $relational_db_response = $rdbH->SQL("SELECT maps_to FROM peg_synonyms WHERE  syn_id = \'$id\' ");
2770      if ($relational_db_response && (@$relational_db_response == 1))      if ($relational_db_response && (@$relational_db_response == 1))
# Line 2791  Line 2821 
2821      my $wantarray = wantarray();      my $wantarray = wantarray();
2822      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
2823    
2824        if ($self->is_deleted_fid($id)) { return $wantarray ? () : "" }
2825    
2826      if (($id =~ /^fig\|(\d+\.\d+\.peg\.\d+)/) && ($wantarray || $user))      if (($id =~ /^fig\|(\d+\.\d+\.peg\.\d+)/) && ($wantarray || $user))
2827      {      {
2828          if (($relational_db_response = $rdbH->SQL("SELECT made_by,assigned_function FROM assigned_functions WHERE ( prot = \'$id\' )")) &&          if (($relational_db_response = $rdbH->SQL("SELECT made_by,assigned_function FROM assigned_functions WHERE ( prot = \'$id\' )")) &&
# Line 2918  Line 2950 
2950      my($self,$peg,$user,$function,$confidence) = @_;      my($self,$peg,$user,$function,$confidence) = @_;
2951      my($role,$roleQ);      my($role,$roleQ);
2952    
2953        if ($self->is_deleted_fid($peg)) { return 0 }
2954    
2955      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
2956      $confidence = $confidence ? $confidence : "";      $confidence = $confidence ? $confidence : "";
2957      my $genome = $self->genome_of($peg);      my $genome = $self->genome_of($peg);
# Line 3012  Line 3046 
3046      my($sim);      my($sim);
3047      $max_expand = defined($max_expand) ? $max_expand : $maxN;      $max_expand = defined($max_expand) ? $max_expand : $maxN;
3048    
3049        if ($self->is_deleted_fid($id)) { return () }
3050    
3051      my @sims = ();      my @sims = ();
3052      my @maps_to = $self->mapped_prot_ids($id);      my @maps_to = $self->mapped_prot_ids($id);
3053      if (@maps_to > 0)      if (@maps_to > 0)
# Line 3046  Line 3082 
3082              @sims = grep { $_->id1 ne $_->id2 } &expand_raw_sims($self,\@raw_sims,$maxP,$select,0,$max_expand);              @sims = grep { $_->id1 ne $_->id2 } &expand_raw_sims($self,\@raw_sims,$maxP,$select,0,$max_expand);
3083          }          }
3084      }      }
3085      return @sims;      return grep { ! $self->is_deleted_fid($_->id2) } @sims;
3086  }  }
3087    
3088  sub expand_raw_sims {  sub expand_raw_sims {
# Line 3059  Line 3095 
3095          next if ($sim->psc > $maxP);          next if ($sim->psc > $maxP);
3096          $id2 = $sim->id2;          $id2 = $sim->id2;
3097          next if ($others{$id2} && (! $dups));          next if ($others{$id2} && (! $dups));
3098    
3099          $others{$id2} = 1;          $others{$id2} = 1;
3100          if (($select && ($select eq "raw")) || ($max_expand <= 0))          if (($select && ($select eq "raw")) || ($max_expand <= 0))
3101          {          {
# Line 3193  Line 3230 
3230      my($self,$peg,$cutoff,$frac_match) = @_;      my($self,$peg,$cutoff,$frac_match) = @_;
3231      my($sim,$peg2,$genome2,$i,@sims2,%seen);      my($sim,$peg2,$genome2,$i,@sims2,%seen);
3232    
3233        if ($self->is_deleted_fid($peg)) { return () }
3234    
3235      $frac_match = defined($frac_match) ? $frac_match : 0;      $frac_match = defined($frac_match) ? $frac_match : 0;
3236    
3237      $cutoff = defined($cutoff) ? $cutoff : 1.0e-10;      $cutoff = defined($cutoff) ? $cutoff : 1.0e-10;
# Line 3305  Line 3344 
3344      my($self,$peg,$user) = @_;      my($self,$peg,$user) = @_;
3345      my($func,$sim,$id2,%related);      my($func,$sim,$id2,%related);
3346    
3347        if ($self->is_deleted_fid($peg)) { return () }
3348    
3349      if (($func = $self->function_of($peg,$user)) && (! &FIG::hypo($func)))      if (($func = $self->function_of($peg,$user)) && (! &FIG::hypo($func)))
3350      {      {
3351          foreach $sim ($self->sims($peg,500,1,"fig",500))          foreach $sim ($self->sims($peg,500,1,"fig",500))
# Line 3568  Line 3609 
3609      my($self,$feature_id,$user,$annotation) = @_;      my($self,$feature_id,$user,$annotation) = @_;
3610      my($genome);      my($genome);
3611    
3612        if ($self->is_deleted_fid($feature_id)) { return 0 }
3613    
3614  #   print STDERR "add: fid=$feature_id user=$user annotation=$annotation\n";  #   print STDERR "add: fid=$feature_id user=$user annotation=$annotation\n";
3615      if ($genome = $self->genome_of($feature_id))      if ($genome = $self->genome_of($feature_id))
3616      {      {
# Line 3636  Line 3679 
3679  sub feature_annotations {  sub feature_annotations {
3680      my($self,$feature_id) = @_;      my($self,$feature_id) = @_;
3681    
3682        if ($self->is_deleted_fid($feature_id)) { return () }
3683    
3684      return map { $_->[1] = localtime($_->[1]); $_ } $self->feature_annotations1($feature_id);      return map { $_->[1] = localtime($_->[1]); $_ } $self->feature_annotations1($feature_id);
3685  }  }
3686    
# Line 3644  Line 3689 
3689      my($tuple,$fileN,$seek,$ln,$annotation,$feature_idQ);      my($tuple,$fileN,$seek,$ln,$annotation,$feature_idQ);
3690      my($file,$fh);      my($file,$fh);
3691    
3692        if ($self->is_deleted_fid($feature_id)) { return () }
3693    
3694      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
3695      my $relational_db_response = $rdbH->SQL("SELECT fileno, seek, len  FROM annotation_seeks WHERE  fid = \'$feature_id\' ");      my $relational_db_response = $rdbH->SQL("SELECT fileno, seek, len  FROM annotation_seeks WHERE  fid = \'$feature_id\' ");
3696      my @annotations = ();      my @annotations = ();
# Line 3747  Line 3794 
3794          foreach $entry (@$relational_db_response)          foreach $entry (@$relational_db_response)
3795          {          {
3796              ($fid,$when,$fileno,$seek,$len) = @$entry;              ($fid,$when,$fileno,$seek,$len) = @$entry;
3797              if (($fid =~ /^fig\|(\d+\.\d+)/) && $genomes{$1})              if (($fid =~ /^fig\|(\d+\.\d+)/) && $genomes{$1} && (! $self->is_deleted_fid($fid)))
3798              {              {
3799                  if ($len < 4)                  if ($len < 4)
3800                  {                  {
# Line 3777  Line 3824 
3824      my($relational_db_response,$entry,$fileno,$seek,$len,$ann);      my($relational_db_response,$entry,$fileno,$seek,$len,$ann);
3825      my($epoch_date,$when,%sofar,$x);      my($epoch_date,$when,%sofar,$x);
3826    
3827        if ($self->is_deleted_fid($fid)) { return () }
3828    
3829      my @assignments = ();      my @assignments = ();
3830      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
3831    
# Line 3855  Line 3904 
3904          foreach $entry (@$relational_db_response)          foreach $entry (@$relational_db_response)
3905          {          {
3906              ($fid,$when,$fileno,$seek,$len) = @$entry;              ($fid,$when,$fileno,$seek,$len) = @$entry;
3907              if (($fid =~ /^fig\|(\d+\.\d+)/) && $genomes{$1})              if (($fid =~ /^fig\|(\d+\.\d+)/) && $genomes{$1} && (! $self->id_deleted_fid($fid)))
3908              {              {
3909                  $ann = $self->read_annotation($fileno,$seek,$len);                  $ann = $self->read_annotation($fileno,$seek,$len);
3910    
# Line 3900  Line 3949 
3949    
3950  #   print STDERR "pattern=$pattern patternQ=$patternQ\n";  #   print STDERR "pattern=$pattern patternQ=$patternQ\n";
3951      @raw = `$FIG_Config::ext_bin/glimpse -y -H $FIG_Config::data/Indexes -i -w \'$patternQ\'`;      @raw = `$FIG_Config::ext_bin/glimpse -y -H $FIG_Config::data/Indexes -i -w \'$patternQ\'`;
3952      @pegs  = sort { &FIG::by_fig_id($a->[0],$b->[0]) }      @pegs  = grep { ! $self->is_deleted_fid($_->[0]) }
3953                 sort { &FIG::by_fig_id($a->[0],$b->[0]) }
3954               map { $_ =~ s/^\S+:\s+//; [split(/\t/,$_)] }               map { $_ =~ s/^\S+:\s+//; [split(/\t/,$_)] }
3955               grep { $_ =~ /^\S+peg.index/ } @raw;               grep { $_ =~ /^\S+peg.index/ } @raw;
3956      my %roles = map { $_ =~ s/^\S+:\s+//; $_ => 1} grep { $_ =~ /^\S+role.index/ } @raw;      my %roles = map { $_ =~ s/^\S+:\s+//; $_ => 1} grep { $_ =~ /^\S+role.index/ } @raw;
# Line 4134  Line 4184 
4184          if (($relational_db_response = $rdbH->SQL("SELECT id FROM $relation WHERE ( $set_name = $which)")) &&          if (($relational_db_response = $rdbH->SQL("SELECT id FROM $relation WHERE ( $set_name = $which)")) &&
4185              (@$relational_db_response >= 1))              (@$relational_db_response >= 1))
4186          {          {
4187              return sort { by_fig_id($a,$b) }  map { $_->[0] } @$relational_db_response;              return grep { ! $self->is_deleted_fid($_) }
4188                       sort { by_fig_id($a,$b) }
4189                       map { $_->[0] } @$relational_db_response;
4190          }          }
4191      }      }
4192      return ();      return ();
# Line 4144  Line 4196 
4196      my($self,$id,$relation,$set_name) = @_;      my($self,$id,$relation,$set_name) = @_;
4197      my($relational_db_response);      my($relational_db_response);
4198    
4199        if ($self->is_deleted_fid($id)) { return () }
4200    
4201      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
4202    
4203      if (($relational_db_response = $rdbH->SQL("SELECT $set_name FROM $relation WHERE ( id = \'$id\' )")) &&      if (($relational_db_response = $rdbH->SQL("SELECT $set_name FROM $relation WHERE ( id = \'$id\' )")) &&
# Line 4190  Line 4244 
4244      my $rc = 1;      my $rc = 1;
4245      foreach $id (@ids)      foreach $id (@ids)
4246      {      {
4247            next if ($self->is_deleted_fid($id));
4248          if (! $rdbH->SQL("INSERT INTO $relation ( $set_name,id ) VALUES ( $set,\'$id\' )"))          if (! $rdbH->SQL("INSERT INTO $relation ( $set_name,id ) VALUES ( $set,\'$id\' )"))
4249          {          {
4250              $rc = 0;              $rc = 0;
# Line 4228  Line 4283 
4283    
4284      foreach $pair (sort { ($a->[0] <=> $b->[0]) or &by_fig_id($a->[1],$b->[1]) } @$relational_db_response)      foreach $pair (sort { ($a->[0] <=> $b->[0]) or &by_fig_id($a->[1],$b->[1]) } @$relational_db_response)
4285      {      {
4286            if (! $self->is_deleted_fid($pair->[1]))
4287            {
4288          print TMP join("\t",@$pair),"\n";          print TMP join("\t",@$pair),"\n";
4289      }      }
4290        }
4291      close(TMP);      close(TMP);
4292      return 1;      return 1;
4293  }  }
# Line 4681  Line 4739 
4739          $query = "SELECT distinct prot FROM roles  WHERE (( role = \'$roleQ\' ) AND $who_cond AND (org = \'$genome\'))";          $query = "SELECT distinct prot FROM roles  WHERE (( role = \'$roleQ\' ) AND $who_cond AND (org = \'$genome\'))";
4740      }      }
4741      return (($relational_db_response = $rdbH->SQL($query)) && (@$relational_db_response >= 1)) ?      return (($relational_db_response = $rdbH->SQL($query)) && (@$relational_db_response >= 1)) ?
4742          map { $_->[0] } @$relational_db_response : ();          grep { ! $self->is_deleted_fid($_) } map { $_->[0] } @$relational_db_response : ();
4743  }  }
4744    
4745  =pod  =pod
# Line 4720  Line 4778 
4778              foreach $hit (@$relational_db_response)              foreach $hit (@$relational_db_response)
4779              {              {
4780                  ($peg,$role) = @$hit;                  ($peg,$role) = @$hit;
4781                    if (! $self->is_deleted_fid($peg))
4782                    {
4783                  $genome = $self->genome_of($peg);                  $genome = $self->genome_of($peg);
4784                  push(@{ $result->{$genome}->{$role} },[$peg,scalar $self->function_of($peg,$made_by)]);                  push(@{ $result->{$genome}->{$role} },[$peg,scalar $self->function_of($peg,$made_by)]);
4785              }              }
4786          }          }
4787      }      }
4788        }
4789      return $result;      return $result;
4790  }  }
4791    
# Line 5884  Line 5945 
5945    
5946      return undef unless $sub;      return undef unless $sub;
5947    
5948      return $sub->get_pegs_from_cell($genome, $role);      return grep { ! $self->is_deleted_fid($_) } $sub->get_pegs_from_cell($genome, $role);
5949  }  }
5950    
5951  sub get_clearinghouse :scalar  sub get_clearinghouse :scalar
# Line 5971  Line 6032 
6032  {  {
6033      my($self, $peg) = @_;      my($self, $peg) = @_;
6034    
6035        if ($self->is_deleted_fid($peg)) { return () }
6036    
6037      ($peg =~ /^fig\|\d+\.\d+\.peg\.\d+$/) or return;      ($peg =~ /^fig\|\d+\.\d+\.peg\.\d+$/) or return;
6038    
6039      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
# Line 5995  Line 6058 
6058  {  {
6059      my($self, $peg) = @_;      my($self, $peg) = @_;
6060    
6061        if ($self->is_deleted_fid($peg)) { return () }
6062      my @sublist = $self->subsystems_for_peg($peg);      my @sublist = $self->subsystems_for_peg($peg);
6063    
6064      return map { $_->[0] } @sublist;      return map { $_->[0] } @sublist;
# Line 6204  Line 6268 
6268      my($self,$peg) = @_;      my($self,$peg) = @_;
6269      my($i,$got,$genome,$pegN);      my($i,$got,$genome,$pegN);
6270    
6271        if ($self->is_deleted_fid($peg)) { return () }
6272      my @links = ();      my @links = ();
6273      my @aliases = $self->feature_aliases($peg);      my @aliases = $self->feature_aliases($peg);
6274      if (open(GLOBAL,"<$FIG_Config::global/peg.links"))      if (open(GLOBAL,"<$FIG_Config::global/peg.links"))
# Line 6269  Line 6334 
6334  sub add_peg_link {  sub add_peg_link {
6335      my($self,$peg,$link) = @_;      my($self,$peg,$link) = @_;
6336    
6337        if ($self->is_deleted_fid($peg)) { return }
6338      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
6339    
6340      $rdbH->SQL("INSERT INTO peg_links ( peg,link ) VALUES ( \'$peg\',\'$link\' )");      $rdbH->SQL("INSERT INTO peg_links ( peg,link ) VALUES ( \'$peg\',\'$link\' )");
# Line 6284  Line 6350 
6350      my($self,$peg,$link) = @_;      my($self,$peg,$link) = @_;
6351      my($i);      my($i);
6352    
6353        if ($self->is_deleted_fid($peg)) { return }
6354      my $genome = $self->genome_of($peg);      my $genome = $self->genome_of($peg);
6355    
6356      if (-s "$FIG_Config::organisms/$genome/Features/peg/peg.links")      if (-s "$FIG_Config::organisms/$genome/Features/peg/peg.links")
# Line 6305  Line 6372 
6372      my($self,$peg) = @_;      my($self,$peg) = @_;
6373      my($i);      my($i);
6374    
6375        if ($self->is_deleted_fid($peg)) { return }
6376      my $genome = $self->genome_of($peg);      my $genome = $self->genome_of($peg);
6377    
6378      if (-s "$FIG_Config::organisms/$genome/Features/peg/peg.links")      if (-s "$FIG_Config::organisms/$genome/Features/peg/peg.links")
# Line 6842  Line 6910 
6910              close(TMP);              close(TMP);
6911          }          }
6912      }      }
6913        return $x->{$fid};
6914  }  }
6915    
6916  =pod  =pod
6917    
6918  =head1 change_location_of_feature(FeatureID,Location,Translation)  =head1 change_location_of_feature(FeatureID,Location,Translation)
6919    
6920  usage: change_location_of_feature($fid,$location,$translation)  usage: $fig->change_location_of_feature($fid,$location,$translation)
6921    
6922  Invoking this routine changes the location of the feature.  The $translation argument  Invoking this routine changes the location of the feature.  The $translation argument
6923  is optional (and applies only to PEGs).  is optional (and applies only to PEGs).
# Line 6858  Line 6927 
6927  =cut  =cut
6928    
6929  sub change_location_of_feature {  sub change_location_of_feature {
6930      my($fid,$location,$translation) = @_;      my($self,$fid,$location,$translation) = @_;
6931    
6932      print STDERR "changing location of $fid to $location; ",&Dumper($translation);      if ($self->is_deleted_fid($fid)) { return 0 }
6933      return 1;  
6934        my $dbh = $self->db_handle();
6935    
6936        my $genome = &genome_of($fid);
6937        my $type   = &ftype($fid);
6938    
6939        my($got) = 0;
6940        my @loc = split(/,/,$location);
6941        my($contig,$beg,$end);
6942        if (($loc[0] =~ /^(\S+)_(\d+)_\d+$/) && (($contig,$beg) = ($1,$2)) && ($location =~ /(\d+)$/))
6943        {
6944            $end = $1;
6945            if ($beg > $end)  { ($beg,$end) = ($end,$beg) }
6946        }
6947        else
6948        {
6949            return 0;
6950        }
6951    
6952        if (open(TMP,"<$FIG_Config::organisms/$genome/Features/$type/tbl"))
6953        {
6954            my(@tbl) = ();
6955            flock(TMP,LOCK_EX) || confess "cannot lock $FIG_Config::organisms/$genome/Features/$type/tbl";
6956            while (($_ = <TMP>) && ($_ =~ /^(\S+)/))
6957            {
6958                if ($1 ne $fid)
6959                {
6960                    push(@tbl,$_);
6961                }
6962                else
6963                {
6964                    chop;
6965                    my @flds = split(/\t/,$_);
6966                    $flds[1] = $location;
6967                    push(@tbl,join("\t",@flds) . "\n");
6968                    $got = 1;
6969                }
6970            }
6971            close(TMP);
6972            if ($got && open(TMP,">$FIG_Config::organisms/$genome/Features/$type/tbl"))
6973            {
6974                flock(TMP,LOCK_EX) || confess "cannot lock $FIG_Config::organisms/$genome/Features/$type/tbl";
6975                print TMP join("",@tbl);
6976                close(TMP);
6977    
6978                $dbh->SQL("UPDATE features SET location = '$location',
6979                                               contig = '$contig',
6980                                               minloc = $beg,
6981                                               maxloc = $end
6982                                           WHERE id = '$fid'");
6983                if (($type eq "peg") && defined($translation))
6984                {
6985                    if (open(TMP,"<$FIG_Config::organisms/$genome/Features/$type/fasta"))
6986                    {
6987                        my(@fasta) = ();
6988                        flock(TMP,LOCK_EX) || confess "cannot lock $FIG_Config::organisms/$genome/Features/$type/fasta";
6989    
6990                        $/ = "\n>";
6991                        while (defined($_ = <TMP>))
6992                        {
6993                            chomp;
6994                            if ($_ =~ /^>?(\S+)[^\n]*\n(.*)/s)
6995                            {
6996                                if ($1 ne $fid)
6997                                {
6998                                    my $peg = $1;
6999                                    my $seq = $2;
7000                                    $seq =~ s/\s//gs;
7001                                    push(@fasta,">$peg\n$seq\n");
7002                                }
7003                                else
7004                                {
7005                                    push(@fasta,">$fid\n$translation\n");
7006                                }
7007                            }
7008                        }
7009                        $/ = "\n";
7010                        close(TMP);
7011    
7012                        if (open(TMP,">$FIG_Config::organisms/$genome/Features/$type/fasta"))
7013                        {
7014                            flock(TMP,LOCK_EX) || confess "cannot lock $FIG_Config::organisms/$genome/Features/$type/fasta";
7015                            print TMP join("",@fasta);
7016                            close(TMP);
7017                            &run("index_translations $genome");
7018                        }
7019                    }
7020                }
7021            }
7022        }
7023        return $got;
7024  }  }
7025    
7026  ### Begin FIG::Job module  ### Begin FIG::Job module
# Line 6923  Line 7082 
7082    
7083  package FIG;  package FIG;
7084  1;  1;
   
   

Legend:
Removed from v.1.135  
changed lines
  Added in v.1.136

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3