view release on metacpan or  search on metacpan

lib/Bio/CIPRES/Output.pm  view on Meta::CPAN

package Bio::CIPRES::Output;

use 5.012;
use strict;
use warnings;

use Carp;
use XML::LibXML;
use Scalar::Util qw/blessed weaken/;

use Bio::CIPRES::Error;

sub new {

    my ($class, %args) = @_;

    my $self = bless {}, $class;

    croak "Must define user agent" if (! defined $args{agent});
    croak "Agent must be an LWP::UserAgent object"
        if ( blessed($args{agent}) ne 'LWP::UserAgent' );
    $self->{agent} = $args{agent};
    weaken( $self->{agent} );

    croak "Must define initial status" if (! defined $args{dom});
    $self->_parse_dom( $args{dom} );

    return $self;


}

sub size  { return $_[0]->{length}       };
sub name  { return $_[0]->{filename}     };
sub group { return $_[0]->{group}        };
sub url   { return $_[0]->{url_download} };

sub download {

    my ($self, %args) = @_;

    # don't overwrite existing files unless told to
    if (
        defined $args{out}
        && ! $args{overwrite}
        && -e $args{out}
    ) {
        die "Output file exists and 'overwrite' not given";
    };
        
    my @a = $self->{url_download};
    push @a, ':content_file', $args{out}
        if (defined $args{out});

    my $res = $self->{agent}->get(@a)
        or croak "LWP internal error: $@";

    die Bio::CIPRES::Error->new( $res->content )
        if (! $res->is_success);
    die "Unspecified error on download"
        if ($res->header('X-Died')
        || $res->header('Client-Aborted'));

    if (defined $args{out}) {
        croak "Error saving file to disk: missing output"
            if (! -e $args{out});
        croak "Downloaded file wrong size"
            if (-s $args{out} != $self->size);
    }
    else {
        croak "Downloaded content wrong size"
            if (length($res->content) != $self->size);
    }

    return defined $args{out}
        ? 1
        : $res->content;

}

sub _parse_dom {

    my ($self, $dom) = @_;