richter 02/03/11 00:47:27
Modified: . Tag: Embperl2c Changes.pod Embperl.pm README.v2
embperl.h epapinit.c epinit.c epmain.c eputil.c
test.pl
Embperl Tag: Embperl2c App.pm Object.pm
test/conf Tag: Embperl2c httpd.conf.src
test/html/rawinput Tag: Embperl2c include.htm
test/html/registry Tag: Embperl2c Execute.htm
Log:
misc
Revision Changes Path
No revision
No revision
1.129.4.51 +16 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.129.4.50
retrieving revision 1.129.4.51
diff -u -r1.129.4.50 -r1.129.4.51
--- Changes.pod 10 Mar 2002 20:27:17 -0000 1.129.4.50
+++ Changes.pod 11 Mar 2002 08:47:25 -0000 1.129.4.51
@@ -37,7 +37,16 @@
PerlModule Embperl
AddModule embperl.c
+
+ (On Win32 without the AddModule)
+ - The default for input unescaping is now set to off. So people which are
+ working with an text editor should be happy, people who are using any
+ sort of HTML editor should use EMBPERL_INPUT_ESCMODE to set the way
+ Embperl interprets the input.
+ - Added new configuration directives EMBPERL_INPUT_ESCMODE which controls
+ the unescaping of the input. This superseds the old optRawInput and allows
+ a more differentiated control.
- Added form data validation. Embperl is now capable to do server-side
and client-side validation of form input. You just have to define
a set of rules and Embperl generates the correct JavaScript code and
@@ -69,6 +78,13 @@
to configure to pass session inside of the QUERY_STRING
- Embperl doesn't add's a \r\n at the end of textfiles
anymore.
+ - Moved send_error_page and mail_errors into Embperl::App, so they can
+ be overridden by a custom application object.
+ - Added configuration directives EMBPERL_MAIL_ERRORS_LIMIT,
+ EMBPERL_MAIL_ERRORS_RESET_TIME and EMBPERL_MAIL_ERRORS_RESEND_TIME
+ to limit the number of errors send in a small time.
+ - When running under Embperl::Object all sourcefiles including for
+ example xsl stylesheets are now search throught the searchpath.
=head1 2.0b5 (BETA) 27. Nov. 2001
1.118.4.96 +13 -161 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118.4.95
retrieving revision 1.118.4.96
diff -u -r1.118.4.95 -r1.118.4.96
--- Embperl.pm 5 Mar 2002 21:55:23 -0000 1.118.4.95
+++ Embperl.pm 11 Mar 2002 08:47:25 -0000 1.118.4.96
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Embperl.pm,v 1.118.4.95 2002/03/05 21:55:23 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.96 2002/03/11 08:47:25 richter Exp $
#
###################################################################################
@@ -78,18 +78,17 @@
sub Execute
{
- my $rc ;
- my $param = shift ;
+ my $_ep_param = shift ;
local $SIG{__WARN__} = \&Warn ;
- if (!ref $param)
+ if (!ref $_ep_param)
{
- Embperl::Req::ExecuteRequest (undef, { inputfile => $param, param => [@_]})
;
+ Embperl::Req::ExecuteRequest (undef, { inputfile => $_ep_param, param =>
[@_]}) ;
}
else
{
- Embperl::Req::ExecuteRequest (undef, $param) ;
+ Embperl::Req::ExecuteRequest (undef, $_ep_param) ;
}
}
@@ -98,13 +97,10 @@
sub handler
{
- my $rc ;
- my $r = shift ;
-
local $SIG{__WARN__} = \&Warn ;
- $req_rec = $r ;
+ $req_rec = $_[0] ;
- Embperl::Req::ExecuteRequest ($r) ;
+ Embperl::Req::ExecuteRequest ($_[0]) ;
}
#######################################################################################
@@ -143,16 +139,15 @@
sub ExecuteComponent
{
- my $rc ;
- my $param = shift ;
+ my $_ep_param = shift ;
- if (!ref $param)
+ if (!ref $_ep_param)
{
- $Embperl::req -> execute_component ({ inputfile => $param, param => [@_]}) ;
+ $Embperl::req -> execute_component ({ inputfile => $_ep_param, param =>
[@_]}) ;
}
- elsif ($param -> {object})
+ elsif ($_ep_param -> {object})
{
- my $c = $Embperl::req -> setup_component ($param) ;
+ my $c = $Embperl::req -> setup_component ($_ep_param) ;
my $rc = $c -> run ;
my $package = $c -> curr_package ;
$c -> cleanup ;
@@ -166,7 +161,7 @@
}
else
{
- $Embperl::req -> execute_component ($param) ;
+ $Embperl::req -> execute_component ($_ep_param) ;
}
}
@@ -210,149 +205,6 @@
}
}
}
-
-#######################################################################################
-
-
-sub SendErrorDoc ()
-
- {
- my ($self) = @_ ;
- local $SIG{__WARN__} = 'Default' ;
-
- my $virtlog = '' ; # $self -> VirtLogURI || '' ;
- my $logfilepos = $self -> log_file_start_pos ;
- my $url = '' ; # $Embperl::dbgLogLink?"<A
HREF=\"$virtlog\?$logfilepos\&$$\">Logfile</A>":'' ;
- my $req_rec = $self -> apache_req ;
- my $err ;
- my $cnt = 0 ;
- local $Embperl::escmode = 0 ;
- my $time = localtime ;
- my $mail = $req_rec -> server -> server_admin if (defined ($req_rec)) ;
- $mail ||= '' ;
-
- $req_rec -> content_type('text/html') if (defined ($req_rec)) ;
-
- $self -> output ("<HTML><HEAD><TITLE>Embperl Error</TITLE></HEAD><BODY
bgcolor=\"#FFFFFF\">\r\n$url") ;
- $self -> output ("<H1>Internal Server Error</H1>\r\n") ;
- $self -> output ("The server encountered an internal error or misconfiguration
and was unable to complete your request.<P>\r\n") ;
- $self -> output ("Please contact the server administrator, $mail and inform
them of the time the error occurred, and anything you might have done that may have
caused the error.<P><P>\r\n") ;
-
- my $errors = $self -> errors ;
- if ($virtlog ne '' && $Embperl::dbgLogLink)
- {
- foreach $err (@$errors)
- {
- $self -> output ("<A HREF=\"$virtlog?$logfilepos&$$#E$cnt\">") ;
#<tt>") ;
- $Embperl::escmode = 3 ;
- $err =~ s|\\|\\\\|g;
- $err =~ s|\n|\n\\<br\\>\\ \\ \\ \\ |g;
- $err =~ s|(Line [0-9]*:)|$1\\</a\\>|;
- $self -> output ($err) ;
- $Embperl::escmode = 0 ;
- $self -> output ("<p>\r\n") ;
- #$self -> output ("</tt><p>\r\n") ;
- $cnt++ ;
- }
- }
- else
- {
- $Embperl::escmode = 3 ;
- foreach $err (@$errors)
- {
- $err =~ s|\\|\\\\|g;
- $err =~ s|\n|\n\\<br\\>\\ \\ \\ \\ |g;
- $self -> output ("$err\\<p\\>\r\n") ;
- #$self -> output ("\\<tt\\>$err\\</tt\\>\\<p\\>\r\n") ;
- $cnt++ ;
- }
- $Embperl::escmode = 0 ;
- }
-
- my $server = $ENV{SERVER_SOFTWARE} || 'Offline' ;
-
- $self -> output ("$server Embperl $Embperl::VERSION [$time]<P>\r\n") ;
- $self -> output ("</BODY></HTML>\r\n\r\n") ;
-
- }
-
-#######################################################################################
-
-sub MailErrorsTo ()
-
- {
- my ($self) = @_ ;
- local $SIG{__WARN__} = 'Default' ;
-
- my $to = $ENV{'EMBPERL_MAIL_ERRORS_TO'} ;
- return undef if (!$to) ;
-
- $self -> log ("[$$]ERR: Mail errors to $to\n") ;
-
- my $time = localtime ;
-
- #eval 'require Net::SMTP' ;
- #die "require Net::SMTP failed: $@" if ($@);
- require Net::SMTP ;
-
- my $smtp = Net::SMTP->new($ENV{'EMBPERL_MAILHOST'} || 'localhost', Debug =>
$ENV{'EMBPERL_MAILDEBUG'}) or die "Cannot connect to mailhost" ;
- $smtp->mail("Embperl\@$ENV{SERVER_NAME}");
- $smtp->to($to);
- my $ok = $smtp->data();
- $ok and $ok = $smtp->datasend("To: $to\r\n");
- $ok and $ok = $smtp->datasend("Subject: ERROR in Embperl page $ENV{SCRIPT_NAME}
on $ENV{HTTP_HOST}\r\n");
- $ok and $ok = $smtp->datasend("\r\n");
-
- $ok and $ok = $smtp->datasend("ERROR in Embperl page
$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}\r\n");
- $ok and $ok = $smtp->datasend("\r\n");
-
- $ok and $ok = $smtp->datasend("-------\r\n");
- $ok and $ok = $smtp->datasend("Errors:\r\n");
- $ok and $ok = $smtp->datasend("-------\r\n");
- my $errors = $self -> ErrArray() ;
- my $err ;
-
- foreach $err (@$errors)
- {
- $ok and $ok = $smtp->datasend("$err\r\n");
- }
-
- $ok and $ok = $smtp->datasend("-----------\r\n");
- $ok and $ok = $smtp->datasend("Formfields:\r\n");
- $ok and $ok = $smtp->datasend("-----------\r\n");
-
- my $ffld = $self -> FormArray() ;
- my $fdat = $self -> FormHash() ;
- my $k ;
- my $v ;
-
- foreach $k (@$ffld)
- {
- $v = $fdat->{$k} ;
- $ok and $ok = $smtp->datasend("$k\t= \"$v\" \n" );
- }
- $ok and $ok = $smtp->datasend("-------------\r\n");
- $ok and $ok = $smtp->datasend("Environment:\r\n");
- $ok and $ok = $smtp->datasend("-------------\r\n");
-
- my $env = $self -> EnvHash() ;
-
- foreach $k (sort keys %$env)
- {
- $v = $env -> {$k} ;
- $ok and $ok = $smtp->datasend("$k\t= \"$v\" \n" );
- }
-
- my $server = $ENV{SERVER_SOFTWARE} || 'Offline' ;
-
- $ok and $ok = $smtp->datasend("-------------\r\n");
- $ok and $ok = $smtp->datasend("$server Embperl $Embperl::VERSION [$time]\r\n") ;
-
- $ok and $ok = $smtp->dataend() ;
- $smtp->quit;
-
- return $ok ;
- }
1.1.4.26 +46 -4 embperl/Attic/README.v2
Index: README.v2
===================================================================
RCS file: /home/cvs/embperl/Attic/README.v2,v
retrieving revision 1.1.4.25
retrieving revision 1.1.4.26
diff -u -r1.1.4.25 -r1.1.4.26
--- README.v2 10 Mar 2002 20:27:17 -0000 1.1.4.25
+++ README.v2 11 Mar 2002 08:47:25 -0000 1.1.4.26
@@ -9,7 +9,7 @@
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-$Id: README.v2,v 1.1.4.25 2002/03/10 20:27:17 richter Exp $
+$Id: README.v2,v 1.1.4.26 2002/03/11 08:47:25 richter Exp $
### !! IMPORTANT !! IMPORTANT !! IMPORTANT !! IMPORTANT !! IMPORTANT !!
@@ -135,19 +135,25 @@
------------------------------------------------------
- When running under mod_perl the following lines are
- now required to laod Embperl:
+ now required to load Embperl:
PerlModule Embperl
AddModule embperl.c
+ On Windows you only need to load the Embperl module,
+ but don't have to write the AddModule.
You can use the Embperl configuration directives now
- directly, (which out PerlSetEnv/SetEnv). If you still
+ directly, (wihtout PerlSetEnv/SetEnv). If you still
want to use enviroment varibales to configure EMbperl, write
Embperl_UseEnv on
- The following options can currently only be set from httpd.conf:
- optRawInput, optKeepSpaces
+ optKeepSpaces
+
+- The option optRawInput is replaced by EMBPERL_INPUT_ESCMODE,
+ which is off by default (same as when optRawInput was set
+ in 1.x)
- The following options are currently not supported:
optDisableHtmlScan, optDisableTableScan,
@@ -299,6 +305,42 @@
[$ syntax SSI $]
now you can only use SSI commands inside your page.
+
+EMBPERL_INPUT_ESCMODE
+---------------------
+
+0 don't interpret input (default)
+1 unescape html escapes to their characters (i.e. < becomes < )
+ inside of Perl code
+2 unescape url escapes to their characters (i.e. %26; becomes & )
+ inside of Perl code
+3 unescape html and url escapes, depending on the context
+
+Add 4 to remove html tags inside of Perl code. This is help full when
+an html editor insert html tags like <br> inside your Perl code.
+
+Set EMBPERL_INPUT_ESCMODE to 7 to get the old default of Embperl < 2.0b6
+Set EMBPERL_INPUT_ESCMODE to 0 to get the old behaviour when optRawInput was set.
+This is the current default.
+
+Error mailing
+-------------
+
+EMBPERL_MAIL_ERRORS_TO <email>
+ email address to mail any error to
+
+EMBPERL_MAIL_ERRORS_LIMIT <num>
+ do not mail more then <num> errors. Set to 0 for no limit.
+
+EMBPERL_MAIL_ERRORS_RESET_TIME <sec>
+ reset error counter if for <sec> seconds no error has occured
+
+EMBPERL_MAIL_ERRORS_RESEND_TIME <sec>
+ mail errors of <sec> seconds regardless of the error counter
+
+All error counting is done per child, so if you run a large site and
+have 100 childs, you may get 100 * EMBPERL_MAIL_ERRORS_LIMIT mail
+before they are limited.
Session handling
1.19.4.26 +23 -13 embperl/embperl.h
Index: embperl.h
===================================================================
RCS file: /home/cvs/embperl/embperl.h,v
retrieving revision 1.19.4.25
retrieving revision 1.19.4.26
diff -u -r1.19.4.25 -r1.19.4.26
--- embperl.h 10 Mar 2002 20:27:17 -0000 1.19.4.25
+++ embperl.h 11 Mar 2002 08:47:25 -0000 1.19.4.26
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: embperl.h,v 1.19.4.25 2002/03/10 20:27:17 richter Exp $
+# $Id: embperl.h,v 1.19.4.26 2002/03/11 08:47:25 richter Exp $
#
###################################################################################*/
@@ -90,8 +90,8 @@
rcCannotCheckUri,
rcSetupSessionErr,
rcRefcntNotOne,
- rcForbidden = 401,
- rcNotFound = 404,
+ rcForbidden = 403,
+ rcNotFound = 404,
rcDecline = -1
} ;
@@ -170,23 +170,31 @@
optShowBacktrace = 0x8000000
} ;
+/* --- output escaping --- */
-/*
- Escape modes
-*/
+enum tEscMode
+ {
+ escNone = 0,
+ escHtml = 1,
+ escUrl = 2,
+ escStd = 3,
+ escEscape = 4,
+ escXML = 8
+ } ;
+/* --- input escaping --- */
-enum tEscMode
+enum tInputEscMode
{
- escNone = 0,
- escHtml = 1,
- escUrl = 2,
- escStd = 3,
- escEscape = 4,
- escXML = 8
+ iescNone = 0,
+ iescHtml = 1,
+ iescUrl = 2,
+ iescRemoveTags = 4,
} ;
+/* --- session handling --- */
+
enum tSessionMode
{
smodeNone = 0,
@@ -198,6 +206,8 @@
} ;
#define smodeStd smodeUDatCookie
+
+/* --- misc --- */
#if !defined (pid_t) && defined (WIN32)
#define pid_t int
1.1.2.28 +18 -7 embperl/epapinit.c
Index: epapinit.c
===================================================================
RCS file: /home/cvs/embperl/epapinit.c,v
retrieving revision 1.1.2.27
retrieving revision 1.1.2.28
diff -u -r1.1.2.27 -r1.1.2.28
--- epapinit.c 10 Mar 2002 20:27:17 -0000 1.1.2.27
+++ epapinit.c 11 Mar 2002 08:47:26 -0000 1.1.2.28
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epapinit.c,v 1.1.2.27 2002/03/10 20:27:17 richter Exp $
+# $Id: epapinit.c,v 1.1.2.28 2002/03/11 08:47:26 richter Exp $
#
###################################################################################*/
@@ -129,8 +129,6 @@
void embperl_ApacheAddModule ()
{
- dTHX ;
- fprintf ((FILE *)stderr, "add module\n") ;
if (!ap_find_linked_module("embperl.c"))
{
embperl_module.name = "embperl.c" ;
@@ -151,7 +149,6 @@
pool * subpool = ap_make_sub_pool(p);
dTHX ;
- fprintf (stderr, "init module\n") ;
ap_register_cleanup(subpool, NULL, embperl_ApacheInitCleanup,
embperl_ApacheInitCleanup);
ap_add_version_component ("Embperl/"VERSION) ;
@@ -164,8 +161,6 @@
static void embperl_ApacheInitCleanup (void * p)
{
- dTHX ;
- fprintf ((FILE *)stderr, "cleanup module\n") ;
/* make sure embperl module is removed before mod_perl */
ap_remove_module (&embperl_module) ;
}
@@ -379,7 +374,12 @@
memcpy (&pConfig -> pPool + 1, &pDirCfg -> AppConfig.pPool + 1, sizeof
(*pConfig) - ((tUInt8 *)(&pConfig -> pPool) - (tUInt8 *)pConfig) - sizeof (pConfig ->
pPool)) ;
pConfig -> bDebug = pDirCfg -> ComponentConfig.bDebug ;
-
+ if (pConfig -> pSessionArgs)
+ SvREFCNT_inc(pConfig -> pSessionArgs);
+ if (pConfig -> pSessionClasses)
+ SvREFCNT_inc(pConfig -> pSessionClasses);
+ if (pConfig -> pObjectAddpathAV)
+ SvREFCNT_inc(pConfig -> pObjectAddpathAV);
if (pDirCfg -> bUseEnv)
embperl_GetCGIAppConfig (pThread, pPool, pConfig, 1, 0, 0) ;
@@ -413,6 +413,10 @@
memcpy (&pConfig -> pPool + 1, &pDirCfg -> ReqConfig.pPool + 1, sizeof
(*pConfig) - ((tUInt8 *)(&pConfig -> pPool) - (tUInt8 *)pConfig) - sizeof (pConfig ->
pPool)) ;
pConfig -> bDebug = pDirCfg -> ComponentConfig.bDebug ;
pConfig -> bOptions = pDirCfg -> ComponentConfig.bOptions ;
+ if (pConfig -> pAllow)
+ SvREFCNT_inc(pConfig -> pAllow);
+ if (pConfig -> pPathAV)
+ SvREFCNT_inc(pConfig -> pPathAV);
if (pDirCfg -> bUseEnv)
embperl_GetCGIReqConfig (pApp, pPool, pConfig, 1, 0, 0) ;
@@ -446,6 +450,13 @@
#include "epcfg.h"
memcpy (&pConfig -> pPool + 1, &pDirCfg -> ComponentConfig.pPool + 1,
sizeof (*pConfig) - ((tUInt8 *)(&pConfig -> pPool) - (tUInt8 *)pConfig) - sizeof
(pConfig -> pPool)) ;
+ if (pConfig -> pExpiredFunc)
+ SvREFCNT_inc(pConfig -> pExpiredFunc);
+ if (pConfig -> pCacheKeyFunc)
+ SvREFCNT_inc(pConfig -> pCacheKeyFunc);
+ if (pConfig -> pRecipe)
+ SvREFCNT_inc(pConfig -> pRecipe);
+
if (pDirCfg -> bUseEnv)
embperl_GetCGIComponentConfig (pReq, pPool, pConfig, 1, 0, 0) ;
}
1.1.2.39 +18 -15 embperl/Attic/epinit.c
Index: epinit.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epinit.c,v
retrieving revision 1.1.2.38
retrieving revision 1.1.2.39
diff -u -r1.1.2.38 -r1.1.2.39
--- epinit.c 10 Mar 2002 20:27:17 -0000 1.1.2.38
+++ epinit.c 11 Mar 2002 08:47:26 -0000 1.1.2.39
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epinit.c,v 1.1.2.38 2002/03/10 20:27:17 richter Exp $
+# $Id: epinit.c,v 1.1.2.39 2002/03/11 08:47:26 richter Exp $
#
###################################################################################*/
@@ -210,6 +210,8 @@
pCfg -> sLog = "/tmp/embperl.log" ;
#endif
pCfg -> bDebug = dbgStd ;
+ pCfg -> nMailErrorsResetTime = 60 ;
+ pCfg -> nMailErrorsResendTime = 60 * 15 ;
}
@@ -1259,7 +1261,7 @@
pApacheReq = r -> pApacheReq = (request_rec *)SvIV((SV*)SvRV(pApacheReqSV));
else
pApacheReq = r -> pApacheReq = NULL ;
- r -> pApacheReqSV = pApacheReqSV ;
+ r -> pApacheReqSV = SvREFCNT_inc(pApacheReqSV) ;
if (pApacheReq)
{
embperl_GetApacheReqConfig (pApp, pPool, pApacheCfg, &r -> Config) ;
@@ -1402,10 +1404,10 @@
CloseOutput (r, pOutput) ;
- if (SvREFCNT(pOutput -> _perlsv) != 1)
+ if (SvREFCNT(SvRV(pOutput -> _perlsv)) != 1)
{
char buf[20] ;
- sprintf (buf, "%d", SvREFCNT(pOutput -> _perlsv)) ;
+ sprintf (buf, "%d", SvREFCNT(SvRV(pOutput -> _perlsv)) - 1) ;
LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.component.output") ;
}
SvREFCNT_dec (pOutput -> _perlsv) ;
@@ -1463,22 +1465,22 @@
embperl_CleanupOutput (r, c) ;
- if (SvREFCNT(c -> Config._perlsv) != 1)
+ if (SvREFCNT(SvRV(c -> Config._perlsv)) != 1)
{
char buf[20] ;
- sprintf (buf, "%d", SvREFCNT(c -> Config._perlsv)) ;
+ sprintf (buf, "%d", SvREFCNT(SvRV(c -> Config._perlsv)) - 1) ;
LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.component.config") ;
}
- if (SvREFCNT(c -> Param._perlsv) != 1)
+ if (SvREFCNT(SvRV(c -> Param._perlsv)) != 1)
{
char buf[20] ;
- sprintf (buf, "%d", SvREFCNT(c -> Param._perlsv)) ;
+ sprintf (buf, "%d", SvREFCNT(SvRV(c -> Param._perlsv)) - 1) ;
LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.component.param") ;
}
if (SvREFCNT(c -> _perlsv) != 1)
{
char buf[20] ;
- sprintf (buf, "%d", SvREFCNT(c -> _perlsv)) ;
+ sprintf (buf, "%d", SvREFCNT(SvRV(c -> _perlsv)) - 1) ;
LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.component") ;
}
SvREFCNT_dec (c -> Config._perlsv) ;
@@ -1581,22 +1583,22 @@
Cache_CleanupRequest (r) ;
- if (SvREFCNT(r -> Config._perlsv) != 1)
+ if (SvREFCNT(SvRV(r -> Config._perlsv)) != 1)
{
char buf[20] ;
- sprintf (buf, "%d", SvREFCNT(r -> Config._perlsv)) ;
+ sprintf (buf, "%d", SvREFCNT(SvRV(r -> Config._perlsv)) - 1) ;
LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.config") ;
}
- if (SvREFCNT(r -> Param._perlsv) != 1)
+ if (SvREFCNT(SvRV(r -> Param._perlsv)) != 1)
{
char buf[20] ;
- sprintf (buf, "%d", SvREFCNT(r -> Param._perlsv)) ;
+ sprintf (buf, "%d", SvREFCNT(SvRV(r -> Param._perlsv)) - 1) ;
LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.param") ;
}
- if (SvREFCNT(r -> _perlsv) != 1)
+ if (SvREFCNT(SvRV(r -> _perlsv)) != 1)
{
char buf[20] ;
- sprintf (buf, "%d", SvREFCNT(r -> _perlsv)) ;
+ sprintf (buf, "%d", SvREFCNT(SvRV(r -> _perlsv)) - 1) ;
LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request") ;
}
SvREFCNT_dec (r -> Config._perlsv) ;
@@ -1655,6 +1657,7 @@
pCfg -> nEscMode = escStd ;
pCfg -> bCacheKeyOptions = ckoptDefault ;
pCfg -> sSyntax = "Embperl" ;
+ pCfg -> sInputCharset = "iso-8859-1" ;
#ifdef LIBXSLT
pCfg -> sXsltproc = "libxslt" ;
#else
1.75.4.111 +24 -8 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.75.4.110
retrieving revision 1.75.4.111
diff -u -r1.75.4.110 -r1.75.4.111
--- epmain.c 10 Mar 2002 20:27:17 -0000 1.75.4.110
+++ epmain.c 11 Mar 2002 08:47:26 -0000 1.75.4.111
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epmain.c,v 1.75.4.110 2002/03/10 20:27:17 richter Exp $
+# $Id: epmain.c,v 1.75.4.111 2002/03/11 08:47:26 richter Exp $
#
###################################################################################*/
@@ -749,10 +749,25 @@
if (r -> pApp -> Config.sMailErrorsTo)
{
/* --- check if error should be mailed --- */
- PUSHMARK(sp); /* remember the stack pointer */
- XPUSHs(r -> _perlsv) ; /* push pointer to obeject */
- PUTBACK;
- perl_call_method ("MailErrorsTo", G_DISCARD) ; /* call the function
*/
+ tApp * a = r -> pApp ;
+ time_t nTime = time(NULL) ;
+
+ if (a -> nErrorsLastTime < nTime - a -> Config.nMailErrorsResetTime)
+ a -> nErrorsCount = 0 ;
+ else if (a -> nErrorsLastSendTime < nTime - a ->
Config.nMailErrorsResendTime)
+ a -> nErrorsCount = 0 ;
+ a -> nErrorsLastTime = nTime ;
+ if (a -> Config.nMailErrorsLimit == 0 || a -> nErrorsCount < a ->
Config.nMailErrorsLimit)
+ {
+ a -> nErrorsCount++ ;
+ a -> nErrorsLastSendTime = nTime ;
+
+ PUSHMARK(sp);
+ XPUSHs(r -> pApp -> _perlsv) ;
+ XPUSHs(r -> _perlsv) ;
+ PUTBACK;
+ perl_call_method ("mail_errors", G_DISCARD) ;
+ }
}
if (r -> Component.Config.bOptions & optReturnError)
@@ -770,10 +785,11 @@
oRollbackOutput (r, NULL) ; /* forget everything outputed so far */
oBegin (r) ;
- PUSHMARK(sp); /* remember the stack pointer */
- XPUSHs(r -> _perlsv) ; /* push pointer to obeject */
+ PUSHMARK(sp);
+ XPUSHs(r -> pApp -> _perlsv) ;
+ XPUSHs(r -> _perlsv) ;
PUTBACK;
- perl_call_method ("SendErrorDoc", G_DISCARD) ; /* call the function
*/
+ perl_call_method ("send_error_page", G_DISCARD) ;
#ifdef APACHE
if (r -> pApacheReq)
r -> pApacheReq -> status = 500 ;
1.15.4.49 +15 -9 embperl/eputil.c
Index: eputil.c
===================================================================
RCS file: /home/cvs/embperl/eputil.c,v
retrieving revision 1.15.4.48
retrieving revision 1.15.4.49
diff -u -r1.15.4.48 -r1.15.4.49
--- eputil.c 27 Feb 2002 11:58:24 -0000 1.15.4.48
+++ eputil.c 11 Mar 2002 08:47:26 -0000 1.15.4.49
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: eputil.c,v 1.15.4.48 2002/02/27 11:58:24 richter Exp $
+# $Id: eputil.c,v 1.15.4.49 2002/03/11 08:47:26 richter Exp $
#
###################################################################################*/
@@ -375,11 +375,17 @@
char * s ;
char * e ;
struct tCharTrans * pChar ;
- int bInUrl = r -> Component.bEscInUrl ;
+ bool bInUrl = r -> Component.bEscInUrl ;
+ bool bUrlEsc = r -> Component.Config.nInputEscMode & iescUrl ;
+ bool bHtmlEsc = r -> Component.Config.nInputEscMode & iescHtml ;
+ bool bRemove = r -> Component.Config.nInputEscMode & iescRemoveTags ;
+
+ if (bUrlEsc && bHtmlEsc && !bInUrl)
+ bUrlEsc = 0 ;
EPENTRY (TransHtml) ;
- if (r -> Component.Config.bOptions & optRawInput)
+ if (r -> Component.Config.nInputEscMode == iescNone)
{
#if PERL_VERSION < 5
/* Just remove CR for raw input for perl 5.004 */
@@ -423,7 +429,7 @@
if (*p == '\\')
{
- if (p[1] == '<')
+ if (bRemove && p[1] == '<')
{ /* Quote next HTML tag */
memmove (p, p + 1, e - p - 1) ;
e[-1] = ' ' ;
@@ -431,7 +437,7 @@
while (p < e && *p != '>')
p++ ;
}
- else if (p[1] == '&')
+ else if (bHtmlEsc && p[1] == '&')
{ /* Quote next HTML char */
memmove (p, p + 1, e - p - 1) ;
e[-1] = ' ' ;
@@ -439,7 +445,7 @@
while (p < e && *p != ';')
p++ ;
}
- else if (bInUrl && p[1] == '%')
+ else if (bUrlEsc && p[1] == '%')
{ /* Quote next URL escape */
memmove (p, p + 1, e - p - 1) ;
e[-1] = ' ' ;
@@ -457,7 +463,7 @@
#endif
else
{
- if (p[0] == '<' && (isalpha (p[1]) || p[1] == '/'))
+ if (bRemove && p[0] == '<' && (isalpha (p[1]) || p[1] == '/'))
{ /* count HTML tag length */
s = p ;
p++ ;
@@ -471,7 +477,7 @@
s = NULL ;
}
}
- else if (p[0] == '&')
+ else if (bHtmlEsc && p[0] == '&')
{ /* count HTML char length */
s = p ;
p++ ;
@@ -498,7 +504,7 @@
s = NULL ;
}
}
- else if (bInUrl && p[0] == '%' && isdigit (p[1]) && isxdigit (p[2]))
+ else if (bUrlEsc && p[0] == '%' && isdigit (p[1]) && isxdigit (p[2]))
{
s = p ;
1.70.4.126 +12 -2 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.125
retrieving revision 1.70.4.126
diff -u -r1.70.4.125 -r1.70.4.126
--- test.pl 10 Mar 2002 20:27:18 -0000 1.70.4.125
+++ test.pl 11 Mar 2002 08:47:26 -0000 1.70.4.126
@@ -11,7 +11,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: test.pl,v 1.70.4.125 2002/03/10 20:27:18 richter Exp $
+# $Id: test.pl,v 1.70.4.126 2002/03/11 08:47:26 richter Exp $
#
###################################################################################
@@ -40,6 +40,7 @@
# syntax =>
# msg =>
# app_handler_class =>
+# input_escmode =>
@testdata = (
'ascii' => { },
@@ -120,6 +121,7 @@
'rawinput/rawinput.htm' => {
'option' => '16',
'cgi' => 0,
+ 'input_escmode' => 0,
},
'var.htm' => { },
'varerr.htm' => {
@@ -261,6 +263,7 @@
'version' => 2,
'cgi' => 0,
'repeat' => 2,
+ 'input_escmode' => 0,
},
'execnotfound.htm' => {
'errors' => '1',
@@ -1781,6 +1784,7 @@
$ENV{EMBPERL_APP_HANDLER_CLASS} = $test -> {'app_handler_class'}
if (defined ($test -> {'app_handler_class'})) ;
delete $ENV{EMBPERL_APPNAME} if (defined (delete
$ENV{EMBPERL_APPNAME})) ;
$ENV{EMBPERL_APPNAME} = $test -> {'app_handler_class'} if (defined
($test -> {'app_handler_class'})) ;
+ $ENV{EMBPERL_INPUT_ESCMODE} = defined ($test ->
{'input_escmode'})?$test -> {'input_escmode'}:7 ;
@testargs = ( '-o', $outfile ,
'-l', $logfile,
'-d', $debug,
@@ -1882,7 +1886,8 @@
'mtime' => 1,
'outputfile' => $outfile,
'debug' => $defaultdebug,
- }) ;
+ input_escmode => 7,
+ }) ;
$t_exec += 0 ; # Embperl::Clock () - $t1 ;
@@ -1903,6 +1908,7 @@
'mtime' => 1,
'outputfile' => $outfile,
'debug' => $defaultdebug,
+ input_escmode => 7,
}) ;
$t_exec += 0 ; # Embperl::Clock () - $t1 ;
@@ -1925,6 +1931,7 @@
'mtime' => 1,
'output' => \$outdata,
'debug' => $defaultdebug,
+ input_escmode => 7,
}) ;
$t_exec += 0 ; # Embperl::Clock () - $t1 ;
@@ -1952,6 +1959,7 @@
$err = Embperl::Execute ({'inputfile' => $src,
'mtime' => 1,
'debug' => $defaultdebug,
+ input_escmode => 7,
}) ;
$t_exec += 0 ; # Embperl::Clock () - $t1 ;
untie *STDOUT ;
@@ -1980,6 +1988,7 @@
'output' => \$outdata,
'errors' => \@errors,
'debug' => $defaultdebug,
+ input_escmode => 7,
}) ;
$t_exec += 0 ; # Embperl::Clock () - $t1 ;
@@ -2024,6 +2033,7 @@
'output' => \$outdata,
'debug' => $defaultdebug,
'errors' => \@errors,
+ input_escmode => 7,
}) ;
$t_exec += 0 ; # Embperl::Clock () - $t1 ;
No revision
No revision
1.1.2.2 +144 -333 embperl/Embperl/Attic/App.pm
Index: App.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/App.pm,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- App.pm 25 Feb 2002 11:37:58 -0000 1.1.2.1
+++ App.pm 11 Mar 2002 08:47:27 -0000 1.1.2.2
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: App.pm,v 1.1.2.1 2002/02/25 11:37:58 richter Exp $
+# $Id: App.pm,v 1.1.2.2 2002/03/11 08:47:27 richter Exp $
#
###################################################################################
@@ -64,363 +64,174 @@
}
+# ---------------------------------------------------------------------------------
+#
+# send error page
+#
+# ---------------------------------------------------------------------------------
-1;
-
-
-__END__
-
-
-=pod
-
-=head1 NAME
-
-Embperl base class for defining custom recipes
-
-=head1 SYNOPSIS
-
-PerlSetEnv EMBPERL_RECIPE "XSLT Embperl"
-
-=head1 DESCRIPTION
-
-Embperl::Recipe provides basic features that are necessary for createing
-your own recipes.
-To do so you have to create a class that provides a C<new> method which returns
-a hash that contains the description what to do.
-
-=head2 new ($class, $r, $recipe)
-
-=over 4
-
-=item $class
-
-The class name
-
-=item $r
-
-The Embperl request record object (Embperl::Req), maybe a derived
-object when running under EmbperlObject.
-
-=item $recipe
-
-The name of the recipe
-
-=back
-
-The function must return a hash that describes the desired action.
-The hash contains a tree structure of providers.
-
-=head2 Providers
-
-=over 4
-
-
-=item file
-
-read file data
-
-Parameter:
-
-=over 4
-
-=item filename
-
-Gives the file to read
-
-=back
-
-
-=item memory
-
-get data from a scalar
-
-Parameter:
-
-=over 4
-
-=item source
-
-Gives the source as a scalar reference
-
-=item name
-
-Gives the name under which this item should be cache
-
-=back
-
-
-=item epparse
-
-parse file into a Embperl tree structure
-
-Parameter:
-
-=over 4
-
-=item source
-
-Gives the source
-
-=item syntax
-
-Syntax to use
-
-=back
-
-
-=item epcompile
-
-compile Embperl tree structure
-
-Parameter:
-
-=over 4
-
-=item source
-
-Gives the source
-
-=back
-
-
-=item eprun
-
-execute Embperl tree structure
-
-Parameter:
-
-=over 4
-
-=item source
-
-Gives the source
-
-=item cache_key
-
-See description of cacheing
-
-=item cache_key_options
-
-See description of cacheing
-
-=item cache_key_func
-
-See description of cacheing
-
-=back
-
-
-=item eptostring
-
-convert Embperl tree structure to string
-
-Parameter:
-
-=over 4
-
-=item source
-
-Gives the source
-
-=back
-
-
-=item libxslt-parse-xml
-
-parse xml source for libxslt
-
-Parameter:
-
-=over 4
-
-=item source
-
-Gives the xml source
-
-=back
-
-
-=item libxslt-compile-xsl
-
-parse and compile stylesheet for libxslt
-
-Parameter:
-
-=over 4
-
-=item stylesheet
-
-Gives the stylesheet source
-
-=back
-
-
-=item libxslt
-
-do a xsl transformation via libxslt
-
-Parameter:
-
-=over 4
-
-=item source
-
-Gives the parsed xml source
-
-=item stylesheet
-
-Gives the compiled stylesheet source
-
-=item param
-
-Gives the parameters as hash ref
-
-=back
-
-
-=item xalan-parse-xml
-
-parse xml source for xalan
-
-Parameter:
-
-=over 4
-
-=item source
-
-Gives the xml source
-
-=back
-
-
-
-=item xalan-compile-xsl
-
-parse and compile stylesheet for xalan
-
-Parameter:
-
-=over 4
-
-=item stylesheet
-
-Gives the stylesheet source
-
-=back
-
-
-=item xalan
-
-do a xsl transformation via xalan
-
-Parameter:
-
-=over 4
-
-=item source
-
-Gives the parsed xml source
+sub send_error_page
-=item stylesheet
+ {
+ my ($self, $r) = @_ ;
-Gives the compiled stylesheet source
+ local $SIG{__WARN__} = 'Default' ;
+
+ my $virtlog = '' ; # $r -> VirtLogURI || '' ;
+ my $logfilepos = $r -> log_file_start_pos ;
+ my $url = '' ; # $Embperl::dbgLogLink?"<A
HREF=\"$virtlog\?$logfilepos\&$$\">Logfile</A>":'' ;
+ my $req_rec = $r -> apache_req ;
+ my $err ;
+ my $cnt = 0 ;
+ local $Embperl::escmode = 0 ;
+ my $time = localtime ;
+ my $mail = $req_rec -> server -> server_admin if (defined ($req_rec)) ;
+ $mail ||= '' ;
+
+ $req_rec -> content_type('text/html') if (defined ($req_rec)) ;
+
+ $r -> output ("<HTML><HEAD><TITLE>Embperl Error</TITLE></HEAD><BODY
bgcolor=\"#FFFFFF\">\r\n$url") ;
+ $r -> output ("<H1>Internal Server Error</H1>\r\n") ;
+ $r -> output ("The server encountered an internal error or misconfiguration and
was unable to complete your request.<P>\r\n") ;
+ $r -> output ("Please contact the server administrator, $mail and inform them
of the time the error occurred, and anything you might have done that may have caused
the error.<P><P>\r\n") ;
-=item param
+ my $errors = $r -> errors ;
+ if ($virtlog ne '' && $Embperl::dbgLogLink)
+ {
+ foreach $err (@$errors)
+ {
+ $r -> output ("<A HREF=\"$virtlog?$logfilepos&$$#E$cnt\">") ; #<tt>") ;
+ $Embperl::escmode = 3 ;
+ $err =~ s|\\|\\\\|g;
+ $err =~ s|\n|\n\\<br\\>\\ \\ \\ \\ |g;
+ $err =~ s|(Line [0-9]*:)|$1\\</a\\>|;
+ $r -> output ($err) ;
+ $Embperl::escmode = 0 ;
+ $r -> output ("<p>\r\n") ;
+ #$r -> output ("</tt><p>\r\n") ;
+ $cnt++ ;
+ }
+ }
+ else
+ {
+ $Embperl::escmode = 3 ;
+ foreach $err (@$errors)
+ {
+ $err =~ s|\\|\\\\|g;
+ $err =~ s|\n|\n\\<br\\>\\ \\ \\ \\ |g;
+ $r -> output ("$err\\<p\\>\r\n") ;
+ #$r -> output ("\\<tt\\>$err\\</tt\\>\\<p\\>\r\n") ;
+ $cnt++ ;
+ }
+ $Embperl::escmode = 0 ;
+ }
+
+ my $server = $ENV{SERVER_SOFTWARE} || 'Offline' ;
-Gives the parameters as hash ref
+ $r -> output ("$server Embperl $Embperl::VERSION [$time]<P>\r\n") ;
+ $r -> output ("</BODY></HTML>\r\n\r\n") ;
+ }
-=back
+# ---------------------------------------------------------------------------------
+#
+# mail errors
+#
+# ---------------------------------------------------------------------------------
-=back
+sub mail_errors
-=head2 Cache parameter
+ {
+ my ($self, $r) = @_ ;
-=over 4
+ local $SIG{__WARN__} = 'Default' ;
+
+ my $to = $self -> config -> mail_errors_to ;
+ return undef if (!$to) ;
+
+ $r -> log ("[$$]ERR: Mail errors to $to\n") ;
+
+ my $time = localtime ;
+
+ require Net::SMTP ;
+
+ my $mailhost = $self -> config -> mailhost || 'localhost' ;
+ my $smtp = Net::SMTP->new($mailhost, Debug => $self -> config -> maildebug) or
die "Cannot connect to mailhost $mailhost" ;
+ $smtp->mail("Embperl\@$ENV{SERVER_NAME}");
+ $smtp->to($to);
+ my $ok = $smtp->data();
+ $ok and $ok = $smtp->datasend("To: $to\r\n");
+ $ok and $ok = $smtp->datasend("Subject: ERROR in Embperl page " . $r -> param
-> uri . " on $ENV{HTTP_HOST}\r\n");
+ $ok and $ok = $smtp->datasend("\r\n");
+
+ $ok and $ok = $smtp->datasend("ERROR in Embperl page
$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}\r\n");
+ $ok and $ok = $smtp->datasend("\r\n");
+
+ $ok and $ok = $smtp->datasend("-------\r\n");
+ $ok and $ok = $smtp->datasend("Errors:\r\n");
+ $ok and $ok = $smtp->datasend("-------\r\n");
+ my $errors = $r -> errors ;
+ my $err ;
+
+ foreach $err (@$errors)
+ {
+ $ok and $ok = $smtp->datasend("$err\r\n");
+ }
+
+ $ok and $ok = $smtp->datasend("-----------\r\n");
+ $ok and $ok = $smtp->datasend("Formfields:\r\n");
+ $ok and $ok = $smtp->datasend("-----------\r\n");
+
+ my $ffld = $r -> thread -> form_array ;
+ my $fdat = $r -> thread -> form_hash ;
+ my $k ;
+ my $v ;
+
+ foreach $k (@$ffld)
+ {
+ $v = $fdat->{$k} ;
+ $ok and $ok = $smtp->datasend("$k\t= \"$v\" \n" );
+ }
+ $ok and $ok = $smtp->datasend("-------------\r\n");
+ $ok and $ok = $smtp->datasend("Environment:\r\n");
+ $ok and $ok = $smtp->datasend("-------------\r\n");
+
+ my $env = $r -> thread -> env_hash ;
+
+ foreach $k (sort keys %$env)
+ {
+ $v = $env -> {$k} ;
+ $ok and $ok = $smtp->datasend("$k\t= \"$v\" \n" );
+ }
-=item expires_in
+ my $server = $ENV{SERVER_SOFTWARE} || 'Offline' ;
-=item expires_func
+ $ok and $ok = $smtp->datasend("-------------\r\n");
+ $ok and $ok = $smtp->datasend("$server Embperl $Embperl::VERSION [$time]\r\n") ;
-=item expires_filename
+ $ok and $ok = $smtp->dataend() ;
+ $smtp->quit;
-=item cache
+ return $ok ;
+ }
-=back
-=head2 Format
+1;
-Heres an example that show how the hash must be build:
- sub new
- {
- my ($class, $r, $recipe) = @_ ;
+__END__
- my $self =
- {
- 'provider' =>
- {
- 'type' => 'xalan',
- 'source' =>
- {
- 'cache' => 0,
- provider =>
- {
- 'type' => 'xalan-parse-xml',
- 'source' =>
- {
- 'cache' => 0,
- provider =>
- {
- 'type' => 'file',
- 'filename' => $param -> {inputfile},
- }
- },
- },
- },
- 'stylesheet' =>
- {
- 'cache' => 1,
- provider =>
- {
- 'type' => 'xalan-compile-xsl',
- 'stylesheet' =>
- {
- 'cache' => 0,
- provider =>
- {
- 'type' => 'file',
- 'filename' => $param -> {xsltstylesheet},
- }
- },
- },
- }
- }
- } ;
- return $self ;
- }
+=pod
-This corresponds to the following diagramm:
+=head1 NAME
+Embperl base class for application objects
+=head1 SYNOPSIS
- +-------------------+ +--------------------+
- + file {inputfile} + +file{xsltstylesheet}+
- +-------------------+ +--------------------+
- | |
- v v
- +-------------------+ +-------------------+
- + xalan-parse-xml + + xalan-compile-xsl +
- +-------------------+ +-------------------+
- | |
- | |
- | +-----------+ |
- +-------> + xalan + <-+
- +-----------+
-Take a look at the recipes that comes with Embperl to get more
-ideas what can be done.
+=head1 DESCRIPTION
1.1.2.16 +10 -1 embperl/Embperl/Attic/Object.pm
Index: Object.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Object.pm,v
retrieving revision 1.1.2.15
retrieving revision 1.1.2.16
diff -u -r1.1.2.15 -r1.1.2.16
--- Object.pm 1 Mar 2002 22:12:18 -0000 1.1.2.15
+++ Object.pm 11 Mar 2002 08:47:27 -0000 1.1.2.16
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Object.pm,v 1.1.2.15 2002/03/01 22:12:18 richter Exp $
+# $Id: Object.pm,v 1.1.2.16 2002/03/11 08:47:27 richter Exp $
#
###################################################################################
@@ -456,6 +456,15 @@
methods from this class. This class must contain C<Embperl::Req> in his
@ISA array.
+=head2 EMBPERL_OBJECT_APP
+
+Filename of the application object. The file should contain the Perl code for
+the application object. The must be no package name given (as the package is set
+by Embperl::Object), but the @ISA should point to Embperl::App.
+If set this file is searched throught the same search path as any content file.
+After a successfull load the init method is called with the Embperl request object
+as parameter. The init method can change the parameters inside the request object
+to influence the current request.
=head1 Execute
No revision
No revision
1.24.4.54 +15 -2 embperl/test/conf/httpd.conf.src
Index: httpd.conf.src
===================================================================
RCS file: /home/cvs/embperl/test/conf/httpd.conf.src,v
retrieving revision 1.24.4.53
retrieving revision 1.24.4.54
diff -u -r1.24.4.53 -r1.24.4.54
--- httpd.conf.src 10 Mar 2002 20:27:19 -0000 1.24.4.53
+++ httpd.conf.src 11 Mar 2002 08:47:27 -0000 1.24.4.54
@@ -69,6 +69,7 @@
EMBPERL_DEBUG $EPDEBUG
#EMBPERL_VIRTLOG /embperl/log
EMBPERL_LOG \"$EPPATH/test/tmp/test.log\"
+EMBPERL_INPUT_ESCMODE 7
ErrorLog tmp/httpd.err.log
PidFile tmp/httpd.pid
@@ -125,9 +126,8 @@
Alias /embperl/sub/ \"$EPPATH/test/html/\"
Alias /embperl/ \"$EPPATH/test/html/\"
Alias /embperl2/ \"$EPPATH/test/html2/\"
+Alias /embperlmail/ \"$EPPATH/test/html/\"
Alias /eg/ \"$EPPATH/eg/\"
-Alias /embperldbg/ \"$EPPATH/test/html/\"
-Alias /registrydbg/ \"$EPPATH/test/html/registry/\"
<Location /embperl>
SetHandler perl-script
@@ -190,10 +190,12 @@
PerlHandler Embperl
Options ExecCGI
EMBPERL_OPTIONS 16
+EMBPERL_INPUT_ESCMODE 0
</Location>
<Location /cgi-bin/rawinput>
SetEnv EMBPERL_OPTIONS 16
+SetEnv EMBPERL_INPUT_ESCMODE 0
</Location>
<Location /embperl/nochdir>
@@ -335,6 +337,17 @@
EMBPERL_SESSION_MODE 0x22
</Location>
+<Location /embperlmail>
+SetHandler perl-script
+PerlHandler Embperl
+Options ExecCGI
+EMBPERL_APPNAME MailApp
+EMBPERL_MAILHOST mail.i.ecos.de
+EMBPERL_MAIL_ERRORS_TO richter
+EMBPERL_MAIL_ERRORS_LIMIT 2
+EMBPERL_MAIL_ERRORS_RESET_TIME 20
+EMBPERL_MAIL_ERRORS_RESEND_TIME 60
+</Location>
### CGI setup ###
No revision
No revision
1.1.4.10 +3 -3 embperl/test/html/rawinput/Attic/include.htm
Index: include.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/rawinput/Attic/include.htm,v
retrieving revision 1.1.4.9
retrieving revision 1.1.4.10
diff -u -r1.1.4.9 -r1.1.4.10
--- include.htm 5 Feb 2002 09:04:06 -0000 1.1.4.9
+++ include.htm 11 Mar 2002 08:47:27 -0000 1.1.4.10
@@ -163,11 +163,11 @@
<H1> 8a.) Include a file</H1>
-[- Execute ({inputfile => '../inc.htm', options => 0, }) -]
+[- Execute ({inputfile => '../inc.htm', options => 0, input_escmode => 7, }) -]
<H1> 8b.) Include again the same file </H1>
-[- Execute ({inputfile => '../inc.htm', options => 0, }) -]
+[- Execute ({inputfile => '../inc.htm', options => 0, input_escmode => 7, }) -]
<H1> 9.) Include a file and return output in a scalar</H1>
@@ -175,7 +175,7 @@
[- Execute ({inputfile => '../inc.htm',
output => \$out,
- options => 0,
+ options => 0, input_escmode => 7,
req_rec => $req_rec}) ;
-]
No revision
No revision
1.1.2.1.6.7 +2 -2 embperl/test/html/registry/Execute.htm
Index: Execute.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/registry/Execute.htm,v
retrieving revision 1.1.2.1.6.6
retrieving revision 1.1.2.1.6.7
diff -u -r1.1.2.1.6.6 -r1.1.2.1.6.7
--- Execute.htm 10 Mar 2002 20:27:19 -0000 1.1.2.1.6.6
+++ Execute.htm 11 Mar 2002 08:47:27 -0000 1.1.2.1.6.7
@@ -111,7 +111,7 @@
print "\n<H1> 8.) Inculde a file</H1>\n" ;
-Embperl::Execute ({inputfile => '../inc.htm',
+Embperl::Execute ({inputfile => '../inc.htm', input_escmode => 7,
req_rec => $r}) ;
@@ -119,7 +119,7 @@
my $out ;
-Embperl::Execute ({inputfile => '../inc.htm',
+Embperl::Execute ({inputfile => '../inc.htm', input_escmode => 7,
output => \$out,
req_rec => $r}) ;
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
