view release on metacpan or  search on metacpan

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

            my $sent = $r->print( $res );
        };
        if( $@ )
        {
            $r->log->error( "${class} encountered an error while sending resulting data via Apache2::Filter->print: $@" );
        }
        return( &Apache2::Const::OK );
    }
}

# https://perl.apache.org/docs/2.0/user/handlers/filters.html#C_PerlOutputFilterHandler_
# sub handler : FilterRequestHandler
# sub handler : method
sub apache_filter_handler
{
    # my( $class, $f, $brigade, $mode, $type, $len ) = @_;
    my( $class, $f, $bb ) = @_;
    my $r = $f->r;
    # my $class = __PACKAGE__;
    my $main = $r->is_initial_req ? $r : $r->main;
    return( &Apache2::Const::DECLINED ) unless( $r->is_initial_req && $main->content_type eq 'text/html' );
    my $debug = int( $r->dir_config( 'Apache2_SSI_DEBUG' ) );
    $main->no_cache(1) if( ( $r->dir_config( 'Apache2_SSI_NO_CACHE' ) ) eq 'on' );
    $r->log->debug( "${class} [PerlOutputFilterHandler]: Received request for uri '", $r->uri, "' with path info '", $r->path_info, "'." ) if( $debug > 0 );
    
    my $ctx = $f->ctx;
    unless( $ctx->{invoked} )
    {
        $r->log->debug( "${class} [PerlOutputFilterHandler]: First time invoked, removing Content-Length header currently set to '", $r->headers_out->get( 'Content-Length' ), "'." ) if( $debug > 0 );
        $r->headers_out->unset( 'Content-Length' );
    }
    
    # Then, we might get called multiple time, since there may be multiple brigade buckets
    # Here, we retrieve the last buffer we put in $f->ctx->{data} if any
    my $html = exists( $ctx->{data} ) ? $ctx->{data} : '';
    $r->log->debug( "${class} [PerlOutputFilterHandler]: HTML data buffer set to '$html'." ) if( $debug > 0 );
    $ctx->{invoked}++;
    my $seen_eos = 0;
    my $max_length = int( $r->dir_config( 'Apache2_SSI_Max_Length' ) ) || 0;
    $r->log->debug( "${class} [PerlOutputFilterHandler]: Maximum length set to '$max_length'." ) if( $debug > 0 );
    # Get all the brigade buckets data
    for( my $b = $bb->first; $b; $b = $bb->next( $b ) )
    {
        $seen_eos++, last if( $b->is_eos );
        $b->read( my $bdata );
        $html .= $bdata;
        return( &Apache2::Const::DECLINED ) if( $max_length && length( $html ) >= $max_length );
    }
    
    # If we have not reached the special End-of-String bucket, we store our buffer in $f->ctx->{data} and return OK
    if( !$seen_eos )
    {
        # store context for all but the last invocation
        $r->log->debug( "${class} [PerlOutputFilterHandler]: Not reached the EOS bucket. Storing html to data buffer." ) if( $debug > 0 );
        $ctx->{data} = $html;
        $f->ctx( $ctx );
        return( &Apache2::Const::OK );
    }
    
    # Let's behave well as per the doc
    if( $f->c->keepalive == &Apache2::Const::CONN_KEEPALIVE )
    {
        $r->log->debug( "${class} [PerlOutputFilterHandler]: KeepAlive count (", $f->c->keepalive, ") reached the threshold of '", &Apache2::Const::CONN_KEEPALIVE, "'." ) if( $debug > 0 );
        $ctx->{data} = '';
        $f->ctx( $ctx );
    }
    
    my $size = length( $html );
    $ctx->{data} = '';
    $ctx->{invoked} = 0;
    $f->ctx( $ctx );
    if( $size == 0 )
    {
        $r->log->debug( "${class} [PerlOutputFilterHandler]: Data received is empty. Nothing to do." );
        return( &Apache2::Const::OK );
    }

    local $@;
    # try-catch
    $html = eval
    {
        Encode::decode( 'utf8', $html, Encode::FB_CROAK );
    };
    if( $@ )
    {
        $r->log->error( "${class} [PerlOutputFilterHandler]: Failed to decode data from utf8: $@" );
        return( &Apache2::Const::DECLINED );
    }
    
    #W We just add that the charset is utf-8
    $main->content_type( 'text/html; charset=utf-8' ) unless( $main->content_type =~ /\bcharset\n/i );
    
    my $params =
    {
    apache_filter => $f,
    apache_request => $r,
    debug => 3,
    };
    my $val;
    my $map = 
    {
    DEBUG   => 'debug',
    Echomsg => 'echomsg',
    Errmsg  => 'errmsg',
    Sizefmt => 'sizefmt',
    Timefmt => 'timefmt',
    };
    foreach my $key ( keys( %$map ) )
    {
        if( length( $val = $r->dir_config( "Apache2_SSI_${key}" ) ) )
        {
            $params->{ $map->{ $key } } = $val;
        }
    }
    if( $r->dir_config( 'Apache2_SSI_Expression' ) eq 'legacy' )
    {
        $params->{legacy} = 1;
    }
    elsif( $r->dir_config( 'Apache2_SSI_Expression' ) eq 'trunk' )
    {
        $params->{trunk} = 1;
    }
    $r->log->debug( "${class} [PerlOutputFilterHandler]: Creating a ${class} object." ) if( $debug > 0 );