rare-quickprot 1.10.0__py3-none-any.whl

quickprot/Fasta_reader.pm

@@ -0,0 +1,169 @@
+#!/usr/local/bin/perl -w
+
+# lightweight fasta reader capabilities:
+package Fasta_reader;
+
+use strict;
+
+sub new {
+    my ($packagename, $fastaFile) = @_;
+
+	## note: fastaFile can be a filename or an IO::Handle
+	
+
+    my $self = { fastaFile => undef,,
+				 fileHandle => undef };
+
+    bless ($self, $packagename);
+    
+    ## create filehandle
+    my $filehandle = undef;
+    
+	if (ref $fastaFile eq 'IO::Handle') {
+		$filehandle = $fastaFile;
+	}
+	else {
+		
+		open ($filehandle, $fastaFile) or die "Error: Couldn't open $fastaFile\n";
+		$self->{fastaFile} = $fastaFile;
+	}
+	
+	$self->{fileHandle} = $filehandle;
+
+    return ($self);
+}
+
+
+
+#### next() fetches next Sequence object.
+sub next {
+    my $self = shift;
+    my $orig_record_sep = $/;
+    $/="\n>";
+    my $filehandle = $self->{fileHandle};
+    my $next_text_input = <$filehandle>;
+    
+	if (defined($next_text_input) && $next_text_input !~ /\w/) {
+		## must have been some whitespace at start of fasta file, before first entry.
+		## try again:
+		$next_text_input = <$filehandle>;
+	}
+	
+	my $seqobj = undef;
+    
+	if ($next_text_input) {
+		$next_text_input =~ s/^>|>$//g; #remove trailing > char.
+		$next_text_input =~ tr/\t\n\000-\037\177-\377/\t\n/d; #remove cntrl chars
+		my ($header, @seqlines) = split (/\n/, $next_text_input);
+		my $sequence = join ("", @seqlines);
+		$sequence =~ s/\s//g;
+		
+		$seqobj = Sequence->new($header, $sequence);
+    }
+    
+    $/ = $orig_record_sep; #reset the record separator to original setting.
+    
+    return ($seqobj); #returns null if not instantiated.
+}
+
+
+#### finish() closes the open filehandle to the query database.
+sub finish {
+    my $self = shift;
+    my $filehandle = $self->{fileHandle};
+    close $filehandle;
+    $self->{fileHandle} = undef;
+}
+
+####
+sub retrieve_all_seqs_hash {
+	my $self = shift;
+
+	my %acc_to_seq;
+	
+	while (my $seq_obj = $self->next()) {
+		my $acc = $seq_obj->get_accession();
+		my $sequence = $seq_obj->get_sequence();
+
+		$acc_to_seq{$acc} = $sequence;
+	}
+
+	return(%acc_to_seq);
+}
+
+
+
+##############################################
+package Sequence;
+use strict;
+
+sub new {
+    my ($packagename, $header, $sequence) = @_;
+    
+    ## extract an accession from the header:
+    my ($acc, $rest) = split (/\s+/, $header, 2);
+        
+    my $self = { accession => $acc,
+		 header => $header,
+		 sequence => $sequence,
+		 filename => undef };
+    bless ($self, $packagename);
+    return ($self);
+}
+
+####
+sub get_accession {
+    my $self = shift;
+    return ($self->{accession});
+}
+
+####
+sub get_header {
+    my $self = shift;
+    return ($self->{header});
+}
+
+####
+sub get_sequence {
+    my $self = shift;
+    return ($self->{sequence});
+}
+
+#### 
+sub get_FASTA_format {
+    my $self = shift;
+    my $header = $self->get_header();
+    my $sequence = $self->get_sequence();
+    $sequence =~ s/(\S{60})/$1\n/g;
+    my $fasta_entry = ">$header\n$sequence\n";
+    return ($fasta_entry);
+}
+
+
+####
+sub write_fasta_file {
+    my $self = shift;
+    my $filename = shift;
+
+    my ($accession, $header, $sequence) = ($self->{accession}, $self->{header}, $self->{sequence});
+    
+	my $fasta_entry = $self->get_FASTA_format();
+	
+    my $tempfile;
+    if ($filename) {
+		$tempfile = $filename;
+    } else {
+		my $acc = $accession;
+		$acc =~ s/\W/_/g;
+		$tempfile = "$acc.fasta";
+    }
+    
+    open (TMP, ">$tempfile") or die "ERROR! Couldn't write a temporary file in current directory.\n";
+    print TMP $fasta_entry;
+    close TMP;
+    return ($tempfile);
+}
+
+1; #EOM
+
+

