view release on metacpan or  search on metacpan

lib/Bio/Translator.pm  view on Meta::CPAN

    # try to translate the start codon
    my @start_peptide;
    if ($start) {
        my $start_aa =
          $self->table->codon2start->[$rc]
          { substr( $$seq_ref, $codon_starts[0], 3 ) };
        if ($start_aa) {
            push @start_peptide, $start_aa;
            shift @codon_starts;
        }
    }

    # translate the rest of the peptide
    my $codon2aa = $self->table->codon2aa->[$rc];
    my $peptide = join '', @start_peptide,
      map { $_ || 'X' }
      @$codon2aa{ map { substr $$seq_ref, $_, 3 } @codon_starts };

    return \$peptide;
}

=head2 translate_codon

    my $residue = $translator->translate_codon( $codon );
    my $residue = $translator->translate_codon( $codon, \%params );

Translate a codon. Return 'X' or '-' if it isn't in the
codon table. Handles degenerate nucleotides, so if all
possible codons for an ambiguity map to the same residue,
return that residue.

Example:

    $residue = $translator->translate_codon('atg');
    $residue = $translator->translate_codon( 'tty', { strand => -1 } );
    $residue = $translator->translate_codon( 'cat', { start => 1 } );

=cut

sub translate_codon {
    my $self = shift;

    my ( $codon, @p ) = validate_pos(
        @_,
        { regex => qr/^${all_nucleotide_match}{3}$/ },
        { type  => Params::Validate::HASHREF, default => {} }

    );

    my %p = validate(
        @p,
        {
            strand => $VAL_STRAND,
            start  => { %$VAL_START, default => 0 }
        }
    );

    $codon = uc $codon;

    # Set up the translation table given the strand and whether this is
    # searching for stop codons. Set up the not_found string by whether this
    # is a start or not.
    my $rc = $p{strand} == 1 ? 0 : 1;
    my ( $table, $not_found );
    unless ( $p{start} ) {
        $table     = $self->table->codon2aa->[$rc];
        $not_found = 'X';
    }
    else {
        $table     = $self->table->codon2start->[$rc];
        $not_found = '-';
    }

    return $self->table->_unroll( $codon, $table, { start => $p{start} } )
      || $not_found;
}

1;

=head1 AUTHOR

Kevin Galinsky, C<kgalinsky plus cpan at gmail dot com>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-bio-translator at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Bio-Translator>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Bio::Translator

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Bio-Translator>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Bio-Translator>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Bio-Translator>

=item * Search CPAN

L<http://search.cpan.org/dist/Bio-Translator>

=back

=head1 ACKNOWLEDGEMENTS

JCVI/Paolo Amedeo

=head1 COPYRIGHT & LICENSE

Copyright 2008-2009 J. Craig Venter Institute, 2011 Kevin Galinsky.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut