view release on metacpan or  search on metacpan

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

        require APR::Base64;
        require APR::Request;
        require APR::SockAddr;
        require APR::Finfo;
        require APR::Const;
        APR::Const->import( -compile => qw( FINFO_NORM ) );
    }
    use Apache2::Expression;
    use Apache2::SSI::File;
    use Apache2::SSI::Finfo;
    use Apache2::SSI::Notes;
    use Apache2::SSI::URI;
    use Config;
    use Encode ();
    use HTML::Entities ();
    use IO::Select;
    use Regexp::Common qw( net Apache2 );
    use Scalar::Util ();
    use URI;
    use version;
    our $VERSION = 'v0.2.12';
    use constant PERLIO_IS_ENABLED => $Config{useperlio};
    # As of Apache 2.4.41 and mod perl 2.0.11 Apache2::SubProcess::spawn_proc_prog() is not working
    use constant MOD_PERL_SPAWN_PROC_PROG_WORKING => 0;
    our $HAS_SSI_RE = qr{<!--#(?:comment|config|echo|elif|else|endif|exec|flastmod|fsize|if|include|perl|printenv|set).*?-->}is;
};

use strict;
use warnings;

{
    # Compile it beforehand and keep it there
    our $ATTRIBUTES_RE = qr/
        (
            (?<tag_attr>
                (?:
                    [[:blank:]\h]*
                    (?<attr_name>[\w\-]+)
                    [[:blank:]\h]*
                    =
                    [[:blank:]\h]*
                    # (?<!\\)(?<attr_val>[^\"\'[:blank:]\h]+)
                    # (?:(?<!\")|(?<!\'))(?<attr_val>[^[:blank:]\h]+)
                    (?!["'])(?<attr_val>[^[:blank:]\h]+)
                    [[:blank:]\h]*
                )
                |
                (?:
                    [[:blank:]\h]*
                    (?<attr_name>[\w\-]+)
                    [[:blank:]\h]*
                    =
                    [[:blank:]\h]*
                    (?<quote>(?<quote_double>\")|(?<quote_single>\'))
                    (?(<quote_double>)
                        (?<attr_val>(?>\\"|[^"])*+)
                        |
                        (?<attr_val>(?>\\'|[^'])*+)
                    )
                    # (?>\\["']|[^"'])*+
                    \g{quote}
                    [[:blank:]\h]*
                )
            )
        )
    /xsm;
    
    our $EXPR_RE = qr/
        (?<tag_attr>
            \b(?<attr_name>expr)
            [[:blank:]\h]*\=
            (?:
                (?:
                    (?!["'])(?<attr_val>[^[:blank:]\h]+)
                    [[:blank:]\h]*
                )
                |
                (?:
                    [[:blank:]\h]*
                    (?<quote>(?<quote_double>\")|(?<quote_single>\'))
                    (?(<quote_double>)
                        (?<attr_val>(?>\\"|[^"])*+)
                        |
                        (?<attr_val>(?>\\'|[^'])*+)
                    )
                    \g{quote}
                    [[:blank:]\h]*
                )
            )
        )
    /xsmi;
    
    our $SUPPORTED_FUNCTIONS = qr/(base64|env|escape|http|ldap|md5|note|osenv|replace|req|reqenv|req_novary|resp|sha1|tolower|toupper|unbase64|unescape)/i;
    our $FUNCTION_PARAMETERS_RE = qr/
        [[:blank:]\h]*                                                  # Some possible leading blanks
        (?:
            (?:
                (?<func_quote>(?<func_quote_2>\")|(?<func_quote_1>\'))  # quotes used to enclose function parameters
                (?(<func_quote_2>)
                    (?<func_params>(?>\\"|[^"])*+)
                    |
                    (?<func_params>(?>\\'|[^'])*+)
                )
                \g{func_quote}
            )
            |
            (?<func_params>(?>\\\)|[^\)\}])*+)                             # parameters not surounded by quotes
        )
        [[:blank:]\h]*                                                  # Some possible trailing blanks
    /xsm;
    
    our $IS_UTF8 = qr/
        ^(
            ([\0-\x7F])
            |
            ([\xC2-\xDF][\x80-\xBF])
            |
            (
                (
                    ([\xE0][\xA0-\xBF])
                    |
                    ([\xE1-\xEC\xEE-\xEF][\x80-\xBF])
                    |
                    ([\xED][\x80-\x9F])
                )
                [\x80-\xBF]
            )
            |
            (
                (
                    ([\xF0][\x90-\xBF])
                    |
                    ([\xF1-\xF3][\x80-\xBF])
                    |
                    ([\xF4][\x80-\x8F])
                )
                [\x80-\xBF][\x80-\xBF]
            )
        )*$
    /x;
}

# PerlResponseHandler
sub handler : method
{
    if( Scalar::Util::blessed( $_[1] ) && $_[1]->isa( 'Apache2::Filter' ) )
    {
        return( &apache_filter_handler( @_ ) );
    }
    else
    {
        return( &apache_response_handler( @_ ) );
    }
}

sub ap2perl_expr
{
    my $self = shift( @_ );
    my $ref  = shift( @_ );
    my $buf  = shift( @_ );
    return( [] ) if( ref( $ref ) ne 'HASH' );
    my $opts = $self->_get_args_as_hash( @_ );
    $opts->{skip} = [] if( !exists( $opts->{skip} ) );
    $opts->{top} = 0 if( !exists( $opts->{top} ) );