[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.134, Fri Aug 13 14:04:20 2004 UTC revision 1.135, Mon Aug 16 22:10:55 2004 UTC
# Line 2  Line 2 
2    
3  use strict;  use strict;
4    
5    use Fcntl qw/:flock/;  # import LOCK_* constants
6    
7  use POSIX;  use POSIX;
8    
9  use DBrtns;  use DBrtns;
# Line 42  Line 44 
44  }  }
45    
46    
 use Fcntl qw/:flock/;  # import LOCK_* constants  
   
47  use FIGAttributes;  use FIGAttributes;
48  use base 'FIGAttributes';  use base 'FIGAttributes';
49    
# Line 6643  Line 6643 
6643      return $arch;      return $arch;
6644  }  }
6645    
 package FIG::Job;  
   
 use FIGAttributes;  
 use base 'FIGAttributes';  
   
 sub new  
 {  
     my($class, $job_id, $job_dir) = @_;  
   
     my $self = {  
         id => $job_id,  
         dir => $job_dir,  
     };  
     return bless $self, $class;  
 }  
   
 sub status :scalar  
 {  
     my($self) = @_;  
   
     return &FIG::file_read("$self->{dir}/STATUS");  
 }  
   
 sub running :scalar  
 {  
     my($self) = @_;  
     my $rc;  
     warn "running test on $self->{id}\n";  
     if (kill(0, $self->{id}) > 0)  
     {  
         $rc = 1;  
     }  
     else  
     {  
         $rc = 0;  
     }  
     warn "running returns $rc\n";  
   
     return $rc;  
 }  
   
 sub info :scalar :list  
 {  
     my($self) = @_;  
     return &FIG::file_read("$self->{dir}/INFO");  
 }  
   
 sub output :scalar :list  
 {  
     my($self) = @_;  
     return &FIG::file_read("$self->{dir}/OUTPUT");  
 }  
