File Coverage

blib/lib/HTTP/ProxyCheck.pm

Criterion	Covered	Total	%
statement	19	240	7.9
branch	0	124	0.0
condition	0	12	0.0
subroutine	6	28	21.4
pod	14	14	100.0
total	39	418	9.3

#===============================================================================
# HTTP::ProxyCheck Version 1.4, Thu May 25 10:47:42 CEST 2006
#===============================================================================
# Copyright (c) 2004 - 2006 Thomas Weibel. All rights reserved.
#
# This library is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# More information: See "pod2text ProxyCheck.pm"
#===============================================================================

package HTTP::ProxyCheck;

use strict;
use vars qw($answer $error $VERSION);
use warnings;

use Validate::Net;
use IO::Socket;

BEGIN {
    $VERSION = 1.4;
    $answer  = '';
    $error   = '';

    # Autoflush = True
    $| = 1;
}

=head1 NAME

HTTP::ProxyCheck - a class to check the functionality of HTTP proxy servers.

=head1 SYNOPSIS

    use HTTP::ProxyCheck;

    my $proxy       = 'proxy:8080';
    my $url         = 'http://search.cpan.org/';
    my $proxy_check = new HTTP::ProxyCheck(
        proxy       => $proxy,
        url         => $url,
        answer_size => 'header',
        print_error => 0,
    )
    or die $HTTP::ProxyCheck::error;

    print "Trying to connect to '$proxy' and retrieve '$url'\n";

    if ( $proxy_check->check() ) {
        print "'$proxy' returns:\n\n", $proxy_check->get_answer(), "\n\n";
    }
    else {
        print "Error: ", $proxy_check->get_error(), "\n";
    }

=head1 DESCRIPTION

HTTP::ProxyCheck is a class to check HTTP proxy servers. It connects to given
HTTP proxy servers and tries to retrieve a provided URL through them.

=head1 CONSTRUCTOR

=head2 new( [attribute => $value, ...] )

C is the HTTP::ProxyCheck object constructor.

If an error happens while constructing the object, use
C<$HTTP::ProxyCheck::error> to get the error message.

All named attributes of C are optional.

B

=over 10

=item * proxy => $proxy

Specifies the address of the proxy server to check. This can also be done with
C.

The proxy server address has to match the patter 'host:port'. Host and port are
tested whether they are valid. If you want to disable this test, you can set
C<< check_proxy => 0 >>.

=item * check_proxy => 1|0

Set C<< check_proxy => 0 >> to disable the check whether the proxy server
address is valid.

The default value of C is C<1> which means, the proxy server
address gets tested.

This attribute can also be set with C.

=item * url => $url

Specifies the URL to use for the proxy server check. This can also be done
with C.

The URL has to be of a valid form, e.g. 'http://search.cpan.org'. It gets
tested whether it is valid. If you want to disable this test, you can set
C<< check_url => 0 >>.

=item * check_url => 1|0

Set C<< check_url => 0 >> to disable the check whether the URL is valid.

The default value of C is C<1> which means, the URL gets tested.

This attribute can also be set with C.

=item * answer_size => short|header|full

Defines the size of the proxy server answer.

C means that only the HTTP status code, e.g.

    HTTP/1.0 200 OK

is returned.

With C the full HTTP header gets returned, e.g.

    HTTP/1.0 200 OK
    Date: Tue, 12 Aug 2003 12:19:46 GMT
    Server: Apache/1.3.27 (Unix) mod_perl/1.27
    Cache-Control: max-age=3600
    Expires: Tue, 12 Aug 2003 13:19:46 GMT
    Last-Modified: Tue, 12 Aug 2003 12:19:46 GMT
    Content-Type: text/html
    X-Cache: MISS from search.cpan.org
    X-Cache: MISS from hactar.earth.net
    X-Cache-Lookup: HIT from hactar.earth.net:8080
    Proxy-Connection: close

Use C if you want the HTTP header including the whole data from the
proxy server.

