view release on metacpan or  search on metacpan

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

        # $r->content_encoding( 'bzip2' );
        $self->response->content_encoding( 'bzip2' );
        $self->response->headers->set( 'Content-Encoding' => 'bzip2' );
        $self->response->headers->merge( 'Vary' => 'Accept-Encoding' );
        # $r->send_http_header;
        $z->print( $json );
        $z->close;
    }
    elsif( CORE::length( $json ) > $threshold && 
        $self->request->accept_encoding =~ /\bdeflate\b/i && 
        $self->_load_class( 'IO::Compress::Deflate' ) &&
        ( $z = IO::Compress::Deflate->new( '-' ) ) )
    {
        ## $r->content_encoding( 'deflate' );
        $self->response->content_encoding( 'deflate' );
        $self->response->headers->set( 'Content-Encoding' => 'deflate' );
        $self->response->headers->merge( 'Vary' => 'Accept-Encoding' );
        # $r->send_http_header;
        $z->print( $json );
        $z->close;
    }
    else
    {
        $self->response->headers->unset( 'Content-Encoding' );
        # $self->response->content_encoding( undef() );
        # $r->send_http_header;
        # $r->print( $json );
        # $json = Encode::encode_utf8( $json ) if( utf8::is_utf8( $json ) );
        # try-catch
        local $@;
        eval
        {
            my $bytes = $r->print( $json );
        };
        if( $@ )
        {
        }
    }
    # $r->rflush;
    # Flush any buffered data to the client using Apache2::RequestIO
    $self->response->rflush;
    return( $self );
}

# push_handlers($hook_name => \&handler);
# push_handlers($hook_name => [\&handler, \&handler2]);
sub push_handlers { return( shift->_try( 'server', 'push_handlers', @_ ) ); }

