view release on metacpan or  search on metacpan

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

    return '';
}

sub echo_DATE_GMT   { shift()->_format_time(time(), undef, 'GMT') }
sub echo_DATE_LOCAL { shift()->_format_time(time()              ) }
sub echo_DOCUMENT_NAME {
    shift();
    my $r = _2main(shift);
    return &_set_VAR($r, 'DOCUMENT_NAME', basename $r->filename);
}
sub echo_DOCUMENT_URI {
    shift();
    my $r = _2main(shift);
    return &_set_VAR($r, 'DOCUMENT_URI', $r->uri);
}
sub echo_LAST_MODIFIED {
    my ($self, $r) = (shift(), _2main(shift));
    return &_set_VAR($r, 'LAST_MODIFIED', $self->_lastmod($r->filename));
}

sub _set_VAR {
    $_[0]->subprocess_env($_[1], $_[2]);
    return $_[2];
}

sub _eval_vars {
    my $self = shift;
    my $text = shift;
    $text =~ s{ (^|[^\\]) (\\\\)* \$(\{)?(\w+)(\})? }
              { $1 . substr($2,length($2)/2) . "\${ \\(\$self->ssi_echo({var=>'$4'})) }" }exg;
    #;  For poor BBEdit because of that last line
    package main; # In case they're running functions
    my $result = eval $text;
    $self->error("Eval error: $@") if $@;
    return $result;
}

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

# This might be better for _interp_vars:
#sub _interp_vars {
#    local $_ = shift;
#    my $out;
#
#    while (1) {
#
#        if ( /\G([^\\\$]+)/gc ) {
#            $out .= $1;
#            
#        } elsif ( /\G(\\\\)+/gc ) {
#            $out .= '\\' x (length($1)/2);
#            
#        } elsif ( /\G\\([^\$])/gc ) {
#            $out .= &escape_char($1);
#            
#        } elsif ( /\G\$(\w+)/gc ) {
#            $out .= &lookup($1);
#        
#        } elsif ( /\G\$\{(\w+)\}/gc ) {
#            $out .= &lookup($1);
#        
#        } else {
#            last;
#        }
#    }
#    $out;
#}

sub error {
    my $self = shift;
    print $self->{'errmsg'};
    $self->{_r}->log_error($_[0]) if @_ and $self->{_r};
    return '';
}


sub _2main { $_[0]->is_main() ? $_[0] : $_[0]->main() }

sub _format_time {
  my ($self, $time, $format, $tzone) = @_;
  $format ||= $self->{timefmt};
  return ($format ? 
	  POSIX::strftime($format, $self->_time_args($time, $tzone)) :
	  scalar $self->_time_args($time, $tzone));
}

sub _time_args {
  # This routine must respect the caller's wantarray() context.
  my ($self, $time, $zone) = @_;
  return ($zone && $zone =~ /GMT/) ? gmtime($time) : localtime($time);
}

sub _lastmod {
  my ($self, $file, $format) = @_;
  return $self->_format_time((stat $file)[9], $format);
}

1;

__END__

=head1 NAME

Apache::SSI - Implement Server Side Includes in Perl

=head1 SYNOPSIS

In httpd.conf:

    <Files *.phtml>  # or whatever
    SetHandler perl-script
    PerlHandler Apache::SSI
    </Files>