The default value of C is C.

This attribute can also be set with C.

=item * user_agent => $user_agent

Specifies the name of the user agent sent to the proxy.

If you don't specify a user agent, "HTTP::ProxyCheck/1.4" is used.

=item * verbose_errors => 0|1

Set C<< verbose_errors => 1 >> to enable verbose error messages.

Verbose error messages look like this:

    $method failed: $error_message

And non-verbose error messages like this:

    $error_message

The default value of C is C<0>.

For more information see L.

=item * print_error => 1|0

Set C<< print_error => 0 >> to disable that error messages are displayed with
C.

The default value of C is C<1>.

For more information see L.

=item * raise_error => 0|1

Set C<< raise_error => 1 >> to enable that error messages are displayed with
C and the program is brought to an end.

The default value of C is C<0>.

For more information see L.

=back

B

=over 10

=item * Okay

Blessed reference

=item * Error

C

The error message can be retrieved with C<$HTTP::ProxyCheck::error>.

=back

=cut

sub new {
    my ( $class, %attr ) = @_;
    my $self = bless( {%attr}, $class );

    if ( $self->_init ) {
        return $self;
    }
    else {
        return $self->_throw( $self->{error} );
    }
}

=head1 METHODS

=head2 check( [attribute => $value, ...] )

C does the actual proxy server checking. It connects to a specified
proxy server and tries to get a defined URL through it.

All named attributes of C are optional, but C and C
must be either set as object or method attribute.

B

=over 10

=item * proxy => $proxy

Defines the proxy server to check.

C<< proxy => $proxy >> has higher precedence than the object attribute
C. It is only used by this method call. It doesn't get saved as object
attribute or changes the object attribute. If you want to do this use
C.

For more information see L.

=item * check_proxy => 1|0

Set C<< check_proxy => 0 >> to disable the check whether the proxy server
address is valid. If C<< check_proxy => 1 >> is set the proxy server
address gets tested.

This method attribute has higher precedence than the object attribute
C. It is only used by this method call. It doesn't get saved as
object attribute or changes the object attribute. If you want to do this use
C.

=item * url => $url

Defines the URL to use with the proxy server check.

C<< url => $url >> has higher precedence than the object attribute
C. It is only used by this method call. It doesn't get saved as object
attribute or changes the object attribute. If you want to do this use
C.

For more information see L.

=item * check_url => 1|0

Set C<< check_url => 0 >> to disable the check whether the URL is valid. If
C<< check_url => 1 >> is set the URL gets tested.

This method attribute has higher precedence than the object attribute
C. It is only used by this method call. It doesn't get saved as
object attribute or changes the object attribute. If you want to do this use
C.

=item * answer_size => short|header|full

Defines the size of the proxy server answer.

This method attribute has higher precedence than the object attribute
C. It is only used by this method call. It doesn't get saved as
object attribute or changes the object attribute. If you want to do this use
C.

For more information see L.

=back

B

=over 10

=item * Okay

C<1>

The answer of the proxy server can be retrieved with C or
C<$HTTP::ProxyCheck::answer>

=item * Error

C

The error message can be retrieved with C or
C<$HTTP::ProxyCheck::error>

=back

=cut

