[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.420, Fri Jan 13 06:54:49 2006 UTC revision 1.421, Fri Jan 13 20:22:39 2006 UTC
# Line 3176  Line 3176 
3176      return (@$relational_db_response == 1)      return (@$relational_db_response == 1)
3177  }  }
3178    
3179    sub is_genome {
3180        my($self,$genome) = @_;
3181        my($x,$y);
3182    
3183        if (! ($x = $self->{_is_genome}))
3184        {
3185            $x = $self->{_is_genome} = {};
3186        }
3187    
3188        if (defined($y = $x->{$genome})) { return $y }
3189        my $rdbH = $self->db_handle;
3190        my $relational_db_response = $rdbH->SQL("SELECT genome  FROM genome where (genome = '$genome')");
3191        $y = (@$relational_db_response == 1);
3192        $x->{$genome} = $y;
3193        return $y;
3194    }
3195    
3196  =head3 genome_counts  =head3 genome_counts
3197    
3198  C<< my ($arch, $bact, $euk, $vir, $env, $unk) = $fig->genome_counts($complete); >>  C<< my ($arch, $bact, $euk, $vir, $env, $unk) = $fig->genome_counts($complete); >>
# Line 6238  Line 6255 
6255  Note that no annotation is written.  This should normally be done in a separate  Note that no annotation is written.  This should normally be done in a separate
6256  call of the form  call of the form
6257    
6258  ????      $userR = $user;
6259        $userR =~ s/^master://;    # get rid of the silly "master:"
6260        $fig->add_annotation($cgi,$fid,$userR,"Set master function to\n$function\n");
6261    
6262  =cut  =cut
6263    
6264  sub assign_function {  sub assign_function {
6265      my($self,$peg,$user,$function,$confidence) = @_;      my($self,$fid,$user,$function,$confidence) = @_;
6266      my($role,$roleQ,$kvs,$kv,$k,$v);      my($role,$roleQ,$kvs,$kv,$k,$v);
6267    
6268      if (! $self->is_real_feature($peg)) { return 0 }      if (! $self->is_real_feature($fid)) { return 0 }
6269    
6270      my $genome = $self->genome_of($peg);      my $genome = $self->genome_of($fid);
6271    
6272      $function =~ s/\s+/ /sg;      $function =~ s/\s+/ /sg;
6273      $function =~ s/^\s+//;      $function =~ s/^\s+//;
# Line 6267  Line 6286 
6286                      ($k,$v) = ($1,$2);                      ($k,$v) = ($1,$2);
6287                      if ($v !~ /\S/)                      if ($v !~ /\S/)
6288                      {                      {
6289                          &replace_peg_key_value($self,$peg,$k,"");                          &replace_peg_key_value($self,$fid,$k,"");
6290                      }                      }
6291                      else                      else
6292                      {                      {
6293                          &replace_peg_key_value($self,$peg,$k,$v);                          &replace_peg_key_value($self,$fid,$k,$v);
6294                      }                      }
6295                  }                  }
6296                  elsif ($kv =~ /^([A-Za-z0-9._\-\+\%]+)$/)                  elsif ($kv =~ /^([A-Za-z0-9._\-\+\%]+)$/)
6297                  {                  {
6298                      &replace_peg_key_value($self,$peg,$1,1);                      &replace_peg_key_value($self,$fid,$1,1);
6299                  }                  }
6300              }              }
6301          }          }
# Line 6285  Line 6304 
6304      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
6305      $confidence = $confidence ? $confidence : "";      $confidence = $confidence ? $confidence : "";
6306    
6307      $rdbH->SQL("DELETE FROM assigned_functions WHERE ( prot = \'$peg\' AND made_by = \'$user\' )");      $rdbH->SQL("DELETE FROM assigned_functions WHERE ( prot = \'$fid\' AND made_by = \'$user\' )");
6308    
6309      my $funcQ = quotemeta $function;      my $funcQ = quotemeta $function;
6310      $rdbH->SQL("INSERT INTO assigned_functions ( prot, made_by, assigned_function, quality, org ) VALUES ( \'$peg\', \'$user\', \'$funcQ\', \'$confidence\', \'$genome\' )");      $rdbH->SQL("INSERT INTO assigned_functions ( prot, made_by, assigned_function, quality, org ) VALUES ( \'$fid\', \'$user\', \'$funcQ\', \'$confidence\', \'$genome\' )");
6311      $rdbH->SQL("DELETE FROM roles WHERE ( prot = \'$peg\' AND made_by = \'$user\' )");      $rdbH->SQL("DELETE FROM roles WHERE ( prot = \'$fid\' AND made_by = \'$user\' )");
6312    
6313      foreach $role (&roles_of_function($function))      foreach $role (&roles_of_function($function))
6314      {      {
6315          $roleQ = quotemeta $role;          $roleQ = quotemeta $role;
6316          $rdbH->SQL("INSERT INTO roles ( prot, role, made_by, org ) VALUES ( \'$peg\', '$roleQ\', \'$user\',  \'$genome\' )");          $rdbH->SQL("INSERT INTO roles ( prot, role, made_by, org ) VALUES ( \'$fid\', '$roleQ\', \'$user\',  \'$genome\' )");
6317      }      }
6318    
6319      &verify_dir("$FIG_Config::organisms/$genome/UserModels");      &verify_dir("$FIG_Config::organisms/$genome/UserModels");
# Line 6309  Line 6328 
6328      {      {
6329          flock(TMP,LOCK_EX) || confess "cannot lock assigned_functions";          flock(TMP,LOCK_EX) || confess "cannot lock assigned_functions";
6330          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";
6331          print TMP "$peg\t$function\t$confidence\n";          print TMP "$fid\t$function\t$confidence\n";
6332          close(TMP);          close(TMP);
6333          chmod(0777,$file);          chmod(0777,$file);
6334          return 1;          return 1;
6335      }      }
6336      else      else
6337      {      {
6338          print STDERR "FAILED ASSIGNMENT: $peg\t$function\t$confidence\n";          print STDERR "FAILED ASSIGNMENT: $fid\t$function\t$confidence\n";
6339      }      }
6340      return 0;      return 0;
6341  }  }
# Line 11373  Line 11392 
11392                      my @entries = split(/,/,$flds[$i]);                      my @entries = split(/,/,$flds[$i]);
11393                      foreach $id (@entries)                      foreach $id (@entries)
11394                      {                      {
11395                          $seqs{"fig\|$genome\.peg.$id"} = 1;                          my $type = ($id =~ /^(\S+)\.(\d+)$/) ? $1 : "peg";
11396                            my $n    = ($id =~ /(\d+)$/) ? $1 : "";
11397                            if ($type && $n)
11398                            {
11399                                $seqs{"fig\|$genome.$type.$n"} = 1;
11400                            }
11401                      }                      }
11402                  }                  }
11403              }              }
# Line 11384  Line 11408 
11408          # Assignments and aliases.          # Assignments and aliases.
11409          #          #
11410    
11411          my $peg;          my($fid);
11412          foreach $peg (sort { &FIG::by_fig_id($a,$b) } keys(%seqs))          foreach $fid (sort { &FIG::by_fig_id($a,$b) } keys(%seqs))
11413          {          {
11414              my @aliases = grep { $_ =~ /^(sp\||gi\||pirnr\||kegg\||N[PGZ]_)/ } $self->feature_aliases($peg);              my @aliases = grep { $_ =~ /^(sp\||gi\||pirnr\||kegg\||N[PGZ]_)/ } $self->feature_aliases($fid);
11415    
11416              my $alias_txt = join(",",@aliases);              my $alias_txt = join(",",@aliases);
11417              my $gs_txt = $self->genus_species($self->genome_of($peg));              my $genome = $self->genome_of($fid);
11418              my $func_txt = scalar $self->function_of($peg);              my $gs_txt = $self->genus_species($genome);
11419                my $func_txt = scalar $self->function_of($fid);
11420                my $location = $self->feature_location($fid);
11421                my %seen;
11422                my @checksums = map { [ $_, $self->contig_md5sum( $genome, $_ ) ] }
11423                                grep { $_ && ( ! $seen{ $_ }++ ) }
11424                                map  { m/^(\S+)_\d+_\d+$/ }
11425                                split(/,/,$location);
11426                                my @loc = split( /,/, $location );
11427                my $checksum = join(";",map { join(",",@$_) } @checksums);
11428    
11429              push(@$spreadsheet, join("\t", ($peg,              push(@$spreadsheet, join("\t", ($fid,
11430                                              $alias_txt,                                              $alias_txt,
11431                                              $gs_txt,                                              $gs_txt,
11432                                              $func_txt)) . "\n");                                              $func_txt),
11433                                                $location,
11434                                                $checksum) . "\n");
11435          }          }
11436          push(@$spreadsheet,"//\n");          push(@$spreadsheet,"//\n");
11437    
11438          #          #
11439          # Protein sequence data          # sequence data
11440          #          #
11441    
11442          foreach $peg (sort { &FIG::by_fig_id($a,$b) } keys(%seqs))          foreach $fid (sort { &FIG::by_fig_id($a,$b) } keys(%seqs))
11443          {          {
11444              my $aliases = $self->feature_aliases($peg);              my $aliases = $self->feature_aliases($fid);
11445              my $seq = $self->get_translation($peg);              my $seq = (&ftype($fid) eq "peg") ? $self->get_translation($fid) :
11446              push(@$spreadsheet,">$peg $aliases\n");                                                  $self->dna_seq(&genome_of($fid),
11447                                                                   scalar $self->feature_location($fid));
11448                push(@$spreadsheet,">$fid $aliases\n");
11449              my($i,$ln);              my($i,$ln);
11450              $ln = length($seq);              $ln = length($seq);
11451              for ($i=0; ($i < $ln); $i += 60)              for ($i=0; ($i < $ln); $i += 60)
# Line 11424  Line 11461 
11461              }              }
11462          }          }
11463          close(SSA);          close(SSA);
11464    
11465          push(@$spreadsheet,"//\n");          push(@$spreadsheet,"//\n");
11466    
11467          #          #
# Line 11508  Line 11546 
11546    
11547              }              }
11548          }          }
   
