view release on metacpan or  search on metacpan

lib/Apache2/SSI/URI.pm  view on Meta::CPAN

# whereas the env() one has triggers that could otherwise create an infinite loop.
sub _set_env
{
    my $self = shift( @_ );
    my $name = shift( @_ );
    return( $self->error( "No environment variable name provided." ) ) if( !length( $name ) );
    $self->{_env} = {} if( !ref( $self->{_env} ) );
    my $env = $self->{_env};
    my $r = $self->apache_request;
    if( @_ )
    {
        my $v = shift( @_ );
        $r->subprocess_env( $name => $v ) if( $r );
        $env->{ $name } = $v;
    }
    return( $self );
}

sub _trim_trailing_slash
{
    my $self = shift( @_ );
    my $uri  = shift( @_ );
    return( $self->error( "No uri provided to trim trailing slash." ) ) if( !length( "$uri" ) );
    unless( Scalar::Util::blessed( $uri ) && $uri->isa( 'URI' ) )
    {
        $uri = $self->new_uri( "$uri" );
    }
    if( substr( $uri->path, -1, 1 ) eq '/' && length( $uri->path ) > 1 )
    {
        # By splitting the string on '/' and without the last argument for split being -1, perl will remove trailing blank entries
        $uri->path( join( '/', split( '/', $uri->path ) ) );
    }
    return( $uri );
}

1;
# NOTE: POD
__END__

=encoding utf-8

=head1 NAME

Apache2::SSI::URI - Apache2 Server Side Include URI Object Class

=head1 SYNOPSIS

    # if the global option PerlOptions +GlobalRequest is set in your VirtualHost
    my $r = Apache2::RequestUtil->request
    my $uri = Apache2::SSI::URI->new(
        apache_request => $r,
        document_uri => '/some/uri/file.html',
        document_root => '/home/john/www',
        base_uri => '/',
    ) || die( "Unable to create an Apache2::SSI::URI object: ", Apache2::SSI::URI->error );

    unless( $uri->code == Apache2::Const::HTTP_OK )
    {
        die( "Sorry, the uri does not exist.\n" );
    }
    print( $uri->slurp_utf8 );

    # Changing the base uri, which is used to resolve relative uri
    $uri->base_uri( '/ssi' );

    my $uri2 = $uri->clone;
    $uri2->filename( '/home/john/some-file.txt' );
    die( "No such file\n" ) if( $uri2->finfo->filetype == Apache2::SSI::Finfo::FILETYPE_NOFILE );

    my $dir = $uri->document_directory;

    # Full path to the filename, e.g. /home/john/www/some/dir/file.html
    # Possible dots are resolved /home/john/www/some/dir/../ssi/../dir/./file.html => /home/john/www/some/dir/file.html
    my $filename = $uri->document_filename;

    # The uri without path info or query string
    my $path = $uri->document_path;

    my $doc_root = $uri->document_root;
    
    # The document uri including path info, and query string if any
    my $u = $uri->document_uri;

    my $req_uri = $uri->env( 'REQUEST_URI' );

    # Access to the Apache2::SSI::Finfo object
    my $finfo = $uri->finfo;

    # A new Apache2::SSI::URI object
    my $uri3 = $uri->new_uri( document_uri => '/some/where/about.html', document_root => '/home/john/www' );

    # Returns /some/uri
    my $parent = $uri->parent;

    # The uri is now /some/uri/file.html/some/path
    $uri->path_info( '/some/path' );

    # The uri is now /some/uri/file.html/some/path?q=something&l=ja_JP
    $uri->query_string( 'q=something&l=ja_JP' );

    my $html = $uri->slurp_utf8;
    my $raw = $uri->slurp({ binmode => ':raw' });

    # Same as $uri->document_uri
    my $uri = $uri->uri;

=head1 VERSION

    v0.1.3

=head1 DESCRIPTION

L<Apache2::SSI::URI> is used to manipulate and query http uri. It is used by L<Apache2::SSI> both for the main query, and also for sub queries like when there is an C<include> directive.

In this case, there would be the main document uri such as C</some/path/file.html> and containing a directive such as:

    <!--#include virtual="../other.html" -->