sub check {
    my ( $self, %attr ) = @_;
    my ( $check_proxy, $check_url, $proxy, $url, $answer_size, $user_agent );

    #---------------------------------------------------------------------------
    # Parse attributes and set defaults
    #---------------------------------------------------------------------------

    # Set the proxy check attribute
    if ( defined $attr{check_proxy} ) {
        $check_proxy = $self->_get_bool( $attr{check_proxy} );
    }
    else {
        $check_proxy = $self->{check_proxy};
    }

    # Set the URL check attribute
    if ( defined $attr{check_url} ) {
        $check_url = $self->_get_bool( $attr{check_url} );
    }
    else {
        $check_url = $self->{check_url};
    }

    # Set the proxy address
    if ( defined $attr{proxy} ) {
        $proxy = $attr{proxy};
        unless ( $self->_check_proxy( $proxy, $check_proxy ) ) {
            return $self->_throw( $self->{error} );
        }
    }
    elsif ( defined $self->{proxy} ) {
        $proxy = $self->{proxy};
    }
    else {
        return $self->_throw(
q#No proxy defined. Set it as attribute of your 'HTTP::ProxyCheck' object or the 'check()' method. You can also set it with 'set_proxy()'.#
        );
    }

    # Set the URL
    if ( defined $attr{url} ) {
        $url = $attr{url};
        unless ( $self->_check_url( $url, $check_url ) ) {
            return $self->_throw( $self->{error} );
        }
    }
    elsif ( defined $self->{url} ) {
        $url = $self->{url};
    }
    else {
        return $self->_throw(
q#No url defined. Set it as attribute of your 'HTTP::ProxyCheck' object or the 'check()' method. You can also set it with 'set_url()'.#
        );
    }

    # Set the answer size
    if ( defined $attr{answer_size} ) {
        $answer_size = $attr{answer_size};
        unless ( $self->_check_answer_size($answer_size) ) {
            return $self->_throw( $self->{error} );
        }
    }
    elsif ( defined $self->{answer_size} ) {
        $answer_size = $self->{answer_size};
    }
    else {
        return $self->_throw(
q#No answer_size defined. Set it as attribute of your 'HTTP::ProxyCheck' object or the 'check()' method. You can also set it with 'set_answer_size()'.#
        );
    }

    # Set the user agent
    if ( defined $attr{user_agent} ) {
        $user_agent = $attr{user_agent};
    }
    elsif ( defined $self->{user_agent} ) {
        $user_agent = $self->{user_agent};
    }
    else {
        $user_agent = "HTTP::ProxyCheck/" . $VERSION;
    }

    #---------------------------------------------------------------------------
    # Proxy check
    #---------------------------------------------------------------------------

    my ( $i, @answer, $answer, @header, $request, $line, $EOL );

    $EOL = "\015\012";

    # Fix to unset the error message of a previous IO::Socket::INET run
    # Thanks to Ben Schnopp
    undef $@;

    # Open socket to proxy server
    my $socket = IO::Socket::INET->new(
        PeerAddr => $proxy,
        Proto    => 'tcp',
        Timeout  => 5,
        Type     => SOCK_STREAM
    );

    # If there was an error, throw an exception
    if ($@) {
        return $self->_throw("Couldn't connect to '$proxy'. $@");
    }

    # Set request
    $request = <<"REQUEST";
GET $url HTTP/1.0
Referer: None
User-Agent: $user_agent
Pragma: no-cache

REQUEST

    $request =~ s/\n/\015\012/g;

    # Print request to the open socket
    print $socket $request;

    # Read the answer of the proxy server to an array
    while ( defined( $line = <$socket> ) ) {
        $line =~ s/\n//g;
        push @answer, $line;
    }

    $answer = join "\n", @answer;

    # Throw an exception if the answer is empty
    unless ( defined $answer && $answer !~ /^\s*$/ ) {
        return $self->_throw("'$proxy' didn't return anything. Maybe '$proxy' is not the address of a proxy server.");
    }

    # Parse the answer according to the requested answer size
    if ( $answer_size eq 'short' ) {
        $answer = $answer[0];
    }
    elsif ( $answer_size eq 'header' ) {
        foreach (@answer) {
            if ( !/^\s*
                push @header, $_;
            }
            else {
                last;
            }
        }
        $answer = join "\n", @header;
    }

    # Throw an exception if the parsed answer is empty
    unless ( defined $answer && $answer !~ /^\s*$/ ) {
        return $self->_throw(qq#'$proxy' didn't return a header. Try setting 'answer_size => "full"' as attribute of your 'HTTP::ProxyCheck' object or the 'check()' method. You can also use 'set_answer_size( "full" )'.#);
    }

    close($socket);

    $self->_set_answer($answer);

    return 1;
}

=head2 get_answer( )

C gets the most recent proxy server answer.

The proxy server answer is in the form specified by the C
attribute of the HTTP::ProxyCheck object or the C method.

For more information see L.

B

=over 10

=item * Okay

C<< $proxy_check->{answer} >>

This is the most recent proxy server answer.

=item * Error

C

The error message can be retrieved with C or
C<$HTTP::ProxyCheck::error>

=back

=cut

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

    unless ( defined $self->{answer} ) {
        return $self->_throw('No answer returned so far.');
    }

    return $self->{answer};
}