# See also <https://developer.mozilla.org/en-US/docs/Web/HTTP/Reference/Status/406>
sub reply
{
    my $self = shift( @_ );
    my( $code, $ref );
    my $use_rfc_error = $self->{use_rfc_error} // $USE_RFC_ERROR;
    # rfc9457 standard for REST API error response: <https://www.rfc-editor.org/rfc/rfc9457.html>
    # Legacy JSON payload like Google, Twitter, Facebook
    # Modern REST APIs now uses rfc9457 with a flattened payload.
    # When the use_rfc_error object property is true, we use rfc9457 flattened error, this will produce something like:
    # {
    #     error  => 'not_found',
    #     status => 404,
    #     title  => 'Not found!',
    #     detail => q{The requested URL was not found on this server. If you entered the URL manually please check your spelling and try again.},
    #     locale => 'en-US',
    #     type   => 'https://api.example.com/problems/not-found',
    # }
    # otherwise, the legacy approach would be:
    # {
    #     error =>
    #     {
    #         code => 404,
    #         message => q{The requested URL was not found on this server. If you entered the URL manually please check your spelling and try again.},
    #     },
    #     locale => 'en-US',
    # }
    # $self->reply( Apache2::Const::HTTP_OK, { message => "All is well" } );
    if( scalar( @_ ) == 2 )
    {
        ( $code, $ref ) = @_;
    }
    elsif( scalar( @_ ) == 1 &&
        $self->_can( $_[0] => 'code' ) && 
        $self->_can( $_[0] => 'message' ) )
    {
        my $ex = shift( @_ );
        $code = $ex->code;
        $ref = 
        {
            message => $ex->message,
            ( $ex->can( 'public_message' ) ? ( public_message => $ex->public_message ) : () ),
            ( $ex->can( 'locale' ) ? ( locale => $ex->locale ) : () ),
        };
    }
    # $self->reply({ code => Apache2::Const::HTTP_OK, message => "All is well" } );
    elsif( ref( $_[0] ) eq 'HASH' )
    {
        $ref = shift( @_ );
        $code = $ref->{code} if( length( $ref->{code} ) );
    }
    my $r    = $self->apache_request;
    my $req  = $self->request;
    my $resp = $self->response;

    # Guardrails on inputs
    if( !defined( $code ) || $code !~ /^[0-9]{3}$/ )
    {
        $resp->code( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
        $resp->rflush;
        $resp->print( $self->json->utf8->encode({ error => 'An unexpected server error occured', code => 500 }) );
        $self->error( "http code to be used '", ( $code // 'undef' ), "' is invalid. It should be only integers." );
        return( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
    }
    if( ref( $ref ) ne 'HASH' )
    {
        $resp->code( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
        $resp->rflush;
        # $r->send_http_header;
        $resp->print( $self->json->utf8->encode({ error => 'An unexpected server error occured', code => 500 }) );
        $self->error( "Data provided to send is not a hash ref." );
        return( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
    }

    # Resolve whether this is an error
    my $is_error = $resp->is_error( $code ) ? 1 : 0;

    # NOTE: guess_preferred_locale() -> this is used to get he most appropriate locale if not defined already so we can, in turn, get the fallback description
    my $guess_preferred_locale = sub
    {
        my $locale = shift( @_ );
        if( !defined( $locale ) )
        {

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

    use Apache2::API
    # To import in your namespace
    # use Apache2::API qw( :common :http );

    # $r is an Apache2::RequestRec object that you can get from within an handler or 
    # with Apache2::RequestUtil->request
    my $api = Apache2::API->new( $r, compression_threshold => 204800 ) ||
        die( Apache2::API->error );
    # or:
    my $api = Apache2::API->new( apache_request => $r, compression_threshold => 204800 ) ||
        die( Apache2::API->error );

    # or even inside your mod_perl script/cgi:
    #!/usr/bin/perl
    use strict;
    use warnings;
    use Apache2::API;

    my $r = shift( @_ );
    my $api = Apache2::API->new( $r );
    # for example:
    return( $api->reply( Apache2::Const::HTTP_OK => { message => "Hello world" } ) );

    my $r = $api->apache_request;
    return( $api->bailout({
        message => "Oops",
        code => Apache2::Const::BAD_REQUEST,
        public_message => "An unexpected error occurred.",
    }) );
    # or
    return( $api->bailout( @some_reasons ) );

    # 100kb
    $api->compression_threshold(102400);
    my $decoded = $api->decode_base64( $b64_string );
    my $ref = $api->decode_json( $json_data );
    my $decoded = $api->decode_url;
    my $perl_utf8 = $api->decode_utf8( $data );
    my $b64_string = $api->encode_base64( $data );
    my $json_data = $api->encode_json( $ref );
    my $encoded = $api->encode_url( $uri );
    my $utf8 = $api->encode_utf8( $data );
    my $uuid = $api->generate_uuid;
    my $auth = $api->get_auth_bearer;
    my $handlers = $api->get_handlers;
    my $dt = $api->header_datetime( $http_datetime );
    my $bool = $api->is_perl_option_enabled;
    # JSON object
    my $json = $api->json( pretty => 1, sorted => 1, relaxed => 1 );
    my $lang = $api->lang( 'en_GB' );
    # en_GB
    my $lang = $api->lang_unix;
    # en-GB
    my $lang = $api->lang_web;
    $api->log_error( "Oops" );
    $api->print( @some_data );
    $api->push_handlers( $name => $code_reference );
    return( $api->reply( Apache2::Const::HTTP_OK => {
        message => "All good!",
        # arbitrary property
        client_id => "efe4bcf3-730c-4cb2-99df-25d4027ec404",
        # special property
        cleanup => sub
        {
            # Some code here to be executed after the reply is sent out to the client.
        }
    }) );
    # Apache2::API::Request
    my $req = $api->request;
    # Apache2::API::Response
    my $req = $api->response;
    my $server = $api->server;
    my $version = $api->server_version;
    $api->set_handlers( $name => $code_reference );
    $api->warn( @some_warnings );

    my $hash = apr1_md5( $clear_password );
    my $hash = apr1_md5( $clear_password, $salt );
    my $ht = $api->htpasswd( $clear_password );
    my $ht = $api->htpasswd( $clear_password, salt => $salt );
    my $hash = $ht->hash;
    say "Does our password match ? ", $ht->matches( $user_clear_password ) ? "yes" : "not";

=head1 VERSION

    v0.5.3

=head1 DESCRIPTION

This module provides a comprehensive, powerful, yet simple framework to access L<Apache mod_perl's API|https://perl.apache.org/docs/2.0/api/> and documented appropriately.

Apache mod_perl is an awesome framework, but quite complexe with a steep learning curve and methods all over the place. So much so that L<they have developed a module dedicated to find appropriate methods|https://perl.apache.org/docs/2.0/user/coding/...

=head1 METHODS

=head2 new

    my $api = Apache2::API->new( $r, $hash_ref_of_options );
    # or
    my $api = Apache2::API->new( apache_request => $r, compression_threshold => 102400 );

This initiates the package and takes an L<Apache2::RequestRec> object and an hash or hash reference of parameters, or only an hash or hash reference of parameters:

=over 4

=item * C<apache_request>

See L</apache_request>

=item * C<compression_threshold>

See L</compression_threshold>

=item * C<debug>

Optional. If set with a positive integer, this will activate debugging message

=back

=head2 apache_request