Apache2-SSI

 view release on metacpan or  search on metacpan

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

sub legacy { return( shift->_set_get_boolean( 'legacy', @_ ) ); }

sub parse
{
    my $self = shift( @_ );
    my $data = shift( @_ );
    return( '' ) if( !length( $data ) );
    my $opts = $self->_get_args_as_hash( @_ );
    pos( $data ) = 0;
    my $prefix = $self->legacy ? 'Legacy' : $self->trunk ? 'Trunk' : '';
    my @callinfo = caller(0);
    $opts->{top} = 0;
    $opts->{top} = 1 if( $callinfo[0] ne ref( $self ) || ( $callinfo[0] eq ref( $self ) && substr( (caller(1))[3], rindex( (caller(1))[3], ':' ) + 1 ) ne 'parse' ) );
    # This is used to avoid looping when an expression drills down its substring by calling parse again
    my $skip = {};
    if( ref( $opts->{skip} ) eq 'ARRAY' &&
        scalar( @{$opts->{skip}} ) )
    {
        @$skip{ @{$opts->{skip}} } = ( 1 ) x scalar( @{$opts->{skip}} )
    }
    my $p = {};
    $p->{is_negative} = 0;
    my $elems = [];

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

    my $parent = $self->parent;
    return( $parent );
}

sub document_filename { return( shift->filename( @_ ) ); }

sub document_path
{
    my $self = shift( @_ );
    my $class = ref( $self );
    my $caller = (caller(1))[3] // '';
    # my $caller = substr( $sub, rindex( $sub, ':' ) + 1 );
    my $r = $self->apache_request;
    if( $r )
    {
        if( @_ )
        {
            my $uri = shift( @_ );
            $r = $r->is_initial_req ? $r : $r->main;
            my $rr = $self->lookup_uri( $uri );
            if( !defined( $rr ) )

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

        }
        return( $env->{ $name } );
    }
}

# This is set by document_uri
sub filename
{
    my $self = shift( @_ );
    my $class = ref( $self );
    my $caller = (caller(1))[3] // '';
    # my $caller = substr( $sub, rindex( $sub, ':' ) + 1 );
    my $r = $self->apache_request;
    my $newfile;
    if( @_ )
    {
        $newfile = shift( @_ );
        return( $self->error( "New file provided, but it was an empty string." ) ) if( !defined( $newfile ) || !length( $newfile ) );
    }
    
    if( $r )

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

    my @segments = $self->document_path->path_segments;
    pop( @segments );
    return( $self ) if( !scalar( @segments ) );
    return( $self->make( document_uri => join( '/', @segments ) ) );
}

sub path_info
{
    my $self = shift( @_ );
    my $class = ref( $self );
    my $caller = (caller(1))[3] // '';
    # my $caller = substr( $sub, rindex( $sub, ':' ) + 1 );
    my $r = $self->apache_request;
    if( $r )
    {
        if( @_ )
        {
            $r->path_info( shift( @_ ) );
            $self->_set_env( PATH_INFO => $r->path_info );
            $self->{_uri_reset} = 'path_info' unless( $caller eq "${class}\::document_uri" );
        }

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

            $self->{_uri_reset} = 'path_info' unless( $caller eq "${class}\::document_uri" );
        }
        return( $self->{path_info} );
    }
}

sub query_string
{
    my $self = shift( @_ );
    my $class = ref( $self );
    my $caller = (caller(1))[3] // '';
    # my $caller = substr( $sub, rindex( $sub, ':' ) + 1 );
    my $r = $self->apache_request;
    if( $r )
    {
        if( @_ )
        {
            my $qs = shift( @_ );
            $r->args( $qs );
            $self->_set_env( QUERY_STRING => $qs );
            $self->{_uri_reset} = 'query_string' unless( $caller eq "${class}\::document_uri" );

t/SSITest.pm  view on Meta::CPAN

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

sub message
{
    my $self = shift( @_ );
    return unless( $self->{debug} );
    my $class = ref( $self );
    my $r = $self->apache_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 );