quickprot/GFF3_utils2.pm

@@ -0,0 +1,249 @@
+#!/usr/local/bin/perl
+
+package main;
+our $SEE;
+
+
+package GFF3_utils2; # removes DB_File requirement, no use of Gene_obj_indexer module.
+
+use strict;
+use warnings;
+use Gene_obj;
+use Carp;
+use URI::Escape;
+use Data::Dumper;
+
+
+####
+sub index_GFF3_gene_objs {
+    
+    my ($gff_filename, $gene_obj_indexer, $contig_id) = @_;
+    # contig_id is optional.
+    
+    unless (ref $gene_obj_indexer eq 'HASH') {
+        confess "Error, \$gene_obj_indexer must be a hashref";
+    }
+    
+    ## note can use either a gene_obj_indexer or a hash reference.
+    
+    my %gene_coords;
+    my %asmbl_id_to_gene_id_list;
+    my %transcript_to_gene;
+    my %cds_phases;
+    
+    my %gene_names;
+	my %loci;
+
+    open (my $fh, $gff_filename) or die $!;
+
+    my %gene_id_to_source_type;
+
+    my %source_tracker;
+    
+    my $counter = 0;
+    # print STDERR "\n-parsing file $gff_filename\n";
+    while (<$fh>) {
+
+		chomp;
+        
+        unless (/\w/) { next;} # empty line
+        
+        if (/^\#/) { next; } # comment entry in gff3
+
+        my @x = split (/\t/);
+
+		unless (scalar @x >= 9) {
+			print STDERR "-ignoring line $_\n";
+			next;
+		}
+		
+        my ($asmbl_id, $source, $feat_type, $lend, $rend, $orient, $cds_phase, $gene_info) = ($x[0], $x[1], $x[2], $x[3], $x[4], $x[6], $x[7], $x[8]);    
+        
+        if ($contig_id && $asmbl_id ne $contig_id) { next; }
+
+        unless ($feat_type) { die "Error, $_, no feat_type: line\[$_\]"; }
+        
+        unless ($feat_type =~ /^(gene|mRNA|CDS|exon)$/) { next;} ## these are the only fields I care about right now.
+
+        $gene_info = uri_unescape($gene_info);
+        
+        $gene_info =~ /ID=([^;\s]+);?/;
+        my $id = $1 or die "Error, couldn't get the id field $_";
+        
+        if (exists $source_tracker{$id} && $source_tracker{$id} ne $source) {
+            confess "Error, gene ID $id is given source $source when previously encountered with source $source_tracker{$id} ";
+        }
+        
+        if ($feat_type eq 'gene') {
+            my $gene_name = "";
+            if ($gene_info =~ /Name=\"?([^\;\"]+)\"?/) {
+                $gene_name = $1;
+			}
+			else {
+				$gene_name = "";
+			}
+            
+            if ($gene_info =~ /Note=\"?([^\;\"]+)\"?/) {
+                $gene_name .= " $1";
+            }
+                        			
+            $gene_names{$id} = $gene_name;
+			
+		}
+        
+		if ($gene_info =~ /Alias=([^;]+)/) {
+			my $locus = $1;
+			$loci{$id} = $locus;
+		}
+		
+	 
+        if ($feat_type eq 'gene') { next;} ## beyond this pt, gene is not needed.
+        
+        $gene_info =~ /Parent=([^;\s]+);?/;
+        my $parent = $1 or die "Error, couldn't get the parent info $_";
+                
+        # print "id: $id, parent: $parent\n";
+        
+        if ($feat_type eq 'mRNA') {
+            ## just get the identifier info
+            $transcript_to_gene{$id} = $parent;
+            next;
+        }
+        
+        my $transcript_id = $parent;
+        my $gene_id = $transcript_to_gene{$transcript_id};
+		unless (defined $gene_id) {
+			print STDERR "Error, no gene feature found for $transcript_id.... ignoring feature.\n";
+			next;
+		}
+
+			        
+        $gene_id_to_source_type{$gene_id} = $source;
+
+        my ($end5, $end3) = ($orient eq '+') ? ($lend, $rend) : ($rend, $lend);
+        
+        $gene_coords{$asmbl_id}->{$gene_id}->{$transcript_id}->{$feat_type}->{$end5} = $end3;
+        # print "$asmbl_id, $gene_id, $transcript_id, $feat_type, $end5, $end3\n";
+        
+        if ($cds_phase =~ /^\d+$/) {
+            $cds_phases{$gene_id}->{$transcript_id}->{$end5} = $cds_phase;
+        }
+        
+    }
+    close $fh;
+    
+    ## 
+    # print STDERR "\n-caching genes.\n";
+    foreach my $asmbl_id (sort keys %gene_coords) {
+        my $genes_href = $gene_coords{$asmbl_id};
+        
+		foreach my $gene_id (keys %$genes_href) {
+            #print STDERR "\r-indexing [$gene_id]  ";
+            my $transcripts_href = $genes_href->{$gene_id};
+            
+            my @gene_objs;
+            
+            foreach my $transcript_id (keys %$transcripts_href) {
+            
+                my $cds_coords_href = $transcripts_href->{$transcript_id}->{CDS} || {}; # could be a noncoding transcript w/ no CDS
+                my $exon_coords_href = $transcripts_href->{$transcript_id}->{exon};
+                
+                unless (ref $exon_coords_href) {
+                    print STDERR Dumper ($transcripts_href);
+                    die "Error, missing exon coords for $transcript_id, $gene_id\n";
+                }
+                
+                my $gene_obj = new Gene_obj();
+                
+                
+                if (scalar (keys %$cds_coords_href) == 1) {
+                    
+                    ## could be that only the cds span was provided. 
+                    ## break it up across the exon segments
+                    
+                    my ($cds_lend, $cds_rend) = sort {$a<=>$b} %$cds_coords_href;
+                    my @exon_coords;
+                    my $orient;
+                    foreach my $exon_end5 (keys %$exon_coords_href) {
+                        my $exon_end3 = $exon_coords_href->{$exon_end5};
+                        push (@exon_coords, [$exon_end5, $exon_end3]);
+                        if ($exon_end5 < $exon_end3) {
+                            $orient = '+';
+                        }
+                        elsif ($exon_end5 > $exon_end3) {
+                            $orient = '-';
+                        }
+                    }
+                    
+                    $gene_obj->build_gene_obj_exons_n_cds_range(\@exon_coords, $cds_lend, $cds_rend, $orient);
+                }
+                else {
+                    
+                    ## cds and exons specified separately
+                    
+                    $gene_obj->populate_gene_obj($cds_coords_href, $exon_coords_href);
+                }
+                
+                $gene_obj->{Model_feat_name} = $transcript_id;
+                $gene_obj->{TU_feat_name} = $gene_id;
+                $gene_obj->{asmbl_id} = $asmbl_id;
+        
+				if (my $gene_locus = $loci{$gene_id}) {
+					$gene_obj->{pub_locus} = $gene_locus;
+				}
+				if (my $transcript_locus = $loci{$transcript_id}) {
+					$gene_obj->{model_pub_locus} = $transcript_locus;
+				}
+				
+        
+                $gene_obj->{com_name} = $gene_names{$gene_id} || $transcript_id;
+        
+                $gene_obj->{source} = $gene_id_to_source_type{$gene_id};
+                
+                ## set CDS phase info if available from the gff
+                my $cds_phases_href = $cds_phases{$gene_id}->{$transcript_id};
+                if (ref $cds_phases_href) {
+                    ## set the cds phases
+                    my @exons = $gene_obj->get_exons();
+                    foreach my $exon (@exons) {
+                        if (my $cds = $exon->get_CDS_obj()) {
+                            my ($end5, $end3) = $cds->get_coords();
+                            my $phase = $cds_phases_href->{$end5};
+                            unless ($phase =~ /\d+/) {
+                                confess "Error, should have phase set for cds $gene_id $transcript_id $end5, but I do not. ";
+                            }
+                            $cds->set_phase($phase);
+                        }
+                    }
+                }
+                        
+                push (@gene_objs, $gene_obj);
+            }
+            
+            ## want single gene that includes all alt splice variants here
+            my $template_gene_obj = shift @gene_objs;
+            foreach my $other_gene_obj (@gene_objs) {
+                $template_gene_obj->add_isoform($other_gene_obj);
+            }
+            
+			$template_gene_obj->refine_gene_object();
+			
+
+            $gene_obj_indexer->{$gene_id} = $template_gene_obj;
+                        
+            print "GFF3_utils: stored $gene_id\n" if $SEE;
+            
+            # add to gene list for asmbl_id
+            my $gene_list_aref = $asmbl_id_to_gene_id_list{$asmbl_id};
+            unless (ref $gene_list_aref) {
+                $gene_list_aref = $asmbl_id_to_gene_id_list{$asmbl_id} = [];
+            }
+            push (@$gene_list_aref, $gene_id);
+        }
+    }
+    print STDERR "\n";
+    return (\%asmbl_id_to_gene_id_list);
+}
+
+
+1; #EOM