=head2 get_error( )

C gets the most recent error message.

For more information see L.

B

=over 10

=item * Okay

C<< $proxy_check->{error} >>

This is the most recent error message.

=back

=cut

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

    unless ( defined $self->{error} ) {
        return $self->_throw('No error happened so far.');
    }

    return $self->{error};
}

=head2 get_proxy( )

C gets the current value of the object attribute C.

B

=over 10

=item * Okay

C<< $proxy_check->{proxy} >>

This is the current proxy server address.

=item * Error

C

The error message can be retrieved with C or
C<$HTTP::ProxyCheck::error>

=back

=cut

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

    unless ( defined $self->{proxy} ) {
        $self->_throw(
q#No proxy defined. Set it as attribute of your 'HTTP::ProxyCheck' object or with 'set_proxy()'.#
        );
    }

    return $self->{proxy};
}

=head2 set_proxy( $proxy )

C sets the value of the object attribute C.

B

=over 10

=item * $proxy

The proxy server address has to match the patter 'host:port'. Host and port are
tested whether they are valid. If you want to disable this test, you can set
the object attribute C<< check_proxy => 0 >> or use C.

=back

B

=over 10

=item * Okay

C<1>

=item * Error

C

The error message can be retrieved with C or
C<$HTTP::ProxyCheck::error>

=back

=cut

sub set_proxy {
    my ( $self, $proxy ) = @_;

    unless ( defined $proxy ) {
        return $self->_throw('No proxy server defined.');
    }

    # Check the proxy server address
    unless ( $self->_check_proxy( $proxy, $self->{check_proxy} ) ) {
        return $self->_throw( $self->{error} );
    }

    $self->{proxy} = $proxy;

    return 1;
}

=head2 get_check_proxy( )

C gets the current value of the object attribute C.

B

=over 10

=item * Okay

C<< $proxy_check->{check_proxy} >>

This is the current value of the C attribute.

=back

=cut

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

    return $self->{check_proxy};
}

=head2 set_check_proxy( $check )

C sets the object attribute C.

B

=over 10

=item * $check

Use C<0> to disable the check whether the proxy server address is valid and C<1>
to enable it.

=back

B

=over 10

=item * Okay

C<1>

=item * Error

C

The error message can be retrieved with C or
C<$HTTP::ProxyCheck::error>

=back

=cut

sub set_check_proxy {
    my ( $self, $check_proxy ) = @_;

    unless ( defined $check_proxy ) {
        return $self->_throw(q#No 'check_proxy' value defined.#);
    }

    # Get boolean value for $check_proxy
    $check_proxy = $self->_get_bool( $check_proxy );

    $self->{check_proxy} = $check_proxy;

    return 1;
}

=head2 get_url( )

C gets the current value of the object attribute C.

B

=over 10

=item * Okay

C<< $proxy_check->{url} >>

This is the current URL.

=item * Error

C

The error message can be retrieved with C or
C<$HTTP::ProxyCheck::error>

=back

=cut

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

    unless ( defined $self->{url} ) {
        $self->_throw(
q#No url defined. Set it as attribute of your 'HTTP::ProxyCheck' object or with 'set_url()'.#
        );
    }

    return $self->{url};
}

=head2 set_url( $url )

C sets the object attribute C.

B

=over 10

=item * $url

