You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by "Philippe M. Chiasson" <go...@cpan.org> on 2003/12/16 00:15:12 UTC
[Patch mp2] #3 PerlSections namespace
After making the small changes we discussed, here is a simpler version
of the original <Perl> namespace patch, without exposing it thru
ModPerl::Util and a few style tweaks as per stas's recommendations.
? Doxyfile
? SIGNATURE
? dox
? foo
? perlsection.diff
? src.diff
? build/indent
? lib/C
? lib/threads
? t/modperl/util.t
Index: lib/Apache/PerlSections.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/PerlSections.pm,v
retrieving revision 1.1
diff -u -I$Id: -r1.1 PerlSections.pm
--- lib/Apache/PerlSections.pm 20 Oct 2003 17:44:48 -0000 1.1
+++ lib/Apache/PerlSections.pm 15 Dec 2003 23:13:28 -0000
@@ -13,6 +13,7 @@
use Apache::Const -compile => qw(OK);
use constant SPECIAL_NAME => 'PerlConfig';
+use constant SPECIAL_PACKAGE => 'Apache::ReadConfig';
sub new {
my($package, @args) = @_;
@@ -54,24 +55,28 @@
sub symdump {
my($self) = @_;
- my $pack = $self->package;
-
unless ($self->{symbols}) {
- $self->{symbols} = [];
-
no strict;
-
- #XXX: Shamelessly borrowed from Devel::Symdump;
- while (my ($key, $val) = each(%{ *{"$pack\::"} })) {
- local (*ENTRY) = $val;
- if (defined $val && defined *ENTRY{SCALAR}) {
- push @{$self->{symbols}}, [$key, $ENTRY];
- }
- if (defined $val && defined *ENTRY{ARRAY}) {
- push @{$self->{symbols}}, [$key, \@ENTRY];
- }
- if (defined $val && defined *ENTRY{HASH} && $key !~ /::/) {
- push @{$self->{symbols}}, [$key, \%ENTRY];
+
+ $self->{symbols} = [];
+
+ #XXX: Here would be a good place to warn about NOT using
+ # Apache::ReadConfig:: directly in <Perl> sections
+ foreach my $pack ($self->package, $self->SPECIAL_PACKAGE) {
+ #XXX: Shamelessly borrowed from Devel::Symdump;
+ while (my ($key, $val) = each(%{ *{"$pack\::"} })) {
+ #We don't want to pick up stashes...
+ next if ($key =~ /::$/);
+ local (*ENTRY) = $val;
+ if (defined $val && defined *ENTRY{SCALAR}) {
+ push @{$self->{symbols}}, [$key, $ENTRY];
+ }
+ if (defined $val && defined *ENTRY{ARRAY}) {
+ push @{$self->{symbols}}, [$key, \@ENTRY];
+ }
+ if (defined $val && defined *ENTRY{HASH} && $key !~ /::/) {
+ push @{$self->{symbols}}, [$key, \%ENTRY];
+ }
}
}
}
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 15 Dec 2003 23:13:28 -0000
@@ -361,8 +361,11 @@
apr_table_t *options = NULL;
const char *handler_name = NULL;
modperl_handler_t *handler = NULL;
- const char *package_name = NULL;
+ const char *pkg_base = NULL;
+ const char *pkg_namespace = NULL;
+ const char *pkg_name = NULL;
const char *line_header = NULL;
+ ap_directive_t *directive = parms->directive;
int status = OK;
AV *args = Nullav;
SV *dollar_zero = Nullsv;
@@ -397,17 +400,25 @@
handler = modperl_handler_new(p, handler_name);
- if (!(package_name = apr_table_get(options, "package"))) {
- package_name = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_PACKAGE);
- apr_table_set(options, "package", package_name);
+ if (!(pkg_base = apr_table_get(options, "package"))) {
+ pkg_base = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_PACKAGE);
}
+
+ pkg_namespace = modperl_file2package(p, directive->filename);
+
+ pkg_name = apr_psprintf(p, "%s::%s::line_%d",
+ pkg_base,
+ pkg_namespace,
+ directive->line_num);
+
+ apr_table_set(options, "package", pkg_name);
line_header = apr_psprintf(p, "\n#line %d %s\n",
- parms->directive->line_num,
- parms->directive->filename);
+ directive->line_num,
+ directive->filename);
/* put the code about to be executed in the configured package */
- arg = apr_pstrcat(p, "package ", package_name, ";", line_header,
+ arg = apr_pstrcat(p, "package ", pkg_name, ";", line_header,
arg, NULL);
}
@@ -421,7 +432,7 @@
ENTER;
save_item(dollar_zero);
- sv_setpv(dollar_zero, parms->directive->filename);
+ sv_setpv(dollar_zero, directive->filename);
eval_pv(arg, FALSE);
LEAVE;
@@ -436,8 +447,8 @@
}
else {
modperl_log_warn(s, apr_psprintf(p, "Syntax error at %s:%d %s",
- parms->directive->filename,
- parms->directive->line_num,
+ directive->filename,
+ directive->line_num,
SvPVX(ERRSV)));
}
@@ -455,7 +466,7 @@
SvREFCNT_dec((SV*)args);
if (!(saveconfig = MP_PERLSECTIONS_SAVECONFIG_SV) || !SvTRUE(saveconfig)) {
- HV *symtab = (HV*)gv_stashpv(package_name, FALSE);
+ HV *symtab = (HV*)gv_stashpv(pkg_name, FALSE);
if (symtab) {
modperl_clear_symtab(aTHX_ symtab);
}
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 15 Dec 2003 23:13:28 -0000
@@ -769,3 +769,53 @@
}
}
#endif
+
+#define MP_VALID_PKG_CHAR(c) (isalnum(c) ||(c) == '_')
+#define MP_VALID_PATH_DELIM(c) ((c) == '/' || (c) =='\\')
+char *modperl_file2package(apr_pool_t *p, const char *file)
+{
+ char *package;
+ char *c;
+ const char *f;
+ int len = strlen(file)+1;
+
+ /* First, skip invalid prefix characters */
+ while (!MP_VALID_PKG_CHAR(*file)) {
+ file++;
+ len--;
+ }
+
+ /* Then figure out how big the package name will be like */
+ for(f = file; *f; f++) {
+ if (MP_VALID_PATH_DELIM(*f)) {
+ len++;
+ }
+ }
+
+ package = apr_pcalloc(p, len);
+
+ /* Then, replace bad characters with '_' */
+ for (c = package; *file; c++, file++) {
+ if (MP_VALID_PKG_CHAR(*file)) {
+ *c = *file;
+ }
+ else if (MP_VALID_PATH_DELIM(*file)) {
+
+ /* Eliminate subsequent duplicate path delim */
+ while (*(file+1) && MP_VALID_PATH_DELIM(*(file+1))) {
+ file++;
+ }
+
+ /* path delim not until end of line */
+ if (*(file+1)) {
+ *c = *(c+1) = ':';
+ c++;
+ }
+ }
+ else {
+ *c = '_';
+ }
+ }
+
+ return package;
+}
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 15 Dec 2003 23:13:28 -0000
@@ -159,4 +159,5 @@
void modperl_apr_table_dump(pTHX_ apr_table_t *table, char *name);
#endif
+char *modperl_file2package(apr_pool_t *p, const char *file);
#endif /* MODPERL_UTIL_H */
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 15 Dec 2003 23:13:28 -0000
@@ -19,6 +19,7 @@
};
#This is a comment
$TestDirective::perl::comments="yes";
+$TestDirective::perl::PACKAGE = __PACKAGE__;
</Perl>
<Perl >
@@ -26,6 +27,23 @@
$TestDirective::perl::filename = __FILE__;
$TestDirective::perl::dollar_zero = $0;
$TestDirective::perl::line = __LINE__;
+</Perl>
+
+#Handle re-entrant <Perl> sections
+<Perl >
+$Include = "@ServerRoot@/conf/perlsection.conf";
+</Perl>
+
+#Deprecated access to Apache::ReadConfig:: still works
+<Perl >
+push @Apache::ReadConfig::Alias,
+ ['/perl_sections_readconfig', '@DocumentRoot@'];
+$Apache::ReadConfig::Location{'/perl_sections_readconfig'} = {
+ 'PerlInitHandler' => 'ModPerl::Test::add_config',
+ 'AuthType' => 'Basic',
+ 'AuthName' => 'PerlSection',
+ 'PerlAuthenHandler' => 'TestHooks::authen',
+ };
</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 15 Dec 2003 23:13:28 -0000
@@ -0,0 +1,4 @@
+#This is to test re-entrancy of <Perl> blocks
+<Perl >
+$TestDirective::perl::Included++;
+</Perl>
Index: t/directive/perl.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/directive/perl.t,v
retrieving revision 1.1
diff -u -I$Id: -r1.1 perl.t
--- t/directive/perl.t 24 Aug 2002 16:12:57 -0000 1.1
+++ t/directive/perl.t 15 Dec 2003 23:13:28 -0000
@@ -4,27 +4,29 @@
use Apache::Test;
use Apache::TestRequest;
-plan tests => 4;
+plan tests => 8;
#so we don't have to require lwp
my @auth = (Authorization => 'Basic ZG91Z206Zm9v'); #dougm:foo
-my $location = "/perl_sections/index.html";
-sok {
- ! GET_OK $location;
-};
-
-sok {
- my $rc = GET_RC $location;
- $rc == 401;
-};
-
-sok {
- GET_OK $location, @auth;
-};
-
-sok {
- ! GET_OK $location, $auth[0], $auth[1] . 'bogus';
-};
+foreach my $location ("/perl_sections/index.html",
+ "/perl_sections_readconfig/index.html") {
+ sok {
+ ! GET_OK $location;
+ };
+
+ sok {
+ my $rc = GET_RC $location;
+ $rc == 401;
+ };
+
+ sok {
+ GET_OK $location, @auth;
+ };
+
+ sok {
+ ! GET_OK $location, $auth[0], $auth[1] . 'bogus';
+ };
+}
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 15 Dec 2003 23:13:28 -0000
@@ -10,15 +10,22 @@
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/t::conf::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 +36,8 @@
ok $TestDirective::perl::line > 3;
ok t_cmp("-e", $0, '$0');
+
+ ok t_cmp(1, $TestDirective::perl::Included, "Include");
Apache::OK;
}
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 15 Dec 2003 23:13:28 -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/3D11A4E5.6010202@stason.org
--------------------------------------------------------------------------------
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}'
Re: [Patch mp2] #3 PerlSections namespace
Posted by Stas Bekman <st...@stason.org>.
Philippe M. Chiasson wrote:
> On Mon, 2003-12-15 at 16:21, Stas Bekman wrote:
>
>>Philippe M. Chiasson wrote:
>>
>>>After making the small changes we discussed, here is a simpler version
>>>of the original <Perl> namespace patch, without exposing it thru
>>>ModPerl::Util and a few style tweaks as per stas's recommendations.
>>
>>[...]
>>
>>Looks great! + a few indent comments ;)
>>
>
>
> I am obviously still having a hard time getting my whitespace right ;-(
> Thank you everwatching Stas and BAD, BAD gozer ;-)
;)
> This patch I believe is proprely cleaned up. If nobody finds anything
> wrong about it, I'll get it in tomorrow morning.
looks good ;)
> Have all a good day!
you too ;)
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [Patch mp2] #3 PerlSections namespace
Posted by "Philippe M. Chiasson" <go...@cpan.org>.
On Mon, 2003-12-15 at 16:21, Stas Bekman wrote:
> Philippe M. Chiasson wrote:
> > After making the small changes we discussed, here is a simpler version
> > of the original <Perl> namespace patch, without exposing it thru
> > ModPerl::Util and a few style tweaks as per stas's recommendations.
> [...]
>
> Looks great! + a few indent comments ;)
>
I am obviously still having a hard time getting my whitespace right ;-(
Thank you everwatching Stas and BAD, BAD gozer ;-)
This patch I believe is proprely cleaned up. If nobody finds anything
wrong about it, I'll get it in tomorrow morning.
Have all a good day!
? lib/C
? lib/threads
Index: lib/Apache/PerlSections.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/PerlSections.pm,v
retrieving revision 1.1
diff -u -I$Id: -r1.1 PerlSections.pm
--- lib/Apache/PerlSections.pm 20 Oct 2003 17:44:48 -0000 1.1
+++ lib/Apache/PerlSections.pm 16 Dec 2003 01:15:47 -0000
@@ -13,6 +13,7 @@
use Apache::Const -compile => qw(OK);
use constant SPECIAL_NAME => 'PerlConfig';
+use constant SPECIAL_PACKAGE => 'Apache::ReadConfig';
sub new {
my($package, @args) = @_;
@@ -54,24 +55,28 @@
sub symdump {
my($self) = @_;
- my $pack = $self->package;
-
unless ($self->{symbols}) {
- $self->{symbols} = [];
-
no strict;
-
- #XXX: Shamelessly borrowed from Devel::Symdump;
- while (my ($key, $val) = each(%{ *{"$pack\::"} })) {
- local (*ENTRY) = $val;
- if (defined $val && defined *ENTRY{SCALAR}) {
- push @{$self->{symbols}}, [$key, $ENTRY];
- }
- if (defined $val && defined *ENTRY{ARRAY}) {
- push @{$self->{symbols}}, [$key, \@ENTRY];
- }
- if (defined $val && defined *ENTRY{HASH} && $key !~ /::/) {
- push @{$self->{symbols}}, [$key, \%ENTRY];
+
+ $self->{symbols} = [];
+
+ #XXX: Here would be a good place to warn about NOT using
+ # Apache::ReadConfig:: directly in <Perl> sections
+ foreach my $pack ($self->package, $self->SPECIAL_PACKAGE) {
+ #XXX: Shamelessly borrowed from Devel::Symdump;
+ while (my ($key, $val) = each(%{ *{"$pack\::"} })) {
+ #We don't want to pick up stashes...
+ next if ($key =~ /::$/);
+ local (*ENTRY) = $val;
+ if (defined $val && defined *ENTRY{SCALAR}) {
+ push @{$self->{symbols}}, [$key, $ENTRY];
+ }
+ if (defined $val && defined *ENTRY{ARRAY}) {
+ push @{$self->{symbols}}, [$key, \@ENTRY];
+ }
+ if (defined $val && defined *ENTRY{HASH} && $key !~ /::/) {
+ push @{$self->{symbols}}, [$key, \%ENTRY];
+ }
}
}
}
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 16 Dec 2003 01:15:47 -0000
@@ -361,8 +361,11 @@
apr_table_t *options = NULL;
const char *handler_name = NULL;
modperl_handler_t *handler = NULL;
- const char *package_name = NULL;
+ const char *pkg_base = NULL;
+ const char *pkg_namespace = NULL;
+ const char *pkg_name = NULL;
const char *line_header = NULL;
+ ap_directive_t *directive = parms->directive;
int status = OK;
AV *args = Nullav;
SV *dollar_zero = Nullsv;
@@ -397,17 +400,25 @@
handler = modperl_handler_new(p, handler_name);
- if (!(package_name = apr_table_get(options, "package"))) {
- package_name = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_PACKAGE);
- apr_table_set(options, "package", package_name);
+ if (!(pkg_base = apr_table_get(options, "package"))) {
+ pkg_base = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_PACKAGE);
}
+
+ pkg_namespace = modperl_file2package(p, directive->filename);
+
+ pkg_name = apr_psprintf(p, "%s::%s::line_%d",
+ pkg_base,
+ pkg_namespace,
+ directive->line_num);
+
+ apr_table_set(options, "package", pkg_name);
line_header = apr_psprintf(p, "\n#line %d %s\n",
- parms->directive->line_num,
- parms->directive->filename);
+ directive->line_num,
+ directive->filename);
/* put the code about to be executed in the configured package */
- arg = apr_pstrcat(p, "package ", package_name, ";", line_header,
+ arg = apr_pstrcat(p, "package ", pkg_name, ";", line_header,
arg, NULL);
}
@@ -421,7 +432,7 @@
ENTER;
save_item(dollar_zero);
- sv_setpv(dollar_zero, parms->directive->filename);
+ sv_setpv(dollar_zero, directive->filename);
eval_pv(arg, FALSE);
LEAVE;
@@ -436,8 +447,8 @@
}
else {
modperl_log_warn(s, apr_psprintf(p, "Syntax error at %s:%d %s",
- parms->directive->filename,
- parms->directive->line_num,
+ directive->filename,
+ directive->line_num,
SvPVX(ERRSV)));
}
@@ -455,7 +466,7 @@
SvREFCNT_dec((SV*)args);
if (!(saveconfig = MP_PERLSECTIONS_SAVECONFIG_SV) || !SvTRUE(saveconfig)) {
- HV *symtab = (HV*)gv_stashpv(package_name, FALSE);
+ HV *symtab = (HV*)gv_stashpv(pkg_name, FALSE);
if (symtab) {
modperl_clear_symtab(aTHX_ symtab);
}
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 16 Dec 2003 01:15:47 -0000
@@ -769,3 +769,53 @@
}
}
#endif
+
+#define MP_VALID_PKG_CHAR(c) (isalnum(c) ||(c) == '_')
+#define MP_VALID_PATH_DELIM(c) ((c) == '/' || (c) =='\\')
+char *modperl_file2package(apr_pool_t *p, const char *file)
+{
+ char *package;
+ char *c;
+ const char *f;
+ int len = strlen(file)+1;
+
+ /* First, skip invalid prefix characters */
+ while (!MP_VALID_PKG_CHAR(*file)) {
+ file++;
+ len--;
+ }
+
+ /* Then figure out how big the package name will be like */
+ for (f = file; *f; f++) {
+ if (MP_VALID_PATH_DELIM(*f)) {
+ len++;
+ }
+ }
+
+ package = apr_pcalloc(p, len);
+
+ /* Then, replace bad characters with '_' */
+ for (c = package; *file; c++, file++) {
+ if (MP_VALID_PKG_CHAR(*file)) {
+ *c = *file;
+ }
+ else if (MP_VALID_PATH_DELIM(*file)) {
+
+ /* Eliminate subsequent duplicate path delim */
+ while (*(file+1) && MP_VALID_PATH_DELIM(*(file+1))) {
+ file++;
+ }
+
+ /* path delim not until end of line */
+ if (*(file+1)) {
+ *c = *(c+1) = ':';
+ c++;
+ }
+ }
+ else {
+ *c = '_';
+ }
+ }
+
+ return package;
+}
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 16 Dec 2003 01:15:47 -0000
@@ -159,4 +159,5 @@
void modperl_apr_table_dump(pTHX_ apr_table_t *table, char *name);
#endif
+char *modperl_file2package(apr_pool_t *p, const char *file);
#endif /* MODPERL_UTIL_H */
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 16 Dec 2003 01:15:47 -0000
@@ -19,6 +19,7 @@
};
#This is a comment
$TestDirective::perl::comments="yes";
+$TestDirective::perl::PACKAGE = __PACKAGE__;
</Perl>
<Perl >
@@ -26,6 +27,23 @@
$TestDirective::perl::filename = __FILE__;
$TestDirective::perl::dollar_zero = $0;
$TestDirective::perl::line = __LINE__;
+</Perl>
+
+#Handle re-entrant <Perl> sections
+<Perl >
+$Include = "@ServerRoot@/conf/perlsection.conf";
+</Perl>
+
+#Deprecated access to Apache::ReadConfig:: still works
+<Perl >
+push @Apache::ReadConfig::Alias,
+ ['/perl_sections_readconfig', '@DocumentRoot@'];
+$Apache::ReadConfig::Location{'/perl_sections_readconfig'} = {
+ 'PerlInitHandler' => 'ModPerl::Test::add_config',
+ 'AuthType' => 'Basic',
+ 'AuthName' => 'PerlSection',
+ 'PerlAuthenHandler' => 'TestHooks::authen',
+ };
</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 16 Dec 2003 01:15:47 -0000
@@ -0,0 +1,4 @@
+#This is to test re-entrancy of <Perl> blocks
+<Perl >
+$TestDirective::perl::Included++;
+</Perl>
Index: t/directive/perl.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/directive/perl.t,v
retrieving revision 1.1
diff -u -I$Id: -r1.1 perl.t
--- t/directive/perl.t 24 Aug 2002 16:12:57 -0000 1.1
+++ t/directive/perl.t 16 Dec 2003 01:15:47 -0000
@@ -4,27 +4,29 @@
use Apache::Test;
use Apache::TestRequest;
-plan tests => 4;
+plan tests => 8;
#so we don't have to require lwp
my @auth = (Authorization => 'Basic ZG91Z206Zm9v'); #dougm:foo
-my $location = "/perl_sections/index.html";
-sok {
- ! GET_OK $location;
-};
-
-sok {
- my $rc = GET_RC $location;
- $rc == 401;
-};
-
-sok {
- GET_OK $location, @auth;
-};
-
-sok {
- ! GET_OK $location, $auth[0], $auth[1] . 'bogus';
-};
+foreach my $location ("/perl_sections/index.html",
+ "/perl_sections_readconfig/index.html") {
+ sok {
+ ! GET_OK $location;
+ };
+
+ sok {
+ my $rc = GET_RC $location;
+ $rc == 401;
+ };
+
+ sok {
+ GET_OK $location, @auth;
+ };
+
+ sok {
+ ! GET_OK $location, $auth[0], $auth[1] . 'bogus';
+ };
+}
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 16 Dec 2003 01:15:47 -0000
@@ -10,15 +10,22 @@
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/t::conf::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 +36,8 @@
ok $TestDirective::perl::line > 3;
ok t_cmp("-e", $0, '$0');
+
+ ok t_cmp(1, $TestDirective::perl::Included, "Include");
Apache::OK;
}
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 16 Dec 2003 01:15:47 -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/3D11A4E5.6010202@stason.org
--
--------------------------------------------------------------------------------
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}'
Re: [Patch mp2] #3 PerlSections namespace
Posted by Stas Bekman <st...@stason.org>.
Philippe M. Chiasson wrote:
> After making the small changes we discussed, here is a simpler version
> of the original <Perl> namespace patch, without exposing it thru
> ModPerl::Util and a few style tweaks as per stas's recommendations.
[...]
Looks great! + a few indent comments ;)
> 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 15 Dec 2003 23:13:28 -0000
> @@ -769,3 +769,53 @@
> }
> }
> #endif
> +
> +#define MP_VALID_PKG_CHAR(c) (isalnum(c) ||(c) == '_')
^^
> +#define MP_VALID_PATH_DELIM(c) ((c) == '/' || (c) =='\\')
^^
> + /* Then figure out how big the package name will be like */
> + for(f = file; *f; f++) {
^^^
> Index: t/conf/extra.last.conf.in
> ===================================================================
[...]
> +push @Apache::ReadConfig::Alias,
> + ['/perl_sections_readconfig', '@DocumentRoot@'];
> +$Apache::ReadConfig::Location{'/perl_sections_readconfig'} = {
> + 'PerlInitHandler' => 'ModPerl::Test::add_config',
> + 'AuthType' => 'Basic',
> + 'AuthName' => 'PerlSection',
> + 'PerlAuthenHandler' => 'TestHooks::authen',
> + };
^^^^^
indent 4, and align => keys if you feel like ;)
> Index: t/response/TestDirective/perldo.pm
> ===================================================================
[...]
> + {
> + no strict 'refs';
> + %Location = %{$TestDirective::perl::PACKAGE . '::Location'};
> + }
indent
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org