view release on metacpan or  search on metacpan

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

        }
        my( $key, $val );
        my $headers = {};
        while( $buf =~ s/([^\012]*)\012// ) 
        {
            my $line = $1;
            # if we need to restore as content when illegal headers are found.
            my $save = "$line\012"; 
    
            $line =~ s/\015$//;
            last unless( length( $line ) );
    
            if( $line =~ /^([a-zA-Z0-9_\-.]+)\s*:\s*(.*)/ ) 
            {
                # $response->push_header( $key, $val ) if( $key );
                $headers->{ $key } = $val if( $key );
                ( $key, $val ) = ( $1, $2 );
            } 
            elsif( $line =~ /^\s+(.*)/ && $key ) 
            {
                $val .= " $1";
            } 
            else 
            {
                # $response->push_header( "Client-Bad-Header-Line" => $line );
                $headers->{ 'Client-Bad-Header-Line' } = $line;
            }
        }
        # $response->push_header( $key, $val ) if( $key );
        $headers->{ $key } = $val if( $key );
        return( $buf );
    }
}

sub parse_expr
{
    my $self = shift( @_ );
    my $text = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    $opts->{embedded} = 0 if( !exists( $opts->{embedded} ) );
    $opts->{_depth} = ( $opts->{_depth} || 0 ) + 1;
    return( $self->error( "Too deep recursion in parse_expr( '$text' )" ) ) if( $opts->{_depth} > 20 );

    $opts->{_seen} ||= {};
    return( $text ) if( ++$opts->{_seen}->{ $text } > 1 );

    my $r = $self->apache_request;
    my $env = $self->env;
    my $prev_regexp_capture = $self->{_regexp_capture};
    unless( $self->{_exp} )
    {
        $self->{_exp} = Apache2::Expression->new( legacy => 1, debug => $self->debug );
    }
    
    my $exp = $self->{_exp};
    my $hash = {};
    local $@;
    # try-catch
    eval
    {
        local $SIG{ALRM} = sub{ die( "Timeout!\n" ) };
        alarm(90);
        $hash = $exp->parse( $text );
        alarm(0);
    };
    if( $@ )
    {
        return( $self->error( "Error parsing expression '$text': $@" ) );
    }
    my $res = [];
    $opts->{top} = 1;
    $opts->{_seen} = {} if( $opts->{top} );
    foreach my $this ( @{$hash->{elements}} )
    {
        my $res2 = $self->ap2perl_expr( $this, [], $opts );
        push( @$res, @$res2 );
    }
    return( join( ' ', @$res ) );
}

sub parse_expr_args
{
    my $self = shift( @_ );
    my $args = shift( @_ );
    return( $self->error( "I was expecting an array reference, but instead got '$args'." ) ) if( !$self->_is_array( $args ) );
    my $buff = [];
    my $prev_regexp_capture = $self->{_regexp_capture};
    my $r = $self->apache_request;
    my $env = $self->env;
    foreach my $this ( @$args )
    {
        my $res = $self->ap2perl_expr( $this, [] );
        push( @$buff, @$res ) if( $res );
    }
    return( join( ', ', @$buff ) );
}

sub parse_flastmod
{
    my( $self, $args ) = @_;
    my $p = $self->find_file( $args );
    unless( $p->code == 200 )
    {
        return( $self->errmsg );
    }
    return( $self->_lastmod( $p, $args->{timefmt} || $self->{timefmt} ) );
}

sub parse_fsize
{ 
    my( $self, $args ) = @_;
    my $f = $self->find_file( $args );
    unless( $f->code == 200 )
    {
        return( $self->errmsg );
    }
    my $finfo = $f->finfo;
    my $size = $finfo->size;
    my $n = Module::Generic::Number->new( $size );
    if( $self->{sizefmt} eq 'bytes' )
    {