6646    
6647  ############################### Interfaces to Other Systems ######################################  ############################### Interfaces to Other Systems ######################################
6648  # This section contains the functionality introduced by the interface with GenDB.  The initial  # This section contains the functionality introduced by the interface with GenDB.  The initial
# Line 6762  Line 6710 
6710    
6711  =head1 delete_feature(FeatureID)  =head1 delete_feature(FeatureID)
6712    
6713  usage: delete_feature($fid)  usage: $fig->delete_feature($fid)
6714    
6715  Invoking this routine deletes the feature designated by $fid.  Invoking this routine deletes the feature designated by $fid.
6716    
6717  =cut  =cut
6718    
6719  sub delete_feature {  sub delete_feature {
6720      my($system,$fid) = @_;      my($self,$fid) = @_;
6721    
6722      print STDERR "$fid has been deleted from the SEED\n";      open(TMP,">>$FIG_Config::global/deleted.features")
6723            || die "could not open $FIG_Config::global/deleted.features";
6724    
6725        flock(TMP,LOCK_EX) || confess "cannot lock deleted.features";
6726        print TMP "$fid\n";
6727        close(TMP);
6728        chmod 02777, "$FIG_Config::global/deleted.features";
6729        $self->{_deleted_fids} = undef;
6730  }  }
6731    
6732  =pod  =pod
6733    
6734  =head1 add_feature(Genome,Type,Location,Aliases,Translation)  =head1 add_feature(Genome,Type,Location,Aliases,Translation)
6735    
6736  usage: $fid = add_feature($genome,$type,$location,$aliases,$translation)  usage: $fid = $fig->add_feature($genome,$type,$location,$aliases,$translation)
6737    
6738  Invoking this routine adds the feature, returning the new (generated) $fid.  Invoking this routine adds the feature, returning the new (generated) $fid.
6739  $translation is optionally and only applies to PEGs.  $translation is optionally and only applies to PEGs.
# Line 6795  Line 6750 
6750  =cut  =cut
6751    
6752  sub add_feature {  sub add_feature {
6753      my($genome,$type,$location,$aliases,$translation) = @_;      my($self,$genome,$type,$location,$aliases,$translation) = @_;
6754    
6755        $aliases = $aliases ? $aliases : "";
6756        my $aliasesT = $aliases;
6757        $aliasesT =~ s/,/\t/g;
6758        my @aliases = split(/\t/,$aliasesT);
6759    
6760        open(TMP,">>$FIG_Config::organisms/$genome/Features/$type/tbl")
6761            || die "could not open $FIG_Config::organisms/$genome/Features/$type/tbl";
6762        flock(TMP,LOCK_EX) || confess "cannot lock $genome/Features/$type/tbl";
6763        my $fid = $self->next_fid($genome,$type);
6764    
6765        print TMP "$fid\t$location\taliasesT\n";
6766        close(TMP);
6767        chmod 0777, "$FIG_Config::organisms/$genome/Features/$type/tbl";
6768    
6769        if (($type eq "peg") and $translation)
6770        {
6771            open(TMP,">>$FIG_Config::organisms/$genome/Features/$type/fasta")
6772                || die "could not open $FIG_Config::organisms/$genome/Features/$type/fasta";
6773            flock(TMP,LOCK_EX) || confess "cannot lock $genome/Features/$type/fasta";
6774            print TMP ">$fid\n$translation\n";
6775            close(TMP);
6776            chmod 0777, "$FIG_Config::organisms/$genome/Features/$type/fasta";
6777        }
6778    
6779      print STDERR "adding feature: ",&Dumper($genome,$type,$aliases,$translation);      my $dbh = $self->db_handle();
6780        my @loc = split(/,/,$location);
6781        my($contig,$beg,$end);
6782        if (($loc[0] =~ /^(\S+)_(\d+)_\d+$/) && (($contig,$beg) = ($1,$2)) && ($location =~ /(\d+)$/))
6783        {
6784            $end = $1;
6785            if ($beg > $end)  { ($beg,$end) = ($end,$beg) }
6786            $fid =~ /(\d+)$/;
6787            my $fidN = $1;
6788            if ((length($location) < 5000) && (length($contig) < 96) && (length($fid) < 32) && ($fid =~ /(\d+)$/))
6789            {
6790                $dbh->SQL("INSERT INTO features (id,idN,type,genome,location,contig,minloc,maxloc,aliases)
6791                                  VALUES ('$fid',$fidN,'$type','$genome','$location','$contig',$beg,$end,'$aliases')");
6792    
6793                if (@aliases > 0)
6794                {
6795                    my $alias;
6796                    foreach $alias (@aliases)
6797                    {
6798                        if ($alias =~ /^(NP_|gi\||sp\|\tr\||kegg\||uni\|)/)
6799                        {
6800    
6801                            $dbh->SQL("INSERT INTO ext_alias (id,alias,genome)
6802                                       VALUES ('$fid','$alias','$genome')");
6803                        }
6804                    }
6805                }
6806                return $fid;
6807            }
6808        }
6809      return undef;      return undef;
6810  }  }
6811    
6812    sub next_fid {
6813        my($self,$genome,$type) = @_;
6814    
6815        my $dbh = $self->db_handle();
6816        my $res = $dbh->SQL("select max(idN) from features where (genome = '$genome' and type = '$type'");
6817        return undef unless $res;
6818    
6819        my $fidN = $res->[0]->[0] + 1;
6820        while ($self->is_deleted_fid("fig\|$genome\.$type\.$fidN"))
6821        {
6822            $fidN++;
6823        }
6824        return "fig\|$genome\.$type\.$fidN";
6825    }
6826    
6827    sub is_deleted_fid {
6828        my($self,$fid) = @_;
6829        my($x);
6830    
6831        if (! ($x = $self->{_deleted_fids}))
6832        {
6833            if (open(TMP,"<$FIG_Config::global/deleted.features"))
6834            {
6835                while ($_ = <TMP>)
6836                {
6837                    if ($_ =~ /^(fig\|\d+\.\d+\.[a-zA-Z]+\.\d+)/)
6838                    {
6839                        $self->{_deleted_fids}->{$1} = 1;
6840                    }
6841                }
6842                close(TMP);
6843            }
6844        }
6845    }
6846    
6847  =pod  =pod
6848    
6849  =head1 change_location_of_feature(FeatureID,Location,Translation)  =head1 change_location_of_feature(FeatureID,Location,Translation)
# Line 6821  Line 6864 
6864      return 1;      return 1;
6865  }  }
6866    
6867    ### Begin FIG::Job module
6868    
6869    package FIG::Job;
6870    
6871    use FIGAttributes;
6872    use base 'FIGAttributes';
6873    
6874    sub new
6875    {
6876        my($class, $job_id, $job_dir) = @_;
6877    
6878        my $self = {
6879            id => $job_id,
6880            dir => $job_dir,
6881        };
6882        return bless $self, $class;
6883    }
6884    
6885    sub status :scalar
6886    {
6887        my($self) = @_;
6888    
6889        return &FIG::file_read("$self->{dir}/STATUS");
6890    }
6891    
6892    sub running :scalar
6893    {
6894        my($self) = @_;
6895        my $rc;
6896        warn "running test on $self->{id}\n";
6897        if (kill(0, $self->{id}) > 0)
6898        {
6899            $rc = 1;
6900        }
6901        else
6902        {
6903            $rc = 0;
6904        }
6905        warn "running returns $rc\n";
6906    
6907        return $rc;
6908    }
6909    
6910    sub info :scalar :list
6911    {
6912        my($self) = @_;
6913        return &FIG::file_read("$self->{dir}/INFO");
6914    }
6915    
6916    sub output :scalar :list
6917    {
6918        my($self) = @_;
6919        return &FIG::file_read("$self->{dir}/OUTPUT");
6920    }
6921    
6922    ######### End FIG::Job ##
6923    
6924    package FIG;
6925  1;  1;
6926    
6927    

Legend:
Removed from v.1.134  
changed lines
  Added in v.1.135

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3