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

Diff of /FigKernelPackages/FIGV.pm

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

revision 1.9, Wed Nov 29 20:59:44 2006 UTC revision 1.10, Wed Nov 29 21:52:27 2006 UTC
# Line 284  Line 284 
284      }      }
285  }  }
286    
287    sub contig_ln {
288        my ($self, $genome, $contig) = @_;
289    
290        my $fig     = $self->{_fig};
291        my $newG    = $self->{_genome};
292        my $newGdir = $self->{_orgdir};
293    
294        if ($genome ne $newG)
295        {
296            return $fig->contig_ln($genome, $contig);
297        }
298        else
299        {
300            if (open(CONTIGS,"<$newGdir/contigs"))
301            {
302                local $/ = "\n>";
303                while (defined(my $x = <CONTIGS>))
304                {
305                    if ($x =~ />?(\S+)[^\n]*\n(.*)/s)
306                    {
307                        my $id = $1;
308                        my $seq = $2;
309                        $seq =~ s/\s//gs;
310                        if ($id eq $contig)
311                        {
312                            return length($seq);
313                        }
314                    }
315                }
316                close(CONTIGS);
317            }
318        }
319    }
320    
321    sub contigs_of
322    {
323        my ($self, $genome) = @_;
324    
325        my $fig     = $self->{_fig};
326        my $newG    = $self->{_genome};
327        my $newGdir = $self->{_orgdir};
328    
329        if ($genome ne $newG)
330        {
331            return $fig->contigs_of($genome);
332        }
333        else
334        {
335            my @out;
336            if (open(CONTIGS,"<$newGdir/contigs"))
337            {
338                local $/ = "\n>";
339                while (defined(my $x = <CONTIGS>))
340                {
341                    if ($x =~ />?(\S+)[^\n]*\n(.*)/s)
342                    {
343                        my $id = $1;
344                        push(@out, $id);
345                    }
346                }
347                close(CONTIGS);
348            }
349            return @out;
350        }
351    }
352    
353    =head3 dna_seq
354    
355    usage: $seq = dna_seq($genome,@locations)
356    
357    Returns the concatenated subsequences described by the list of locations.  Each location
358    must be of the form
359    
360        Contig_Beg_End
361    
362    where Contig must be the ID of a contig for genome $genome.  If Beg > End the location
363    describes a stretch of the complementary strand.
364    
365    =cut
366    #: Return Type $;
367    sub dna_seq {
368        my($self,$genome,@locations) = @_;
369    
370        my $fig     = $self->{_fig};
371        my $newG    = $self->{_genome};
372        my $newGdir = $self->{_orgdir};
373    
374        if ($genome ne $newG)
375        {
376            return $fig->dna_seq($genome, @locations);
377        }
378    
379        my %contigs;
380        if (open(CONTIGS,"<$newGdir/contigs"))
381        {
382            local $/ = "\n>";
383            while (defined(my $x = <CONTIGS>))
384            {
385                if ($x =~ />?(\S+)[^\n]*\n(.*)/s)
386                {
387                    my $id = $1;
388                    my $seq = $2;
389                    $seq =~ s/\s//gs;
390                    $contigs{$id} = $seq;
391                }
392                close(CONTIGS);
393            }
394        }
395    
396        my(@pieces,$loc,$contig,$beg,$end,$ln,$rdbH);
397    
398        @locations = map { split(/,/,$_) } @locations;
399        @pieces = ();
400        foreach $loc (@locations)
401        {
402            if ($loc =~ /^(\S+)_(\d+)_(\d+)$/)
403            {
404                ($contig,$beg,$end) = ($1,$2,$3);
405                my $seq = $contigs{$contig};
406    
407                $ln = length($seq);
408    
409                if (! $ln) {
410                    print STDERR "$genome/$contig: could not get length\n";
411                    return "";
412                }
413    
414                if (&FIG::between(1,$beg,$ln) && &FIG::between(1,$end,$ln))
415                {
416                    if ($beg < $end)
417                    {
418                        push(@pieces, substr($seq, $beg, $end - $beg + 1));
419                    }
420                    else
421                    {
422                        push(@pieces, &FIG::reverse_comp(substr($seq, $end, $beg - $end + 1)));
423                    }
424                }
425            }
426        }
427        return lc(join("",@pieces));
428    }
429    
430  sub genome_szdna {  sub genome_szdna {
431      my ($self, $genome) = @_;      my ($self, $genome) = @_;
432    
# Line 737  Line 880 
880    
881  }  }
882    
883    sub pegs_of
884    {
885        my($self, $genome) = @_;
886    
887        my $fig     = $self->{_fig};
888        my $newG    = $self->{_genome};
889        my $newGdir = $self->{_orgdir};
890    
891        if ($genome ne $newG)
892        {
893            return $fig->pegs_of($genome);
894        }
895    
896        $self->load_tbl();
897        return grep { /\.peg\./ } keys %{$self->{_tbl}};
898    }
899    
900    
901    sub rnas_of
902    {
903        my($self, $genome) = @_;
904    
905        my $fig     = $self->{_fig};
906        my $newG    = $self->{_genome};
907        my $newGdir = $self->{_orgdir};
908    
909        if ($genome ne $newG)
910        {
911            return $fig->pegs_of($genome);
912        }
913    
914        $self->load_tbl();
915        return grep { /\.rna\./ } keys %{$self->{_tbl}};
916    }
917    
918  sub is_virtual_feature  sub is_virtual_feature
919  {  {
920      my($self, $peg) = @_;      my($self, $peg) = @_;
# Line 765  Line 943 
943      my $pseq     = {};      my $pseq     = {};
944      if (open(FASTA,"<$newGdir/Features/peg/fasta"))      if (open(FASTA,"<$newGdir/Features/peg/fasta"))
945      {      {
946          $/ = "\n>";          local $/ = "\n>";
947          my $x;          my $x;
948          while (defined($x = <FASTA>))          while (defined($x = <FASTA>))
949          {          {
950              if ($x =~ /^>?(\S+)[^\n]*\n(.*)/)              if ($x =~ />?(\S+)[^\n]*\n(.*)/s)
951              {              {
952                  my $peg = $1;                  my $peg = $1;
953                  my $seq = $2;                  my $seq = $2;
# Line 778  Line 956 
956              }              }
957          }          }
958          close(FASTA);          close(FASTA);
         $/ = "\n";  
959      }      }
960      $self->{_pseq} = $pseq;      $self->{_pseq} = $pseq;
961  }  }

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3