Apache2-API

 view release on metacpan or  search on metacpan

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

    $DEBUG   = 0;
    $VERSION = 'v0.3.1';
};

use strict;
use warnings;

sub import
{
    my( $this, @arguments ) = @_ ;
    my $class = CORE::caller();
    # my $code = qq{package ${class}; use Apache2::Const -compile => qw( @arguments );};
    # print( "Evaluating -> $code\n" );
    # eval( $code );
    # print( "\$@ -> $@\n" );

    # local $Exporter::ExportLevel = 1;
    # Apache2::Const->import( '-compile' => @arguments );
    # my @argv = grep( !/^\:http/, @arguments );
    # Apache2::Const->compile( '-compile' => @argv );
    # Apache2::Const->compile( $class => qw( AUTH_REQUIRED ) );

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

    {
        $msg = { code => Apache2::Const::HTTP_INTERNAL_SERVER_ERROR };
        $msg->{message} = join( '', @_ ) if( @_ );
    }
    # We send the error to our error method
    $msg->{code} ||= Apache2::Const::HTTP_INTERNAL_SERVER_ERROR;
    $self->error( $msg ) if( $msg->{message} );
    CORE::delete( $msg->{skip_frames} );
    # So it gets logged or displayed on terminal
    my( $pack, $file, $line ) = caller;
    my $sub_str = ( caller(1) )[3];
    my $sub = CORE::index( $sub_str, '::' ) != -1 ? substr( $sub_str, rindex( $sub_str, '::' ) + 2 ) : $sub_str;
    # Now we tweak the hash to send it to the client
    $msg->{message} = CORE::delete( $msg->{public_message} ) || 'An unexpected server error has occurred';
    # Give it a chance to be localised
    $msg->{message} = $self->gettext( $msg->{message} );
    # For example, if the message is a Text::PO::Gettext::String object
    if( !$msg->{lang} && $self->_can( $msg->{message} => 'lang' ) )
    {
        $msg->{lang} = $msg->{message}->lang;
    }

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

        }
    }
    elsif( $self->response->is_error( $code ) )
    {
        $ref->{error} = {} if( !CORE::exists( $ref->{error} ) || ref( $ref->{error} ) ne 'HASH' );
        $ref->{error}->{code} = $code if( !CORE::length( $ref->{error}->{code} ) );
        CORE::delete( $ref->{code} ) if( CORE::length( $ref->{code} ) );
    }

    my $frameOffset = 0;
    my $sub = ( caller( $frameOffset + 1 ) )[3];
    $frameOffset++ if( substr( $sub, rindex( $sub, '::' ) + 2 ) eq 'reply' );
    my( $pack, $file, $line ) = caller( $frameOffset );
    $sub = ( caller( $frameOffset + 1 ) )[3];
    # Without an Access-Control-Allow-Origin field, this would trigger an erro ron the web browser
    # So we make sure it is there if not set already
    unless( $self->response->headers->get( 'Access-Control-Allow-Origin' ) )
    {
        $self->response->headers->set( 'Access-Control-Allow-Origin' => '*' );
    }
    # As an api, make sure there is no caching by default unless the field has already been set.
    unless( $self->response->headers->get( 'Cache-Control' ) )
    {
        $self->response->headers->set( 'Cache-Control' => 'private, no-cache, no-store, must-revalidate' );

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

# $ok = $s->set_handlers($hook_name => []);
# $ok = $s->set_handlers($hook_name => undef);
# https://perl.apache.org/docs/2.0/api/Apache2/ServerUtil.html#C_set_handlers_
sub set_handlers { return( shift->_try( 'server', 'set_handlers', @_ ) ); }

sub warn
{
    my $self = shift( @_ );
    my $txt = join( '', map( ref( $_ ) eq 'CODE' ? $_->() : $_, @_ ) );
    my( $pkg, $file, $line, @otherInfo ) = caller;
    my $sub = ( caller( 1 ) )[3];
    my $sub2 = substr( $sub, rindex( $sub, '::' ) + 2 );
    my $trace = $self->_get_stack_trace();
    my $frame = $trace->next_frame;
    my $frame2 = $trace->next_frame;
    my $r = $self->apache_request;
    $txt = sprintf( "$txt called from %s in package %s in file %s at line %d\n%s\n",  $frame2->subroutine, $frame->package, $frame->filename, $frame->line, $trace->as_string );
    return( $r->warn( $txt ) ) if( $r );
    return( CORE::warn( $txt ) );
}

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

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Content-Disposition>
# TODO: More work to be done here like create a disposition method to parse its content
sub content_disposition { return( shift->_set_get_one( 'Content-Disposition', @_ ) ); }

# sub content_encoding { return( shift->_request->content_encoding( @_ ) ); }
sub content_encoding
{
    my $self = shift( @_ );
    my( $pack, $file, $line ) = caller;
    my $sub = ( caller( 1 ) )[3];
    # try-catch
    local $@;
    my $rv = eval
    {
        return( $self->_request->content_encoding( @_ ) );
    };
    if( $@ )
    {
        return( $self->error( "An error occurred while trying to access Apache Request method \"content_encoding\": $@" ) );
    }

t/lib/Test/Apache2/Common.pm  view on Meta::CPAN

    return( $self->reply( Apache2::Const::HTTP_EXPECTATION_FAILED => "failed\nI was expecting \"$expect\", but got \"$what\"." ) );
}

sub message
{
    my $self = shift( @_ );
    return unless( $self->{debug} );
    my $class = ref( $self );
    my $r = $self->request || return( $self->error( "No Apache2::RequestRec object set!" ) );
    my $ref = [@_];
    my $sub = (caller(1))[3] // '';
    my $line = (caller())[2] // '';
    $sub = substr( $sub, rindex( $sub, ':' ) + 1 );
    $r->log_error( "${class} -> $sub [$line]: ", join( '', map( ( ref( $_ ) eq 'CODE' ) ? $_->() : ( $_ // '' ), @$ref ) ) );
    return( $self );
}

sub ok
{
    my $self = shift( @_ );
    my $cond = shift( @_ );
    return( $cond ? $self->success : $self->failure );