view release on metacpan or  search on metacpan

lib/Bio/Graphics/Glyph/trace.pm  view on Meta::CPAN

use File::Temp qw( tempdir );
use Digest::MD5 qw( md5_hex );
use base 'Bio::Graphics::Glyph::generic';
our @ISA;

use constant VERTICAL_SPACING => 20;
my %complement = (
    g => 'c',
    a => 't',
    t => 'a',
    c => 'g',
    n => 'n',
    G => 'C',
    A => 'T',
    T => 'A',
    C => 'G',
    N => 'N'
);

sub new {
    my $self = shift->SUPER::new(@_);

    if ( $self->dna_fits ) {
        $self->{parsed_trace} = $self->get_parsed_trace();
    }
    return $self;
}

sub get_parsed_trace {
    my $self = shift;
    my ( $format, $trace_file ) = eval { $self->trace_data };
    unless ($trace_file) {
        warn $@ if $@;
        return;
    }

    if ($self->{'content_type'} eq "ABI"){
        require ABI;
        my $abi = ABI->new(-file=>$trace_file);
        my %scf;
        @{$scf{'bases'}}        = split //, $abi->get_sequence();
        @{$scf{'index'}}        = $abi->get_base_calls();
        @{$scf{'samples'}{'A'}} = $abi->get_trace('A');
        @{$scf{'samples'}{'C'}} = $abi->get_trace('C');
        @{$scf{'samples'}{'G'}} = $abi->get_trace('G');
        @{$scf{'samples'}{'T'}} = $abi->get_trace('T');

        my $scale_factor = $self->option('abi_scale') || 1;
        $self->{'max_trace'} = $scale_factor * $abi->get_max_trace();

        return \%scf;
    }
    else{
        my %scf;
        tie %scf, 'Bio::SCF', $trace_file;
        $self->{'max_trace'} = 1600;
        return \%scf;
    }
}

sub _guess_format {
    my $self = shift;
    my $path = shift;

    my $modded_path = $path;
    $self->{'gzipped'} = ($modded_path =~ s/\.gz\s*$// );
    if ($modded_path =~ /\.scf/){
        $self->{'content_type'} = 'Bio::SCF';
    }
    elsif ($modded_path =~ /\.ab1/){
        $self->{'content_type'} = 'ABI';
    }
    else{
        die "$path: Trace file not of recognized format\n"
    }

    return;
}

sub trace_path {
    my $self     = shift;
    my $feature  = $self->feature or die "no feature!";
    my $dirname  = $self->trace_dir;
    my $basename = $self->option('trace');

    # can't get it from callback, so try looking for an 'trace' attribute
    if ( !$basename ) {
        if ( $feature->can('attributes') ) {
            ($basename) = $feature->attributes('trace');
        }
        elsif ( $feature->can('has_tag') && $feature->has_tag('trace') ) {
            ($basename) = $feature->get_tag_values('trace');
        }
    }

    return unless $basename;
    return $basename if $basename =~ m!^\w+:/!;    # looks like a URL
    return $basename if $basename =~ m!^/!;        # looks like an abs path
    return "$dirname/$basename";
}

sub trace_data {
    my $self = shift;
    my $path = $self->trace_path;
    $self->_guess_format($path);

    if ( $path =~ m!^\w+:/! ) {                    # looks like a URL
        require LWP::UserAgent;
        my $ua       = LWP::UserAgent->new;
        my $response = $ua->get($path);
        if ( $response->is_success ) {

            # In the future, make extensible to ABI format
            my $data      = $response->content;
            my $signature = md5_hex($data);
            my $extension;
            if ($self->{'content_type'} eq 'ABI'){
                $extension = 'ab1';
            }
            else{
                $extension = 'scf';
            }
            if ($self->{'gzipped'}){
                $extension .= '.gz';
            }

            # untaint signature for use in open
            $signature =~ /^([0-9A-Fa-f]+)$/g or return;
            $signature = $1;

            my $dir_path = tempdir();
            my $file_name
                = sprintf( "%s/%s.%s", $dir_path, $signature, $extension );
            open( F, ">$file_name" )
                || die("Can't open file $file_name for writing: $!\n");
            binmode(F);
            print F $data;
            close F;
            
            if ($self->{'gzipped'}){
                $file_name = $self->gunzip_file( $file_name );
            }

            return ( $self->{'content_type'}, $file_name );
        }
        else {
            die $response->status_line;
        }

    }
    else {
        if ($self->{'gzipped'}){
            $path = $self->gunzip_file( $path );
        }
        return ( $self->{'content_type'}, $path );
    }
}

sub gunzip_file {
    my $self      = shift;
    my $file_name = shift;

    $file_name =~ /(.+)\.gz$/;
    my $new_file_name = $1;