Re: piece of code in mod_perl guide
pascal barbedor wrote:
hello,
I am reading mod_perl guide and i had a problem with a piece of code in
chapter 9.7.4.2 about
reloading configuration files. this is version jan 2001 but i have
checked in the last one the piece of code is the same.
when running the code exactly, things don't work, even outside mod_perl
environnment.
the sub below print file is different even though I don't change the file.
I have located that if i change $MODIFIED{$file} = -M _; to an
explicit $MODIFIED{$file} = -M $file;
That's weird. _ uses the cached stat's output from the last stat call.
Does this work for you?
perl -e '-s /etc/passwd; print -M _'
use some existing file of course.
in the last line, everything works fine.
since i do no test on any other file and I have understood that _
account s for the last file tested, I don't understand why it does work.
I am on NT4 perl 5.6.1
try it yourself ! so strange !
thanks for any explanation
*
for (1..10){
reread_conf(l:/asperl/site/lib/afpa/evolif/config.pm);
sleep 2;
}
our %MODIFIED;
sub reread_conf{
my $file=shift;
return unless $file;
return unless -e $file and -r _;
if ($MODIFIED{$file} and $MODIFIED{$file}== -M _){
print same ; }else {print different;}
print \n;
unless ($MODIFIED{$file} and $MODIFIED{$file}== -M _){
unless (my $result = do $file) {
warn ...
}
print \nmod:,$MODIFIED{$file},' :', -M _,\n;
$MODIFIED{$file} = -M _;
}
}
--
_
Stas Bekman JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide http://perl.apache.org/guide
mailto:[EMAIL PROTECTED] http://ticketmaster.com http://apacheweek.com
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
Re: how to catch a killed task?
Christoph Bergmann wrote:
hi...
i use BSD::Resource to limit the ressources of the apache tasks. this
works fine but now i want to clean up afterwards but i don't know how to
catch a killed task... here is what i tried with signals:
my entries in httpd.conf:
PerlModule Apache::Resource
PerlSetEnv PERL_RLIMIT_CPU 120:150
PerlSetEnv PERL_RLIMIT_AS 3000:3500
PerlChildInitHandler Apache::Resource
and this is how i tried to catch the signals:
sub cleanup { die cleanup called...; }
$SIG{XFSZ} = \cleanup;
i use linux, thus i have to use RLIMIT_AS and so maybe XFSZ is the wrong
signal for the RAM limit. which do i have to use then?
but i tried $SIG{XCPU} but it doesnt work as well.
it just killed the task at soft limit without calling cleanup. what is
wrong?
or is there another possibility for cleaning up? probably there is a
handler i can use which will be called when a program is finished, if
so, how can i check if the program has ended as it shoulds or if it was
killed by BSD::resource ?
thanx in advance!
best regards,
christoph bergmann
Does the following help? (Look at the register_cleanup method)
http://thingy.kcilink.com/modperlguide/debug/Safe_Resource_Locking_and_Cleanu.html
--
_
Stas Bekman JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide http://perl.apache.org/guide
mailto:[EMAIL PROTECTED] http://ticketmaster.com http://apacheweek.com
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
Apache::Request UPLOAD_HOOK
The documentation on how to use this feature is a bit sketchy... Can anyone explain: 1) What the variables passed to the callback function are (looks like the Apache::Upload object is the first, but what's been filled in there when the hook gets called? The second looks like the current bunch of data that's been recieved[?], the third is the length, but is that the length recieved so far or the length recieved between the last time it was called and this time? And lastly, what can be placed in HOOK_DATA - scalar only?) 2) Is there any way of knowing how often the hook will get called? 3) Is there a specific phase of the Request that Apache::Request must be called and initialized with the callback before? 4) Are there any specific issues for using this with Apache::Request-instance ? Thanks, Issac Internet is a wonderful mechanism for making a fool ofyourself in front of a very large audience. --Anonymous Moving the mouse won't get you into trouble... Clicking it might. --Anonymous PGP Key 0xE0FA561B - Fingerprint:7E18 C018 D623 A57B 7F37 D902 8C84 7675 E0FA 561B
Re: piece of code in mod_perl guide
- Original Message -
From: Stas Bekman [EMAIL PROTECTED]
To: pascal barbedor [EMAIL PROTECTED]
Cc: [EMAIL PROTECTED]
Sent: Sunday, October 07, 2001 2:22 PM
Subject: Re: piece of code in mod_perl guide
I have located that if i change $MODIFIED{$file} = -M _; to an
explicit $MODIFIED{$file} = -M $file;
That's weird. _ uses the cached stat's output from the last stat call.
Does this work for you?
perl -e '-s /etc/passwd; print -M _'
yes it works, but the piece of code in mod_perl guide does not work, on my
specific config.pm, I don't understand why.
see below, the code, the output of the code, the config file .
In fact, it looks like when I try it on any other file that my config file,
it works. or it works on my config file with the explicit -M $file instead
of -M _.
If you can find any explanation...
pascal barbedor
code run
: --
--
print -s 'l:/config.pm',\n, -M _,\n;
for (1..10){ reread_conf(l:/config.pm) }
our %MODIFIED;
sub reread_conf{
my $file=shift;
return unless $file;
return unless -e $file and -r _;
if ($MODIFIED{$file} and $MODIFIED{$file}== -M _){
print same } else { print different }
print \n;
unless ($MODIFIED{$file} and $MODIFIED{$file}== -M _){
unless (my $result = do $file){
print lecture\n;
warn lecture de $file impossible: $@ if $@;
warn do de $file impossible: $! unless defined $result;
warn run de $file impossible unless $result;
}
print \nmod:,$MODIFIED{$file},' :', -M _,\n;
$MODIFIED{$file} = -M _;
}
}
---
output of code (see that the first stat worked and gives an age of very few
fraction of days, where reread_conf gives 66 days.)
with -M _ last line
983
0.00259259259259259
different
mod: :
different
mod: :67.2868981481481
different
mod:67.2868981481481 :67.2868981481481
different
mod:67.2868981481481 :67.2868981481481
different
mod:67.2868981481481 :67.2868981481481
different
mod:67.2868981481481 :67.2868981481481
different
mod:67.2868981481481 :67.2868981481481
different
mod:67.2868981481481 :67.2868981481481
different
mod:67.2868981481481 :67.2868981481481
different
mod:67.2868981481481 :67.2868981481481
Bonne exécution du processus
-
output of code with -M $file last line
983
0.0047337962962963
different
mod: :
same
same
same
same
same
same
same
same
same
Bonne exécution du processus
--
config.pm file
package AFPA::Evolif::Config ;
use XML::LibXML () ;
use XML::LibXSLT () ;
use XML::XPath () ;
use XML::Simple () ;
use DBI () ;
my $base='l:/perlinclude';
$CHASH{pconn}-disconnect() if $CHASH{pconn};
our %CHASH = (
indicateurs =
XML::LibXML-new-parse_file('l:/perlinclude/indicateurs.xml')
,
glups =
XML::LibXSLT-new-parse_stylesheet
(XML::LibXML-new-parse_file(l:/perlinclude/glups.xsl))
,
groupes =XML::XPath-
new(filename=l:/perlinclude/categories/groupements.xml)
,
zones =XML::XPath-
new(filename=l:/perlinclude/categories/decoupages.xml)
,
select=XML::LibXSLT-new-parse_stylesheet
(XML::LibXML-new-parse_file(l:/perlinclude/evselecteur.xsl))
,
pconn=DBI-connect(DBI:mysql:database=evolif;host=localhost,
pconn,
undef,
{RaiseError=1}
)
,
) ;
#my $stylesheet=
# XML::LibXSLT-new-parse_stylesheet (F_GLUP_XML);
#print $stylesheet-transform(F_IND_XML);
1 ;
Re: how to catch a killed task?
it just killed the task at soft limit without calling cleanup. what is wrong? I believe the limiting done by BSD::Resource is pretty harsh and may actually be at the kernel level. I don't think you can catch the signal and deal with it yourself. What you should do is use Apache::SizeLimit to handle your size constraints, and just use BSD::Resource for extreme cases, i.e. out of control servers in tight loops. or is there another possibility for cleaning up? probably there is a handler i can use which will be called when a program is finished, if so, how can i check if the program has ended as it shoulds or if it was killed by BSD::resource ? Put your cleanup code in a PerlChildExitHandler. Apache::SizeLimit will allow this to be called, since it uses the $r-child_terminate() call. BSD::Resource just does a harsh kill. - Perrin
Re: piece of code in mod_perl guide
[ ]
config.pm file
-
package AFPA::Evolif::Config ;
use XML::LibXML () ;
use XML::LibXSLT () ;
use XML::XPath () ;
use XML::Simple () ;
use DBI () ;
[ ... ]
Hi,
Could it be that XML::XPath does file tests on the
file $xmlfile passed to it through
XML::XPath-new(filename = $xmlfile)
which would cause '_' to use the stat on $xmlfile, rather
than the original config file?
best regards,
randy kobes
oh yes, this was the answer ! XML::XPATh-new stats the file.
thanks for clearing it out !
then maybe the last line of reread_conf in mod_perl guide should be
modified to
$MODIFIED{$file} = -M $file;
in case the do ( ) loads something which can possibily stat file.
pascal barbedor
sub reread_conf{
my $file=shift;
return unless $file;
return unless -e $file and -r _;
unless ($MODIFIED{$file} and $MODIFIED{$file}== -M _){
unless (my $result = do $file){
print lecture\n;
warn lecture de $file impossible: $@ if $@;
warn do de $file impossible: $! unless defined $result;
warn run de $file impossible unless $result;
}
$MODIFIED{$file} = -M _
}
}
POST and GET and getting multiple unsynced requests
Hi all,
I've written a web app as a single mod_perl handler. I started writing
my forms so they would do a POST and GET simultaneously. I did this by
making the form method=POST action=/job_details?job=65 for example.
Now I notice that IE and Netscape do a POST and GET request every time
the form is submitted (so I'm logging two requests for the same URI and
Mime type for each form submission. The first is GET and the second is
POST). My problem is that the data returned to the browser is from the
GET request. The page that is generated has content that is affected by
the POSTed data, but this is only visible on a refresh of the same page.
I've done tests with Netscape and IE. I consistently have this problem
with Netscape, and with IE it works most of the time, but approximatelly
every 20 requests, I'll get a page that is generated from the GET data,
not the POSTed data.
I've included a source snippit from my handler below. If anyone has seen
this before, I'd appreciate any help! (I scoured the guide and archive.
I'm really sorry if I missed it!)
--snip--
sub handler
{
my $r = Apache::Request-new(shift @_);
$r-log_error(Request being handled: . $r-content_type() .
- . $r-uri() . - . $r-method());
#We dont want to handle image, CSS or javascript requests
if($r-content_type() =~ m/(^image|^text\/css|javascript)/)
{
return DECLINED;
}
my $dbh = FUtil::connect_database();
--end snippet--
And the error log shows:
[Sun Oct 7 23:05:38 2001] [error] Request being handled: -
/job_details - GET
[Sun Oct 7 23:05:38 2001] [error] Request being handled: -
/job_details - POST
[Sun Oct 7 23:05:38 2001] [error] Request being handled: text/css -
/style.css - GET
[Sun Oct 7 23:05:38 2001] [error] Request being handled:
application/x-javascript - /js.js - GET
The form HTML tag that did this was:
form action=http://www.freeusall.com/job_details?job=61; method=POST
name=hotlist_form_jd_61
This is doing a POST and GET.
cvs commit: modperl-2.0/xs/maps apache_functions.map apr_functions.map
dougm 01/10/07 12:22:49
Modified:lib/ModPerl TypeMap.pm
xs/Apache/Filter Apache__Filter.h
xs/maps apache_functions.map apr_functions.map
Log:
remove ModPerl::TypeMap::first_class guessing based on return_type
Revision ChangesPath
1.11 +0 -2 modperl-2.0/lib/ModPerl/TypeMap.pm
Index: TypeMap.pm
===
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/TypeMap.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- TypeMap.pm2001/09/15 18:17:31 1.10
+++ TypeMap.pm2001/10/07 19:22:49 1.11
@@ -266,8 +266,6 @@
sub first_class {
my($self, $func) = @_;
-return $func-{return_type} if $func-{return_type} =~ /::/;
-
for my $e (@{ $func-{args} }) {
next unless $e-{type} =~ /::/;
#there are alot of util functions that take an APR::Pool
1.15 +3 -0 modperl-2.0/xs/Apache/Filter/Apache__Filter.h
Index: Apache__Filter.h
===
RCS file: /home/cvs/modperl-2.0/xs/Apache/Filter/Apache__Filter.h,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- Apache__Filter.h 2001/08/30 01:08:24 1.14
+++ Apache__Filter.h 2001/10/07 19:22:49 1.15
@@ -1,6 +1,9 @@
#define mpxs_Apache__RequestRec_add_output_filter(r, name, ctx) \
ap_add_output_filter(name, ctx, r, NULL)
+#define mpxs_Apache__RequestRec_add_input_filter(r, name, ctx) \
+ap_add_output_filter(name, ctx, r, NULL)
+
#define mp_xs_sv2_modperl_filter(sv) \
((SvROK(sv) (SvTYPE(SvRV(sv)) == SVt_PVMG)) \
|| (Perl_croak(aTHX_ argument is not a blessed reference),0) ? \
1.32 +3 -1 modperl-2.0/xs/maps/apache_functions.map
Index: apache_functions.map
===
RCS file: /home/cvs/modperl-2.0/xs/maps/apache_functions.map,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- apache_functions.map 2001/10/06 01:03:27 1.31
+++ apache_functions.map 2001/10/07 19:22:49 1.32
@@ -193,10 +193,12 @@
MODULE=Apache::Filter PACKAGE=Apache::RequestRec
ap_filter_t *:DEFINE_add_output_filter | | \
request_rec *:r, const char *:name, void *:ctx
+ap_filter_t *:DEFINE_add_input_filter | | \
+ request_rec *:r, const char *:name, void *:ctx
PACKAGE=guess
~ap_add_output_filter
- ap_add_input_filter
+~ap_add_input_filter
ap_get_brigade | mpxs_ | \
filter, bucket, mode=AP_MODE_NONBLOCKING, SV *:readbytes=Nullsv
ap_pass_brigade
1.24 +1 -1 modperl-2.0/xs/maps/apr_functions.map
Index: apr_functions.map
===
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- apr_functions.map 2001/09/28 17:20:32 1.23
+++ apr_functions.map 2001/10/07 19:22:49 1.24
@@ -454,7 +454,7 @@
apr_getnameinfo
-apr_getservbyname
apr_parse_addr_port
-PACKAGE=guess
+PACKAGE=APR::IpSubnet
apr_ipsubnet_t *:apr_ipsubnet_create | mpxs_ | \
SV *:CLASS, p, ipstr, mask_or_numbits=NULL | new
apr_ipsubnet_test
cvs commit: modperl-2.0/src/modules/perl modperl_util.c
dougm 01/10/07 13:20:53
Modified:src/modules/perl modperl_util.c
Log:
style nits
Revision ChangesPath
1.22 +20 -17modperl-2.0/src/modules/perl/modperl_util.c
Index: modperl_util.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- modperl_util.c2001/10/06 23:27:35 1.21
+++ modperl_util.c2001/10/07 20:20:53 1.22
@@ -399,51 +399,54 @@
}
}
-MP_INLINE
-SV *modperl_dir_config(pTHX_ request_rec *r, server_rec *s,
- char *key, SV *sv_val)
+MP_INLINE SV *modperl_dir_config(pTHX_ request_rec *r, server_rec *s,
+ char *key, SV *sv_val)
{
-SV *RETVAL = PL_sv_undef;
+SV *retval = PL_sv_undef;
if (r r-per_dir_config) {
MP_dDCFG;
-RETVAL = modperl_table_get_set(aTHX_ dcfg-SetVar, key, sv_val, FALSE);
+retval = modperl_table_get_set(aTHX_ dcfg-SetVar,
+ key, sv_val, FALSE);
}
-if (!SvTRUE(RETVAL)) {
+if (!SvTRUE(retval)) {
if (s s-module_config) {
MP_dSCFG(s);
-SvREFCNT_dec(RETVAL); /* in case above did newSV(0) */
-RETVAL = modperl_table_get_set(aTHX_ scfg-SetVar, key, sv_val, FALSE);
-} else {
-RETVAL = PL_sv_undef;
+SvREFCNT_dec(retval); /* in case above did newSV(0) */
+retval = modperl_table_get_set(aTHX_ scfg-SetVar,
+ key, sv_val, FALSE);
}
+else {
+retval = PL_sv_undef;
+}
}
-return RETVAL;
+return retval;
}
SV *modperl_table_get_set(pTHX_ apr_table_t *table, char *key,
SV *sv_val, bool do_taint)
{
-SV *RETVAL = PL_sv_undef;
+SV *retval = PL_sv_undef;
if (table == NULL) {
/* do nothing */
}
else if (key == NULL) {
-RETVAL = modperl_hash_tie(aTHX_ APR::Table, Nullsv, (void*)table);
+retval = modperl_hash_tie(aTHX_ APR::Table,
+ Nullsv, (void*)table);
}
else if (sv_val == PL_sv_no) { /* no val was passed */
char *val;
if ((val = (char *)apr_table_get(table, key))) {
-RETVAL = newSVpv(val, 0);
+retval = newSVpv(val, 0);
}
else {
-RETVAL = newSV(0);
+retval = newSV(0);
}
if (do_taint) {
-SvTAINTED_on(RETVAL);
+SvTAINTED_on(retval);
}
}
else if (sv_val == PL_sv_undef) { /* val was passed in as undef */
@@ -453,7 +456,7 @@
apr_table_set(table, key, SvPV_nolen(sv_val));
}
-return RETVAL;
+return retval;
}
MP_INLINE int modperl_perl_module_loaded(pTHX_ const char *name)
cvs commit: modperl-2.0/src/modules/perl modperl_util.c modperl_util.h
dougm 01/10/07 13:22:02
Modified:src/modules/perl modperl_util.c modperl_util.h
Log:
s/bool/int/ (i dont think bool is portable)
Revision ChangesPath
1.23 +1 -1 modperl-2.0/src/modules/perl/modperl_util.c
Index: modperl_util.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- modperl_util.c2001/10/07 20:20:53 1.22
+++ modperl_util.c2001/10/07 20:22:02 1.23
@@ -426,7 +426,7 @@
}
SV *modperl_table_get_set(pTHX_ apr_table_t *table, char *key,
- SV *sv_val, bool do_taint)
+ SV *sv_val, int do_taint)
{
SV *retval = PL_sv_undef;
1.22 +1 -1 modperl-2.0/src/modules/perl/modperl_util.h
Index: modperl_util.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- modperl_util.h2001/10/06 23:27:35 1.21
+++ modperl_util.h2001/10/07 20:22:02 1.22
@@ -72,7 +72,7 @@
char *key, SV *sv_val);
SV *modperl_table_get_set(pTHX_ apr_table_t *table, char *key,
- SV *sv_val, bool do_taint);
+ SV *sv_val, int do_taint);
MP_INLINE int modperl_perl_module_loaded(pTHX_ const char *name);
cvs commit: modperl-2.0/src/modules/perl modperl_util.c modperl_util.h
dougm 01/10/07 13:24:22
Modified:src/modules/perl modperl_util.c modperl_util.h
Log:
add modperl_perl_call_list() function
Revision ChangesPath
1.24 +23 -0 modperl-2.0/src/modules/perl/modperl_util.c
Index: modperl_util.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- modperl_util.c2001/10/07 20:22:02 1.23
+++ modperl_util.c2001/10/07 20:24:21 1.24
@@ -399,6 +399,29 @@
}
}
+void modperl_perl_call_list(pTHX_ AV *subs, const char *name)
+{
+I32 i, oldscope = PL_scopestack_ix;
+SV **ary = AvARRAY(subs);
+
+for (i=0; i=AvFILLp(subs); i++) {
+ CV *cv = (CV*)ary[i];
+ SV *atsv = ERRSV;
+
+ PUSHMARK(PL_stack_sp);
+ call_sv((SV*)cv, G_EVAL|G_DISCARD);
+
+ if (SvCUR(atsv)) {
+Perl_sv_catpvf(aTHX_ atsv, %s failed--call queue aborted,
+ name);
+ while (PL_scopestack_ix oldscope) {
+ LEAVE;
+}
+Perl_croak(aTHX_ %s, SvPVX(atsv));
+ }
+}
+}
+
MP_INLINE SV *modperl_dir_config(pTHX_ request_rec *r, server_rec *s,
char *key, SV *sv_val)
{
1.23 +2 -0 modperl-2.0/src/modules/perl/modperl_util.h
Index: modperl_util.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- modperl_util.h2001/10/07 20:22:02 1.22
+++ modperl_util.h2001/10/07 20:24:21 1.23
@@ -68,6 +68,8 @@
MP_INLINE void modperl_perl_av_push_elts_ref(pTHX_ AV *dst, AV *src);
+void modperl_perl_call_list(pTHX_ AV *subs, const char *name);
+
MP_INLINE SV *modperl_dir_config(pTHX_ request_rec *r, server_rec *s,
char *key, SV *sv_val);
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/10/07 14:59:16
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
implement logic for saving Perl special subroutines (END,BEGIN,CHECK,INIT)
into the per-interpreter PL_modglobal hash
modperl_perl_global_avcv_call() function to call the subroutines for given
package
modperl_perl_global_avcv_clear() function to clear the subroutines for given
package
END blocks are now saved via the new logic
Revision ChangesPath
1.6 +130 -0modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- modperl_perl_global.c 2001/10/07 19:04:20 1.5
+++ modperl_perl_global.c 2001/10/07 21:59:16 1.6
@@ -6,9 +6,131 @@
globals-inc.gv= PL_incgv;
globals-defout.gv = PL_defoutgv;
globals-rs.sv = PL_rs;
+globals-end.av= PL_endav;
+globals-end.key = MP_MODGLOBAL_END;
}
+/* XXX: PL_modglobal thingers might be useful elsewhere */
+
+#define MP_MODGLOBAL_ENT(key) \
+{key, ModPerl:: key, (sizeof(ModPerl::)-1)+(sizeof(key)-1), 0}
+
+static modperl_modglobal_key_t MP_modglobal_keys[] = {
+MP_MODGLOBAL_ENT(END),
+};
+
+static AV *modperl_perl_global_avcv_fetch(pTHX_ modperl_modglobal_key_t *gkey,
+ const char *package, I32 packlen)
+{
+SV **svp = hv_fetch(PL_modglobal, gkey-val, gkey-len, FALSE);
+HV *hv;
+
+if (!(svp (hv = (HV*)*svp))) {
+return Nullav;
+}
+
+if (!(svp = hv_fetch(hv, package, packlen, FALSE))) {
+return Nullav;
+}
+
+return (AV*)*svp;
+}
+
+void modperl_perl_global_avcv_call(pTHX_ modperl_modglobal_key_t *gkey,
+ const char *package, I32 packlen)
+{
+AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen);
+
+if (!av) {
+return;
+}
+
+modperl_perl_call_list(aTHX_ av, gkey-name);
+}
+
+void modperl_perl_global_avcv_clear(pTHX_ modperl_modglobal_key_t *gkey,
+const char *package, I32 packlen)
+{
+AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen);
+
+if (!av) {
+return;
+}
+
+av_clear(av);
+}
+
+static int modperl_perl_global_avcv_set(pTHX_ SV *sv, MAGIC *mg)
+{
+HV *hv;
+AV *mav, *av = (AV*)sv;
+const char *package = HvNAME(PL_curstash);
+I32 packlen = strlen(package);
+modperl_modglobal_key_t *gkey =
+(modperl_modglobal_key_t *)mg-mg_ptr;
+
+hv = (HV*)*hv_fetch(PL_modglobal, gkey-val, gkey-len, TRUE);
+(void)SvUPGRADE((SV*)hv, SVt_PVHV);
+
+mav = (AV*)*hv_fetch(hv, package, packlen, TRUE);
+(void)SvUPGRADE((SV*)mav, SVt_PVAV);
+
+/* $cv = pop @av */
+sv = AvARRAY(av)[AvFILLp(av)];
+AvARRAY(av)[AvFILLp(av)--] = PL_sv_undef;
+
+/* push @{ $PL_modglobal{$key}{$package} }, $cv */
+av_store(mav, AvFILLp(av)+1, sv);
+
+return 1;
+}
+
+static MGVTBL modperl_vtbl_global_avcv_t = {
+0,
+MEMBER_TO_FPTR(modperl_perl_global_avcv_set),
+0, 0, 0,
+};
+
+/* XXX: Apache::RegistryLoader type things need access to this
+ * for compiling scripts at startup
+ */
+static void modperl_perl_global_avcv_tie(pTHX_ modperl_modglobal_key_e key,
+ AV *av)
+{
+if (!SvMAGIC((SV*)av)) {
+MAGIC *mg;
+Newz(702, mg, 1, MAGIC);
+mg-mg_virtual = modperl_vtbl_global_avcv_t;
+mg-mg_ptr = (char *)MP_modglobal_keys[key];
+mg-mg_len = -1; /* prevent free() of mg-mg_ptr */
+SvMAGIC((SV*)av) = mg;
+}
+
+SvSMAGICAL_on((SV*)av);
+}
+
+static void modperl_perl_global_avcv_untie(pTHX_ AV *av)
+{
+SvSMAGICAL_off((SV*)av);
+}
+
+static void
+modperl_perl_global_avcv_save(pTHX_ modperl_perl_global_avcv_t *avcv)
+{
+avcv-origav = *avcv-av;
+*avcv-av = newAV(); /* XXX: only need 1 of these AVs per-interpreter */
+modperl_perl_global_avcv_tie(aTHX_ avcv-key, *avcv-av);
+}
+
static void
+modperl_perl_global_avcv_restore(pTHX_ modperl_perl_global_avcv_t *avcv)
+{
+modperl_perl_global_avcv_untie(aTHX_ *avcv-av);
+SvREFCNT_dec(*avcv-av); /* XXX: see XXX above */
+*avcv-av = avcv-origav;
+}
+
+static void
modperl_perl_global_gvhv_save(pTHX_ modperl_perl_global_gvhv_t *gvhv)
{
U32 mg_flags;
@@ -93,6 +215,7 @@
}
typedef enum {
+MP_GLOBAL_AVCV,
MP_GLOBAL_GVHV,
MP_GLOBAL_GVAV,
MP_GLOBAL_GVIO,
@@ -109,6 +232,7 @@
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/10/07 15:04:07
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
add modperl_modglobal_lookup() function to lookup a modperl_modglobal_key_t based on
string name
Revision ChangesPath
1.7 +14 -0 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- modperl_perl_global.c 2001/10/07 21:59:16 1.6
+++ modperl_perl_global.c 2001/10/07 22:04:07 1.7
@@ -17,7 +17,21 @@
static modperl_modglobal_key_t MP_modglobal_keys[] = {
MP_MODGLOBAL_ENT(END),
+{ NULL },
};
+
+modperl_modglobal_key_t *modperl_modglobal_lookup(pTHX_ const char *name)
+{
+int i;
+
+for (i=0; MP_modglobal_keys[i].name; i++) {
+if (strEQ(MP_modglobal_keys[i].name, name)) {
+return MP_modglobal_keys[i];
+}
+}
+
+return NULL;
+}
static AV *modperl_perl_global_avcv_fetch(pTHX_ modperl_modglobal_key_t *gkey,
const char *package, I32 packlen)
1.6 +2 -0 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- modperl_perl_global.h 2001/10/07 21:59:16 1.5
+++ modperl_perl_global.h 2001/10/07 22:04:07 1.6
@@ -49,6 +49,8 @@
modperl_perl_global_svpv_t rs;
} modperl_perl_globals_t;
+modperl_modglobal_key_t *modperl_modglobal_lookup(pTHX_ const char *name);
+
void modperl_perl_global_request_save(pTHX_ request_rec *r);
void modperl_perl_global_request_restore(pTHX_ request_rec *r);
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/10/07 15:07:15
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
wont be able to use a precomputed hash for modperl_modglobal_key_t's
Revision ChangesPath
1.8 +1 -1 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_perl_global.c 2001/10/07 22:04:07 1.7
+++ modperl_perl_global.c 2001/10/07 22:07:15 1.8
@@ -13,7 +13,7 @@
/* XXX: PL_modglobal thingers might be useful elsewhere */
#define MP_MODGLOBAL_ENT(key) \
-{key, ModPerl:: key, (sizeof(ModPerl::)-1)+(sizeof(key)-1), 0}
+{key, ModPerl:: key, (sizeof(ModPerl::)-1)+(sizeof(key)-1)}
static modperl_modglobal_key_t MP_modglobal_keys[] = {
MP_MODGLOBAL_ENT(END),
1.7 +0 -1 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- modperl_perl_global.h 2001/10/07 22:04:07 1.6
+++ modperl_perl_global.h 2001/10/07 22:07:15 1.7
@@ -5,7 +5,6 @@
const char *name;
const char *val;
I32 len;
-U32 hash;
} modperl_modglobal_key_t;
typedef enum {
cvs commit: modperl-2.0/xs/tables/current/ModPerl FunctionTable.pm
dougm 01/10/07 15:11:56
Modified:xs/tables/current/ModPerl FunctionTable.pm
Log:
sync
Revision ChangesPath
1.31 +124 -8modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- FunctionTable.pm 2001/10/06 01:03:27 1.30
+++ FunctionTable.pm 2001/10/07 22:11:56 1.31
@@ -2,7 +2,7 @@
# !!
# ! WARNING: generated by ModPerl::ParseSource/0.01
-# ! Fri Oct 5 17:52:47 2001
+# ! Sun Oct 7 15:18:16 2001
# ! do NOT edit, any changes will be lost !
# !!
@@ -122,6 +122,10 @@
'name' = 'p'
},
{
+'type' = 'request_rec *',
+'name' = 'r'
+ },
+ {
'type' = 'server_rec *',
'name' = 's'
},
@@ -433,6 +437,24 @@
},
{
'return_type' = 'const char *',
+'name' = 'modperl_cmd_init_handlers',
+'args' = [
+ {
+'type' = 'cmd_parms *',
+'name' = 'parms'
+ },
+ {
+'type' = 'void *',
+'name' = 'mconfig'
+ },
+ {
+'type' = 'const char *',
+'name' = 'arg'
+ }
+]
+ },
+ {
+'return_type' = 'const char *',
'name' = 'modperl_cmd_input_filter_handlers',
'args' = [
{
@@ -2513,6 +2535,20 @@
]
},
{
+'return_type' = 'modperl_modglobal_key_t *',
+'name' = 'modperl_modglobal_lookup',
+'args' = [
+ {
+'type' = 'PerlInterpreter *',
+'name' = 'my_perl'
+ },
+ {
+'type' = 'const char *',
+'name' = 'name'
+ }
+]
+ },
+ {
'return_type' = 'SV *',
'name' = 'modperl_newSVsv_obj',
'args' = [
@@ -2688,34 +2724,114 @@
},
{
'return_type' = 'void',
-'name' = 'modperl_perl_global_restore',
+'name' = 'modperl_perl_av_push_elts_ref',
'args' = [
{
'type' = 'PerlInterpreter *',
'name' = 'my_perl'
},
{
-'type' = 'modperl_perl_globals_t *',
-'name' = 'globals'
+'type' = 'AV *',
+'name' = 'dst'
+ },
+ {
+'type' = 'AV *',
+'name' = 'src'
}
]
},
{
'return_type' = 'void',
-'name' = 'modperl_perl_global_save',
+'name' = 'modperl_perl_call_list',
'args' = [
{
'type' = 'PerlInterpreter *',
'name' = 'my_perl'
},
+ {
+'type' = 'AV *',
+'name' = 'subs'
+ },
{
-'type' = 'modperl_perl_globals_t *',
-'name' = 'globals'
+'type' = 'const char *',
+'name' = 'name'
}
]
},
{
'return_type' = 'void',
+'name' = 'modperl_perl_global_avcv_call',
+'args' = [
+ {
+'type' = 'PerlInterpreter *',
+'name' = 'my_perl'
+ },
+ {
+'type' = 'modperl_modglobal_key_t *',
+'name' = 'gkey'
+ },
+ {
+'type' = 'const char *',
+'name' = 'package'
+ },
+ {
+'type' = 'I32',
+'name' = 'packlen'
+ }
+]
+ },
+ {
+'return_type' = 'void',
+'name' = 'modperl_perl_global_avcv_clear',
+'args' = [
+ {
+'type' = 'PerlInterpreter *',
+'name' = 'my_perl'
+ },
+ {
+'type' = 'modperl_modglobal_key_t *',
+'name' = 'gkey'
+ },
+ {
+'type' = 'const char *',
+'name' = 'package'
+ },
+ {
+'type' = 'I32',
+'name' = 'packlen'
+ }
+]
+ },
+ {
+'return_type' = 'void',
+'name' = 'modperl_perl_global_request_restore',
+'args' = [
+ {
+'type' = 'PerlInterpreter *',
+'name' = 'my_perl'
+ },
+ {
+'type' = 'request_rec *',
+'name' = 'r'
+ }
+]
+ },
+ {
+'return_type' = 'void',
+'name' = 'modperl_perl_global_request_save',
+'args' = [
+ {
+'type' = 'PerlInterpreter *',
+'name' = 'my_perl'
+ },
+ {
+'type' = 'request_rec *',
+'name' = 'r'
+ }
+]
+ },
+ {
+'return_type' = 'void',
'name' = 'modperl_perl_ids_get',
'args' = [
{
@@ -3068,7 +3184,7 @@
'name' = 'sv_val'
},
{
-'type' = 'char',
+'type' = 'int',
'name' = 'do_taint'
cvs commit: modperl-2.0/lib/ModPerl ParseSource.pm WrapXS.pm
dougm 01/10/07 15:39:09
Modified:lib/ModPerl ParseSource.pm WrapXS.pm
Log:
include ModPerl:: in generated xs
Revision ChangesPath
1.3 +1 -1 modperl-2.0/lib/ModPerl/ParseSource.pm
Index: ParseSource.pm
===
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/ParseSource.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- ParseSource.pm2001/04/19 17:23:23 1.2
+++ ParseSource.pm2001/10/07 22:39:09 1.3
@@ -25,7 +25,7 @@
#filter/sort
my @wanted = grep { /mod_perl\.h/ } @$includes;
push @wanted, grep { m:xs/modperl_xs_: } @$includes;
-push @wanted, grep { m:xs/A: } @$includes;
+push @wanted, grep { m:xs/[AM]: } @$includes;
\@wanted;
}
1.23 +1 -1 modperl-2.0/lib/ModPerl/WrapXS.pm
Index: WrapXS.pm
===
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/WrapXS.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- WrapXS.pm 2001/09/25 19:44:02 1.22
+++ WrapXS.pm 2001/10/07 22:39:09 1.23
@@ -553,7 +553,7 @@
$self-prepare;
-for (qw(ModPerl::WrapXS Apache APR)) {
+for (qw(ModPerl::WrapXS Apache APR ModPerl)) {
$self-write_makefilepl($_);
}
cvs commit: modperl-2.0/xs/tables/current/ModPerl FunctionTable.pm
dougm 01/10/07 16:02:41
Modified:xs/maps modperl_functions.map
xs/tables/current/ModPerl FunctionTable.pm
Added: xs/ModPerl/Global ModPerl__Global.h
Log:
add ModPerl::Global module with functions to call/clear special lists (END,etc)
Revision ChangesPath
1.1 modperl-2.0/xs/ModPerl/Global/ModPerl__Global.h
Index: ModPerl__Global.h
===
typedef void (*mpxs_special_list_do_t)(pTHX_ modperl_modglobal_key_t *,
const char *, I32);
static int mpxs_special_list_do(pTHX_ const char *name,
SV *package,
mpxs_special_list_do_t func)
{
STRLEN packlen;
modperl_modglobal_key_t *gkey = modperl_modglobal_lookup(aTHX_ name);
if (!gkey) {
return FALSE;
}
SvPV_force(package, packlen);
func(aTHX_ gkey, SvPVX(package), packlen);
return TRUE;
}
static
MP_INLINE int mpxs_ModPerl__Global_special_list_call(const char *name,
SV *package)
{
dTHX; /* XXX */
return mpxs_special_list_do(aTHX_ name, package,
modperl_perl_global_avcv_call);
}
static
MP_INLINE int mpxs_ModPerl__Global_special_list_clear(const char *name,
SV *package)
{
dTHX; /* XXX */
return mpxs_special_list_do(aTHX_ name, package,
modperl_perl_global_avcv_clear);
}
1.21 +4 -0 modperl-2.0/xs/maps/modperl_functions.map
Index: modperl_functions.map
===
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- modperl_functions.map 2001/09/28 20:11:02 1.20
+++ modperl_functions.map 2001/10/07 23:02:41 1.21
@@ -1,5 +1,9 @@
#modperl specfic functions
+MODULE=ModPerl::Global
+ mpxs_ModPerl__Global_special_list_call
+ mpxs_ModPerl__Global_special_list_clear
+
MODULE=Apache::RequestUtil PACKAGE=guess
mpxs_Apache__RequestRec_push_handlers
mpxs_Apache__RequestRec_set_handlers
1.32 +43 -1 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- FunctionTable.pm 2001/10/07 22:11:56 1.31
+++ FunctionTable.pm 2001/10/07 23:02:41 1.32
@@ -2,7 +2,7 @@
# !!
# ! WARNING: generated by ModPerl::ParseSource/0.01
-# ! Sun Oct 7 15:18:16 2001
+# ! Sun Oct 7 15:51:20 2001
# ! do NOT edit, any changes will be lost !
# !!
@@ -4168,6 +4168,34 @@
]
},
{
+'return_type' = 'int',
+'name' = 'mpxs_ModPerl__Global_special_list_call',
+'args' = [
+ {
+'type' = 'const char *',
+'name' = 'name'
+ },
+ {
+'type' = 'SV *',
+'name' = 'package'
+ }
+]
+ },
+ {
+'return_type' = 'int',
+'name' = 'mpxs_ModPerl__Global_special_list_clear',
+'args' = [
+ {
+'type' = 'const char *',
+'name' = 'name'
+ },
+ {
+'type' = 'SV *',
+'name' = 'package'
+ }
+]
+ },
+ {
'return_type' = 'void',
'name' = 'mpxs_ap_allow_methods',
'args' = [
@@ -4676,6 +4704,20 @@
{
'type' = 'apr_read_type_e',
'name' = 'block'
+ }
+]
+ },
+ {
+'return_type' = 'int',
+'name' = 'mpxs_special_list_do',
+'args' = [
+ {
+'type' = '',
+'name' = 'my_perl'
+ },
+ {
+'type' = 'mpxs_special_list_do_t',
+'name' = 'func'
}
]
}
cvs commit: modperl-2.0/src/modules/perl mod_perl.c modperl_perl_global.c modperl_perl_global.h
dougm 01/10/07 12:04:20
Modified:src/modules/perl mod_perl.c modperl_perl_global.c
modperl_perl_global.h
Log:
add modperl_perl_global_request_{restore,save} functions for future use of
request_rec to manage globals
Revision ChangesPath
1.87 +2 -2 modperl-2.0/src/modules/perl/mod_perl.c
Index: mod_perl.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.86
retrieving revision 1.87
diff -u -r1.86 -r1.87
--- mod_perl.c2001/10/06 19:43:40 1.86
+++ mod_perl.c2001/10/07 19:04:20 1.87
@@ -529,7 +529,7 @@
rcfg-wbucket.header_parse = 1;
}
-modperl_perl_global_save(aTHX_ rcfg-perl_globals);
+modperl_perl_global_request_save(aTHX_ r);
h_stdout = modperl_io_tie_stdout(aTHX_ r);
h_stdin = modperl_io_tie_stdin(aTHX_ r);
@@ -550,7 +550,7 @@
modperl_env_request_untie(aTHX_ r);
#endif
-modperl_perl_global_restore(aTHX_ rcfg-perl_globals);
+modperl_perl_global_request_restore(aTHX_ r);
#ifdef USE_ITHREADS
if (MpInterpPUTBACK(interp)) {
1.5 +14 -2 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- modperl_perl_global.c 2001/10/06 23:27:47 1.4
+++ modperl_perl_global.c 2001/10/07 19:04:20 1.5
@@ -128,7 +128,7 @@
apr_uint64_t **ptr = (apr_uint64_t **) \
((char *)globals + (int)(long)modperl_perl_global_entries[i].offset)
-void modperl_perl_global_save(pTHX_ modperl_perl_globals_t *globals)
+static void modperl_perl_global_save(pTHX_ modperl_perl_globals_t *globals)
{
int i;
@@ -154,7 +154,7 @@
}
}
-void modperl_perl_global_restore(pTHX_ modperl_perl_globals_t *globals)
+static void modperl_perl_global_restore(pTHX_ modperl_perl_globals_t *globals)
{
int i;
@@ -176,4 +176,16 @@
break;
}
}
+}
+
+void modperl_perl_global_request_save(pTHX_ request_rec *r)
+{
+MP_dRCFG;
+modperl_perl_global_save(aTHX_ rcfg-perl_globals);
+}
+
+void modperl_perl_global_request_restore(pTHX_ request_rec *r)
+{
+MP_dRCFG;
+modperl_perl_global_restore(aTHX_ rcfg-perl_globals);
}
1.4 +2 -2 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- modperl_perl_global.h 2001/09/28 19:53:22 1.3
+++ modperl_perl_global.h 2001/10/07 19:04:20 1.4
@@ -31,8 +31,8 @@
modperl_perl_global_svpv_t rs;
} modperl_perl_globals_t;
-void modperl_perl_global_save(pTHX_ modperl_perl_globals_t *globals);
+void modperl_perl_global_request_save(pTHX_ request_rec *r);
-void modperl_perl_global_restore(pTHX_ modperl_perl_globals_t *globals);
+void modperl_perl_global_request_restore(pTHX_ request_rec *r);
#endif
