It's been a long time that perl sections have been having trouble with recursive inclusion. This has been discussed before and has to do with the fact that all PerlSections are evaluated in the same namespace Apache::ReadSections.
The following patch follows a similar design than ModPerl::Registry, putting each <Perl> block in it's own namespace, based on filename & lineno. This now prevents infinite-recursion problems and makes $Includes from within <Perl> sections work fine. There is still one little problem left with this, people will not be able to put stuff directly in the Apache::ReadSections namespace themselves. I do have a plan for fixing that as well in a subsequent patch. As usual, look at it and tell me if it breaks more stuff than it fixes ;-) I had to introduce a function in mod_perl_util.c, modperl_file2package, that makes a package-safe name from a filepath, so maybe it could be exposed and used by ModPerl::Registry as well? Index: todo/release =================================================================== RCS file: /home/cvs/modperl-2.0/todo/release,v retrieving revision 1.5 diff -u -I$Id: -r1.5 release --- todo/release 1 Dec 2003 19:11:19 -0000 1.5 +++ todo/release 9 Dec 2003 19:34:34 -0000 @@ -27,11 +27,6 @@ A few issues with <Perl> sections: http://marc.theaimsgroup.com/?l=apache-modperl-dev&m=106074969831522&w=2 -* Recursive <Perl> sections: - http://www.gossamer-threads.com/archive/mod_perl_C1/dev_F4/%5BMP2_-_BUG_%5D_Issue_handing_Apache_config._error_messages_P70501/ - and - http://mathforum.org/epigone/modperl/dartrimpcil - * Fixing Apache->warn("foo") Report: http://mathforum.org/epigone/modperl-dev/noxtramcay/[EMAIL PROTECTED] Index: t/conf/extra.last.conf.in =================================================================== RCS file: /home/cvs/modperl-2.0/t/conf/extra.last.conf.in,v retrieving revision 1.9 diff -u -I$Id: -r1.9 extra.last.conf.in --- t/conf/extra.last.conf.in 17 Nov 2003 01:11:06 -0000 1.9 +++ t/conf/extra.last.conf.in 9 Dec 2003 19:34:34 -0000 @@ -19,6 +19,7 @@ }; #This is a comment $TestDirective::perl::comments="yes"; +$TestDirective::perl::PACKAGE = __PACKAGE__; </Perl> <Perl > @@ -26,6 +27,10 @@ $TestDirective::perl::filename = __FILE__; $TestDirective::perl::dollar_zero = $0; $TestDirective::perl::line = __LINE__; +</Perl> + +<Perl > +$Include = "@ServerRoot@/conf/perlsection.conf"; </Perl> ### --------------------------------- ### Index: t/conf/perlsection.conf =================================================================== RCS file: t/conf/perlsection.conf diff -N t/conf/perlsection.conf --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ t/conf/perlsection.conf 9 Dec 2003 19:34:34 -0000 @@ -0,0 +1,3 @@ +<Perl > +$TestDirective::perl::Included++; +</Perl> Index: t/response/TestDirective/perldo.pm =================================================================== RCS file: /home/cvs/modperl-2.0/t/response/TestDirective/perldo.pm,v retrieving revision 1.5 diff -u -I$Id: -r1.5 perldo.pm --- t/response/TestDirective/perldo.pm 17 Nov 2003 01:11:06 -0000 1.5 +++ t/response/TestDirective/perldo.pm 9 Dec 2003 19:34:34 -0000 @@ -10,15 +10,21 @@ sub handler { my $r = shift; - plan $r, tests => 9; + plan $r, tests => 11; ok t_cmp('yes', $TestDirective::perl::worked); - ok not exists $Apache::ReadConfig::Location{'/perl_sections'}; + ok t_cmp(qr/extra_last_conf::line_\d+$/, $TestDirective::perl::PACKAGE, '__PACKAGE__'); - ok exists $Apache::ReadConfig::Location{'/perl_sections_saved'}; - - ok t_cmp('PerlSection', $Apache::ReadConfig::Location{'/perl_sections_saved'}{'AuthName'}); + my %Location; + { + no strict 'refs'; + %Location = %{$TestDirective::perl::PACKAGE . '::Location'}; + } + + ok not exists $Location{'/perl_sections'}; + ok exists $Location{'/perl_sections_saved'}; + ok t_cmp('PerlSection', $Location{'/perl_sections_saved'}{'AuthName'}); ok t_cmp('yes', $TestDirective::perl::comments); @@ -29,6 +35,8 @@ ok $TestDirective::perl::line > 3; ok t_cmp("-e", $0, '$0'); + + ok t_cmp(1, $TestDirective::perl::Included, "Include"); Apache::OK; } Index: src/modules/perl/modperl_cmd.c =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v retrieving revision 1.51 diff -u -I$Id: -r1.51 modperl_cmd.c --- src/modules/perl/modperl_cmd.c 17 Nov 2003 01:11:06 -0000 1.51 +++ src/modules/perl/modperl_cmd.c 9 Dec 2003 19:34:34 -0000 @@ -399,8 +399,18 @@ if (!(package_name = apr_table_get(options, "package"))) { package_name = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_PACKAGE); - apr_table_set(options, "package", package_name); } + + package_name = modperl_section2package(p, package_name, + parms->directive->filename, + parms->directive->line_num); + + apr_table_set(options, "package", package_name); + + MP_TRACE_s(MP_FUNC, "PerlSection from file=%s, line=%d placed in %s\n", + parms->directive->filename, + parms->directive->line_num, + package_name); line_header = apr_psprintf(p, "\n#line %d %s\n", parms->directive->line_num, Index: src/modules/perl/modperl_util.c =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v retrieving revision 1.58 diff -u -I$Id: -r1.58 modperl_util.c --- src/modules/perl/modperl_util.c 25 Nov 2003 20:31:29 -0000 1.58 +++ src/modules/perl/modperl_util.c 9 Dec 2003 19:34:34 -0000 @@ -769,3 +769,45 @@ } } #endif + +#define MP_VALID_PKG_CHAR(c) (isalnum(c)||c==':'||c=='_') +static const char *modperl_file2package(apr_pool_t *p, const char *file) +{ + char *package; + char *c; + + c = package = apr_pcalloc(p, strlen(file)); + + /* First, skip invalid prefix characters */ + while (!MP_VALID_PKG_CHAR(*file)) { + file++; + } + + /* Then, replace bad characters with '_' */ + while (*file) { + if (MP_VALID_PKG_CHAR(*file)) { + *c = *file; + } + else { + /* Replace many bad characters with only one '_' */ + while (*(file+1) && !MP_VALID_PKG_CHAR(*(file+1))) { + file++; + } + + *c = '_'; + } + + c++; + file++; + } + + return package; +} + +const char *modperl_section2package(apr_pool_t *p, const char *namespace, const char *filename, int lineno) +{ + return apr_psprintf(p, "%s::%s::line_%d", namespace, modperl_file2package(p, filename), lineno); +} + + + Index: src/modules/perl/modperl_util.h =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v retrieving revision 1.48 diff -u -I$Id: -r1.48 modperl_util.h --- src/modules/perl/modperl_util.h 22 Sep 2003 23:46:19 -0000 1.48 +++ src/modules/perl/modperl_util.h 9 Dec 2003 19:34:34 -0000 @@ -159,4 +159,6 @@ void modperl_apr_table_dump(pTHX_ apr_table_t *table, char *name); #endif +const char *modperl_section2package(apr_pool_t *p, const char *namespace, const char *filename, int lineno); + #endif /* MODPERL_UTIL_H */ -- -------------------------------------------------------------------------------- Philippe M. Chiasson /gozer\@(cpan|ectoplasm)\.org/ 88C3A5A5 (122FF51B/C634E37B) http://gozer.ectoplasm.org/ F9BF E0C2 480E 7680 1AE5 3631 CB32 A107 88C3 A5A5 Q: It is impossible to make anything foolproof because fools are so ingenious. perl -e'$$=\${gozer};{$_=unpack(P7,pack(L,$$));/^JAm_pH\n$/&&print||$$++&&redo}'
signature.asc
Description: This is a digitally signed message part
