view release on metacpan or  search on metacpan

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

            if( $desc =~ /\bApache\/([\d\.]+)/ )
            {
                $vers = $1;
            }
        };
        if( $@ )
        {
        }
    }
    
    require File::Which;
    # NOTE: to test our alternative approach
    if( !$vers && ( my $apxs = File::Which::which( 'apxs' ) ) )
    {
        $vers = qx( $apxs -q -v HTTPD_VERSION );
        chomp( $vers );
        $vers = '' unless( $vers =~ /^[\d\.]+$/ );
    }
    # Try apache2
    if( !$vers )
    {
        foreach my $bin ( qw( apache2 httpd ) )
        {
            if( ( my $apache2 = File::Which::which( $bin ) ) )
            {
                my $v_str = qx( $apache2 -v );
                if( ( split( /\r?\n/, $v_str ) )[0] =~ /\bApache\/([\d\.]+)/ )
                {
                    $vers = $1;
                    chomp( $vers );
                    last;
                }
            }
        }
    }
    if( $vers )
    {
        $self->{server_version} = $SERVER_VERSION = version->parse( $vers );
        return( $self->{server_version} );
    }
    return( '' );
}

sub sizefmt { return( shift->_set_get_scalar( 'sizefmt', @_ ) ); }

sub timefmt { return( shift->_set_get_scalar( 'timefmt', @_ ) ); }

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

sub uri { return( shift->_set_get_object( 'uri', 'Apache2::SSI::URI', @_ ) ); }

sub _format_time
{
    my( $self, $time, $format, $tzone ) = @_;
    my $env = $self->env;
    $format ||= $self->{timefmt};
    # Quotes are important as they are used to stringify overloaded $time
    my $params = { epoch => "$time" };
    $params->{time_zone} = ( $tzone || 'local' );
    $params->{locale} = $env->{lang} if( length( $env->{lang} ) );
    require DateTime;
    require DateTime::Format::Strptime;
    my $tz;
    # DateTime::TimeZone::Local will die ungracefully if the local timezeon is not set with the error:
    # "Cannot determine local time zone"
    local $@;
    # try-catch
    eval
    {
        require DateTime::TimeZone;
        $tz = DateTime::TimeZone->new( name => 'local' );
    };
    if( $@ )
    {
        $tz = DateTime::TimeZone->new( name => 'UTC' );
        warn( "Your system is missing key timezone components. Reverting to UTC instead of local time zone.\n" );
    }
    
    # try-catch
    my $rv = eval
    {
        my $dt = DateTime->from_epoch( %$params );
        if( length( $format ) )
        {
            my $fmt = DateTime::Format::Strptime->new(
                pattern => $format,
                time_zone => ( $params->{time_zone} || $tz ),
                locale => $dt->locale->code,
            );
            $dt->set_formatter( $fmt );
            return( $dt );
        }
        else
        {
            return( $dt->format_cldr( $dt->locale->date_format_full ) );
        }
    };
    if( $@ )
    {
        $self->error( "An error occurred getting a DateTime object for time \"$time\" with format \"$format\": $@" );
        return( $self->errmsg );
    }
    return( $rv );
}

sub _handle_ifs
{
    my $self = shift( @_ );
    my $cond = shift( @_ );
    
    if( $self->{if_state}->[0] )
    {
        $self->{suspend}->[0] = 1;
    }
    else
    {
        $self->{suspend}->[0] = !( $self->{if_state}->[0] = !!$cond );
    }
    return( '' );
}

sub _has_utf8
{
    my $self = shift( @_ );
    return( $_[0] =~ /$IS_UTF8/ );
}

sub _interp_vars
{
    # Find all $var and ${var} expressions in the string and fill them in.
    my $self = shift( @_ );
    # Because ssi_echo may change $1, $2, ...
    my( $a, $b, $c );
    $_[0] =~ s{ (^|[^\\]) (\\\\)* \$(\{)?(\w+)(\})? }
              { ($a,$b,$c) = ($1,$2,$4);
                $a . ( length( $b ) ? substr( $b, length( $b ) / 2 ) : '' ) . $self->parse_echo({ var => $c }) }exg;
}

sub _ipmatch
{
    my $self = shift( @_ );
    my $subnet = shift( @_ ) || return( $self->error( "No subnet provided" ) );
    my $ip   = shift( @_ ) || $self->remote_ip;
    local $@;
    # try-catch
    my $rv = eval
    {
        local $SIG{__WARN__} = sub{};
        require Net::Subnet;
        my $net = Net::Subnet::subnet_matcher( $subnet );
        my $res = $net->( $ip );
        return( $res ? 1 : 0 );
    };
    if( $@ )
    {
        $self->error( "Error while calling Net::Subnet: $@" );
        return(0);
    }
    return( $rv );
}