DateTime results from the CPAN

DateTime

Apache2-API

view release on metacpan or search on metacpan


# <https://perl.apache.org/docs/2.0/api/APR/UUID.html>
sub generate_uuid
{
    my $self = shift( @_ );
    # try-catch
    local $@;
    my $rv = eval
    {
        return( APR::UUID->new->format );
    };
    if( $@ )
    {
        return( $self->error( "An error occurred while trying to generate an uuid using APR::UUID package: $@" ) );
    }
    return( $rv );
}

# rfc 6750 <https://tools.ietf.org/html/rfc6750>
sub get_auth_bearer
{
    my $self = shift( @_ );
    my $bearer = $self->request->authorization;
    # Found a bearer
    if( $bearer )
    {
        # https://jwt.io/introduction/
        # https://tools.ietf.org/html/rfc7519
        # if( $bearer =~ /^Bearer[[:blank:]]+([a-zA-Z0-9][a-zA-Z0-9\-\_\~\+\/\=]+(?:\.[a-zA-Z0-9\_][a-zA-Z0-9\-\_\~\+\/\=]+){2,4})$/i )
        if( $bearer =~ /^Bearer[[:blank:]]+([a-zA-Z0-9][a-zA-Z0-9\-\_\~\+\/\=]+(?:\.[a-zA-Z0-9\_][a-zA-Z0-9\-\_\~\+\/\=]+)*)$/i )
        {
            my $token = $1;
            return( $token );
        }
        else
        {
            return( $self->error({ code => Apache2::Const::HTTP_BAD_REQUEST, message => "Bad bearer authorization format" }) );
        }
    }
    else
    {
        # Return empty, not undef, because undef is for errors
        return( '' );
    }
}

# <https://perl.apache.org/docs/2.0/api/Apache2/ServerUtil.html>
sub get_handlers { return( shift->_try( 'server', 'get_handlers', @_ ) ); }

# Does nothing and it should be superseded by a class inheriting our module
# This gives a chance to return a localised version of our string to the user
sub gettext { return( $_[1] ); }

