File Coverage

blib/lib/Bio/GFF3/Transform/FromFasta.pm

Criterion	Covered	Total	%
statement	53	53	100.0
branch	12	20	60.0
condition	7	13	53.8
subroutine	11	11	100.0
pod	1	1	100.0
total	84	98	85.7

package Bio::GFF3::Transform::FromFasta;
BEGIN {
  $Bio::GFF3::Transform::FromFasta::AUTHORITY = 'cpan:RBUELS';
}
{
  $Bio::GFF3::Transform::FromFasta::VERSION = '2.0';
}
# ABSTRACT: make gff3 for the sequences in a fasta file

use strict;
use warnings;
use Carp;
use Scalar::Util 'blessed';

use base 'Exporter';
our @EXPORT_OK = ( 'gff3_from_fasta' );

use Bio::GFF3::LowLevel 'gff3_format_feature';


sub gff3_from_fasta {
    my %args = @_;
    $args{out} or croak 'must provide "out" arg';

    $args{in} or croak 'must provide "in" arg';
    $args{in} = [ $args{in} ] unless ref $args{in} eq 'ARRAY';
    $args{type} or croak( 'must provide "type" arg');

    my $out_fh = _to_filehandle($args{out},'>');

    my @fhs =
        map _to_filehandle($_),
        @{ $args{in} };

    print $out_fh "##gff-version 3\n";
    for my $fh ( @fhs ) {
        _for_fasta( $fh, sub {
            my ( $ident, $desc, $seq ) = @_;

            print $out_fh gff3_format_feature({
                seq_id => $$ident,
                source => $args{source} || 'fasta',
                type   => $args{type},
                start  => 1,
                end    => length($$seq),
                strand => '+',
                attributes => {
                    Name => [ $$ident ],
                    ( $$desc ? (Note => [ $$desc ]) : () ),
                  },
              });
        });
    }

    if( $args{fasta_section} ) {
        seek( $_, 0, 0 ) for @fhs;
        print $out_fh "##FASTA\n";
        local $_;
        for my $fh (@fhs) {
            while( <$fh> ) {
                chomp;
                s/\s//g unless /^>/;
                print $out_fh $_,"\n";
            }
        }
    }
}

sub _for_fasta {
    my ( $fh, $cb ) = @_;

    local $/ = "\n>";
    while( my $seq = <$fh> ) {
        $seq =~ s/\s*>?\s*//;
        $seq =~ s/^(\S+) *(.*)//
            or croak 'error parsing fasta';
        my ( $ident, $desc ) = ( $1, $2 );
        $seq =~ s/\s//g;
        $cb->( \$ident, \$desc, \$seq );
    }

}

sub _to_filehandle {
    my ( $thing, $mode ) = @_;

    return $thing if
           $thing
        && ref $thing
        && (    ref $thing eq 'GLOB'
             || blessed $thing && $thing->can('print')
           );

    open( my $f, ($mode || '<'), $thing) or confess "$! opening $thing";
    return $f;
}

1;

__END__