An L<Apache2::SSI::URI> object would be instantiated to process the uri C<../other.html>, flatten the dots and get its underlying filename.

Even if the uri provided does not exist, am L<Apache2::SSI::URI> object would still be returned, so you need to check if the file exists by doing:

    if( $uri->code == 404 )
    {
        die( "Not there\n" );
    }

Or, this would work too:

    if( $uri->finfo->filetype == Apache2::SSI::Finfo::FILETYPE_NOFILE )
    {
        die( "No such file !\n" );
    }

=head1 METHODS

=head2 new

This instantiate an object that is used to access other key methods. It takes the following parameters:

=over 4

=item C<apache_request>

This is the L<Apache2::RequestRec> object that is provided if running under mod_perl.

it can be retrieved from L<Apache2::RequestUtil/request> or via L<Apache2::Filter/r>

You can get this L<Apache2::RequestRec> object by requiring L<Apache2::RequestUtil> and calling its class method L<Apache2::RequestUtil/request> such as C<Apache2::RequestUtil->request> and assuming you have set C<PerlOptions +GlobalRequest> in your ...

Note that there is a main request object and subprocess request object, so to find out which one you are dealing with, use L<Apache2::RequestUtil/is_initial_req>, such as:

    use Apache2::RequestUtil (); # extends Apache2::RequestRec objects
    my $r = $r->is_initial_req ? $r : $r->main;

=item C<base_uri>

This is the base uri which is used to make uri absolute.

For example, if the main document uri is C</some/folder/file.html> containing a directive:

lib/Apache2/SSI/URI.pm  view on Meta::CPAN

Returns the parent of the document uri, or if there is no parent, it returns the current object itself.

    my $up = $uri->parent;
    # would return /some/path assuming the document uri was /some/path/file.html

=head2 path_info

Sets or gets the path info for the current uri.

Example:

    my $string = $ssi->path_info;
    $ssi->path_info( '/my/path/info' );

The path info value is also set automatically when L</document_uri> is called, such as:

    $ssi->document_uri( '/some/path/to/file.html/my/path/info?q=something&l=ja_JP' );

This will also set automatically the C<PATH_INFO> environment variable.

=head2 query_string

Set or gets the query string for the current uri.

Example:

    my $string = $ssi->query_string;
    $ssi->query_string( 'q=something&l=ja_JP' );

or, using the L<URI> module:

    $ssi->query_string( $uri->query );

The query string value is set automatically when you provide an L<document_uri> upon instantiation or after:

    $ssi->document_uri( '/some/path/to/file.html?q=something&l=ja_JP' );

This will also set automatically the C<QUERY_STRING> environment variable.

=head2 root

Returns an object representation of the root uri, i.e. C</>

=head2 slurp

It returns the content of the L</filename>

it takes an hash reference of parameters:

=over 4

=item C<binmode>

    my $content = $uri->slurp({ binmode => ':utf-8' });

=back

It will return undef and sets an L<Module::Generic/error> if there is no L</filename> value set or if the file cannot be opened.

=head2 slurp_utf8

It returns the content of the file L</filename> utf-8 decoded.

This is equivalent to:

    my $content = $uri->slurp({ binmode => ':utf8' });

C<:utf8> is slightly a bit more lax than C<:utf-8>, so it you want strict utf8, you can do:

    my $content = $uri->slurp({ binmode => ':utf-8' });

=head1 AUTHOR

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

CPAN ID: jdeguest

L<https://gitlab.com/jackdeguest/Apache2-SSI>

=head1 SEE ALSO

L<Apache2::SSI::File>, L<Apache2::SSI::Finfo>, L<Apache2::SSI>

mod_include, mod_perl(3), L<APR::URI>, L<URI>
L<https://httpd.apache.org/docs/current/en/mod/mod_include.html>,
L<https://httpd.apache.org/docs/current/en/howto/ssi.html>,
L<https://httpd.apache.org/docs/current/en/expr.html>
L<https://perl.apache.org/docs/2.0/user/handlers/filters.html#C_PerlOutputFilterHandler_>

=head1 COPYRIGHT & LICENSE

Copyright (c) 2020-2021 DEGUEST Pte. Ltd.

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

=cut