richter 01/11/14 07:01:42
Modified: . Tag: Embperl2c epcache.c epcomp.c epdom.c epeval.c
epmain.c epparse.c eputil.c
Embperl Tag: Embperl2c Recipe.pm
Added: Embperl/Recipe Tag: Embperl2c Embperl.pm
Log:
Embperl 2 - memory debugging & Recipes
Revision Changes Path
No revision
No revision
1.1.2.13 +6 -11 embperl/Attic/epcache.c
Index: epcache.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcache.c,v
retrieving revision 1.1.2.12
retrieving revision 1.1.2.13
diff -u -r1.1.2.12 -r1.1.2.13
--- epcache.c 2001/11/12 12:45:39 1.1.2.12
+++ epcache.c 2001/11/14 15:01:40 1.1.2.13
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epcache.c,v 1.1.2.12 2001/11/12 12:45:39 richter Exp $
+# $Id: epcache.c,v 1.1.2.13 2001/11/14 15:01:40 richter Exp $
#
###################################################################################*/
@@ -82,7 +82,7 @@
pProviders = newHV () ;
pCacheItems = newHV () ;
- ArrayNew (&pCachesToRelease, sizeof (tCacheItem *), 16) ;
+ ArrayNew (&pCachesToRelease, 16, sizeof (tCacheItem *)) ;
}
@@ -398,9 +398,7 @@
/* */
/*!
* \_en
-* Gets an CacheItem by it's key. First key is considered a filename
-* an the current work direcory is appended, if the filename is relative
-* to make sure it is unique
+* Gets an CacheItem by it's key.
*
* @param r Embperl request record
* @param sKey Key
@@ -408,10 +406,7 @@
* \endif
*
* \_de
-* Liefert das durch den Schl�ssel angegeben CacheItem zur�ck. Der Schl�ssel
-* setzt sich aus einem Dateinamen und einem Modifier zusammen. Ist der
-* Dateiname relativ, wird das aktuelle Verzeichnis angehangen um ihn
-* eindeutig zu machen.
+* Liefert das durch den Schl�ssel angegeben CacheItem zur�ck.
*
* @param r Embperl request record
* @param sKey Key
@@ -470,14 +465,14 @@
int n ;
if (!pItem -> pDependsOn)
- ArrayNew (&pItem -> pDependsOn, sizeof (tCacheItem *), 2) ;
+ ArrayNew (&pItem -> pDependsOn, 2, sizeof (tCacheItem *)) ;
n = ArrayAdd (&pItem -> pDependsOn, 1) ;
pItem -> pDependsOn[n] = pDependsOn ;
if (!pDependsOn -> pNeededFor)
- ArrayNew (&pDependsOn -> pNeededFor, sizeof (tCacheItem *), 2) ;
+ ArrayNew (&pDependsOn -> pNeededFor, 2, sizeof (tCacheItem *)) ;
n = ArrayAdd (&pDependsOn -> pNeededFor, 1) ;
pDependsOn -> pNeededFor[n] = pItem ;
1.4.2.78 +3 -1 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.77
retrieving revision 1.4.2.78
diff -u -r1.4.2.77 -r1.4.2.78
--- epcomp.c 2001/11/14 09:30:29 1.4.2.77
+++ epcomp.c 2001/11/14 15:01:40 1.4.2.78
@@ -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.77 2001/11/14 09:30:29 richter Exp $
+# $Id: epcomp.c,v 1.4.2.78 2001/11/14 15:01:40 richter Exp $
#
###################################################################################*/
@@ -1796,6 +1796,8 @@
return rc ;
}
+ else
+ *pResultDomTree = 0 ;
r -> nPhase = phTerm ;
1.4.2.75 +15 -2 embperl/Attic/epdom.c
Index: epdom.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.c,v
retrieving revision 1.4.2.74
retrieving revision 1.4.2.75
diff -u -r1.4.2.74 -r1.4.2.75
--- epdom.c 2001/11/14 09:30:29 1.4.2.74
+++ epdom.c 2001/11/14 15:01:40 1.4.2.75
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epdom.c,v 1.4.2.74 2001/11/14 09:30:29 richter Exp $
+# $Id: epdom.c,v 1.4.2.75 2001/11/14 15:01:40 richter Exp $
#
###################################################################################*/
@@ -1120,8 +1120,20 @@
SvREFCNT_dec (pDomTree -> pSV) ;
if (pDomTree -> pDependsOn)
- SvREFCNT_dec (pDomTree -> pDependsOn) ;
+ {
+ /*
+ int i ;
+ for (i = 0 ; i < AvFILL (pDomTree -> pDependsOn); i++)
+ {
+ SV * pSV = *av_fetch (pDomTree -> pDependsOn, i, 0) ;
+ lprintf (pCurrReq, "pDependsOn #%d type = %d\n", i, SvTYPE(pSV)) ;
+ }
+ av_clear (pDomTree -> pDependsOn) ;
+ */
+ SvREFCNT_dec (pDomTree -> pDependsOn) ;
+ }
+
xNdx = ArrayAdd (&pFreeDomTrees, 1) ;
pDomTree -> xNdx = 0 ;
pFreeDomTrees[xNdx] = xDomTree ;
@@ -1185,6 +1197,7 @@
pDomTree = DomTree_alloc () ;
+ pDomTree -> pDependsOn = newAV () ;
pOrgDomTree = DomTree_self (xOrgDomTree) ; /* relookup in case it has moved */
pDomTree -> xDocument = pOrgDomTree -> xDocument ;
1.23.4.12 +11 -3 embperl/epeval.c
Index: epeval.c
===================================================================
RCS file: /home/cvs/embperl/epeval.c,v
retrieving revision 1.23.4.11
retrieving revision 1.23.4.12
diff -u -r1.23.4.11 -r1.23.4.12
--- epeval.c 2001/11/13 07:35:17 1.23.4.11
+++ epeval.c 2001/11/14 15:01:41 1.23.4.12
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epeval.c,v 1.23.4.11 2001/11/13 07:35:17 richter Exp $
+# $Id: epeval.c,v 1.23.4.12 2001/11/14 15:01:41 richter Exp $
#
###################################################################################*/
@@ -51,6 +51,7 @@
perl_eval_sv(pArg, G_SCALAR | G_KEEPERR);
+ tainted = 0 ;
pSVErr = ERRSV ;
if (SvTRUE (pSVErr))
{
@@ -110,6 +111,7 @@
SV * pRV ;
pRV = perl_eval_pv (s, 0) ;
+ tainted = 0 ;
if (SvROK (pRV))
{
*pCV = (CV *)SvRV (pRV) ;
@@ -218,6 +220,7 @@
PUSHMARK(sp);
n = perl_eval_sv(pSVCmd, G_SCALAR | G_KEEPERR);
SvREFCNT_dec(pSVCmd);
+ tainted = 0 ;
SPAGAIN;
if (n > 0)
@@ -297,12 +300,14 @@
XPUSHs(sv_2mortal(newSVpv((char *)sArg, strlen (sArg)))); /* push the base onto
the stack */
PUTBACK; /* make local stack pointer global */
num = perl_call_pv ("_eval_", G_SCALAR /*| G_EVAL*/) ; /* call the function
*/
+ tainted = 0 ;
#else
pSVArg = sv_2mortal(newSVpv((char *)sArg, strlen (sArg))) ;
/*num = perl_eval_sv (pSVArg, G_SCALAR) ; / * call the function */
*/
num = perl_eval_sv (pSVArg, G_DISCARD) ; /* call the function */
+ tainted = 0 ;
num = 0 ;
#endif
SPAGAIN; /* refresh stack pointer */
@@ -383,7 +388,8 @@
PUSHMARK(sp); /* remember the stack pointer */
perl_call_pv ("HTML::Embperl::watch", G_DISCARD | G_NOARGS) ; /* call the
function */
-
+ tainted = 0 ;
+
return ok ;
}
@@ -433,7 +439,8 @@
PUSHMARK(sp); /* remember the stack pointer */
num = perl_call_sv ((SV *)pSub, flags | G_EVAL | G_NOARGS) ; /* call the
function */
-
+ tainted = 0 ;
+
SPAGAIN; /* refresh stack pointer */
if (r -> bDebug & dbgMem)
@@ -716,6 +723,7 @@
PUTBACK;
num = perl_call_sv ((SV *)pSub, flags | G_EVAL | (numArgs?0:G_NOARGS)) ; /*
call the function */
+ tainted = 0 ;
SPAGAIN; /* refresh stack pointer */
1.75.4.67 +10 -2 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.75.4.66
retrieving revision 1.75.4.67
diff -u -r1.75.4.66 -r1.75.4.67
--- epmain.c 2001/11/14 09:30:30 1.75.4.66
+++ epmain.c 2001/11/14 15:01:41 1.75.4.67
@@ -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.66 2001/11/14 09:30:30 richter Exp $
+# $Id: epmain.c,v 1.75.4.67 2001/11/14 15:01:41 richter Exp $
#
###################################################################################*/
@@ -749,6 +749,8 @@
}
dowarn = savewarn ;
}
+ /* print out of env set tainted, so reset it now */
+ tainted = 0 ;
#ifdef APACHE
if (r -> pApacheReq)
@@ -816,6 +818,8 @@
_free (r, f) ;
#endif
+ tainted = 0 ;
+
return rc ;
}
@@ -1806,8 +1810,11 @@
SV * * ppCV ;
int rc ;
#endif
+
tConf * pConf = malloc (sizeof (tConf)) ;
+ tainted = 0 ;
+
if (!pConf)
return NULL ;
@@ -1944,6 +1951,8 @@
EPENTRY (SetupFileData) ;
+ tainted = 0 ;
+
/* Have we seen this sourcefile/package already ? */
cache_key_len = strlen( sSourcefile ) ;
if ( pConf->sPackage )
@@ -3443,7 +3452,6 @@
i = GetHashValueInt (pRP, "expires_in", 0) ;
c = GetHashValueSVinc (pRP, "expires_func", NULL) ;
s = GetHashValueStrDup (pRP, "expires_filename", NULL) ;
- lprintf (r, "i=%x c=%x s=%x\n", i, c, s) ;
pParam = (HV *)SvRV(sv_2mortal (CreateHashRef (
"expires_in", hashtint, i,
1.4.2.44 +4 -2 embperl/Attic/epparse.c
Index: epparse.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epparse.c,v
retrieving revision 1.4.2.43
retrieving revision 1.4.2.44
diff -u -r1.4.2.43 -r1.4.2.44
--- epparse.c 2001/11/14 09:30:30 1.4.2.43
+++ epparse.c 2001/11/14 15:01:41 1.4.2.44
@@ -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.43 2001/11/14 09:30:30 richter Exp $
+# $Id: epparse.c,v 1.4.2.44 2001/11/14 15:01:41 richter Exp $
#
###################################################################################*/
@@ -229,7 +229,9 @@
unsigned char * pStartChars = pTokenTable -> cStartChars ;
unsigned char * pAllChars = pTokenTable -> cAllChars ;
- r -> bDebug |= dbgBuildToken ;
+ tainted = 0 ;
+
+ /* r -> bDebug |= dbgBuildToken ; */
memset (pStartChars, 0, sizeof (pTokenTable -> cStartChars)) ;
memset (pAllChars, 0, sizeof (pTokenTable -> cAllChars)) ;
1.15.4.28 +11 -6 embperl/eputil.c
Index: eputil.c
===================================================================
RCS file: /home/cvs/embperl/eputil.c,v
retrieving revision 1.15.4.27
retrieving revision 1.15.4.28
diff -u -r1.15.4.27 -r1.15.4.28
--- eputil.c 2001/11/14 09:30:30 1.15.4.27
+++ eputil.c 2001/11/14 15:01:41 1.15.4.28
@@ -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.27 2001/11/14 09:30:30 richter Exp $
+# $Id: eputil.c,v 1.15.4.28 2001/11/14 15:01:41 richter Exp $
#
###################################################################################*/
@@ -709,11 +709,13 @@
SV ** ppSV ;
/*EPENTRY (GetHashValueInt) ;*/
-
+
ppSV = hv_fetch(pHash, (char *)sKey, strlen (sKey), 0) ;
- if (ppSV != NULL)
- return SvUV (*ppSV) ;
-
+ if (ppSV != NULL && *ppSV)
+ {
+ return SvUV ((*ppSV)) ;
+ }
+
return nDefault ;
}
@@ -905,11 +907,14 @@
/*in*/ IV nValue)
{
- SV * pSV = newSViv (nValue) ;
+ SV * pSV ;
/*EPENTRY (GetHashValueInt) ;*/
+ tainted = 0 ; /* doesn't make sense to taint an integer */
+ pSV = newSViv (nValue) ;
hv_store(pHash, (char *)sKey, strlen (sKey), pSV, 0) ;
+
}
No revision
No revision
1.1.2.3 +35 -16 embperl/Embperl/Attic/Recipe.pm
Index: Recipe.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Recipe.pm,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- Recipe.pm 2001/11/12 12:45:40 1.1.2.2
+++ Recipe.pm 2001/11/14 15:01:42 1.1.2.3
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Recipe.pm,v 1.1.2.2 2001/11/12 12:45:40 richter Exp $
+# $Id: Recipe.pm,v 1.1.2.3 2001/11/14 15:01:42 richter Exp $
#
###################################################################################
@@ -36,28 +36,47 @@
my @names = split (/\s/, $name) ;
+no strict ;
foreach $recipe (@names)
{
- if (exists ($Recipes{$recipe}))
+ my $mod ;
+ if (!($mod = $Recipes{$recipe}))
{
- my $obj = $Recipes{$recipe} ;
- next if (!$obj -> CanHandle ($param) ;
- return $obj ;
+ my $mod = ($name =~ /::/)?$recipe:'HTML::Embperl::Recipe::'. $recipe ;
+ if (!defined (&{$mod . '::new}))
+ {
+ eval "require $mod" ;
+ if ($@)
+ {
+ warn $@ ;
+ return undef ;
+ }
+ }
}
- my $mod = ($name =~ /::/)?$recipe:'HTML::Embperl::Recipe::'. $recipe ;
- eval "require $mod" ;
- if ($@)
- {
- warn $@ ;
- return undef ;
+
+ my $obj = $mod -> new ($recipe, $param) ;
+ return $obj if ($obj) ;
}
-no strict ;
- my $obj = $Recipes{$recipe} = $mod -> new ($recipe, $param) ;
-use strict ;
- next if (!$obj -> CanHandle ($param) ;
- return $obj ;
}
+use strict ;
return undef ;
+ }
+
+
+# ---------------------------------------------------------------------------------
+#
+# Execute
+#
+# ---------------------------------------------------------------------------------
+
+
+
+sub Execute
+
+ {
+ my ($self) = @_ ;
+
+ return HTML::Embperl::Execute ({recipe => $self}) ;
}
No revision
No revision
1.1.2.1 +96 -0 embperl/Embperl/Recipe/Attic/Embperl.pm
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
