[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.110, Thu Jun 3 20:58:04 2004 UTC revision 1.111, Tue Jun 8 15:02:14 2004 UTC
# Line 1  Line 1 
1  package FIG;  package FIG;
2    
3    use strict;
4    
5  use DBrtns;  use DBrtns;
6  use Sim;  use Sim;
7  use Blast;  use Blast;
# Line 25  Line 27 
27  use File::Spec;  use File::Spec;
28  use FIGrpc;  use FIGrpc;
29    
 use strict;  
30  use Fcntl qw/:flock/;  # import LOCK_* constants  use Fcntl qw/:flock/;  # import LOCK_* constants
31    
32    use FIGAttributes;
33    use base 'FIGAttributes';
34    
35    use vars qw(%_FunctionAttributes);
36    
37    use Data::Dumper;
38    
39  sub new {  sub new {
40      my($class) = @_;      my($class) = @_;
41    
# Line 373  Line 381 
381  }  }
382    
383  sub get_hostname_by_adapter {  sub get_hostname_by_adapter {
384        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
385      #      #
386      # Attempt to determine our local hostname based on the      # Attempt to determine our local hostname based on the
387      # network environment.      # network environment.
# Line 528  Line 537 
537      # If it's not there, create one, and make it readonly.      # If it's not there, create one, and make it readonly.
538      #      #
539    
540        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
541      my $id;      my $id;
542      my $id_file = "$FIG_Config::fig_disk/config/seed_id";      my $id_file = "$FIG_Config::fig_disk/config/seed_id";
543      if (! -f $id_file)      if (! -f $id_file)
# Line 555  Line 565 
565  }  }
566    
567  sub cgi_url {  sub cgi_url {
568        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
569      return &plug_url($FIG_Config::cgi_url);      return &plug_url($FIG_Config::cgi_url);
570  }  }
571    
572  sub temp_url {  sub temp_url {
573        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
574      return &plug_url($FIG_Config::temp_url);      return &plug_url($FIG_Config::temp_url);
575  }  }
576    
577  sub plug_url {  sub plug_url {
578        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
579      my($url) = @_;      my($url) = @_;
580    
581      my $name;      my $name;
# Line 586  Line 599 
599    
600  sub file_read  sub file_read
601  {  {
602        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
603      my($file) = @_;      my($file) = @_;
604    
605      if (open(my $fh, "<$file"))      if (open(my $fh, "<$file"))
# Line 608  Line 622 
622    
623  sub file_head  sub file_head
624  {  {
625        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
626      my($file, $n) = @_;      my($file, $n) = @_;
627    
628      if (!$n)      if (!$n)
# Line 684  Line 699 
699  =cut  =cut
700    
701  sub min {  sub min {
702        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
703      my(@x) = @_;      my(@x) = @_;
704      my($min,$i);      my($min,$i);
705    
# Line 707  Line 723 
723  =cut  =cut
724    
725  sub max {  sub max {
726        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
727      my(@x) = @_;      my(@x) = @_;
728      my($max,$i);      my($max,$i);
729    
# Line 730  Line 747 
747  =cut  =cut
748    
749  sub between {  sub between {
750        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
751      my($x,$y,$z) = @_;      my($x,$y,$z) = @_;
752    
753      if ($x < $z)      if ($x < $z)
# Line 754  Line 772 
772  =cut  =cut
773    
774  sub standard_genetic_code {  sub standard_genetic_code {
775        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
776    
777      my $code = {};      my $code = {};
778    
# Line 837  Line 856 
856  =cut  =cut
857    
858  sub translate {  sub translate {
859        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
860      my( $dna,$code,$start) = @_;      my( $dna,$code,$start) = @_;
861      my( $i,$j,$ln );      my( $i,$j,$ln );
862      my( $x,$y );      my( $x,$y );
# Line 882  Line 902 
902  =cut  =cut
903    
904  sub reverse_comp {  sub reverse_comp {
905        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
906      my($seq) = @_;      my($seq) = @_;
907    
908      return ${&rev_comp(\$seq)};      return ${&rev_comp(\$seq)};
909  }  }
910    
911  sub rev_comp {  sub rev_comp {
912        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
913      my( $seqP ) = @_;      my( $seqP ) = @_;
914      my( $rev  );      my( $rev  );
915    
# Line 908  Line 930 
930  =cut  =cut
931    
932  sub verify_dir {  sub verify_dir {
933        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
934      my($dir) = @_;      my($dir) = @_;
935    
936      if (-d $dir) { return }      if (-d $dir) { return }
# Line 931  Line 954 
954    
955    
956  sub run {  sub run {
957        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
958      my($cmd) = @_;      my($cmd) = @_;
959    
960  #   my @tmp = `date`; chomp @tmp; print STDERR "$tmp[0]: running $cmd\n";  #   my @tmp = `date`; chomp @tmp; print STDERR "$tmp[0]: running $cmd\n";
# Line 961  Line 985 
985    
986  sub read_fasta_record  sub read_fasta_record
987  {  {
988        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
989      my ($file_handle) = @_;      my ($file_handle) = @_;
990      my ( $old_end_of_record, $fasta_record, @lines, $head, $sequence, $seq_id, $comment, @parsed_fasta_record );      my ( $old_end_of_record, $fasta_record, @lines, $head, $sequence, $seq_id, $comment, @parsed_fasta_record );
991    
# Line 1008  Line 1033 
1033    
1034    
1035  sub display_id_and_seq {  sub display_id_and_seq {
1036        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1037      my( $id, $seq, $fh ) = @_;      my( $id, $seq, $fh ) = @_;
1038    
1039      if (! defined($fh) )  { $fh = \*STDOUT; }      if (! defined($fh) )  { $fh = \*STDOUT; }
# Line 1017  Line 1043 
1043  }  }
1044    
1045  sub display_seq {  sub display_seq {
1046        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1047      my ( $seq, $fh ) = @_;      my ( $seq, $fh ) = @_;
1048      my ( $i, $n, $ln );      my ( $i, $n, $ln );
1049    
# Line 1051  Line 1078 
1078  #  #
1079  #=cut  #=cut
1080  #  #
1081  sub file2N {  sub file2N :scalar {
1082      my($self,$file) = @_;      my($self,$file) = @_;
1083      my($relational_db_response);      my($relational_db_response);
1084    
# Line 1088  Line 1115 
1115  #  #
1116  #=cut  #=cut
1117  #  #
1118  sub N2file {  sub N2file :scalar {
1119      my($self,$fileno) = @_;      my($self,$fileno) = @_;
1120      my($relational_db_response);      my($relational_db_response);
1121    
# Line 1273  Line 1300 
1300    
1301  =cut  =cut
1302    
1303  sub genomes {  sub genomes  :remote :list {
1304      my($self,$complete,$restrictions) = @_;      my($self,$complete,$restrictions) = @_;
1305    
1306      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
# Line 1492  Line 1519 
1519    
1520  =cut  =cut
1521    
1522  sub genus_species {  sub genus_species :scalar {
1523      my ($self,$genome) = @_;      my ($self,$genome) = @_;
1524      my $ans;      my $ans;
1525    
# Line 1553  Line 1580 
1580    
1581  =cut  =cut
1582    
1583  sub abbrev {  sub abbrev :scalar {
1584        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1585      my($genome_name) = @_;      my($genome_name) = @_;
1586    
1587      $genome_name =~ s/^(\S{3})\S+/$1./;      $genome_name =~ s/^(\S{3})\S+/$1./;
# Line 1586  Line 1614 
1614  =cut  =cut
1615    
1616  sub ftype {  sub ftype {
1617        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1618      my($feature_id) = @_;      my($feature_id) = @_;
1619    
1620      if ($feature_id =~ /^fig\|\d+\.\d+\.([^\.]+)/)      if ($feature_id =~ /^fig\|\d+\.\d+\.([^\.]+)/)
# Line 1607  Line 1636 
1636    
1637    
1638  sub genome_of {  sub genome_of {
1639        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1640      my $prot_id = (@_ == 1) ? $_[0] : $_[1];      my $prot_id = (@_ == 1) ? $_[0] : $_[1];
1641    
1642      if ($prot_id =~ /^fig\|(\d+\.\d+)/) { return $1; }      if ($prot_id =~ /^fig\|(\d+\.\d+)/) { return $1; }
# Line 1623  Line 1653 
1653    
1654    
1655  sub genome_and_peg_of {  sub genome_and_peg_of {
1656        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1657      my $prot_id = (@_ == 1) ? $_[0] : $_[1];      my $prot_id = (@_ == 1) ? $_[0] : $_[1];
1658    
1659      if ($prot_id =~ /^fig\|(\d+\.\d+)\.peg\.(\d+)/)      if ($prot_id =~ /^fig\|(\d+\.\d+)\.peg\.(\d+)/)
# Line 1751  Line 1782 
1782    
1783  =cut  =cut
1784    
1785  sub feature_location {  sub feature_location :scalar :list {
1786      my($self,$feature_id) = @_;      my($self,$feature_id) = @_;
1787      my($relational_db_response,$locations,$location);      my($relational_db_response,$locations,$location);
1788    
# Line 1789  Line 1820 
1820  =cut  =cut
1821    
1822  sub boundaries_of {  sub boundaries_of {
1823        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1824      my($location) = (@_ == 1) ? $_[0] : $_[1];      my($location) = (@_ == 1) ? $_[0] : $_[1];
1825      my($contigQ);      my($contigQ);
1826    
# Line 2272  Line 2304 
2304  }  }
2305    
2306  sub close_enough {  sub close_enough {
2307        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
2308      my($locs1,$locs2,$bound) = @_;      my($locs1,$locs2,$bound) = @_;
2309    
2310  #   print STDERR &Dumper(["close enough",$locs1,$locs2]);  #   print STDERR &Dumper(["close enough",$locs1,$locs2]);
# Line 2517  Line 2550 
2550    
2551    
2552  sub extract_by_who {  sub extract_by_who {
2553        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
2554      my($xL,$who) = @_;      my($xL,$who) = @_;
2555      my($i);      my($i);
2556    
# Line 2625  Line 2659 
2659  }  }
2660    
2661  sub hypo {  sub hypo {
2662        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
2663      my $x = (@_ == 1) ? $_[0] : $_[1];      my $x = (@_ == 1) ? $_[0] : $_[1];
2664    
2665      if (! $x)                             { return 1 }      if (! $x)                             { return 1 }
# Line 2819  Line 2854 
2854  }  }
2855    
2856  sub read_block {  sub read_block {
2857        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
2858      my($fh,$seek,$ln) = @_;      my($fh,$seek,$ln) = @_;
2859      my($piece,$readN);      my($piece,$readN);
2860    
# Line 2952  Line 2988 
2988  }  }
2989    
2990  sub blastit {  sub blastit {
2991        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
2992      my($id,$seq,$db,$maxP) = @_;      my($id,$seq,$db,$maxP) = @_;
2993    
2994      if (! $maxP) { $maxP = 1.0e-5 }      if (! $maxP) { $maxP = 1.0e-5 }
# Line 3346  Line 3383 
3383  }  }
3384    
3385  sub epoch_to_readable {  sub epoch_to_readable {
3386        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
3387      my($epoch) = @_;      my($epoch) = @_;
3388    
3389      my($sec,$min,$hr,$dd,$mm,$yr) = localtime($epoch);      my($sec,$min,$hr,$dd,$mm,$yr) = localtime($epoch);
# Line 3524  Line 3562 
3562  #=cut  #=cut
3563    
3564  sub load_all {  sub load_all {
3565        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
3566    
3567      &run("load_peg_mapping");      &run("load_peg_mapping");
3568      &run("index_contigs");      &run("index_contigs");
# Line 3568  Line 3607 
3607  =cut  =cut
3608    
3609  sub auto_assign {  sub auto_assign {
3610        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
3611      my($peg,$seq) = @_;      my($peg,$seq) = @_;
3612    
3613      my $cmd = $seq ? "echo \"$peg\t$seq\" | $FIG_Config::bin/auto_assign | $FIG_Config::bin/make_calls" : "echo \"$peg\" | $FIG_Config::bin/auto_assign | $FIG_Config::bin/make_calls";      my $cmd = $seq ? "echo \"$peg\t$seq\" | $FIG_Config::bin/auto_assign | $FIG_Config::bin/make_calls" : "echo \"$peg\" | $FIG_Config::bin/auto_assign | $FIG_Config::bin/make_calls";
# Line 4208  Line 4248 
4248  =cut  =cut
4249    
4250  sub roles_of_function {  sub roles_of_function {
4251        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
4252      my $func = (@_ == 1) ? $_[0] : $_[1];      my $func = (@_ == 1) ? $_[0] : $_[1];
4253    
4254      return (split(/\s*[\/;]\s+/,$func),($func =~ /\d+\.\d+\.\d+\.\d+/g));      return (split(/\s*[\/;]\s+/,$func),($func =~ /\d+\.\d+\.\d+\.\d+/g));
# Line 4376  Line 4417 
4417  }  }
4418    
4419  sub close_enough_locs {  sub close_enough_locs {
4420        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
4421      my($x,$y) = @_;      my($x,$y) = @_;
4422    
4423      return (($x->[1] eq $y->[1]) && (abs($x->[2] - $y->[2]) < 5000));      return (($x->[1] eq $y->[1]) && (abs($x->[2] - $y->[2]) < 5000));
# Line 4595  Line 4637 
4637  =cut  =cut
4638    
4639  sub extract_seq {  sub extract_seq {
4640        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
4641      my($contigs,$loc) = @_;      my($contigs,$loc) = @_;
4642      my($contig,$beg,$end,$contig_seq);      my($contig,$beg,$end,$contig_seq);
4643      my($plus,$minus);      my($plus,$minus);
# Line 4999  Line 5042 
5042  }  }
5043    
5044  sub limit_labels {  sub limit_labels {
5045        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
5046      my($tree,$min_for_label) = @_;      my($tree,$min_for_label) = @_;
5047    
5048      my($children) = &tree_utilities::node_pointers($tree);      my($children) = &tree_utilities::node_pointers($tree);
# Line 5030  Line 5074 
5074  }  }
5075    
5076  sub taxonomic_groups {  sub taxonomic_groups {
5077        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
5078      my($tree) = @_;      my($tree) = @_;
5079    
5080      my($groups,undef) = &taxonomic_groups_and_children($tree);      my($groups,undef) = &taxonomic_groups_and_children($tree);
# Line 5037  Line 5082 
5082  }  }
5083    
5084  sub taxonomic_groups_and_children {  sub taxonomic_groups_and_children {
5085        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
5086      my($tree) = @_;      my($tree) = @_;
5087      my($ids1,$i,$groupsC,$idsC);      my($ids1,$i,$groupsC,$idsC);
5088    
# Line 5170  Line 5216 
5216      return ($spreadsheet,$notes);      return ($spreadsheet,$notes);
5217  }  }
5218    
5219  sub is_exchangable_subsystem {  sub is_exchangable_subsystem :scalar {
5220        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
5221      my $ssa = (@_ == 1) ? $_[0] : $_[1];      my $ssa = (@_ == 1) ? $_[0] : $_[1];
5222      $ssa =~ s/ /_/g;      $ssa =~ s/ /_/g;
5223      if (open(TMP,"<$FIG_Config::data/Subsystems/$ssa/EXCHANGABLE"))      if (open(TMP,"<$FIG_Config::data/Subsystems/$ssa/EXCHANGABLE"))
# Line 5187  Line 5234 
5234  }  }
5235    
5236  sub all_exchangable_subsystems {  sub all_exchangable_subsystems {
5237        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
5238    
5239      my @exchangable = ();      my @exchangable = ();
5240      if (opendir(SUB,"$FIG_Config::data/Subsystems"))      if (opendir(SUB,"$FIG_Config::data/Subsystems"))
# Line 5198  Line 5246 
5246  }  }
5247    
5248  sub all_subsystems {  sub all_subsystems {
5249        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
5250    
5251      my @subsystems = ();      my @subsystems = ();
5252      if (opendir(SUB,"$FIG_Config::data/Subsystems"))      if (opendir(SUB,"$FIG_Config::data/Subsystems"))
# Line 5208  Line 5257 
5257      return @subsystems;      return @subsystems;
5258  }  }
5259    
5260  sub subsystem_version {  sub subsystem_version :scalar {
5261        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
5262      my $ssa = (@_ == 1) ? $_[0] : $_[1];      my $ssa = (@_ == 1) ? $_[0] : $_[1];
5263      $ssa =~ s/ /_/g;      $ssa =~ s/ /_/g;
5264    
# Line 5235  Line 5285 
5285    
5286  =cut  =cut
5287    
5288  sub subsystem_curator {  sub subsystem_curator :scalar {
5289      my($self, $ssa) = @_;      my($self, $ssa) = @_;
5290      my($who) = "";      my($who) = "";
5291    
# Line 5329  Line 5379 
5379    
5380  =cut  =cut
5381    
5382  sub subsystem_genomes {  sub subsystem_genomes :scalar {
5383      my($self,$ssa) = @_;      my($self,$ssa) = @_;
5384      my($genomes);      my($genomes);
5385    
# Line 5382  Line 5432 
5432  #    @maps             = $fig->role_to_maps($role)  #    @maps             = $fig->role_to_maps($role)
5433  #    @subsystems = $fig->peg_to_subsystems($peg);  #    @subsystems = $fig->peg_to_subsystems($peg);
5434    
5435  sub get_subsystem  sub get_subsystem :scalar
5436  {  {
5437      my($self, $subsystem, $force_load) = @_;      my($self, $subsystem, $force_load) = @_;
5438      my $sub;      my $sub;
# Line 5407  Line 5457 
5457      return $sub->get_pegs_from_cell($genome, $role);      return $sub->get_pegs_from_cell($genome, $role);
5458  }  }
5459    
5460  sub get_clearinghouse  sub get_clearinghouse :scalar
5461  {  {
5462      my($self, $url) = @_;      my($self, $url) = @_;
5463    
# Line 5501  Line 5551 
5551      {      {
5552          return @$relational_db_response;          return @$relational_db_response;
5553      }      }
5554        else
5555        {
5556            return ();
5557        }
5558  }  }
5559    
5560    
# Line 5773  Line 5827 
5827      }      }
5828  }  }
5829    
5830  1  1;
5831    
5832    

Legend:
Removed from v.1.110  
changed lines
  Added in v.1.111

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3