richter 02/01/24 00:37:07
Modified: . Tag: Embperl2c Embperl.pm Embperl.xs Makefile.PL
Syntax.xs epcgiinit.c epcomp.c epdat2.h epinit.c
epparse.c eppriv.h test.pl
Embperl Tag: Embperl2c Run.pm Syntax.pm Util.pm
Embperl/Syntax Tag: Embperl2c EmbperlBlocks.pm
test/cmp2 Tag: Embperl2c varerr.htm varerr.htm56
Log:
Revision Changes Path
No revision
No revision
1.118.4.80 +178 -3 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118.4.79
retrieving revision 1.118.4.80
diff -u -r1.118.4.79 -r1.118.4.80
--- Embperl.pm 23 Jan 2002 15:09:00 -0000 1.118.4.79
+++ Embperl.pm 24 Jan 2002 08:37:05 -0000 1.118.4.80
@@ -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.79 2002/01/23 15:09:00 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.80 2002/01/24 08:37:05 richter Exp $
#
###################################################################################
@@ -27,6 +27,9 @@
use Embperl::Syntax ;
use Embperl::Recipe ;
use Embperl::Constant ;
+use Embperl::Util ;
+use Embperl::Out ;
+use Embperl::Log ;
use strict ;
use vars qw(
@@ -88,6 +91,15 @@
package Embperl::Req ;
+#######################################################################################
+
+use strict ;
+
+if (defined ($ENV{MOD_PERL}))
+ {
+ eval 'use Apache::Constants qw(&OPT_EXECCGI &DECLINED &OK &FORBIDDEN)' ;
+ die "use Apache::Constants failed: $@" if ($@);
+ }
#######################################################################################
@@ -99,7 +111,7 @@
my $virtlog = '' ; # $self -> VirtLogURI || '' ;
my $logfilepos = $self -> log_file_start_pos ;
- my $url = '' ; # $HTML::Embperl::dbgLogLink?"<A
HREF=\"$virtlog\?$logfilepos\&$$\">Logfile</A>":'' ;
+ my $url = '' ; # $Embperl::dbgLogLink?"<A
HREF=\"$virtlog\?$logfilepos\&$$\">Logfile</A>":'' ;
my $req_rec = $self -> apache_req ;
my $err ;
my $cnt = 0 ;
@@ -223,7 +235,7 @@
my $server = $ENV{SERVER_SOFTWARE} || 'Offline' ;
$ok and $ok = $smtp->datasend("-------------\r\n");
- $ok and $ok = $smtp->datasend("$server HTML::Embperl $HTML::Embperl::VERSION
[$time]\r\n") ;
+ $ok and $ok = $smtp->datasend("$server Embperl $Embperl::VERSION [$time]\r\n") ;
$ok and $ok = $smtp->dataend() ;
$smtp->quit;
@@ -232,5 +244,168 @@
}
+
+#######################################################################################
+
+sub SetupSession
+
+ {
+ my $r ;
+ $r = shift if (!(ref ($_[0]) =~ /^Apache/)) ;
+ my ($req_rec, $Inputfile) = @_ ;
+ local $^W = 0 ;
+
+ if ($Embperl::SessionMgnt && (!defined ($r) || !$r -> SubReq))
+ {
+ my $udat = tied(%Embperl::udat) ;
+ my $mdat = tied(%Embperl::mdat) ;
+ my $sdat = tied(%Embperl::sdat) ;
+ my $cookie_name = $r?$r -> CookieName:$ENV{EMBPERL_COOKIE_NAME} ||
'EMBPERL_UID' ;
+ my $cookie_val = $ENV{HTTP_COOKIE} ||
($req_rec?$req_rec->header_in('Cookie'):undef) ;
+
+ if ((defined ($cookie_val) && ($cookie_val =~ /$cookie_name=(.*?)(\;|\s|$)/))
|| ($ENV{QUERY_STRING} =~ /$cookie_name=.*?:(.*?)(\;|\s|&|$)/) || $ENV{EMBPERL_UID} )
+ {
+ print Embperl::LOG "[$$]SES: Received user session id $1\n" if
($Embperl::dbgSession) ;
+ $udat -> setid ($1) if (!$udat -> getid) ;
+ }
+
+ $mdat -> setidfrom ($Inputfile) if ($Inputfile && !$mdat -> getid) ;
+
+ if (($ENV{QUERY_STRING} =~ /${cookie_name}=(.*?)(\;|\s|&|:|$)/))
+ {
+ print Embperl::LOG "[$$]SES: Received state session id $1\n" if
($Embperl::dbgSession) ;
+ $sdat -> setid ($1) if (!$sdat -> getid) ;
+ }
+ }
+ else
+ {
+ return undef ; # No session Management
+ }
+
+ return wantarray?(\%Embperl::udat, \%Embperl::mdat,
\%Embperl::sdat):\%Embperl::udat ;
+ }
+
+#######################################################################################
+
+sub GetSession
+
+ {
+ if ($Embperl::SessionMgnt)
+ {
+ my $udat = tied(%Embperl::udat) ;
+
+ return wantarray?(\%Embperl::udat, \%Embperl::mdat,
\%Embperl::sdat):\%Embperl::udat ;
+ }
+ else
+ {
+ return undef ; # No session Management
+ }
+ }
+
+#######################################################################################
+
+sub DeleteSession
+
+ {
+ my $r = shift || Embperl::CurrReq () ;
+ my $disabledelete = shift ;
+
+ my $udat = tied (%Embperl::udat) ;
+ if (!$disabledelete) # Delete session data
+ {
+ $udat -> delete ;
+ }
+ else
+ {
+ $udat-> {data} = {} ; # for make test only
+ $udat->{initial_session_id} = "!DELETE" ;
+ }
+ $udat->{status} = 0;
+ }
+
+
+#######################################################################################
+
+sub RefreshSession
+
+ {
+ my $r = shift || Embperl::CurrReq () ;
+
+ $r -> SessionMgnt ($Embperl::SessionMgnt | 4) ; # resend cookie
+ }
+
+#######################################################################################
+
+sub CleanupSession
+
+ {
+ my $r = shift ;
+ $r = Embperl::CurrReq () if (!(ref ($r) =~ /^Embperl/));
+
+ if ($Embperl::SessionMgnt && (!defined ($r) || !$r -> SubReq))
+ {
+ my $udat = tied(%Embperl::udat) ;
+ my $mdat = tied(%Embperl::mdat) ;
+ my $sdat = tied(%Embperl::sdat) ;
+
+ $udat -> cleanup ;
+ $mdat -> cleanup ;
+ $sdat -> cleanup ;
+ }
+ }
+
+
+#######################################################################################
+
+sub SetSessionCookie
+
+ {
+ my $r = shift ;
+ $r = undef if (!(ref ($r) =~ /^Embperl/));
+
+ if ($Embperl::SessionMgnt)
+ {
+ my $udat = tied (%Embperl::udat) ;
+ my ($initialid, $id, $modified) = $udat -> getids ;
+
+ my $name = $ENV{EMBPERL_COOKIE_NAME} || 'EMBPERL_UID' ;
+ my $domain = "; domain=$ENV{EMBPERL_COOKIE_DOMAIN}" if (exists
($ENV{EMBPERL_COOKIE_DOMAIN})) ;
+ my $path = "; path=$ENV{EMBPERL_COOKIE_PATH}" if (exists
($ENV{EMBPERL_COOKIE_PATH})) ;
+ my $expires = "; expires=$ENV{EMBPERL_COOKIE_EXPIRES}" if (exists
($ENV{EMBPERL_COOKIE_EXPIRES})) ;
+
+ if ($id || $initialid)
+ {
+ Apache -> request -> header_out ("Set-Cookie" =>
"$name=$id$domain$path$expires") ;
+ }
+ }
+ }
+
+
+
+
+
+
+#######################################################################################
+
+sub Export
+
+ {
+ my ($self, $exports, $caller) = @_ ;
+
+ my $package = $self -> CurrPackage ;
+
+ print Embperl::LOG "[$$]IMP: Create Imports for $caller from $package
($exports)\n" ;
+ no strict ;
+
+ foreach $k (keys %$exports)
+ {
+ *{"$caller\:\:$k"} = $exports -> {$k} ; #\&{"$package\:\:$k"} ;
+ print Embperl::LOG "[$$]IMP: Created Import for $package\:\:$k ->
$caller\n" ;
+ }
+
+ use strict ;
+ }
+
#######################################################################################
+1 ;
1.29.4.41 +5 -0 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.29.4.40
retrieving revision 1.29.4.41
diff -u -r1.29.4.40 -r1.29.4.41
--- Embperl.xs 22 Jan 2002 15:46:22 -0000 1.29.4.40
+++ Embperl.xs 24 Jan 2002 08:37:05 -0000 1.29.4.41
@@ -129,6 +129,11 @@
PUTBACK;
boot_Embperl__Component__Param (aTHX_ cv) ;
+ PUSHMARK(sp);
+ XPUSHs(sv_2mortal(newSVpv("Embperl::Syntax", 0))) ;
+ XPUSHs(version) ;
+ PUTBACK;
+ boot_Embperl__Syntax (aTHX_ cv) ;
1.31.4.45 +2 -1 embperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /home/cvs/embperl/Makefile.PL,v
retrieving revision 1.31.4.44
retrieving revision 1.31.4.45
diff -u -r1.31.4.44 -r1.31.4.45
--- Makefile.PL 22 Jan 2002 15:46:22 -0000 1.31.4.44
+++ Makefile.PL 24 Jan 2002 08:37:05 -0000 1.31.4.45
@@ -3,7 +3,7 @@
#
# (C) 1997-2001 G.Richter ([EMAIL PROTECTED]) / ECOS
#
-# $Id: Makefile.PL,v 1.31.4.44 2002/01/22 15:46:22 richter Exp $
+# $Id: Makefile.PL,v 1.31.4.45 2002/01/24 08:37:05 richter Exp $
#
@@ -1171,6 +1171,7 @@
xs/Embperl/Req/Config/Config
xs/Embperl/Req/Param/Param
xs/Embperl/Thread/Thread
+xs/Embperl/Syntax/Syntax
}) . '$(OBJ_EXT)';
$sublibs =~ s/\//\\/g if ($win32) ;
1.1.2.8 +2 -1 embperl/Syntax.xs
Index: Syntax.xs
===================================================================
RCS file: /home/cvs/embperl/Syntax.xs,v
retrieving revision 1.1.2.7
retrieving revision 1.1.2.8
diff -u -r1.1.2.7 -r1.1.2.8
--- Syntax.xs 22 Jan 2002 15:46:22 -0000 1.1.2.7
+++ Syntax.xs 24 Jan 2002 08:37:05 -0000 1.1.2.8
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Syntax.xs,v 1.1.2.7 2002/01/22 15:46:22 richter Exp $
+# $Id: Syntax.xs,v 1.1.2.8 2002/01/24 08:37:05 richter Exp $
#
###################################################################################
@@ -46,6 +46,7 @@
if (ppSV == NULL || *ppSV == NULL || !SvPOK (*ppSV))
croak ("Internal Error: pSyntaxObj has no -name") ;
+ pTab -> _perlsv = newSVsv (pSyntaxObj) ;
sName = strdup (SvPV(*ppSV, l)) ;
ppSV = hv_fetch (pHV, "-root", 5, 0) ;
1.1.2.5 +2 -2 embperl/Attic/epcgiinit.c
Index: epcgiinit.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcgiinit.c,v
retrieving revision 1.1.2.4
retrieving revision 1.1.2.5
diff -u -r1.1.2.4 -r1.1.2.5
--- epcgiinit.c 22 Jan 2002 09:29:54 -0000 1.1.2.4
+++ epcgiinit.c 24 Jan 2002 08:37:05 -0000 1.1.2.5
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epcgiinit.c,v 1.1.2.4 2002/01/22 09:29:54 richter Exp $
+# $Id: epcgiinit.c,v 1.1.2.5 2002/01/24 08:37:05 richter Exp $
#
###################################################################################*/
@@ -132,7 +132,7 @@
pParam -> sUnparsedUri = GetHashValueStrDup (aTHX_ pPool, pThread -> pEnvHash,
"REQUEST_URI", "") ;
pParam -> sUri = GetHashValueStrDup (aTHX_ pPool, pThread -> pEnvHash,
"SCRIPT_NAME", "") ;
pParam -> sPathInfo = GetHashValueStrDup (aTHX_ pPool, pThread -> pEnvHash,
"PATH_INFO", "") ;
- pParam -> sQueryInfo = GetHashValueStrDup (aTHX_ pPool, pThread -> pEnvHash,
"QUERY_INFO", "") ;
+ pParam -> sQueryInfo = GetHashValueStrDup (aTHX_ pPool, pThread -> pEnvHash,
"QUERY_STRING", "") ;
return ok ;
}
1.4.2.89 +2 -2 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.88
retrieving revision 1.4.2.89
diff -u -r1.4.2.88 -r1.4.2.89
--- epcomp.c 23 Jan 2002 07:58:26 -0000 1.4.2.88
+++ epcomp.c 24 Jan 2002 08:37:05 -0000 1.4.2.89
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epcomp.c,v 1.4.2.88 2002/01/23 07:58:26 richter Exp $
+# $Id: epcomp.c,v 1.4.2.89 2002/01/24 08:37:05 richter Exp $
#
###################################################################################*/
@@ -1847,7 +1847,7 @@
if (!r -> bError)
{
- if (r -> Component.Config.nCleanup > -1)
+ if (r -> Component.Config.nCleanup > -1 && (r -> Component.Config.bOptions
& optDisableVarCleanup) == 0)
SetHashValueInt (r, r -> pCleanupPackagesHV, r ->
Component.sCurrPackage, 1) ;
/* --- change working directory --- */
1.1.2.15 +32 -1 embperl/Attic/epdat2.h
Index: epdat2.h
===================================================================
RCS file: /home/cvs/embperl/Attic/epdat2.h,v
retrieving revision 1.1.2.14
retrieving revision 1.1.2.15
diff -u -r1.1.2.14 -r1.1.2.15
--- epdat2.h 23 Jan 2002 10:11:35 -0000 1.1.2.14
+++ epdat2.h 24 Jan 2002 08:37:05 -0000 1.1.2.15
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epdat2.h,v 1.1.2.14 2002/01/23 10:11:35 richter Exp $
+# $Id: epdat2.h,v 1.1.2.15 2002/01/24 08:37:05 richter Exp $
#
###################################################################################*/
@@ -36,6 +36,36 @@
struct tReq; /* forward */
+/*-----------------------------------------------------------------*/
+/* */
+/* Parser data structures */
+/* */
+/*-----------------------------------------------------------------*/
+
+typedef unsigned char tCharMap [256/(sizeof(unsigned char)*8)] ;
+
+struct tToken ;
+
+struct tTokenTable
+ {
+ void * pCompilerInfo ; /* stores tables of the compiler , !!!must be
first item!!! */
+ SV * _perlsv ; /**< The perl reference to this structure */
+ const char * sName ; /* name of syntax */
+ const char * sRootNode ; /* name of root node */
+ tCharMap cStartChars ; /* for every vaild start char there is one bit set
*/
+ tCharMap cAllChars ; /* for every vaild char there is one bit set */
+ struct tToken * pTokens ; /* table with all tokens */
+ int numTokens ; /* number of tokens in above table */
+ int bLSearch ; /* when set perform a linear, instead of a
binary search */
+ int nDefNodeType ; /* either ntypCDATA or ntypText */
+ struct tToken * pContainsToken ;/* pointer to the token that has a pContains
defined (could be only one per table) */
+ } ;
+
+typedef struct tTokenTable tTokenTable ;
+
+
+
+
typedef struct tComponentConfig
{
@@ -134,6 +164,7 @@
HV * pInputHash ; /* Data of input fields */
AV * pFormArray ; /* Fieldnames */
HV * pHeaderHash ;/* http headers */
+ SV * pReqRV ; /* the request object global */
} tThreadData ;
1.1.2.16 +8 -3 embperl/Attic/epinit.c
Index: epinit.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epinit.c,v
retrieving revision 1.1.2.15
retrieving revision 1.1.2.16
diff -u -r1.1.2.15 -r1.1.2.16
--- epinit.c 23 Jan 2002 15:09:00 -0000 1.1.2.15
+++ epinit.c 24 Jan 2002 08:37:05 -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: epinit.c,v 1.1.2.15 2002/01/23 15:09:00 richter Exp $
+# $Id: epinit.c,v 1.1.2.16 2002/01/24 08:37:05 richter Exp $
#
###################################################################################*/
@@ -44,6 +44,7 @@
#define EMBPERL_FFLD_NAME EMBPERL_PACKAGE_STR"::ffld"
#define EMBPERL_HDR_NAME EMBPERL_PACKAGE_STR"::http_headers_out"
#define EMBPERL_IDAT_NAME EMBPERL_PACKAGE_STR"::idat"
+#define EMBPERL_REQ_NAME EMBPERL_PACKAGE_STR"::req"
#define EMBPERL_ENV_NAME "ENV"
#define EMBPERL_EscMode_NAME EMBPERL_PACKAGE_STR"::escmode"
@@ -117,6 +118,7 @@
pThread -> pHeaderHash = perl_get_hv (EMBPERL_HDR_NAME, TRUE) ;
pThread -> pInputHash = perl_get_hv (EMBPERL_IDAT_NAME, TRUE) ;
pThread -> pEnvHash = perl_get_hv (EMBPERL_ENV_NAME, TRUE) ;
+ pThread -> pReqRV = perl_get_sv (EMBPERL_REQ_NAME, TRUE) ;
/* avoid warnings */
perl_get_hv (EMBPERL_FDAT_NAME, TRUE) ;
perl_get_hv (EMBPERL_SPLIFDAT_NAME, TRUE) ;
@@ -956,7 +958,8 @@
pThread -> pCurrReq = r ;
pApp -> pCurrReq = r ;
-
+ sv_setsv(pThread -> pReqRV, r -> _perlsv) ;
+
*ppReq = r ;
return ok ;
@@ -1019,6 +1022,8 @@
char * pKey ;
I32 l ;
+ sv_setsv(r -> pThread -> pReqRV, &sv_undef) ;
+
embperl_CleanupComponent(r, &r -> Component) ;
@@ -1093,7 +1098,7 @@
{
pCfg -> sPackage ;
pCfg -> bDebug = dbgStd ;
- pCfg -> bOptions = optRawInput | optAllFormData ;
+ /* pCfg -> bOptions = optRawInput | optAllFormData ; */
pCfg -> nEscMode = escStd ;
pCfg -> bCacheKeyOptions = ckoptDefault ;
pCfg -> sSyntax = "Embperl" ;
1.4.2.50 +2 -2 embperl/Attic/epparse.c
Index: epparse.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epparse.c,v
retrieving revision 1.4.2.49
retrieving revision 1.4.2.50
diff -u -r1.4.2.49 -r1.4.2.50
--- epparse.c 23 Jan 2002 15:09:00 -0000 1.4.2.49
+++ epparse.c 24 Jan 2002 08:37:05 -0000 1.4.2.50
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epparse.c,v 1.4.2.49 2002/01/23 15:09:00 richter Exp $
+# $Id: epparse.c,v 1.4.2.50 2002/01/24 08:37:05 richter Exp $
#
###################################################################################*/
@@ -508,7 +508,7 @@
lprintf (r -> pApp, "[%d]PARSE: ParseTimeCode: %*.*s\n", r -> pThread ->
nPid, nLen, nLen, sCode) ;
pSV = newSVpvf("package %s ;\nmy ($_ep_req) = @_;\n#line %d \"%s\"\n%*.*s",
- r -> Component.sEvalPackage, nLinenumber, r -> Component.sSourcefile,
nLen, nLen, sCode) ;
+ "Embperl::Parser" /*r -> Component.sEvalPackage*/, nLinenumber, r ->
Component.sSourcefile, nLen, nLen, sCode) ;
newSVpvf2(pSV) ;
args[0] = r -> _perlsv ;
if ((rc = EvalDirect (r, pSV, 1, args)) != ok)
1.1.2.10 +2 -18 embperl/Attic/eppriv.h
Index: eppriv.h
===================================================================
RCS file: /home/cvs/embperl/Attic/eppriv.h,v
retrieving revision 1.1.2.9
retrieving revision 1.1.2.10
diff -u -r1.1.2.9 -r1.1.2.10
--- eppriv.h 22 Jan 2002 16:52:43 -0000 1.1.2.9
+++ eppriv.h 24 Jan 2002 08:37:05 -0000 1.1.2.10
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: eppriv.h,v 1.1.2.9 2002/01/22 16:52:43 richter Exp $
+# $Id: eppriv.h,v 1.1.2.10 2002/01/24 08:37:05 richter Exp $
#
###################################################################################*/
@@ -88,7 +88,6 @@
/* */
/*-----------------------------------------------------------------*/
-typedef unsigned char tCharMap [256/(sizeof(unsigned char)*8)] ;
struct tToken
{
@@ -116,22 +115,6 @@
const char * sParseTimePerlCode ; /* perl code that is executed when
this token is parsed, %% is replaced by the value of the current attribute */
} ;
-struct tTokenTable
- {
- void * pCompilerInfo ; /* stores tables of the compiler , must be first
item */
- const char * sName ; /* name of syntax */
- const char * sRootNode ; /* name of root node */
- tCharMap cStartChars ; /* for every vaild start char there is one bit set
*/
- tCharMap cAllChars ; /* for every vaild char there is one bit set */
- struct tToken * pTokens ; /* table with all tokens */
- int numTokens ; /* number of tokens in above table */
- int bLSearch ; /* when set perform a linear, instead of a
binary search */
- int nDefNodeType ; /* either ntypCDATA or ntypText */
- struct tToken * pContainsToken ;/* pointer to the token that has a pContains
defined (could be only one per table) */
- } ;
-
-typedef struct tTokenTable tTokenTable ;
-
/* --- threads & mutex --- */
@@ -222,6 +205,7 @@
void embperl_DefaultComponentConfig (/*in*/ tComponentConfig *pCfg) ;
void Embperl__App_new_init(pTHX_ tApp * pApp, SV * pPerlParam, int overwrite) ;
+void Embperl__App__Config_new_init(pTHX_ tApp * pApp, SV * pPerlParam, int
overwrite) ;
void Embperl__Req_new_init (pTHX_ tReq * r, SV * pPerlParam, int overwrite) ;
void Embperl__Req__Config_new_init (pTHX_ tReqConfig * r, SV * pPerlParam, int
overwrite) ;
void Embperl__Req__Param_new_init (pTHX_ tReqParam * r, SV * pPerlParam, int
overwrite) ;
1.70.4.108 +5 -5 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.107
retrieving revision 1.70.4.108
diff -u -r1.70.4.107 -r1.70.4.108
--- test.pl 23 Jan 2002 15:09:00 -0000 1.70.4.107
+++ test.pl 24 Jan 2002 08:37:05 -0000 1.70.4.108
@@ -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.107 2002/01/23 15:09:00 richter Exp $
+# $Id: test.pl,v 1.70.4.108 2002/01/24 08:37:05 richter Exp $
#
###################################################################################
@@ -79,9 +79,6 @@
'notfound.htm' => {
'errors' => '1',
},
- 'execnotfound.htm' => {
- 'errors' => '1',
- },
'notallow.xhtm' => {
'errors' => '1',
},
@@ -152,7 +149,7 @@
'version' => 1,
},
'varerr.htm' => {
- 'errors' => 8,
+ 'errors' => 7,
'noloop' => 1,
'condition' => '$] >= 5.006000',
'cmpext' => '56',
@@ -263,6 +260,9 @@
'version' => 2,
'cgi' => 0,
'repeat' => 2,
+ },
+ 'execnotfound.htm' => {
+ 'errors' => '1',
},
'includeerr1.htm' => {
'errors' => '1',
No revision
No revision
1.1.2.2 +1 -4 embperl/Embperl/Attic/Run.pm
Index: Run.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Run.pm,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- Run.pm 22 Jan 2002 09:29:55 -0000 1.1.2.1
+++ Run.pm 24 Jan 2002 08:37:06 -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: Run.pm,v 1.1.2.1 2002/01/22 09:29:55 richter Exp $
+# $Id: Run.pm,v 1.1.2.2 2002/01/24 08:37:06 richter Exp $
#
###################################################################################
@@ -54,9 +54,6 @@
tie *Embperl::LOG, 'Embperl::Log' ;
- $param{'options'} |= Embperl::Constant::optSendHttpHeader ;
- $param{'cleanup'} = 0 ;
- $param{'cleanup'} = -1 if (($param{'options'} &
Embperl::Constant::optDisableVarCleanup)) ;
$param{'param'} = \@param ;
1.1.4.51 +4 -3 embperl/Embperl/Attic/Syntax.pm
Index: Syntax.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Syntax.pm,v
retrieving revision 1.1.4.50
retrieving revision 1.1.4.51
diff -u -r1.1.4.50 -r1.1.4.51
--- Syntax.pm 22 Jan 2002 09:29:55 -0000 1.1.4.50
+++ Syntax.pm 24 Jan 2002 08:37:06 -0000 1.1.4.51
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Syntax.pm,v 1.1.4.50 2002/01/22 09:29:55 richter Exp $
+# $Id: Syntax.pm,v 1.1.4.51 2002/01/24 08:37:06 richter Exp $
#
###################################################################################
@@ -307,7 +307,6 @@
-
###################################################################################
#
# Definitions for documents
@@ -315,7 +314,6 @@
###################################################################################
-
%DocumentRoot = (
'-lsearch' => 1,
@@ -328,6 +326,7 @@
perlcode => q{
# any initialisation could be put here
$DB::single = 1 ;
+$maxrow=100;$maxcol=10;
},
compiletimeperlcode => q{
use vars ('$_ep_DomTree', '@ISA', '@param') ;
@@ -339,6 +338,7 @@
*_ep_hid=\\&Embperl::Cmd::Hidden;
*_ep_ac=\\&XML::Embperl::DOM::Node::iAppendChild;
*_ep_sa=\\&XML::Embperl::DOM::Element::iSetAttribut;
+Embperl::Util::CreateAliases ;
},
perlcodeend => q{# Include here any cleanup code
$DB::single = 0 ;
@@ -369,6 +369,7 @@
*_ep_hid=\\&Embperl::Cmd::Hidden;
*_ep_ac=\\&XML::Embperl::DOM::Node::iAppendChild;
*_ep_sa=\\&XML::Embperl::DOM::Element::iSetAttribut;
+Embperl::Util::CreateAliases ;
},
perlcodeend => '# Include here any cleanup code',
stackname => 'metacmd',
1.1.2.2 +84 -1 embperl/Embperl/Attic/Util.pm
Index: Util.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Util.pm,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- Util.pm 22 Jan 2002 09:29:55 -0000 1.1.2.1
+++ Util.pm 24 Jan 2002 08:37:06 -0000 1.1.2.2
@@ -10,13 +10,17 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Util.pm,v 1.1.2.1 2002/01/22 09:29:55 richter Exp $
+# $Id: Util.pm,v 1.1.2.2 2002/01/24 08:37:06 richter Exp $
#
###################################################################################
package Embperl::Util ;
+use strict ;
+use vars qw{@AliasScalar @AliasHash @AliasArray %NameSpace} ;
+
+#######################################################################################
sub AddCompartment ($)
@@ -37,5 +41,84 @@
return $cp ;
}
+#######################################################################################
+
+
+@AliasScalar = qw{row col cnt tabmode escmode req_rec maxrow maxcol req_rec
+ dbgAll dbgAllCmds dbgCmd
dbgDefEval dbgEarlyHttpHeader
+ dbgEnv dbgEval dbgFlushLog
dbgFlushOutput dbgForm
+ dbgFunc dbgHeadersIn dbgImport dbgInput
dbgLogLink
+ dbgMem dbgProfile dbgShowCleanup dbgSource
dbgStd
+ dbgSession dbgTab dbgWatchScalar dbgParse
dbgObjectSearch
+ optDisableChdir optDisableEmbperlErrorPage
optReturnError optDisableFormData
+ optDisableHtmlScan optDisableInputScan
optDisableMetaScan optDisableTableScan
+ optDisableSelectScan optDisableVarCleanup
optEarlyHttpHeader optOpcodeMask
+ optRawInput optSafeNamespace
optSendHttpHeader optAllFormData
+ optRedirectStdout optUndefToEmptyValue
optNoHiddenEmptyValue optAllowZeroFilesize
+ optKeepSrcInMemory optKeepSpaces optOpenLogEarly
optNoUncloseWarn
+ _ep_node
+ } ;
+@AliasHash = qw{fdat udat mdat sdat idat http_headers_out fsplitdat} ;
+@AliasArray = qw{ffld} ;
+
+
+#######################################################################################
+
+
+sub CreateAliases
+
+ {
+ my $package = caller ;
+
+ my $dummy ;
+
+ no strict ;
+
+ if (!defined(${"$package\:\:row"}))
+ { # create new aliases for Embperl magic vars
+
+ foreach (@AliasScalar)
+ {
+ *{"$package\:\:$_"} = \${"Embperl\:\:$_"} ;
+ $dummy = ${"$package\:\:$_"} ; # necessary to make sure variable exists!
+ }
+
+ foreach (@AliasHash)
+ {
+ *{"$package\:\:$_"} = \%{"Embperl\:\:$_"} ;
+ }
+ foreach (@AliasArray)
+ {
+ *{"$package\:\:$_"} = \@{"Embperl\:\:$_"} ;
+ }
+
+ if (defined (&Apache::exit))
+ {
+ *{"$package\:\:exit"} = \&Apache::exit
+ }
+ else
+ {
+ *{"$package\:\:exit"} = \&Embperl::exit
+ }
+
+
+ *{"$package\:\:MailFormTo"} = \&Embperl::MailFormTo ;
+ *{"$package\:\:Execute"} = \&Embperl::Execute ;
+
+ tie *{"$package\:\:LOG"}, 'Embperl::Log' ;
+ tie *{"$package\:\:OUT"}, 'Embperl::Out' ;
+
+ my $addcleanup = \%{"$package\:\:CLEANUP"} ;
+ $addcleanup -> {'CLEANUP'} = 0 ;
+ $addcleanup -> {'EXPIRES'} = 0 ;
+ $addcleanup -> {'CACHE_KEY'} = 0 ;
+ $addcleanup -> {'OUT'} = 0 ;
+ $addcleanup -> {'LOG'} = 0 ;
+ }
+
+
+
+ use strict ;
+ }
1;
No revision
No revision
1.1.2.20 +3 -3 embperl/Embperl/Syntax/Attic/EmbperlBlocks.pm
Index: EmbperlBlocks.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/EmbperlBlocks.pm,v
retrieving revision 1.1.2.19
retrieving revision 1.1.2.20
diff -u -r1.1.2.19 -r1.1.2.20
--- EmbperlBlocks.pm 22 Jan 2002 09:29:56 -0000 1.1.2.19
+++ EmbperlBlocks.pm 24 Jan 2002 08:37:06 -0000 1.1.2.20
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: EmbperlBlocks.pm,v 1.1.2.19 2002/01/22 09:29:56 richter Exp $
+# $Id: EmbperlBlocks.pm,v 1.1.2.20 2002/01/24 08:37:06 richter Exp $
#
###################################################################################
@@ -356,11 +356,11 @@
}) ;
$self -> AddMetaCmd ('syntax',
{
- compiletimeperlcode => '$_[0] -> Syntax
(Embperl::Syntax::GetSyntax(%&\'<noname>%, $_[0] -> SyntaxName));',
+ compiletimeperlcode => '$Embperl::req -> component -> syntax
(Embperl::Syntax::GetSyntax(%&\'<noname>%, $Embperl::req -> component -> syntax ->
name));',
removenode => 3,
},
{
- parsetimeperlcode => '$_[0] -> Syntax
(Embperl::Syntax::GetSyntax(\'%%\', $_[0] -> SyntaxName)) ;',
+ parsetimeperlcode => '$Embperl::req -> component -> syntax
(Embperl::Syntax::GetSyntax(\'%%\', $Embperl::req -> component -> syntax -> name)) ;',
},
) ;
$self -> AddMetaStartEnd ('sub', 'endsub',
No revision
No revision
1.1.2.3 +1 -1 embperl/test/cmp2/Attic/varerr.htm
Index: varerr.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp2/Attic/varerr.htm,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- varerr.htm 31 Oct 2001 14:53:32 -0000 1.1.2.2
+++ varerr.htm 24 Jan 2002 08:37:06 -0000 1.1.2.3
@@ -4,7 +4,7 @@
^Please contact the server administrator\,.*?and inform them of the time the error
occurred\, and anything you might have done that may have caused the error\.
^^\[.*?\]ERR\: (32\: Warning|24\: Line \d+: Error) in Perl code\: Global symbol
\"\;\$?d\"\; requires explicit package name at.*?
^\[.*?\]ERR\: (32\: Warning|24\: Line \d+: Error) in Perl code\: Global symbol
\"\;\$?e\"\; requires explicit package name at.*?
-^ HTML\:\:Embperl.*?<P>
+^ Embperl.*?<P>
</BODY></HTML>
1.1.2.3 +1 -3 embperl/test/cmp2/Attic/varerr.htm56
Index: varerr.htm56
===================================================================
RCS file: /home/cvs/embperl/test/cmp2/Attic/varerr.htm56,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- varerr.htm56 31 Oct 2001 14:53:32 -0000 1.1.2.2
+++ varerr.htm56 24 Jan 2002 08:37:06 -0000 1.1.2.3
@@ -14,9 +14,7 @@
^<br> Global symbol "\$d" requires explicit
package name at
^<br> Global symbol "\$e" requires explicit
package name at
-^\[.*?\]ERR\: 24\: varerr.htm\(1\): Error in Perl code\:
-
-^ HTML\:\:Embperl.*?<P>
+^ Embperl.*?<P>
</BODY></HTML>
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
