[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.168, Fri Oct 15 00:38:11 2004 UTC revision 1.169, Fri Oct 15 17:04:09 2004 UTC
# Line 6979  Line 6979 
6979    
6980  ################################# Support for PEG Links  ####################################  ################################# Support for PEG Links  ####################################
6981    
6982    
6983  sub peg_links {  sub peg_links {
6984      my($self,$peg) = @_;      my($self,$fid) = @_;
6985      my($i,$got,$genome,$pegN);  
6986        return $self->fid_links($fid);
6987    }
6988    
6989      if ($self->is_deleted_fid($peg)) { return () }  sub fid_links {
6990        my($self,$fid) = @_;
6991        my($i,$got,$genome,$fidN);
6992    
6993        if ($self->is_deleted_fid($fid)) { return () }
6994      my @links = ();      my @links = ();
6995      my @aliases = $self->feature_aliases($peg);      my @aliases = $self->feature_aliases($fid);
6996      if (open(GLOBAL,"<$FIG_Config::global/peg.links"))  
6997        my $link_file;
6998        for $link_file (("$FIG_Config::global/fid.links","$FIG_Config::global/peg.links"))
6999        {
7000            if (open(GLOBAL,"<$link_file"))
7001      {      {
7002          while (defined($_ = <GLOBAL>))          while (defined($_ = <GLOBAL>))
7003          {          {
# Line 7003  Line 7014 
7014          }          }
7015          close(GLOBAL);          close(GLOBAL);
7016      }      }
7017        }
7018    
7019      my $relational_db_response;      my $relational_db_response;
7020      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
7021    
7022      if (($relational_db_response = $rdbH->SQL("SELECT link FROM peg_links WHERE ( peg = \'$peg\' )")) &&      if (($relational_db_response = $rdbH->SQL("SELECT link FROM fid_links WHERE ( fid = \'$fid\' )")) &&
7023          (@$relational_db_response > 0))          (@$relational_db_response > 0))
7024      {      {
7025          push(@links, map { $_->[0] } @$relational_db_response);          push(@links, map { $_->[0] } @$relational_db_response);
# Line 7017  Line 7029 
7029                    $a cmp $b } @links;                    $a cmp $b } @links;
7030  }  }
7031    
7032  # Each link is a 2-tuple [peg,link]  # Each link is a 2-tuple [fid,link]
7033    
7034  sub add_peg_links {  sub add_peg_links {
7035      my($self,@links) = @_;      my($self,@links) = @_;
7036      my($peg,$link,$pair,$i);  
7037        return $self->add_fid_links(@links);
7038    }
7039    
7040    sub add_fid_links {
7041        my($self,@links) = @_;
7042        my($fid,$link,$pair,$i);
7043    
7044      my $relational_db_response;      my $relational_db_response;
7045      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
7046    
7047      foreach $pair (@links)      foreach $pair (@links)
7048      {      {
7049          ($peg,$link) = @$pair;          ($fid,$link) = @$pair;
7050    
7051          if (($relational_db_response = $rdbH->SQL("SELECT link FROM peg_links WHERE ( peg = \'$peg\' )")) &&          if (($relational_db_response = $rdbH->SQL("SELECT link FROM fid_links WHERE ( fid = \'$fid\' )")) &&
7052              (@$relational_db_response > 0))              (@$relational_db_response > 0))
7053          {          {
7054              for ($i=0; ($i < @$relational_db_response) && ($relational_db_response->[$i]->[0] ne $link); $i++) {}              for ($i=0; ($i < @$relational_db_response) && ($relational_db_response->[$i]->[0] ne $link); $i++) {}
7055              if ($i == @$relational_db_response)              if ($i == @$relational_db_response)
7056              {              {
7057                  &add_peg_link($self,$peg,$link);                  &add_fid_link($self,$fid,$link);
7058              }              }
7059          }          }
7060          else          else
7061          {          {
7062              &add_peg_link($self,$peg,$link);              &add_fid_link($self,$fid,$link);
7063          }          }
7064      }      }
7065  }  }
7066    
7067  sub add_peg_link {  sub add_fid_link {
7068      my($self,$peg,$link) = @_;      my($self,$fid,$link) = @_;
7069    
7070      if ($self->is_deleted_fid($peg)) { return }      if ($self->is_deleted_fid($fid)) { return }
7071      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
7072    
7073      $rdbH->SQL("INSERT INTO peg_links ( peg,link ) VALUES ( \'$peg\',\'$link\' )");      ($fid =~ /^fig\|\d+\.\d+\.([^.]+)\.\d+$/) || confess "bad fid $fid";
7074      if (($peg =~ /^fig\|(\d+\.\d+)\.peg\.\d+$/) && open(TMP,">>$FIG_Config::organisms/$1/Features/peg/peg.links"))      my $type = $1;
7075    
7076        $rdbH->SQL("INSERT INTO fid_links ( fid,link ) VALUES ( \'$fid\',\'$link\' )");
7077        if (($fid =~ /^fig\|(\d+\.\d+)\.fid\.\d+$/) && open(TMP,">>$FIG_Config::organisms/$1/Features/$type/links"))
7078      {      {
7079          print TMP "$peg\t$link\n";          print TMP "$fid\t$link\n";
7080          close(TMP);          close(TMP);
7081          chmod 0777,"$FIG_Config::organisms/$1/Features/peg/peg.links";          chmod 0777,"$FIG_Config::organisms/$1/Features/$type/links";
7082      }      }
7083  }  }
7084    
7085  sub delete_peg_link {  sub delete_peg_link {
7086      my($self,$peg,$link) = @_;      my($self,$peg,$link) = @_;
7087    
7088        $self->delete_fid_link($peg,$link);
7089    }
7090    
7091    sub delete_fid_link {
7092        my($self,$fid,$link) = @_;
7093      my($i);      my($i);
7094    
7095      if ($self->is_deleted_fid($peg)) { return }      if ($self->is_deleted_fid($fid)) { return }
7096      my $genome = $self->genome_of($peg);      my $genome = $self->genome_of($fid);
7097    
7098        ($fid =~ /^fig\|\d+\.\d+\.([^.]+)\.\d+$/) || confess "bad fid $fid";
7099        my $type = $1;
7100    
     if (-s "$FIG_Config::organisms/$genome/Features/peg/peg.links")  
     {  
7101          my $rdbH = $self->db_handle;          my $rdbH = $self->db_handle;
7102          $rdbH->SQL("DELETE FROM peg_links WHERE ( peg = \'$peg\' AND link = \'$link\' )");      $rdbH->SQL("DELETE FROM fid_links WHERE ( fid = \'$fid\' AND link = \'$link\' )");
7103          my @links = `cat $FIG_Config::organisms/$genome/Features/peg/peg.links`;  
7104          for ($i=0; ($i < @links) && (! (($links[$i] =~ /^(\S+)\t(\S.*\S)/) && ($1 eq $peg) && ($2 eq $link))); $i++) {}      my $file;
7105          if (($i < @links) && open(TMP,">$FIG_Config::organisms/$genome/Features/peg/peg.links"))      foreach $file (("$FIG_Config::organisms/$genome/Features/$type/$type.links","$FIG_Config::organisms/$genome/Features/$type/links"))
7106        {
7107            if (-s $file)
7108            {
7109                my @links = `cat $file`;
7110                for ($i=0; ($i < @links) && (! (($links[$i] =~ /^(\S+)\t(\S.*\S)/) && ($1 eq $fid) && ($2 eq $link))); $i++) {}
7111                if (($i < @links) && open(TMP,">$file"))
7112          {          {
7113              splice(@links,$i,1);              splice(@links,$i,1);
7114              print TMP join("",@links);              print TMP join("",@links);
# Line 7082  Line 7116 
7116          }          }
7117      }      }
7118  }  }
7119    }
7120    
7121  sub delete_all_peg_links {  sub delete_all_peg_links {
7122      my($self,$peg) = @_;      my($self,$peg) = @_;
7123    
7124        $self->delete_all_fid_links($peg);
7125    }
7126    
7127    sub delete_all_fid_links {
7128        my($self,$fid) = @_;
7129      my($i);      my($i);
7130    
7131      if ($self->is_deleted_fid($peg)) { return }      if ($self->is_deleted_fid($fid)) { return }
7132      my $genome = $self->genome_of($peg);      my $genome = $self->genome_of($fid);
7133    
     if (-s "$FIG_Config::organisms/$genome/Features/peg/peg.links")  
     {  
7134          my $rdbH = $self->db_handle;          my $rdbH = $self->db_handle;
7135          $rdbH->SQL("DELETE FROM peg_links WHERE ( peg = \'$peg\' )");      $rdbH->SQL("DELETE FROM fid_links WHERE ( fid = \'$fid\' )");
7136          my @links = `cat $FIG_Config::organisms/$genome/Features/peg/peg.links`;  
7137          my @links1 = grep { ! (($_ =~ /^(\S+)/) && ($1 eq $peg)) } @links;      ($fid =~ /^fig\|\d+\.\d+\.([^.]+)\.\d+$/) || confess "bad fid $fid";
7138          if ((@links1 < @links) && open(TMP,">$FIG_Config::organisms/$genome/Features/peg/peg.links"))      my $type = $1;
7139    
7140        my $file;
7141        foreach $file (("$FIG_Config::organisms/$genome/Features/$type/$type.links","$FIG_Config::organisms/$genome/Features/$type/links"))
7142        {
7143            if (-s $file)
7144            {
7145                my @links = `cat $file`;
7146                my @links1 = grep { ! (($_ =~ /^(\S+)/) && ($1 eq $fid)) } @links;
7147                if ((@links1 < @links) && open(TMP,">$file"))
7148          {          {
7149              print TMP join("",@links1);              print TMP join("",@links1);
7150              close(TMP);              close(TMP);
7151          }          }
7152      }      }
7153  }  }
7154    }
7155    
7156    
7157  ###########  ###########

Legend:
Removed from v.1.168  
changed lines
  Added in v.1.169

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3