The URL has to be of a valid form, e.g. 'http://search.cpan.org'. It gets
tested whether it is valid. If you want to disable this test, you can set
the object attribute C<< check_url => 0 >> or use C.

=back

B

=over 10

=item * Okay

C<1>

=item * Error

C

The error message can be retrieved with C or
C<$HTTP::ProxyCheck::error>

=back

=cut

sub set_url {
    my ( $self, $url ) = @_;

    unless ( defined $url ) {
        return $self->_throw('No URL defined.');
    }

    # Check the URL
    unless ( $self->_check_url( $url, $self->{check_url} ) ) {
        return $self->_throw( $self->{error} );
    }

    $self->{url} = $url;

    return 1;
}

=head2 get_check_url( )

C gets the current value of the object attribute C.

B

=over 10

=item * Okay

C<< $proxy_check->{check_url} >>

This is the current value of the C attribute.

=back

=cut

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

    return $self->{check_url};
}

=head2 set_check_url( $check )

C sets the object attribute C.

B

=over 10

=item * $check

Use C<0> to disable the check whether the URL is valid and C<1> to enable it.

=back

B

=over 10

=item * Okay

C<1>

=item * Error

C

The error message can be retrieved with C or
C<$HTTP::ProxyCheck::error>

=back

=cut

sub set_check_url {
    my ( $self, $check_url ) = @_;

    unless ( defined $check_url ) {
        return $self->_throw(q#No 'check_url' value defined.#);
    }

    # Get boolean value for $check_url
    $check_url = $self->_get_bool( $check_url );

    $self->{check_url} = $check_url;

    return 1;
}

=head2 get_answer_size( )

C gets the current value of the object attribute C.

B

=over 10

=item * Okay

C<< $proxy_check->{answer_size} >>

This is the current answer size.

=item * Error

C

The error message can be retrieved with C or
C<$HTTP::ProxyCheck::error>

=back

=cut

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

    unless ( defined $self->{answer_size} ) {
        $self->_throw(
q#No answer size defined. Set it as attribute of your 'HTTP::ProxyCheck' object or with 'set_answer_size()'.#
        );
    }

    return $self->{answer_size};
}

=head2 set_answer_size( $answer_size )

C sets the object attribute C.

B

=over 10

=item * $answer_size

Defines the size of the proxy server answer. Use either C, C or
C as value.

For more information see L.

=back

B

=over 10

=item * Okay

C<1>

=item * Error

C

The error message can be retrieved with C or
C<$HTTP::ProxyCheck::error>

=back

=cut

sub set_answer_size {
    my ( $self, $answer_size ) = @_;

    unless ( defined $answer_size ) {
        return $self->_throw('No answer size defined.');
    }

    # Check the answer size
    unless ( $self->_check_answer_size($answer_size) ) {
        return $self->_throw( $self->{error} );
    }

    $self->{answer_size} = $answer_size;

    return 1;
}

#-------------------------------------------------------------------------------
# Private method: _check_proxy()
#-------------------------------------------------------------------------------
# Checks whether a provided proxy server address complies with the pattern
# 'host:port'.
#
# Attributes
#   * $proxy
#     Defines the proxy server address to check.
#   * $check_proxy
#     Indicates whether to check the proxy server address or not. Possible
#     values are
#     '1' or '0'.
#
# Return values
#   * Okay
#     1
#   * Error
#     undef
#-------------------------------------------------------------------------------

sub _check_proxy {
    my ( $self, $proxy, $check_proxy ) = @_;

    unless ( defined $proxy ) {
        return undef;
    }

    if ($check_proxy) {

        # Check proxy server address format
        unless ( $proxy =~ /^(\S*):(\d{1,5})$/ ) {
            $self->{error} =
"The specified proxy server '$proxy' doesn't comply with the pattern 'host:port' e.g. 'proxy:8080'.";
            return undef;
        }

        my $proxyhost = $1;
        my $proxyport = $2;

        # Check proxy server host and port
        unless ( Validate::Net->host($proxyhost)
            && Validate::Net->port($proxyport) )
        {
            $self->{error} =
              "The specified proxy server address '$proxy' is invalid. "
              . Validate::Net->reason() . ".";
            return undef;
        }
    }

    return 1;
}

