view release on metacpan or  search on metacpan

lib/XML/RSS/Tools.pm  view on Meta::CPAN

        return $self->_raise_error( "HTTP error: $r, " . $ua->status_message )
            unless $r == 200;
        return $ua->body;
    }

    if (   $self->{_http_client} eq 'lwp'
        || $self->{_http_client} eq 'useragent' )
    {
        require LWP::UserAgent;
        my $ua = LWP::UserAgent->new;
        $ua->agent( $user_agent . ' ' . $ua->agent . " ($^O)" );
        $ua->proxy( [ 'http', 'ftp' ], $self->{_proxy_server} )
            if $self->{_proxy_server};
        my $response = $ua->request( HTTP::Request->new( 'GET', $uri ) );
        return $self->_raise_error( 'HTTP error: ' . $response->status_line )
            if $response->is_error;
        return $response->content( );
    }

    if ( $self->{_http_client} eq 'ghttp' ) {
        require HTTP::GHTTP;
        my $ua = HTTP::GHTTP->new($uri);
        $ua->set_header( 'User-Agent',
            "$user_agent HTTP::GHTTP/$HTTP::GHTTP::VERSION ($^O)" );
        if ( $self->{_proxy_server} ) {
            $ua->set_proxy( $self->{_proxy_server} );
            $ua->set_proxy_authinfo( $self->{_proxy_user},
                $self->{_proxy_password} )
                if ( $self->{_proxy_user} && $self->{_proxy_password} );
        }
        $ua->process_request;
        my $xml = $ua->get_body;
        if ( $xml ) {
            my ( $status, $message ) = $ua->get_status;
            return $self->_raise_error("HTTP error: $status, $message")
                unless $status == 200;
            return $xml;
        }
        else {
            return $self->_raise_error(
                "HTTP error: Unable to connect to server: $uri");
        }
    }

    if ($self->{_http_client} eq 'curl' ) {
        require WWW::Curl::Easy;
        my ($curl, $response_body, $file_b, $response_head,
            $file_h, $response, $response_code);

        $curl = WWW::Curl::Easy->new;

        open $file_b, '>', \$response_body;
        open $file_h, '>', \$response_head;

        $curl->setopt( WWW::Curl::Easy->CURLOPT_USERAGENT,
            "$user_agent WWW::Curl::Easy/$WWW::Curl::Easy::VERSION ($^O)" );
        $curl->setopt( WWW::Curl::Easy->CURLOPT_HEADER, 0 );
        $curl->setopt( WWW::Curl::Easy->CURLOPT_NOPROGRESS, 1 );
        $curl->setopt( WWW::Curl::Easy->CURLOPT_URL, $uri );
        $curl->setopt( WWW::Curl::Easy->CURLOPT_WRITEDATA, $file_b );
        $curl->setopt( WWW::Curl::Easy->CURLOPT_WRITEHEADER, $file_h );

        $response = $curl->perform;

        close $file_b;
        close $file_h;

        if ($response == 0) {
            $response_code = $curl->getinfo(
                WWW::Curl::Easy->CURLINFO_HTTP_CODE );
            return $self->_raise_error( "HTTP error: $response_code" )
                unless $response_code == 200;
            return $response_body
        }
        else {
            return $self->_raise_error( "HTTP error : " .
                $curl->strerror( $response ) . " ($response)" );
        }

    }
}

#
#   Fix Entities
#   This subroutine is a mix of Matt Sergent's rss-mirror script
#   And chunks of the HTML::Entites module if you have Perl 5.8 or
#   later you don't need this code.
#
sub _clean_entities {
    my $xml = shift;

    my %entity = (
        trade   => '™',
        euro    => '€',
        quot    => q{"},
        apos    => q{'},
        AElig   => q{Æ},
        Aacute  => q{Á},
        Acirc   => q{Â},
        Agrave  => q{À},
        Aring   => q{Å},
        Atilde  => q{Ã},
        Auml    => q{Ä},
        Ccedil  => q{Ç},
        ETH     => q{Ð},
        Eacute  => q{É},
        Ecirc   => q{Ê},
        Egrave  => q{È},
        Euml    => q{Ë},
        Iacute  => q{Í},
        Icirc   => q{Î},
        Igrave  => q{Ì},
        Iuml    => q{Ï},
        Ntilde  => q{Ñ},
        Oacute  => q{Ó},
        Ocirc   => q{Ô},
        Ograve  => q{Ò},
        Oslash  => q{Ø},
        Otilde  => q{Õ},
        Ouml    => q{Ö},
        THORN   => q{Þ},