view release on metacpan or  search on metacpan

mcprimers_gui.pl  view on Meta::CPAN

        #print STDERR "$cmd\n";
        
        my $pid = open3(\*WTRFH, \*RDRFH, \*RDRFH, $cmd);   
        close(WTRFH);
        
        $mw->update;
        
        my $m;      
        my $line  = <RDRFH>;
        
RESULTS:        
        while (defined $line) {
            
            chop($line);
            if ($^O =~ /^MSW/) { chop $line; }
            push @result, "$line\n";
            
            if ($line =~ /Sorry/   or 
                $line =~ /Error/   or 
                $line =~ /Problem/ or 
                $line =~ /not available/) { 
                        
                $m = $line;
                last RESULTS;
            }
            if ($line =~ /.*Solution # (\d*)/) {
                $m = "Done - $1 solution(s) found";
            }
            $line  = <RDRFH>;
        }
        close RDRFH;
        
        write_text(@result);
        $text_message->configure(-text=>$m);
        $mw->update;
        
    }
    else {
        $text_message->configure(-text=>$initial_text);
    }
}

###################################################################

sub load_vector_file {
        
    &clear_text();
    if ($vector_loaded == 1) {
    
        # can't figure out how to properly destroy old widgets
        # ->destroy isn't good enough
        $text_message->configure(-text=>"Sorry - can\'t reload vector file");
        return;
    }
    
    $text_message->configure(-text=>"Select vector file");
    $vector_loaded = 0;
    
    my $status;
    
    # popup get file name
    my $old_name = $vector_name;
    $vector_name = $filedialog->Show;
    if (defined $vector_name and $vector_name ne '') { 
    
        # details of the plasmid used as a vector
        use Bio::Data::Plasmid::CloningVector;  
        $status = 
           Bio::Data::Plasmid::CloningVector::cloning_vector_data
             ($vector_name, \@re, \%re_name, \@ecut_loc, \@vcut_loc);
    }
    else {
        $status = 0;
    }
    
    if ($status == 0) {
            
        my $m = '';
        if (defined $vector_name) { 
            $m = "Error: Can\'t load \'$vector_name\'";
        }
        else {
            $m = 'Load vector cancelled';
        }
        $text_message->configure(-text=>$m);
        
        $vector_name = $old_name;
    }
    else {
        foreach (@re) { 
            {
                my $f = 1;
                push @sites, \$f;
                push @site_cb, $vec_frame->Checkbutton
                ( -text     => $re_name{$_},
                  -variable => \$f,
                  -font => 'SmallItem')->pack(-side   =>'top',
                                              -anchor => 'nw',  
                                              -padx   => 5);
            }
        }       

        $vector_loaded = 1;

        $vector_name =~ /.*\/(.+)/;
        my $short_name = $1;

        $text_message->configure(-text=>"Vector file $short_name loaded");
        if ($vector_loaded and $seq_loaded) {
            $sub_button->configure(-bg=>'light green');     
        }
        $short_name =~ /(.+)\..+/;
        $vec_message->configure(-text  => "\n$1 cloning sites",); 
    }
}

###################################################################

sub load_seq_file {
        
    $text_message->configure(-text=>"Select FASTA file");
    my $status;
    my $line;
    my $seq_fh;
    @seq = ();
    &clear_text();  
    
    # popup get file name
    my $old_name = $seq_name;
    $seq_name = $filedialog->Show;
    if (defined $seq_name and $seq_name ne '') { 
    
        # read sequence file
        open $seq_fh, $seq_name;
        my $t = <$seq_fh>;
        while (defined $t) {
            push @seq, $t;
            $t = <$seq_fh>;
        }
        $status = 1;    
    }
    else {
        $status = 0;
    }
    
    if ($status == 0) {
        my $m = '';
        if (defined $seq_name) { 
            $m = "Error: Can\'t load \'$seq_name\'";
        }
        else {
            $m = 'Load sequence cancelled';
        }
        $text_message->configure(-text=>$m);

        $seq_name = $old_name;
    }
    else {
        write_text(@seq);       
        $seq_loaded = 1;

        $seq_name =~ /.*\/(.+)/;
        my $short_name = $1;

        $text_message->configure(-text=>"FASTA file $short_name loaded");
        $fname_message->configure(-text=>"FASTA: $short_name");
    }        

    if ($vector_loaded and $seq_loaded) {
        $sub_button->configure(-bg=>'light green');
    }   
}

####################################################################

sub clear_text {

    $seq_text->selectAll; 
    $seq_text->deleteSelected;
}

####################################################################

sub write_text {

    @text = @_;      

    &clear_text();