#-------------------------------------------------------------------------------
# Private method: _check_url()
#-------------------------------------------------------------------------------
# Checks whether a provided URL is a valid URL for HTTP::ProxyCheck e.g.
# 'http://search.cpan.org'.
#
# Attributes
#   * $url
#     Defines the URL to check.
#   * $check_url
#     Indicates whether to check the URL or not. Possible values are '1' or '0'.
#
# Return values
#   * Okay
#     1
#   * Error
#     undef
#-------------------------------------------------------------------------------

sub _check_url {
    my ( $self, $url, $check_url ) = @_;

    unless ( defined $url ) {
        return undef;
    }

    if ($check_url) {

        # Check URL format
        unless ( $url =~ m#^http://([^:/]+)(?::(\d+))?(?:/.*)?# ) {
            $self->{error} =
"The specified URL '$url' doesn't comply with the pattern of a valid URL for HTTP::ProxyCheck e.g. 'http://search.cpan.org'";
            return undef;
        }
        my $host = $1;
        my $port = $2;

        my $invalid_url = "The specified URL '$url' is not valid. ";

        # Check host and port
        unless ( Validate::Net->host($host) ) {
            $self->{error} = $invalid_url . Validate::Net->reason() . ".";
            return undef;
        }

        if ( defined $port ) {
            unless ( Validate::Net->port($port) ) {
                $self->{error} = $invalid_url . Validate::Net->reason() . ".";
                return undef;
            }
        }
    }

    return 1;
}

#-------------------------------------------------------------------------------
# Private method: _check_answer_size()
#-------------------------------------------------------------------------------
# Checks whethera provided answer size is valid.
#
# Attributes
#   * $answer_size
#     Specifies the answer size. Possible values are 'short', 'header' or
#     'full'.
#
# Return values
#   * Okay
#     1
#   * Error
#     undef
#-------------------------------------------------------------------------------

sub _check_answer_size {
    my ( $self, $answer_size ) = @_;

    unless ( defined $answer_size ) {
        return undef;
    }

    # The answer size must be either 'short', 'header' or 'full'
    unless ( $answer_size =~ m/^short|header|full$/ ) {
        $self->{error} =
"The specified answer size '$answer_size' is invalid, use either 'header' or 'full'.";
        return undef;
    }

    return 1;
}

#-------------------------------------------------------------------------------
# Private method: _throw()
#-------------------------------------------------------------------------------
# Throws an exeption with a message and optional with a specified return code.
# If no return code is specified, 'undef' is returned.
#
# Attributes
#   * $message
#     Defines the error message.
#   * $return_code
#     Specifies an optional return code for scalar context (default is 'undef').
#     In list context, '()' (empty list) is used.
#
# Return values
#   * Okay
#       * Array context
#         () (empty list)
#       * Scalar context
#         $return_code
#-------------------------------------------------------------------------------

sub _throw {
    my ( $self, $message, $return_code ) = @_;

    unless ( defined $return_code ) {
        $return_code = undef;
    }

    # Get the method name
    my $method = ( caller 1 )[3];

    # If the verbose errors attribut is set, add 'method_name failed:' to the
    # error message
    if ( $self->{verbose_errors} ) {
        $message = "$method failed: " . $message;
    }

    $self->_set_error($message);

    # Throw the exception
    Carp::croak $self->{error} if $self->{raise_error};
    Carp::carp $self->{error}  if $self->{print_error};

    # Return the return code in the right context
    if (wantarray) {
        return ();
    }
    else {
        return $return_code;
    }
}

