[Bio] / FigKernelPackages / SeedV.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/SeedV.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3, Tue Aug 10 19:38:47 2010 UTC revision 1.4, Wed Aug 18 21:53:56 2010 UTC
# Line 44  Line 44 
44      ($org_dir =~ /(\d+\.\d+)$/) || confess("$org_dir must be a path ending in the genome ID");      ($org_dir =~ /(\d+\.\d+)$/) || confess("$org_dir must be a path ending in the genome ID");
45      $self->{_genome} = $1;      $self->{_genome} = $1;
46    
     $self->{_sap} = SAPserver->new($pseed_url);  
   
47      return bless $self, $class;      return bless $self, $class;
48  }  }
49    
# Line 333  Line 331 
331          return [];          return [];
332      }      }
333      my %assign;      my %assign;
334      foreach $_ (`cat @fnfiles`)      for my $file (@fnfiles)
335        {
336            my $fh;
337            if (!open($fh, "<", $file))
338            {
339                warn "Cannot open $file: $!";
340                next;
341            }
342    
343            while (<$fh>)
344      {      {
345          if ( $_ =~ /^(fig\|\d+\.\d+\.peg\.\d+)\t(\S.*\S)/)          if ( $_ =~ /^(fig\|\d+\.\d+\.peg\.\d+)\t(\S.*\S)/)
346          {          {
347              my($fid,$func) = ($1,$2);              my($fid,$func) = ($1,$2);
348              $assign{$fid} = $func;              $assign{$fid} = $func;
349          }          }
         return [map { [$_,$assign{$_}] } sort { &SeedUtils::by_fig_id($a,$b) } keys(%assign)];  
350      }      }
351            close($fh);
352        }
353        return [map { [$_,$assign{$_}] } sort { &SeedUtils::by_fig_id($a,$b) } keys(%assign)];
354  }  }
355    
356  sub get_genome_subsystem_data {  sub get_genome_subsystem_data {
# Line 350  Line 359 
359      my $newG    = $self->{_genome};      my $newG    = $self->{_genome};
360      my $newGdir = $self->{_orgdir};      my $newGdir = $self->{_orgdir};
361    
362          my %operational = map { (($_ =~ /^(\S.*\S)\t(\S+)/) && (($2 ne '-1') && ($2 ne '0'))) ? ($1 => 1) : () }      my $fh;
363                            `cat $newGdir/Subsystems/subsystems`;      open($fh, "<", "$newGdir/Subsystems/subsystems");
364        my %operational = map { (($_ =~ /^(\S.*\S)\t(\S+)/) && (($2 ne '-1') && ($2 ne '0'))) ? ($1 => 1) : () } <$fh>;
365        close($fh);
366    
367          return [grep { ! $self->is_deleted_fid($_->[2]) }      open($fh, "<", "$newGdir/Subsystems/bindings");
368        my $rc =  [grep { ! $self->is_deleted_fid($_->[2]) }
369                  map { (($_ =~ /^(\S[^\t]+\S)\t(\S[^\t]*\S)\t(\S+)/) && $operational{$1} ) ? [$1,$2,$3] : () }                  map { (($_ =~ /^(\S[^\t]+\S)\t(\S[^\t]*\S)\t(\S+)/) && $operational{$1} ) ? [$1,$2,$3] : () }
370                  `cat $newGdir/Subsystems/bindings`];                  <$fh>];
371        close($fh);
372        return $rc;
373  }  }
374    
375  sub get_genome_subsystem_count  sub get_genome_subsystem_count
# Line 397  Line 411 
411      my $newG    = $self->{_genome};      my $newG    = $self->{_genome};
412      my $newGdir = $self->{_orgdir};      my $newGdir = $self->{_orgdir};
413    
414        open(my $fh, "<", "$newGdir/Subsystems/bindings");
415    
416          my @roles = map { (($_ =~ /^([^\t]+)\t([^\t]+)\t(\S+)$/) && ($1 eq $subsystem) && ($3 eq $peg)) ?          my @roles = map { (($_ =~ /^([^\t]+)\t([^\t]+)\t(\S+)$/) && ($1 eq $subsystem) && ($3 eq $peg)) ?
417                            $2 : () } `cat $newGdir/Subsystems/bindings`;                            $2 : () } <$fh>;
418          my %roles = map { $_ => 1 } @roles;          my %roles = map { $_ => 1 } @roles;
419          return [sort keys(%roles)];          return [sort keys(%roles)];
420  }  }
# Line 922  Line 938 
938      return "";      return "";
939  }  }
940    
941    sub assign_function
942    {
943        my($self, $fid, $user, $function, $confidence) = @_;
944    
945        $confidence = $confidence ? $confidence : "";
946    
947        my $newG    = $self->{_genome};
948        my $newGdir = $self->{_orgdir};
949    
950        if (($fid =~ /^fig\|(\d+\.\d+)/) && ($1 ne $newG))
951        {
952            warn "assign_function on non-seedv fid\n";
953            return 0;
954        }
955    
956        $function =~ s/\s+/ /sg;  # No multiple spaces
957        $function =~ s/^\s+//;    # No space at begining
958        $function =~ s/\s+$//;    # No space at end
959        $function =~ s/ ; /; /g;  # No space before semicolon
960    
961        my $file = "$newGdir/proposed_user_functions";
962        my $status = 1;
963        if ( open( TMP, ">>$file" ) )
964        {
965            print TMP "$fid\t$function\t$confidence\n";
966            close(TMP);
967        }
968        else
969        {
970            print STDERR "FAILED ASSIGNMENT: $fid\t$function\t$confidence\n";
971            $status = 0;
972        }
973    
974        # mdj:  force reload of functions to pick up new assignment
975        $self->load_functions(1);
976    
977        #  We are not getting annotations logged.  So, we will impose it here.
978        $self->add_annotation( $fid, $user, "Set master function to\n$function\n" );
979    
980        #
981        # Mark the genome directory as in need of having bindings recomputed.
982        #
983    #     if (open(S, "<$newGdir/Subsystems/subsystems"))
984    #     {
985    #       while (<S>)
986    #       {
987    #           chomp;
988    #           my($sname, $v) = split(/\t/);
989    #           open(SFILE, ">$self->{_orgdir}/Subsystems/${sname}_bindings_need_recomputation");
990    #           close(SFILE);
991    #       }
992    #       close(S);
993    #     }
994        return $status;
995    }
996    
997    sub add_annotation {
998        my($self,$feature_id,$user,$annotation, $time_made) = @_;
999    
1000        my $newG    = $self->{_genome};
1001        my $newGdir = $self->{_orgdir};
1002    
1003        if (($feature_id =~ /^fig\|(\d+\.\d+)/) && ($1 ne $newG))
1004        {
1005            warn "add_annotation on non-seedv fid\n";
1006            return 0;
1007        }
1008    
1009        $time_made = time unless $time_made =~ /^\d+$/;
1010    
1011        if ($self->is_deleted_fid($feature_id)) { return 0 }
1012    
1013    #   print STDERR "add: fid=$feature_id user=$user annotation=$annotation\n";
1014    
1015        my $file = "$newGdir/annotations";
1016        my $ma   = ($annotation =~ /^Set master function to/);
1017    
1018        if (open(TMP,">>$file"))
1019        {
1020            my $dataLine = "$feature_id\n$time_made\n$user\n$annotation" . ((substr($annotation,-1) eq "\n") ? "" : "\n");
1021            print TMP $dataLine . "//\n";
1022            close(TMP);
1023    
1024            #
1025            # Update local cache.
1026            #
1027            my $ann = $self->{_ann};
1028            push(@{$ann->{$feature_id}}, [$feature_id, $time_made, $user, $annotation . "\n"]);
1029        }
1030        return 0;
1031    }
1032    
1033    
1034  =pod  =pod
1035    
# Line 1343  Line 1451 
1451      my $newGdir = $self->{_orgdir};      my $newGdir = $self->{_orgdir};
1452      my $tbl     = {};      my $tbl     = {};
1453    
1454      foreach my $x (`cat $newGdir/Features/*/tbl`)      for my $tbl_file (<$newGdir/Features/*/tbl>)
1455        {
1456            if (open(my $fh, "<", $tbl_file))
1457            {
1458                while (defined(my $x = <$fh>))
1459      {      {
1460          chomp $x;          chomp $x;
1461          if ($x =~ /^(\S+)\t(\S+)(\t(\S.*\S))?/)          if ($x =~ /^(\S+)\t(\S+)(\t(\S.*\S))?/)
# Line 1360  Line 1472 
1472              warn "Bad feature line in $newGdir:$x:\n";              warn "Bad feature line in $newGdir:$x:\n";
1473          }          }
1474      }      }
1475                close($fh);
1476            }
1477            else
1478            {
1479                warn "Cannot open $tbl_file: $!";
1480            }
1481        }
1482      print STDERR ("Loaded ", (scalar keys %$tbl), " features from $newGdir\n") if $ENV{FIG_VERBOSE};      print STDERR ("Loaded ", (scalar keys %$tbl), " features from $newGdir\n") if $ENV{FIG_VERBOSE};
1483      $self->{_tbl} = $tbl;      $self->{_tbl} = $tbl;
1484  }  }
# Line 1375  Line 1494 
1494      my $roles     = {};      my $roles     = {};
1495    
1496      # order of "cat" is important - proposed_user_functions must be last      # order of "cat" is important - proposed_user_functions must be last
1497      foreach my $x (`cat $newGdir/*functions`)      for my $fn_file (<$newGdir/*functions>)
1498        {
1499            if (open(my $fh, "<", $fn_file))
1500            {
1501                while (defined(my $x = <$fh>))
1502      {      {
1503          if (($x =~ /^(fig\|(\d+\.\d+)\.\S+)\t(\S[^\t]*\S)/) && ($2 eq $newG))          if (($x =~ /^(fig\|(\d+\.\d+)\.\S+)\t(\S[^\t]*\S)/) && ($2 eq $newG))
1504          {          {
# Line 1404  Line 1527 
1527              }              }
1528          }          }
1529      }      }
1530                close($fh);
1531            }
1532            else
1533            {
1534                warn "Cannot open $fn_file: $!";
1535            }
1536        }
1537      $self->{_functions} = $functions;      $self->{_functions} = $functions;
1538      $self->{_roles} = $roles;      $self->{_roles} = $roles;
1539  }  }
# Line 1471  Line 1601 
1601  {  {
1602      my($self) = @_;      my($self) = @_;
1603    
1604      return if exists($self->{correspondence_index});      #return if exists($self->{correspondence_index});
1605    
1606      my $dir = $self->{_orgdir};      my $dir = $self->{_orgdir};
1607      my $index = {};      my $index = {};
# Line 1569  Line 1699 
1699      # regions.      # regions.
1700      #      #
1701      my $sap = $self->{_sap};      my $sap = $self->{_sap};
1702        if (!defined($sap))
1703        {
1704            $sap = $self->{_sap} = SAPserver->new($pseed_url);
1705        }
1706    
1707        my $genome_names = $sap->genome_names(-ids => [map { &SeedUtils::genome_of($_) } @$pin]);
1708        my $my_genome = $self->genus_species;
1709        $my_genome = $self->genome_id if $my_genome eq '';
1710    
1711        $genome_names->{SeedUtils::genome_of($peg)} = $my_genome;
1712    
1713      my $locs = $sap->fid_locations(-ids => $pin, -boundaries => 1);      my $locs = $sap->fid_locations(-ids => $pin, -boundaries => 1);
1714    
# Line 1637  Line 1777 
1777          push @context, [ sort { $a->[2] <=> $b->[2] } @row ];          push @context, [ sort { $a->[2] <=> $b->[2] } @row ];
1778      }      }
1779    
1780      return \@context, $cref;      return \@context, $cref, $genome_names;
1781  }  }
1782    
1783    

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3