sub header_datetime
{
    my $self = shift( @_ );
    my $dt;
    if( @_ )
    {
        return( $self->error( "Date time provided (", ( $_[0] // 'undef' ), ") is not an object." ) ) if( !Scalar::Util::blessed( $_[0] ) );
        return( $self->error( "Object provided (", ref( $_[0] ), ") is not a DateTime or DateTime::Lite object." ) ) if( !$_[0]->isa( 'DateTime' ) && !$_[0]->isa( 'DateTime::Lite' ) );
        $dt = shift( @_ );
    }
    $dt = DateTime::Lite->now if( !defined( $dt ) );
    my $fmt = Apache2::API::DateTime->new;
    $dt->set_formatter( $fmt );
    return( $dt );
}

sub htpasswd
{
    my $self = shift( @_ );
    my $rv = Apache2::API::Password->new( @_ );
    if( !defined( $rv ) && Apache2::API::Password->error )
    {
        return( $self->pass_error( Apache2::API::Password->error ) );
    }
    return( $rv );
}

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

# We return a new object each time, because if we cached it, some routine might set the utf8 bit flagged on while some other would not want it
sub json
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    my $j = JSON->new;
    my $equi =
    {
        ordered => 'canonical',
        sorted => 'canonical',
        sort => 'canonical',
    };

    foreach my $opt ( keys( %$opts ) )
    {
        my $ref;
        $ref = $j->can( exists( $equi->{ $opt } ) ? $equi->{ $opt } : $opt ) || do
        {
            warn( "Unknown JSON option '${opt}'\n" ) if( $self->_warnings_is_enabled );
            next;
        };
        $ref->( $j, $opts->{ $opt } );
    }
    return( $j );
}

sub lang { return( shift->_set_get_scalar( 'lang', @_ ) ); }

sub lang_unix
{
    my $self = shift( @_ );
    my $lang = $self->{lang};
    $lang =~ tr/-/_/;
    return( $lang );
}

sub lang_web
{
    my $self = shift( @_ );
    my $lang = $self->{lang};
    $lang =~ tr/_/-/;
    return( $lang );
}

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

=head2 decode_url( $string )

Given a url-encoded string, this returns the decoded string using L<APR::Request/decode>

=head2 decode_utf8( $data )

Decode some data from ut8 into perl internal utf8 representation using L<Encode>

If an error occurs, it will return undef and set an exception that can be accessed with the L<error|Module::Generic/errir> method.

=head2 encode_base64( $data )

Given some data, this will encode it using base64 algorithm. It uses L<APR::Base64/encode>.

=head2 encode_json( $hash_reference )

Given a hash reference, this will encode it into a json data representation.

However, this will not utf8 encode it, because this is done upon printing the data and returning it to the client.

The JSON object has the following properties enabled: C<allow_nonref>, C<allow_blessed>, C<convert_blessed> and C<relaxed>

=head2 encode_url( $string )

Given a string, this returns its url-encoded version using L<APR::Request/encode>

=head2 encode_utf8( $data )

This encode in ut8 the data provided and return it.

If an error occurs, it will return undef and set an exception that can be accessed with the B<error> method.

=head2 generate_uuid

Generates an uuid string and return it. This uses L<APR::UUID>

=head2 get_auth_bearer

Checks whether an C<Authorization> HTTP header was provided, and get the Bearer value.

If no header was found, it returns an empty string.

If an error occurs, it will return undef and set an exception that can be accessed with the B<error> method.

=head2 get_handlers

Returns a reference to a list of handlers enabled for a given phase.

    $handlers_list = $res->get_handlers( $hook_name );

A list of handlers configured to run at the child_exit phase:

    @handlers = @{ $res->get_handlers( 'PerlChildExitHandler' ) || []};

=head2 gettext( 'string id' )

Get the localised version of the string passed as an argument.

This is supposed to be superseded by the package inheriting from L<Apache2::API>, if any.

=head2 header_datetime( DateTime or DateTime::Lite object )

Given a L<DateTime> or L<DateTime::Lite> object, this sets it to GMT time zone and set the proper formatter (L<Apache2::API::DateTime>) so that the stringification is compliant with HTTP headers standard.

=head2 htpasswd

    my $ht = $api->htpasswd( $clear_password, create => 1 );
    my $ht = $api->htpasswd( $clear_password, create => 1, salt => $salt );
    my $ht = $api->htpasswd( $md5_password );
    my $bool = $ht->matches( $user_input_password );

This instantiates a new L<Apache2::API::Password> object by providing its constructor whatever arguments was received.

It returns a new L<Apache2::API::Password> object, or, upon error, C<undef> in scalar context, or an empty list in list context.

=head2 is_perl_option_enabled

Checks if perl option is enabled in the Virtual Host and returns a boolean value

=head2 json

Returns a JSON object.

You can provide an optional hash or hash reference of properties to enable or disable:

    my $J = $api->json( pretty => 1, relaxed => 1 );

Each property corresponds to one that is supported by L<JSON>

It also supports C<ordered>, C<order> and C<sort> as an alias to C<canonical>

=head2 lang( $string )

Set or get the language for the API. This would typically be the HTTP preferred language.

=head2 lang_unix( $string )

Given a language, this returns a language code formatted the unix way, ie en-GB would become en_GB

=head2 lang_web( $string )

Given a language, this returns a language code formatted the web way, ie en_GB would become en-GB

=head2 log

    $api->log->emerg( "Urgent message." );
    $api->log->alert( "Alert!" );
    $api->log->crit( "Critical message." );
    $api->log->error( "Error message." );
    $api->log->warn( "Warning..." );
    $api->log->notice( "You should know." );
    $api->log->info( "This is for your information." );
    $api->log->debug( "This is debugging message." );

Returns a L<Apache2::Log::Request> object.

=head2 log_error( $string )

Given a string, this will log the data into the error log.

When log_error is accessed with the L<Apache2::RequestRec> the error gets logged into the Virtual Host log, but when log_error gets accessed via the L<Apache2::ServerUtil> object, the error get logged into the Apache main error log.

=head2 print( @list )

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

run the tests in one of the modes: (repeat|random|SEED)

=item C<-ping[=block]>

test if server is running or port in use

=item C<-post>

POST url

=item C<-postamble>

config to add at the end of C<httpd.conf>

=item C<-preamble>

config to add at the beginning of C<httpd.conf>

=item C<-proxy>

proxy requests (default proxy is localhost)

=item C<-run-tests>

run the tests

=item C<-ssl>

run tests through ssl

=item C<-start-httpd>

start the test server

=item C<-stop-httpd>

stop the test server

=item C<-trace=T>

change tracing default to: warning, notice, info, debug, ...

=item C<-verbose[=1]>

verbose output

=back

See for more information L<https://perl.apache.org/docs/general/testing/testing.html>

=head2 API CORE MODULES

L<Apache2::RequestIO>, L<Apache2::RequestRec>

=head1 AUTHOR

Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>

=head1 SEE ALSO

L<Apache2::API::DateTime>, L<Apache2::API::Query>, L<Apache2::API::Request>, L<Apache2::API::Request::Params>, L<Apache2::API::Request::Upload>, L<Apache2::API::Response>, L<Apache2::API::Status>

L<Apache2::Request>, L<Apache2::RequestRec>, L<Apache2::RequestUtil>

=head1 COPYRIGHT & LICENSE

Copyright (c) 2023 DEGUEST Pte. Ltd.

You can use, copy, modify and redistribute this package and associated
files under the same terms as Perl itself.

=cut

( run in 1.339 second using v1.01-cache-2.11-cpan-d7f47b0818f )