view release on metacpan or  search on metacpan

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

    # return( $self->error( "Environment variable value provided is a reference data (", overload::StrVal( $val ), ")." ) ) if( ref( $val ) && ( !overload::Overloaded( $val ) || ( overload::Overloaded( $val ) && !overload::Method( $val, '""' ) ) ) );
    my $r = $opts->{apache_request} || $self->apache_request;
    if( $r )
    {
        # $r = $r->is_initial_req ? $r : $r->main;
        $r->subprocess_env( $name => shift( @_ ) ) if( @_ );
        my $v = $r->subprocess_env( $name );
        return( $v );
    }
    else
    {
        my $env = {};
        unless( scalar( keys( %{$self->{_env}} ) ) )
        {
            # Make a copy of the environment variables
            $self->{_env} = {%ENV};
        }
        $env = $self->{_env};
        if( @_ )
        {
            $env->{ $name } = shift( @_ );
            my $meth = lc( $name );
            if( $self->can( $meth ) )
            {
                $self->$meth( $env->{ $name } );
            }
        }
        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 )
    {
        if( defined( $newfile ) )
        {
            $r = $r->is_initial_req ? $r : $r->main;
            my $rr = $r->lookup_file( $newfile );
            if( $rr->status == &Apache2::Const::HTTP_OK )
            {
                $newfile = $rr->filename;
            }
            else
            {
                $r->filename( $self->collapse_dots( $newfile, { separator => $DIR_SEP }) );
                # <https://perl.apache.org/docs/2.0/api/Apache2/RequestRec.html#toc_C_filename_>
                $r->finfo( APR::Finfo::stat( $newfile, &APR::Const::FINFO_NORM, $r->pool ) );
                $self->finfo( $newfile );
            }
            $r->subprocess_env( SCRIPT_FILENAME => $newfile );
            # Force to create new Apache2::SSI::URI object
            $self->{filename} = $newfile;
            $self->{_uri_reset} = 'filename' unless( $caller eq "${class}\::document_uri" );
        }
        elsif( !length( $self->{filename} ) )
        {
            $self->{filename} = $r->filename;
        }
    }
    else
    {
        if( defined( $newfile ) )
        {
            my $try = Cwd::realpath( $newfile );
            # Cwd::realpath would convert
            # Z:\perl\Apache2-SSI\t\htdocs\ssi\include.cgi
            # into 
            # Z:/perl/Apache2-SSI/t/htdocs/ssi/include.cgi
            # amazingly enough, so to make sure this keeps working on windows related platform, we need to call URI::file
            $newfile = URI::file->new( $try )->file( $^O ) if( defined( $try ) );
            unless( File::Spec->file_name_is_absolute( $newfile ) )
            {
                $newfile = URI::file->new_abs( $newfile )->file( $^O );
            }
            $self->env( SCRIPT_FILENAME => $newfile );
            $self->finfo( $newfile );
            # Force to create new Apache2::SSI::URI object
            # Either a URI object or an URI::file object
            $self->{filename} = $self->collapse_dots( $newfile, { separator => $DIR_SEP })->file( $^O );
            # Pass the file as new argument to URI::file which will create an object based on the value of the current OS
            # and transform it into a path à la linux, which is same as web, which is what we want
            # All this is unnecessary for linux type system or those who use / as directory separator,
            # but for windows type systems this is necessary
            if( CORE::index( $self->{filename}, $self->document_root ) != -1 )
            {
                $self->{document_path} = $self->new_uri( URI::file->new( substr( $self->{filename}, length( $self->document_root ) ) )->file( 'linux' ) );
            }
            else
            {
                $self->{document_path} = $self->new_uri( URI::file->new( $self->{filename} )->file( 'linux' ) );
            }
            $self->{_uri_reset} = 'filename' unless( $caller eq "${class}\::document_uri" );
        }
    }
    return( $self->{filename} );
}

# Alias
sub filepath { return( shift->filename( @_ ) ); }

sub finfo
{
    my $self = shift( @_ );
    my $r = $self->apache_request;
    my $newfile;
    if( @_ )
    {