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/11/08 10:03:06 UTC
cvs commit: embperl Embperl.pm epcache.c epmain.c epprovider.c test.pl
richter 01/11/08 01:03:06
Modified: . Tag: Embperl2c Embperl.pm epcache.c epmain.c
epprovider.c test.pl
Log:
Embperl 2 - cache management
Revision Changes Path
No revision
No revision
1.118.4.57 +5 -5 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118.4.56
retrieving revision 1.118.4.57
diff -u -r1.118.4.56 -r1.118.4.57
--- Embperl.pm 2001/11/07 09:10:27 1.118.4.56
+++ Embperl.pm 2001/11/08 09:03:05 1.118.4.57
@@ -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.56 2001/11/07 09:10:27 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.57 2001/11/08 09:03:05 richter Exp $
#
###################################################################################
@@ -471,10 +471,10 @@
my $lineno = getlineno () ;
my $Inputfile = Sourcefile () ;
- if ($msg =~ /HTML\/Embperl/)
- {
- $msg =~ s/at (.*?) line (\d*)/at $Inputfile in block starting at line $lineno/ ;
- }
+ #if ($msg =~ /HTML\/Embperl/)
+ # {
+ # $msg =~ s/at (.*?) line (\d*)/at $Inputfile in block starting at line $lineno/ ;
+ # }
logerror (rcPerlWarn, $msg);
}
1.1.2.8 +6 -3 embperl/Attic/epcache.c
Index: epcache.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcache.c,v
retrieving revision 1.1.2.7
retrieving revision 1.1.2.8
diff -u -r1.1.2.7 -r1.1.2.8
--- epcache.c 2001/11/07 21:11:25 1.1.2.7
+++ epcache.c 2001/11/08 09:03:05 1.1.2.8
@@ -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.7 2001/11/07 21:11:25 richter Exp $
+# $Id: epcache.c,v 1.1.2.8 2001/11/08 09:03:05 richter Exp $
#
###################################################################################*/
@@ -873,6 +873,9 @@
pItem -> xData = *pData ;
bUpdate = TRUE ;
}
+ else
+ *pData = pItem -> xData ;
+
if (!pItem -> pSVData)
{
if ((r -> bDebug & dbgCache) && !bUpdate)
@@ -883,6 +886,8 @@
pItem -> pSVData = *pSVData ;
bUpdate = TRUE ;
}
+ else
+ *pSVData = pItem -> pSVData ;
if (bUpdate)
{
@@ -892,8 +897,6 @@
{
if (r -> bDebug & dbgCache)
lprintf (r, "[%d]CACHE: %s take from cache\n", r -> nPid, pItem -> sKey) ;
- *pData = pItem -> xData ;
- *pSVData = pItem -> pSVData ;
}
return ok ;
}
1.75.4.58 +32 -21 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.75.4.57
retrieving revision 1.75.4.58
diff -u -r1.75.4.57 -r1.75.4.58
--- epmain.c 2001/11/08 05:57:37 1.75.4.57
+++ epmain.c 2001/11/08 09:03:05 1.75.4.58
@@ -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.57 2001/11/08 05:57:37 richter Exp $
+# $Id: epmain.c,v 1.75.4.58 2001/11/08 09:03:05 richter Exp $
#
###################################################################################*/
@@ -3343,6 +3343,7 @@
SvREFCNT_dec (p2.pOutputExpiresCV) ;
#else
HV * pParam ;
+ SV * pImportParam ;
tCacheItem * pCache ;
if (GetHashValueSV (r -> pConf -> pReqParameter, "provider"))
@@ -3357,7 +3358,7 @@
pSrc = CreateHashRef (
"type", hashtstr, "memory",
"name", hashtstr, r -> Buf.pFile -> sSourcefile,
- "source", hashtsv, SvRV(r -> pInData),
+ "source", hashtsv, SvREFCNT_inc(SvRV(r -> pInData)),
"mtime", hashtint, (int)r -> Buf.pFile -> mtime,
NULL) ;
}
@@ -3389,7 +3390,7 @@
"cache", hashtint, 0,
"provider", hashtsv, CreateHashRef (
"type", hashtstr, "eprun",
- "source", hashtsv, CreateHashRef (
+ "source", hashtsv, pImportParam = CreateHashRef (
"provider", hashtsv, CreateHashRef (
"type", hashtstr, "epcompile",
"source", hashtsv, CreateHashRef (
@@ -3408,6 +3409,10 @@
NULL))) ;
}
+ if (r -> pImportStash)
+ pParam = (HV *)SvRV(pImportParam) ;
+
+
if (SvTYPE(pParam) != SVt_PVHV)
{
strncpy (r -> errdat2, "provider", sizeof(r -> errdat2) - 1) ;
@@ -3831,29 +3836,35 @@
Dirname (sInputfile, dir, sizeof (dir) - 1) ;
getcwd (olddir, sizeof (olddir) - 1) ;
#endif
- if (chdir (dir) < 0)
- lprintf (r, "chdir error\n" ) ;
- else
+ if (dir[0])
{
- if (!(dir[0] == '/'
- #ifdef WIN32
- ||
- dir[0] == '\\' ||
- (isalpha(dir[0]) && dir[1] == ':' &&
- (dir[2] == '\\' || dir[2] == '/'))
- #endif
- ))
+ if (chdir (dir) < 0)
+ lprintf (r, "chdir error\n" ) ;
+ else
{
- strcpy (r->sCWD,olddir) ;
- strcat (r->sCWD,"/") ;
- strcat (r->sCWD,dir) ;
+ if (!(dir[0] == '/'
+ #ifdef WIN32
+ ||
+ dir[0] == '\\' ||
+ (isalpha(dir[0]) && dir[1] == ':' &&
+ (dir[2] == '\\' || dir[2] == '/'))
+ #endif
+ ))
+ {
+ strcpy (r->sCWD,olddir) ;
+ strcat (r->sCWD,"/") ;
+ strcat (r->sCWD,dir) ;
+ }
+ else
+ strcpy (r->sCWD,dir) ;
}
- else
- strcpy (r->sCWD,dir) ;
- }
- }
+ }
+ else
+ r -> bOptions |= optDisableChdir ;
+ }
else
r -> bOptions |= optDisableChdir ;
+
r -> bReqRunning = 1 ;
1.1.2.4 +41 -3 embperl/Attic/epprovider.c
Index: epprovider.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epprovider.c,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -u -r1.1.2.3 -r1.1.2.4
--- epprovider.c 2001/11/07 21:11:26 1.1.2.3
+++ epprovider.c 2001/11/08 09:03:05 1.1.2.4
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epprovider.c,v 1.1.2.3 2001/11/07 21:11:26 richter Exp $
+# $Id: epprovider.c,v 1.1.2.4 2001/11/08 09:03:05 richter Exp $
#
###################################################################################*/
@@ -533,11 +533,49 @@
{
((tProviderMem *)pProvider) -> nLastModifiedWhileGet = ((tProviderMem *)pProvider) -> nLastModified ;
- *pData = ((tProviderMem *)pProvider) -> pSource ;
+ *pData = SvREFCNT_inc(((tProviderMem *)pProvider) -> pSource) ;
return ok ;
}
+/* ------------------------------------------------------------------------ */
+/* */
+/* ProviderMem_FreeContent */
+/* */
+/*!
+* \_en
+* Free the cached data
+*
+* @param r Embperl request record
+* @param pProvider The provider record
+* @return error code
+* \endif
+*
+* \_de
+* Gibt die gecachten Daten frei
+*
+* @param r Embperl request record
+* @param pProvider The provider record
+* @return Fehlercode
+* \endif
+*
+* ------------------------------------------------------------------------ */
+
+
+int ProviderMem_FreeContent(/*in*/ req * r,
+ /*in*/ tCacheItem * pItem)
+
+ {
+ tProviderMem * pProvider = (tProviderMem *)(pItem -> pProvider) ;
+ if (pItem -> pSVData && pProvider -> pSource)
+ {
+ SvREFCNT_dec (pProvider -> pSource) ;
+ pProvider -> pSource = NULL ;
+ }
+
+ return ok ;
+ }
+
/* ------------------------------------------------------------------------ */
/* */
/* ProviderMem_IsExpired */
@@ -579,8 +617,8 @@
&ProviderMem_AppendKey,
&ProviderMem_GetContentSV,
NULL,
- NULL,
NULL,
+ &ProviderMem_FreeContent,
&ProviderMem_IsExpired,
} ;
1.70.4.87 +4 -4 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.86
retrieving revision 1.70.4.87
diff -u -r1.70.4.86 -r1.70.4.87
--- test.pl 2001/11/08 05:57:37 1.70.4.86
+++ test.pl 2001/11/08 09:03:05 1.70.4.87
@@ -12,7 +12,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: test.pl,v 1.70.4.86 2001/11/08 05:57:37 richter Exp $
+# $Id: test.pl,v 1.70.4.87 2001/11/08 09:03:05 richter Exp $
#
###################################################################################
@@ -1754,7 +1754,7 @@
unlink ($outfile) ;
$t1 = HTML::Embperl::Clock () ;
- $err = HTML::Embperl::Execute ({'input' => \$indata,
+ $err = HTML::Embperl::Execute ({'input' => \$indata,
'inputfile' => 'i1',
'mtime' => 1,
'outputfile' => $outfile,
@@ -1885,9 +1885,9 @@
$err = CheckError ($EP2?6:8) if ($err == 0) ;
- if (@errors != ($EP2?2:12))
+ if (@errors != ($EP2?5:12))
{
- print "\n\n\@errors does not return correct number of errors (is " . scalar(@errors) . ", should 2)\n" ;
+ print "\n\n\@errors does not return correct number of errors (is " . scalar(@errors) . ", should 5)\n" ;
$err = 1 ;
}
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org