#-------------------------------------------------------------------------------
# Private method: _set_error()
#-------------------------------------------------------------------------------
# Sets $self->{error} and $error and returns the previous error message.
#
# Attributes
#   * $my_error
#     Defines the error message.
#
# Return values
#   * Okay
#     $prev_error
#   * Error
#     undef
#-------------------------------------------------------------------------------

sub _set_error {
    my ( $self, $my_error ) = @_;
    my $prev_error = $self->{error};

    unless ( defined $my_error ) {
        return undef;
    }

    $self->{error} = $my_error;
    $error = $my_error;

    return $prev_error;
}

#-------------------------------------------------------------------------------
# Private method: _set_answer()
#-------------------------------------------------------------------------------
# Sets $self->{answer} and $answer and returns the previous answer.
#
# Attributes
#   * $my_answer
#     Defines the proxy server answer.
#
# Return values
#   * Okay
#     $prev_answer
#   * Error
#     undef
#-------------------------------------------------------------------------------

sub _set_answer {
    my ( $self, $my_answer ) = @_;
    my $prev_answer = $self->{answer};

    unless ( defined $my_answer ) {
        return undef;
    }

    $self->{answer} = $my_answer;
    $answer = $my_answer;

    return $prev_answer;
}

#-------------------------------------------------------------------------------
# Private method: _get_bool()
#-------------------------------------------------------------------------------
# Translates values to boolean value. '0' remains '0', 'undef' is translated to
# the default value and every other value is gets '1'.
#
# Attributes
#   * $value
#     Specifies the value to translate.
#   * $default
#     Defines the default value for undefined values.
#
# Return values
#   * True
#     1
#   * False
#     0
#-------------------------------------------------------------------------------

sub _get_bool {
    my ( $self, $value, $default ) = @_;

    # Check and set $default
    if ( defined $default ) {
        unless ( $default eq 0 ) {
            $default = 1;
        }
    }
    else {
        $default = 1;
    }

    # Check and set $value
    if ( defined $value ) {
        unless ( $value eq 0 ) {
            $value = 1;
        }
    }
    else {
        $value = $default;
    }

    return $value;
}

#-------------------------------------------------------------------------------
# Private method: _init()
#-------------------------------------------------------------------------------
# Initializes the default values of the attributes of new().
#
# Return values
#   * Okay
#     1
#   * Error
#     undef
#-------------------------------------------------------------------------------

sub _init {
    my ($self) = @_;
    my $verbose_errors = $self->{verbose_errors};
    my $print_error    = $self->{print_error};
    my $raise_error    = $self->{raise_error};
    my $check_proxy    = $self->{check_proxy};
    my $check_url      = $self->{check_url};
    my $proxy          = $self->{proxy};
    my $url            = $self->{url};
    my $answer_size    = $self->{answer_size};

    # Set the verbose errors attribute
    $self->{verbose_errors} = $self->_get_bool( $verbose_errors, 0 );

    # Set the print error attribute
    $self->{print_error} = $self->_get_bool( $print_error, 1 );

    # Set the raise error attribute
    $self->{raise_error} = $self->_get_bool( $raise_error, 0 );

    # Set the check proxy attribute
    $self->{check_proxy} = $self->_get_bool( $check_proxy, 1 );

    # Set the check URL attribute
    $self->{check_url} = $self->_get_bool( $check_url, 1 );

    # Check the proxy server address
    if ( defined $proxy ) {
        unless ( $self->_check_proxy( $proxy, $self->{check_proxy} ) ) {
            return undef;
        }
        $self->{proxy} = $proxy;
    }

    # Check the URL
    if ( defined $url ) {
        unless ( $self->_check_url( $url, $self->{check_url} ) ) {
            return undef;
        }
        $self->{url} = $url;
    }

    # Check the answer size
    if ( defined $answer_size ) {
        unless ( $self->_check_answer_size($answer_size) ) {
            return undef;
        }
    }
    else {
        $answer_size = 'header';
    }
    $self->{answer_size} = $answer_size;

    return 1;
}

1;

__END__