You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by Ken Williams <ke...@forum.swarthmore.edu> on 2001/01/29 23:06:41 UTC
Re: cvs commit: modperl/lib/Apache PerlRun.pm
dougm@apache.org wrote:
> --- PerlRun.pm 2001/01/12 15:45:12 1.34
> +++ PerlRun.pm 2001/01/29 21:51:30 1.35
> @@ -340,7 +340,12 @@
> if (defined &$fullname) {
> no warnings;
> local $^W = 0;
> - *{$fullname} = sub {};
> + if (my $p = prototype $fullname) {
> + eval "*{\$fullname} = sub ($p) {}";
> + }
> + else {
> + *{$fullname} = sub {};
> + }
> undef &$fullname;
I know it's a nitpick, but the following is a bit faster (about 35%
faster according to Benchmark) and a little clearer to read:
==========================================================
--- PerlRun.pm 2001/01/12 15:45:12 1.34
+++ PerlRun.pm 2001/01/29 21:51:30 1.35
@@ -340,7 +340,12 @@
if (defined &$fullname) {
no warnings;
local $^W = 0;
- *{$fullname} = sub {};
+ if (my $p = prototype $fullname) {
+ *{$fullname} = eval "sub ($p) {}";
+ }
+ else {
+ *{$fullname} = sub {};
+ }
undef &$fullname;
}
if (*{$fullname}{IO}) {
==========================================================
------------------- -------------------
Ken Williams Last Bastion of Euclidity
ken@forum.swarthmore.edu The Math Forum
Re: cvs commit: modperl/lib/Apache PerlRun.pm
Posted by Gerald Richter <ri...@ecos.de>.
>
> much better, thanks ken. it'll be even faster when this ToDo item gets
> done :)
>
> - Apache::PerlRun::flush_namespace should be re-written in c
>
>
Just a few weeks ago I have rewritten the Embperl cleanup in C and it's
really much much faster now!
I append my source, maybe it helpfull for PerlRun too. Note that r is not
the Apache request_rec, but Embperl internal request record, it's only
needed for logging here. Also this function takes care about not to cleanup
variables that are imported from other modules. I am not quite sure if this
makes sense for PerlRun too, but I guess so. Additionaly there are a hash
%CLEANUP, here you can disable the cleanup for some variables or add some
that are normaly not cleanedup. Also if the function CLEANUP is defined, it
is called before the CLEANUP happens. I think it's easy to strip those parts
that are not necessary for PerlRun.
Gerald
void ClearSymtab (/*i/o*/ register req * r,
/*in*/ const char * sPackage)
{
SV * val;
char * key;
I32 klen;
int bDebug = 1 ;
SV * sv;
HV * hv;
AV * av;
struct io * io ;
HV * symtab ;
STRLEN l ;
CV * pCV ;
SV * pSV ;
SV * * ppSV ;
SV * pSVErr ;
HV * pCleanupHV ;
char * s ;
GV * pFileGV ;
GV * symtabgv ;
GV * symtabfilegv ;
dTHR;
if ((symtab = gv_stashpv ((char *)sPackage, 0)) == NULL)
return ;
ppSV = hv_fetch (symtab, "__ANON__", 8, 0) ;
if (!ppSV || !*ppSV)
{
if (bDebug)
lprintf (r, "[%d]CUP: No Perl code in %s\n", r -> nPid, sPackage) ;
return ;
}
symtabgv = (GV *)*ppSV ;
symtabfilegv = (GV *)GvFILEGV (symtabgv) ;
pSV = newSVpvf ("%s::CLEANUP", sPackage) ;
s = SvPV (pSV, l) ;
pCV = perl_get_cv (s, 0) ;
if (pCV)
{
if (bDebug)
lprintf (r, "[%d]CUP: Call &%s::CLEANUP\n", r -> nPid, sPackage) ;
perl_call_sv ((SV *)pCV, G_EVAL | G_NOARGS | G_DISCARD) ;
pSVErr = ERRSV ;
if (SvTRUE (pSVErr))
{
STRLEN l ;
char * p = SvPV (pSVErr, l) ;
if (l > sizeof (r -> errdat1) - 1)
l = sizeof (r -> errdat1) - 1 ;
strncpy (r -> errdat1, p, l) ;
if (l > 0 && r -> errdat1[l-1] == '\n')
l-- ;
r -> errdat1[l] = '\0' ;
LogError (r, rcEvalErr) ;
sv_setpv(pSVErr,"");
}
}
pCleanupHV = perl_get_hv (s, 1) ;
SvREFCNT_dec(pSV) ;
(void)hv_iterinit(symtab);
while ((val = hv_iternextsv(symtab, &key, &klen)))
{
if(SvTYPE(val) != SVt_PVGV)
continue;
s = GvNAME((GV *)val) ;
l = strlen (s) ;
ppSV = hv_fetch (pCleanupHV, s, l, 0) ;
if (ppSV && *ppSV && SvIV (*ppSV) == 0)
{
if (bDebug)
lprintf (r, "[%d]CUP: Ignore %s because it's in %%CLEANUP\n", r ->
nPid, s) ;
continue ;
}
if (!(ppSV && *ppSV && SvTRUE (*ppSV)))
{
if(GvIMPORTED((GV*)val))
{
if (bDebug)
lprintf (r, "[%d]CUP: Ignore %s because it's imported\n", r -> nPid,
s) ;
continue ;
}
pFileGV = GvFILEGV ((GV *)val) ;
if (pFileGV != symtabfilegv)
{
if (bDebug)
lprintf (r, "[%d]CUP: Ignore %s because it's defined in another source
file\n", r -> nPid, s) ;
continue ;
}
}
if((sv = GvSV((GV*)val)) && SvOK (sv))
{
if (bDebug)
lprintf (r, "[%d]CUP: $%s = %s\n", r -> nPid, s, SvPV (sv, l)) ;
sv_unmagic (sv, 'q') ; /* untie */
sv_setsv(sv, &sv_undef);
}
if((hv = GvHV((GV*)val)))
{
if (bDebug)
lprintf (r, "[%d]CUP: %%%s = ...\n", r -> nPid, s) ;
sv_unmagic ((SV *)hv, 'P') ; /* untie */
hv_clear(hv);
}
if((av = GvAV((GV*)val)))
{
if (bDebug)
lprintf (r, "[%d]CUP: @%s = ...\n", r -> nPid, s) ;
sv_unmagic ((SV *)av, 'P') ; /* untie */
av_clear(av);
}
if((io = GvIO((GV*)val)))
{
if (bDebug)
lprintf (r, "[%d]CUP: IO %s = ...\n", r -> nPid, s) ;
//sv_unmagic ((SV *)io, 'q') ; /* untie */
//do_close((GV *)val, 0);
}
}
}
-------------------------------------------------------------
Gerald Richter ecos electronic communication services gmbh
Internetconnect * Webserver/-design/-datenbanken * Consulting
Post: Tulpenstrasse 5 D-55276 Dienheim b. Mainz
E-Mail: richter@ecos.de Voice: +49 6133 925131
WWW: http://www.ecos.de Fax: +49 6133 925152
-------------------------------------------------------------
Re: cvs commit: modperl/lib/Apache PerlRun.pm
Posted by Doug MacEachern <do...@covalent.net>.
On Mon, 29 Jan 2001, Ken Williams wrote:
> I know it's a nitpick, but the following is a bit faster (about 35%
> faster according to Benchmark) and a little clearer to read:
much better, thanks ken. it'll be even faster when this ToDo item gets
done :)
- Apache::PerlRun::flush_namespace should be re-written in c