You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@apache.org on 2001/03/07 21:43:49 UTC
cvs commit: embperl/test/html/SSI ssibasic.htm
richter 01/03/07 12:43:46
Modified: . Tag: Embperl2c Changes.pod epparse.c test.pl
Embperl/Syntax Tag: Embperl2c SSI.pm
test/cmp Tag: Embperl2c plain.htm
test/html Tag: Embperl2c plain.htm
Added: test/html/SSI Tag: Embperl2c ssibasic.htm
Log:
Embperl 2 - SSI syntax
Revision Changes Path
No revision
No revision
1.129.4.8 +15 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.129.4.7
retrieving revision 1.129.4.8
diff -u -r1.129.4.7 -r1.129.4.8
--- Changes.pod 2000/12/22 06:23:12 1.129.4.7
+++ Changes.pod 2001/03/07 20:43:22 1.129.4.8
@@ -1,5 +1,20 @@
=pod
+=head1 2.0b2 (BETA)
+
+ - HTML comments are not touched anymore
+ - Embperl files can now debugged via the interavtive debugger.
+ The debugger shows the Embperl page source along with the
+ correct linenumbers. This works offline
+ (perl -d embpexec.pl file.epl) or via Apache::DB under mod_perl
+ - Embperl has now a defined API for creating/adding a new
+ syntax. See perldoc HTML::Embperl::Syntax for details.
+ - Which syntax (also multiple at the same time)
+ a given page uses can be defined via EMBPERL_SYNTAX configuration
+ directive.
+
+
+
=head1 2.0b1 (BETA) 22. Dec 2000
- Syntax of Embperl is now defined in module HTML::Embperl::Syntax
1.4.2.12 +2 -0 embperl/Attic/epparse.c
Index: epparse.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epparse.c,v
retrieving revision 1.4.2.11
retrieving revision 1.4.2.12
diff -u -r1.4.2.11 -r1.4.2.12
--- epparse.c 2001/03/07 14:23:42 1.4.2.11
+++ epparse.c 2001/03/07 20:43:24 1.4.2.12
@@ -482,6 +482,8 @@
for (i = 0, pToken = pTokenTab; i < numTokens; i++, pToken++)
{
+ if (pToken -> nTextLen == 0)
+ continue ;
r = strnicmp (pCurr, pToken -> sText, pToken -> nTextLen) ;
if (r == 0 || *pCurr > *(pToken -> sText))
break ;
1.70.4.30 +2 -2 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.29
retrieving revision 1.70.4.30
diff -u -r1.70.4.29 -r1.70.4.30
--- test.pl 2001/03/07 14:23:43 1.70.4.29
+++ test.pl 2001/03/07 20:43:24 1.70.4.30
@@ -3,10 +3,10 @@
# `make test'. After `make install' it should work as `perl test.pl'
-use HTML::Embperl::Syntax::Embperl ;
+use HTML::Embperl::Syntax::SSI ;
-$syn = HTML::Embperl::Syntax::Embperl -> new ;
+$syn = HTML::Embperl::Syntax::SSI -> new ;
@testdata = (
No revision
No revision
1.1.2.4 +290 -9 embperl/Embperl/Syntax/Attic/SSI.pm
Index: SSI.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/SSI.pm,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -u -r1.1.2.3 -r1.1.2.4
--- SSI.pm 2001/03/07 14:23:50 1.1.2.3
+++ SSI.pm 2001/03/07 20:43:30 1.1.2.4
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: SSI.pm,v 1.1.2.3 2001/03/07 14:23:50 richter Exp $
+# $Id: SSI.pm,v 1.1.2.4 2001/03/07 20:43:30 richter Exp $
#
###################################################################################
@@ -18,7 +18,11 @@
use HTML::Embperl::Syntax qw{:types} ;
use HTML::Embperl::Syntax::HTML ;
+use Apache::Constants qw(:common OPT_INCNOEXEC);
+use File::Basename;
+use POSIX qw{};
+
use strict ;
use vars qw{@ISA} ;
@@ -66,34 +70,311 @@
$self -> AddComment ('#echo', ['var', 'encoding'], undef, undef, { perlcode => '_ep_rp(%$x%, $ENV{%&*\'var%}) ;' } ) ;
+ $self -> AddComment ('#printenv', undef, undef, undef, { perlcode => '_ep_rp(%$x%, join ("\\\\<br\\\\>\n", map { "$_ = $ENV{$_}" } keys %ENV)) ;' } ) ;
$self -> AddComment ('#config', ['errmsg', 'sizefmt', 'timefmt'], undef, undef,
{ perlcode => [
'$_ep_ssi_errmsg = %&*\'errmsg% ;',
- '$_ep_ssi_sizefmt = %&*\'siezfmt% ;',
+ '$_ep_ssi_sizefmt = %&*\'sizefmt% ;',
'$_ep_ssi_timefmt = %&*\'timefmt% ;',
- ] } ) ;
+ ],
+ removenode => 1
+ } ) ;
$self -> AddComment ('#exec', ['cgi', 'cmd'], undef, undef,
{ perlcode => [
- 'open (FH, %&*\'cmd% . '|') or die "Cannot open %&*cmd% ($!)" ; { local $\= undef ; _ep_rp(%$x%, <FH>) ; close FH ; }',
+ '_ep_rp(%$x%, HTML::Embperl::Syntax::SSI::exec (%&\'cmd%, %&\'cgi%)) ;',
] } ) ;
$self -> AddComment ('#fsize', ['file', 'virtual'], undef, undef,
{ perlcode => [
- '_ep_rp(%$x%, -s %&*\'file%) ;',
- '_ep_rp(%$x%, -s virt2file (%&*\'virtual%)) ;',
+ '_ep_rp(%$x%, HTML::Embperl::Syntax::SSI::fsize ($_ep_ssi_sizefmt, %&\'file%, %&\'virtual%)) ;',
] } ) ;
$self -> AddComment ('#flastmod', ['file', 'virtual'], undef, undef,
{ perlcode => [
- '_ep_rp(%$x%, -m %&*\'file%) ;',
- '_ep_rp(%$x%, -m virt2file (%&*\'virtual%)) ;',
+ '_ep_rp(%$x%, HTML::Embperl::Syntax::SSI::flastmod ($_ep_ssi_timefmt, %&\'file%, %&\'virtual%)) ;',
] } ) ;
+ $self -> AddComment ('#include', ['file', 'virtual'], undef, undef,
+ { perlcode => [
+ '_ep_rp(%$x%, HTML::Embperl::Syntax::SSI::include (%&\'file%, %&\'virtual%)) ;',
+ ] } ) ;
$self -> AddComment ('#set', ['var', 'value'], undef, undef,
- { perlcode => '$ENV{%&*\'var%} = %&\'value% ;',
+ { perlcode => '$ENV{%&*\'var%} = HTML::Embperl::Syntax::SSI::InterpretVars (%&\'value%) ;',
removenode => 1
} ) ;
}
+
+
+###################################################################################
+#
+# SSI Implementation
+#
+###################################################################################
+
+# ---------------------------------------------------------------------------------
+#
+# Interpolate vars inside string
+#
+# ---------------------------------------------------------------------------------
+
+
+sub InterpretVars
+
+ {
+ my $val = shift ;
+ $val =~ s/\$(\w)([a-zA-Z0-9_]*)/$ENV{"$1$2"}/g ;
+ $val =~ s/\$\{(\w)([a-zA-Z0-9_]*?)\}/$ENV{"$1$2"}/g ;
+ return $val ;
+ }
+
+# ---------------------------------------------------------------------------------
+#
+# Find a file
+#
+# ---------------------------------------------------------------------------------
+
+sub find_file
+ {
+ my ($fn, $virt) = @_;
+ my $req;
+
+ if (!defined (&Apache::request))
+ {
+ return $fn if ($fn) ;
+ die "Cannot use 'virtual' without mod_perl" if ($virt) ;
+ return $ENV{PATH_TRANSLATED} ;
+ }
+
+ if ($fn)
+ {
+ my $req = Apache -> request -> lookup_file (InterpretVars ($fn)) ;
+ return $req -> filename ;
+ }
+ if ($virt)
+ {
+ my $req = Apache -> request -> lookup_uri (InterpretVars ($fn)) ;
+ return $req -> filename ;
+ }
+ else
+ {
+ return Apache -> request -> filename ;
+ }
+ }
+
+
+# ---------------------------------------------------------------------------------
+#
+# Format time
+#
+# ---------------------------------------------------------------------------------
+
+sub time_args
+
+ {
+ # This routine must respect the caller's wantarray() context.
+ my ($time, $zone) = @_;
+ return $zone =~ /GMT/ ? gmtime($time) : localtime($time);
+ }
+
+
+sub format_time
+ {
+ my ($format, $time, $tzone) = @_;
+ return ($format ?
+ POSIX::strftime($format, time_args($time, $tzone)) :
+ scalar time_args($time, $tzone));
+ }
+
+
+
+
+# ---------------------------------------------------------------------------------
+#
+# Output fsize
+#
+# ---------------------------------------------------------------------------------
+
+
+
+sub fsize
+
+ {
+ my ($fmt, $fn, $virt) = @_;
+
+ my $size = -s find_file($fn, $virt) ;
+
+ $fmt ||= 'abbrev' ;
+
+ if ($fmt eq 'bytes')
+ {
+ return $size;
+ }
+ elsif ($fmt eq 'abbrev')
+ {
+ return " 0k" unless $size;
+ return " 1k" if $size < 1024;
+ return sprintf("%4dk", ($size + 512)/1024) if $size < 1048576;
+ return sprintf("%4.1fM", $size/1048576.0) if $size < 103809024;
+ return sprintf("%4dM", ($size + 524288)/1048576);
+ }
+ else
+ {
+ die "Unrecognized size format '$fmt'" ;
+ }
+ }
+
+# ---------------------------------------------------------------------------------
+#
+# Output flastmod
+#
+# ---------------------------------------------------------------------------------
+
+sub flastmod
+ {
+ my($fmt, $fn, $virt) = @_;
+
+ return format_time($fmt, (stat (find_file($fn, $virt)))[9])
+ }
+
+# ---------------------------------------------------------------------------------
+#
+# Include
+#
+# ---------------------------------------------------------------------------------
+
+sub include
+ {
+ my($fn, $virt) = @_;
+
+ my $file = find_file($fn, $virt) ;
+ local $/ = undef ;
+
+ open FH, "<$file" or die "Cannot open $file ($!)" ;
+ my $val = <FH> ;
+ close FH ;
+
+ return $val ;
+ }
+
+
+# ---------------------------------------------------------------------------------
+#
+# Exec
+#
+# ---------------------------------------------------------------------------------
+
+
+sub exec
+ {
+ my($cmd, $cgi) = @_;
+
+
+ if (!defined (&Apache::request))
+ {
+ return scalar `$cmd` if ($cmd) ;
+ die "Cannot use 'cgi' without mod_perl" ;
+ }
+
+
+ my $r = Apache -> request ;
+ my $filename = $r->filename;
+
+
+ die ("httpd: exec used but not allowed in $filename") if ($r->allow_options & OPT_INCNOEXEC) ;
+
+ return scalar `$cmd` if ($cmd) ;
+
+ die ("No 'cmd' or 'cgi' argument given to #exec") if (!$cgi) ;
+
+ die ("'cgi' as argument to #exec not implemented yet") ;
+
+ # Okay, we're doing <!--#exec cgi=...>
+ my $rr = $r->lookup_uri($cgi);
+ die("Error including cgi: subrequest returned status '" . $rr->status . "', not 200") if ($rr->status != 200);
+
+ # Pass through our own path_info and query_string (does this work?)
+ $rr->path_info( $r->path_info );
+ $rr->args( scalar $r->args );
+ $rr->content_type("application/x-httpd-cgi");
+ &_set_VAR($rr, 'DOCUMENT_URI', $r->uri);
+
+ my $status = $rr->run;
+ return '';
+ }
+
+
+1;
+
+__END__
+
+
+=pod
+
+SSI Syntax for Embperl
+
+Ideas and parts of the code are taken from Apache::SSI
+
+
+
+=cut
+
+
+
+# ---------------------------------------------------------------------------------
+#
+# Perl
+#
+# ---------------------------------------------------------------------------------
+
+
+
+sub perl
+ {
+ my($self, $args, $margs) = @_;
+
+ my ($pass_r, @arg1, @arg2, $sub) = (1);
+ {
+ my @a;
+ while (@a = splice(@$margs, 0, 2)) {
+ $a[1] =~ s/\\(.)/$1/gs;
+ if (lc $a[0] eq 'sub') {
+ $sub = $a[1];
+ } elsif (lc $a[0] eq 'arg') {
+ push @arg1, $a[1];
+ } elsif (lc $a[0] eq 'args') {
+ push @arg1, split(/,/, $a[1]);
+ } elsif (lc $a[0] eq 'pass_request') {
+ $pass_r = 0 if lc $a[1] eq 'no';
+ } elsif ($a[0] =~ s/^-//) {
+ push @arg2, @a;
+ } else { # Any unknown get passed as key-value pairs
+ push @arg2, @a;
+ }
+ }
+ }
+
+ warn "sub is $sub, args are @arg1 & @arg2" if $debug;
+ my $subref;
+ if ( $sub =~ /^\s*sub\s/ ) { # for <!--#perl sub="sub {print ++$Access::Cnt }" -->
+ $subref = eval($sub);
+ if ($@) {
+ $self->error("Perl eval of '$sub' failed: $@") if $self->{_r};
+ warn("Perl eval of '$sub' failed: $@") unless $self->{_r}; # For offline mode
+ }
+ return $self->error("sub=\"sub ...\" didn't return a reference") unless ref $subref;
+ } else { # for <!--#perl sub="package::subr" -->
+ no strict('refs');
+ $subref = (defined &{$sub} ? \&{$sub} :
+ defined &{"${sub}::handler"} ? \&{"${sub}::handler"} :
+ \&{"main::$sub"});
+ }
+
+ $pass_r = 0 if $self->{_r} and lc $self->{_r}->dir_config('SSIPerlPass_Request') eq 'no';
+ unshift @arg1, $self->{_r} if $pass_r;
+ warn "sub is $subref, args are @arg1 & @arg2" if $debug;
+ return scalar &{ $subref }(@arg1, @arg2);
+}
+
1 ;
No revision
No revision
1.6.6.1 +2 -0 embperl/test/cmp/plain.htm
Index: plain.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/plain.htm,v
retrieving revision 1.6
retrieving revision 1.6.6.1
diff -u -r1.6 -r1.6.6.1
--- plain.htm 1999/10/05 06:02:18 1.6
+++ plain.htm 2001/03/07 20:43:34 1.6.6.1
@@ -4,6 +4,8 @@
<title>Some Plain tests for Embperl</title>
</head>
+<!-- Here is a comment -->
+
<body>
Here it starts with some HTML Text<P>
No revision
No revision
1.5.6.2 +2 -0 embperl/test/html/plain.htm
Index: plain.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/plain.htm,v
retrieving revision 1.5.6.1
retrieving revision 1.5.6.2
diff -u -r1.5.6.1 -r1.5.6.2
--- plain.htm 2000/12/18 11:39:01 1.5.6.1
+++ plain.htm 2001/03/07 20:43:39 1.5.6.2
@@ -4,6 +4,8 @@
<title>Some Plain tests for Embperl</title>
</head>
+<!-- Here is a comment -->
+
<body>
Here it starts with some HTML Text<P>
No revision
No revision
1.1.2.1 +67 -0 embperl/test/html/SSI/Attic/ssibasic.htm