11549      }      }
11550      return ($spreadsheet,$notes);      return ($spreadsheet,$notes);
11551  }  }
# Line 11840  Line 11877 
11877    
11878  =head3 subsystems_for_genome  =head3 subsystems_for_genome
11879    
11880  usage: $subsystems = $fig->subsystems_for_genome($genome_name, $zero)  usage: $subsystems = $fig->subsystems_for_genome($genome, $all)
11881    
11882  Return the list of subsystems in which the subsystem has been entered.  Return the list of subsystems in which the genome has been entered.
11883    
11884  $subsystems is a list of genome_id.  $subsystems is a pointer to a list of subsystem names.
11885    
11886  It will only return those genomes with a non-zero variant code.  It will only return those genomes with a variant code other than 0 or -1,
11887    unless the $all argument is "true" (in which case all subsystems are returned).
11888    
11889  =cut  =cut
11890  #: Return Type $@@;  #: Return Type $@@;
11891    
11892    
11893  sub subsystems_for_genome {  sub subsystems_for_genome {
11894      my($self,$genome, $zero) = @_;      my($self,$genome, $all) = @_;
11895    
11896      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
11897    
# Line 11869  Line 11907 
11907          local $dbh->{PrintError} = 0;          local $dbh->{PrintError} = 0;
11908    
11909          my $sql="SELECT DISTINCT subsystem from subsystem_index WHERE (protein like 'fig\|$genome.peg.%'";          my $sql="SELECT DISTINCT subsystem from subsystem_index WHERE (protein like 'fig\|$genome.peg.%'";
11910          unless ($zero) {$sql .= " AND (variant != '-1' AND variant != '0')"}          unless ($all) {$sql .= " AND (variant != '-1' AND variant != '0')"}
11911          $sql .= ")";          $sql .= ")";
11912    
11913          eval {          eval {
# Line 11887  Line 11925 
11925    
11926  =head3 subsystem_genomes  =head3 subsystem_genomes
11927    
11928  usage: $genomes = $fig->subsystem_genomes($subsystem_name, $zero)  usage: $genomes = $fig->subsystem_genomes($subsystem_name, $all)
11929    
11930  Return the list of genomes in the subsystem.  Return the list of genomes in the subsystem.
11931    
11932  $genomes is a list of tuples (genome_id, name)  $genomes is a list of tuples (genome_id, name)
11933    
11934  unless ($zero) is set to true it will only return those genomes with a non-zero variant code  unless ($all) is set to true it will only return those genomes with a variant code other thaN
11935    0 OR -1.
11936    
11937  =cut  =cut
11938  #: Return Type $@@;  #: Return Type $@@;
11939    
   
11940  sub subsystem_genomes :Scalar {  sub subsystem_genomes :Scalar {
11941      my($self,$ssa,$all) = @_;      my($self,$ssa,$all) = @_;
11942      my($genomes);      my($genomes);
# Line 13247  Line 13285 
13285  sub delete_feature {  sub delete_feature {
13286      my($self,$fid) = @_;      my($self,$fid) = @_;
13287    
13288      open(TMP,">>$FIG_Config::global/deleted.features")      my $genome = &genome_of($fid);
13289          || die "could not open $FIG_Config::global/deleted.features";      my $type   = &ftype($fid);
13290        my $dbh = $self->db_handle();
13291        my $file = $self->table_exists('deleted_fids') ? "$FIG_Config::organisms/$genome/Features/$type/deleted.features"
13292                                                       : "$FIG_Config::global/deleted.features";
13293        if (open(TMP,">>$file"))
13294        {
13295      flock(TMP,LOCK_EX) || confess "cannot lock deleted.features";      flock(TMP,LOCK_EX) || confess "cannot lock deleted.features";
13296      print TMP "$fid\n";      print TMP "$fid\n";
13297      close(TMP);      close(TMP);
13298      chmod 0777, "$FIG_Config::global/deleted.features";          chmod 0777, $file;
13299      $self->{_deleted_fids} = undef;      }
13300        if ($file eq "$FIG_Config::organisms/$genome/Features/$type/deleted.features")
13301        {
13302            $dbh->SQL("INSERT INTO deleted_fids (genome,fid) VALUES ('$genome','$fid')");
13303        }
13304        $self->{_deleted_fids}->{$fid} = 1;
13305    }
13306    
13307    sub undelete_feature {
13308        my($self,$fid) = @_;
13309    
13310        my $genome = &genome_of($fid);
13311        my $type   = &ftype($fid);
13312        my $dbh = $self->db_handle();
13313        &undelete_from_file($fid,"$FIG_Config::global/deleted.features");
13314        &undelete_from_file($fid,"$FIG_Config::organisms/$genome/Features/$type/deleted.features");
13315    
13316        if ($self->table_exists('deleted_fids'))
13317        {
13318            $dbh->SQL("DELETE FROM deleted_fids WHERE fid = '$fid'");
13319        }
13320        $self->{_deleted_fids}->{$fid} = 0;
13321  }  }
13322    
13323    # This is not done properly - the possibility of destructive overlap is obvious.  I doubt that
13324    # it will be called 10 times during the lifetime of the SEED.  (RAO)
13325    
13326    sub undelete_from_file {
13327        my($fid,$file) = @_;
13328    
13329        my $fidQ = quotemeta $fid;
13330        my @old = grep { $_ !~ /$fidQ/ } `cat $file`;
13331        if (open(OLDDEL,">$file"))
13332        {
13333            foreach my $line (@old)
13334            {
13335                print OLDDEL $line;
13336            }
13337            close(OLDDEL);
13338        }
13339    }
13340    
13341    
13342  =head3 add_feature  =head3 add_feature
13343    
13344  C<< my $fid = $fig->add_feature($genome,$type,$location,$aliases,$translation,$fid); >>  C<< my $fid = $fig->add_feature($genome,$type,$location,$aliases,$translation,$fid); >>
# Line 13479  Line 13561 
13561      return "fig\|$genome\.$type\.$fidN";      return "fig\|$genome\.$type\.$fidN";
13562  }  }
13563    
13564    sub replace_feature_with {
13565        my($self,$from_fid,$to_fid) = @_;
13566    
13567        my $genome = &genome_of($from_fid);
13568        my $type   = &ftype($from_fid);
13569        if (($genome ne &genome_of($to_fid)) || ($type ne &ftype($to_fid))) { return undef }
13570    
13571        my $dbh = $self->db_handle();
13572        my $file = "$FIG_Config::global/replaced.features";
13573        if (open(TMP,">>$file"))
13574        {
13575            flock(TMP,LOCK_EX) || confess "cannot lock deleted.features";
13576            print TMP "$from_fid\t$to_fid\n";
13577            close(TMP);
13578            chmod 0777, $file;
13579        }
13580        self->delete_feature($from_fid);
13581        my $rc = $dbh->SQL("INSERT INTO replaced_fids (genome,from_fid,to_fid) VALUES ('$genome','$from_fid','$to_fid')");
13582    }
13583    
13584    sub fid_replaced_by {
13585        my($self,$fid) = @_;
13586    
13587        my $dbh = $self->db_handle();
13588        my $res = $dbh->SQL("SELECT to_fid FROM replaced_fids WHERE from_fid = '$fid'");
13589        if (@$res > 0)
13590        {
13591            return $res->[0]->[0];
13592        }
13593        else
13594        {
13595            return undef;
13596        }
13597    }
13598    
13599  sub is_deleted_fid {  sub is_deleted_fid {
13600      my($self,$fid) = @_;      my($self,$fid) = @_;
13601      my($x,$y);      my($x,$y);
13602    
13603      if (! ($x = $self->{_deleted_fids}))      if (! ($x = $self->{_deleted_fids}))
13604      {      {
13605          $self->{_deleted_fids} = {};          $x = $self->{_deleted_fids} = {};
13606          if (open(TMP,"<$FIG_Config::global/deleted.features"))      }
13607    
13608        if (defined($y = $x->{$fid})) { return $y }
13609        if (! $self->is_genome(&genome_of($fid)))  { $x->{$fid} = 1; return 1 }
13610    
13611        my $dbh = $self->db_handle();
13612        if (! $self->table_exists('deleted_fids'))
13613          {          {
13614              #          $dbh->create_table(tbl => 'deleted_fids',flds => 'genome varchar(16), fid varchar(32)');
13615              # Feh. Try using this method inside a loop with $/ set and you'lll get bitten.          my $tmpfile = "$FIG_Config::temp/delfids$$";
13616              #          if ((-s "$FIG_Config::global/deleted.fids") && open(TMP,">$tmpfile"))
13617              local $/ = "\n";          {
13618              while ($y = <TMP>)              open(GLOBDEL,"<$FIG_Config::global/deleted.fids") || die "I could not open $FIG_Config::global/deleted.fids";
13619                while (defined($y = <GLOBDEL>))
13620              {              {
13621                  if ($y =~ /^(fig\|\d+\.\d+\.[a-zA-Z]+\.\d+)/)                  if ($y =~ /^fig\|(\d+\.\d+)/)
13622                  {                  {
13623                      $self->{_deleted_fids}->{$1} = 1;                      print TMP "$1\t$y";
13624                  }                  }
13625              }              }
13626                close(GLOBDEL);
13627              close(TMP);              close(TMP);
13628                $dbh->load_table(tbl => 'deleted_fids', file => $tmpfile, delim => "\t" );
13629                unlink($tmpfile);
13630          }          }
         $x = $self->{_deleted_fids};  
13631      }      }
13632      return $x->{$fid};  
13633        my $res = $dbh->SQL("SELECT fid FROM deleted_fids WHERE fid = '$fid'");
13634        my $deleted = (@$res > 0);
13635        $x->{$fid} = $deleted;
13636        return $deleted;
13637  }  }
13638    
13639  sub fid_with_changed_location {  sub fid_with_changed_location {

Legend:
Removed from v.1.420  
changed lines
  Added in v.1.421

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3