view release on metacpan or  search on metacpan

lib/Apache2/API/Request.pm  view on Meta::CPAN

sub server_software { return( shift->env( 'SERVER_SOFTWARE', @_ ) ); }

# Or maybe the environment variable SERVER_SOFTWARE, e.g. Apache/2.4.18
# sub server_version { return( version->parse( Apache2::ServerUtil::get_server_version ) ); }
sub server_version
{
    my $self = shift( @_ );
    $self->{_server_version} = $SERVER_VERSION if( !CORE::length( $self->{_server_version} ) && CORE::length( $SERVER_VERSION ) );
    $self->{_server_version} = shift( @_ ) if( @_ );
    return( $self->{_server_version} ) if( $self->{_server_version} );
    my $vers = '';
    if( $self->mod_perl )
    {
        # try-catch
        local $@;
        eval
        {
            my $desc = Apache2::ServerUtil::get_server_description();
            if( $desc =~ /\bApache\/([\d\.]+)/ )
            {
                $vers = $1;
            }
        };
        if( $@ )
        {
        }
    }
    
    # NOTE: to test our alternative approach
    if( !$vers && ( my $apxs = File::Which::which( 'apxs' ) ) )
    {
        $vers = qx( $apxs -q -v HTTPD_VERSION );
        chomp( $vers );
        $vers = '' unless( $vers =~ /^[\d\.]+$/ );
    }
    # Try apache2
    if( !$vers )
    {
        foreach my $bin ( qw( apache2 httpd ) )
        {
            if( ( my $apache2 = File::Which::which( $bin ) ) )
            {
                my $v_str = qx( $apache2 -v );
                if( ( split( /\r?\n/, $v_str ) )[0] =~ /\bApache\/([\d\.]+)/ )
                {
                    $vers = $1;
                    chomp( $vers );
                    last;
                }
            }
        }
    }
    if( $vers )
    {
        $self->{_server_version} = $SERVER_VERSION = version->parse( $vers );
        return( $self->{_server_version} );
    }
    return( '' );
}

# e.g. set_basic_credentials( $user, $password );
sub set_basic_credentials { return( shift->_try( 'request', 'set_basic_credentials', @_ ) ); }

# set_handlers( PerlCleanupHandler => [] );
# $ok = $r->set_handlers($hook_name => \&handler);
# $ok = $r->set_handlers($hook_name => ['Foo::Bar::handler', \&handler2]);
# $ok = $r->set_handlers($hook_name => []);
# $ok = $r->set_handlers($hook_name => undef);
# https://perl.apache.org/docs/2.0/api/Apache2/RequestUtil.html#C_set_handlers_
sub set_handlers { return( shift->_try( 'request', 'set_handlers', @_ ) ); }

sub slurp_filename { return( shift->_try( 'request', 'slurp_filename' ) ); }

# Returns a APR::Socket
# See Apache2::Connection manual page
sub socket { return( shift->_try( 'connection', 'client_socket', @_ ) ); }

sub status { return( shift->_try( 'request', 'status', @_ ) ); }

sub status_line { return( shift->_try( 'request', 'status_line', @_ ) ); }

# NOTE: str2datetime for compatibility
sub str2datetime { return( shift->datetime->str2datetime( @_ ) ); }

# NOTE: str2time for compatibility
sub str2time { return( shift->datetime->str2time( @_ ) ); }

sub subnet_of
{
    my $self = shift( @_ );
    my( $ip, $mask ) = @_;
    my $ipsub;
    # try-catch
    local $@;
    my $error;
    eval
    {
        if( $ip && $mask )
        {
            $ipsub = APR::IpSubnet->new( $self->pool, $ip, $mask );
        }
        elsif( $ip )
        {
            $ipsub = APR::IpSubnet->new( $self->pool, $ip );
        }
        else
        {
            $error = "No ip address or block was provided to evaluate current ip against";
        }
    };
    return( $self->error( $error ) ) if( defined( $error ) );
    if( $@ )
    {
        return( $self->error( "An error occurred while trying to create a APR::IpSubnet object with ip \"$ip\" and mask \"$mask\": $@" ) );
    }
    return( $ipsub->test( $self->remote_addr ) );
}

sub subprocess_env { return( shift->_try( 'request', 'subprocess_env' ) ); }

sub temp_dir { return( shift->_try( 'apr', 'temp_dir', @_ ) ); }