view release on metacpan or  search on metacpan

lib/AnyEvent/Net/Curl/Queued/Easy.pm  view on Meta::CPAN

## no critic (RequireArgUnpacking)

sub BUILDARGS {
    return ($_[0] eq ref $_[-1])
        ? $_[-1]
        : FOREIGNBUILDARGS(@_);
}


sub FOREIGNBUILDARGS {
    my $class = shift;
    if (@_ == 1 and q(HASH) eq ref $_[0]) {
        return shift;
    } elsif (@_ == 1) {
        return { initial_url => shift };
    } elsif (@_ % 2 == 0) {
        return { @_ };
    } else {
        confess 'Should be initialized as ' . $class . '->new(Hash|HashRef|URL)';
    }
}


sub unique {
    my ($self) = @_;

    # make URL-friendly Base64
    my $digest = $self->sha->clone->b64digest;
    $digest =~ tr{+/}{-_};

    # return the signature
    return $digest;
}


sub sign {
    my ($self, $str) = @_;

    # add entropy to the signature
    ## no critic (ProtectPrivateSubs)
    Encode::_utf8_off($str);
    return $self->sha->add($str);
}


sub init {
    my ($self) = @_;

    # buffers
    my $data = '';
    $self->set_data(\$data);
    my $header = '';
    $self->set_header(\$header);

    # fragment mangling
    my $url = $self->initial_url->clone;
    $url->fragment(undef);
    $self->setopt(
        Net::Curl::Easy::CURLOPT_URL,           $url->as_string,
        Net::Curl::Easy::CURLOPT_WRITEDATA,     \$data,
        Net::Curl::Easy::CURLOPT_WRITEHEADER,   \$header,
    );

    # common parameters
    if (defined($self->queue)) {
        $self->setopt(
            Net::Curl::Easy::CURLOPT_SHARE,     $self->queue->share,
            Net::Curl::Easy::CURLOPT_TIMEOUT,   $self->queue->timeout,
        );
        $self->setopt($self->queue->common_opts);
        $self->set_http_response($self->queue->http_response)
            if $self->queue->http_response;
    }

    # salt
    $self->sign(ref($self));
    # URL; GET parameters included
    $self->sign($url->as_string);

    # set default options
    $self->setopt($self->opts);

    # call the optional callback
    $self->on_init->(@_) if ref($self->on_init) eq 'CODE';

    return;
}


sub has_error {
    # very bad error
    return 0 + $_[0]->curl_result != Net::Curl::Easy::CURLE_OK;
}


## no critic (ProhibitUnusedPrivateSubroutines)
sub _finish {
    my ($self, $result) = @_;

    # populate results
    $self->set_curl_result($result);
    $self->set_final_url($self->getinfo(Net::Curl::Easy::CURLINFO_EFFECTIVE_URL));

    # optionally encapsulate with HTTP::Response
    if ($self->http_response and $self->final_url->scheme =~ m{^https?$}ix) {
        # libcurl concatenates headers of redirections!
        my $header = ${$self->header};
        $header =~ s/^.*(?:\015\012?|\012\015){2}(?!$)//sx;
        $self->set_response(
            HTTP::Response->parse(
                $header
                . ${$self->data}
            )
        );

        $self->response->headers->header(content_encoding => 'identity')
            if $self->_autodecoded;

        my $msg = $self->response->message // '';
        $msg =~ s/^\s+|\s+$//gsx;
        $self->response->message($msg);