[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.81, Fri May 14 18:06:51 2004 UTC revision 1.82, Mon May 17 09:22:50 2004 UTC
# Line 3137  Line 3137 
3137      &run("load_distances");      &run("load_distances");
3138      &run("make_indexes");      &run("make_indexes");
3139      &run("format_peg_dbs");      &run("format_peg_dbs");
3140        &run("load_links");
3141  }  }
3142    
3143  ################################# Automated Assignments  ####################################  ################################# Automated Assignments  ####################################
# Line 5166  Line 5167 
5167  ################################# Support for PEG Links  ####################################  ################################# Support for PEG Links  ####################################
5168    
5169  sub peg_links {  sub peg_links {
5170      my($fig,$peg) = @_;      my($self,$peg) = @_;
5171      my($i,$got,$genome,$pegN);      my($i,$got,$genome,$pegN);
5172    
5173      my @links = ();      my @links = ();
5174      my @aliases = $fig->feature_aliases($peg);      my @aliases = $self->feature_aliases($peg);
5175      if (open(GLOBAL,"<$FIG_Config::global/peg.links"))      if (open(GLOBAL,"<$FIG_Config::global/peg.links"))
5176      {      {
5177          while (defined($_ = <GLOBAL>))          while (defined($_ = <GLOBAL>))
# Line 5189  Line 5190 
5190          close(GLOBAL);          close(GLOBAL);
5191      }      }
5192    
5193      if ($peg =~ /^fig\|(\d+\.\d+)\.peg\.(\d+)$/)      my $relational_db_response;
5194        my $rdbH = $self->db_handle;
5195    
5196        if (($relational_db_response = $rdbH->SQL("SELECT link FROM peg_links WHERE ( peg = \'$peg\' )")) &&
5197            (@$relational_db_response > 0))
5198        {
5199            push(@links, map { $_->[0] } @$relational_db_response);
5200        }
5201        return @links;
5202    }
5203    
5204    # Each link is a 2-tuple [peg,link]
5205    
5206    sub add_peg_links {
5207        my($self,@links) = @_;
5208        my($peg,$link,$pair,$i);
5209    
5210        my $relational_db_response;
5211        my $rdbH = $self->db_handle;
5212    
5213        foreach $pair (@links)
5214      {      {
5215          $genome = $1;          ($peg,$link) = @$pair;
         $pegN = $2;  
5216    
5217          if (-s "$FIG_Config::organisms/$genome/Features/links")          if (($relational_db_response = $rdbH->SQL("SELECT link FROM peg_links WHERE ( peg = \'$peg\' )")) &&
5218                (@$relational_db_response > 0))
5219            {
5220                for ($i=0; ($i < @$relational_db_response) && ($relational_db_response->[$i]->[0] ne $link); $i++) {}
5221                if ($i == @$relational_db_response)
5222          {          {
5223              push(@links,grep { $_ =~ /^$pegN\t/ } `grep \"^$pegN\" $FIG_Config::organisms/$genome/Features/links`);                  &add_peg_link($self,$peg,$link);
5224                }
5225            }
5226            else
5227            {
5228                &add_peg_link($self,$peg,$link);
5229            }
5230        }
5231    }
5232    
5233    sub add_peg_link {
5234        my($self,$peg,$link) = @_;
5235    
5236        my $rdbH = $self->db_handle;
5237    
5238        $rdbH->SQL("INSERT INTO peg_links ( peg,link ) VALUES ( \'$peg\',\'$link\' )");
5239        if (($peg =~ /^fig\|(\d+\.\d+)\.peg\.\d+$/) && open(TMP,">>$FIG_Config::organisms/$1/Features/peg/peg.links"))
5240        {
5241            print TMP "$peg\t$link\n";
5242            close(TMP);
5243            chmod 0777,"$FIG_Config::organisms/$1/Features/peg/peg.links";
5244        }
5245    }
5246    
5247    sub delete_peg_link {
5248        my($self,$peg,$link) = @_;
5249        my($i);
5250    
5251        my $genome = $self->genome_of($peg);
5252    
5253        if (-s "$FIG_Config::organisms/$genome/Features/peg/peg.links")
5254        {
5255            my $rdbH = $self->db_handle;
5256            $rdbH->SQL("DELETE FROM peg_links WHERE ( peg = \'$peg\' AND link = \'$link\' )");
5257            my @links = `cat $FIG_Config::organisms/$genome/Features/peg/peg.links`;
5258            for ($i=0; ($i < @links) && (! (($links[$i] =~ /^(\S+)\t(\S.*\S)/) && ($1 eq $peg) && ($2 eq $link))); $i++) {}
5259            if (($i < @links) && open(TMP.">$FIG_Config::organisms/$genome/Features/peg/peg.links"))
5260            {
5261                splice(@links,$i,1);
5262                print TMP join("",@links);
5263                close(TMP);
5264            }
5265        }
5266    }
5267    
5268    sub delete_all_peg_links {
5269        my($self,$peg) = @_;
5270        my($i);
5271    
5272        my $genome = $self->genome_of($peg);
5273    
5274        if (-s "$FIG_Config::organisms/$genome/Features/peg/peg.links")
5275        {
5276            my $rdbH = $self->db_handle;
5277            $rdbH->SQL("DELETE FROM peg_links WHERE ( peg = \'$peg\' )");
5278            my @links = `cat $FIG_Config::organisms/$genome/Features/peg/peg.links`;
5279            my @links1 = grep { ! (($_ =~ /^(\S+)/) && ($1 eq $peg)) } @links;
5280            if ((@links1 < @links) && open(TMP.">$FIG_Config::organisms/$genome/Features/peg/peg.links"))
5281            {
5282                print TMP join("",@links1);
5283                close(TMP);
5284          }          }
5285      }      }
     return @links;  
5286  }  }
5287    
5288  1  1

Legend:
Removed from v.1.81  
changed lines
  Added in v.1.82

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3