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/11 20:42:54 UTC
[Patch mp2] #2 PerlSections namespace
Following this discussion:
http://marc.theaimsgroup.com/?t=107100040400003&r=1&w=2
I've made a few adjustements and cleanups.
The following patch adds ModPerl::Util::file2package() to build a safe
package from a pathname or filename.
This is in turn used by <Perl> sections to put each block in it's own
namespace.
Configuration data placed in Apache::ReadConfig:: directly is processed
after the end of each <Perl> blocks to preserve current behaviour.
Should be marked as deprecated as soon as users can feed their own
configuration to Apache::PerlSections (not possible quite yet)
How about this?
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 11 Dec 2003 19:42:00 -0000
@@ -363,6 +363,7 @@
modperl_handler_t *handler = NULL;
const char *package_name = NULL;
const char *line_header = NULL;
+ const char *namespace = NULL;
int status = OK;
AV *args = Nullav;
SV *dollar_zero = Nullsv;
@@ -399,8 +400,16 @@
if (!(package_name = apr_table_get(options, "package"))) {
package_name = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_PACKAGE);
- apr_table_set(options, "package", package_name);
}
+
+ namespace = modperl_file2package(p, parms->directive->filename);
+
+ package_name = apr_psprintf(p, "%s::%s::line_%d",
+ package_name,
+ namespace,
+ parms->directive->line_num);
+
+ apr_table_set(options, "package", 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 11 Dec 2003 19:42:00 -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 11 Dec 2003 19:42:00 -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: 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 11 Dec 2003 19:42:00 -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: 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 11 Dec 2003 19:42:00 -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 11 Dec 2003 19:42:00 -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 11 Dec 2003 19:42:00 -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/modperl/.cvsignore
===================================================================
RCS file: /home/cvs/modperl-2.0/t/modperl/.cvsignore,v
retrieving revision 1.14
diff -u -I$Id: -r1.14 .cvsignore
--- t/modperl/.cvsignore 20 Mar 2003 05:49:55 -0000 1.14
+++ t/modperl/.cvsignore 11 Dec 2003 19:42:00 -0000
@@ -14,4 +14,5 @@
request_rec_tie_api.t
perl.t
taint.t
+util.t
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 11 Dec 2003 19:42:00 -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: t/response/TestModperl/util.pm
===================================================================
RCS file: t/response/TestModperl/util.pm
diff -N t/response/TestModperl/util.pm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ t/response/TestModperl/util.pm 11 Dec 2003 19:42:00 -0000
@@ -0,0 +1,43 @@
+package TestModperl::util;
+
+use strict;
+use warnings FATAL => 'all';
+
+use ModPerl::Util ();
+
+use Apache::Test;
+use Apache::TestUtil;
+
+use Apache::Const -compile => 'OK';
+
+my %test = (
+ 'simple' => 'simple',
+ 'simple.pm' => 'simple_pm',
+ '/some/path' => 'some::path',
+ '/some/path/file' => 'some::path::file',
+ '/some////path////file' => 'some::path::file',
+ '/some////path////file/' => 'some::path::file',
+ '/some////path////file//' => 'some::path::file',
+ '/some////path////file~//-/' => 'some::path::file_::_',
+ '/some/path/file.pl' => 'some::path::file_pl',
+ '/some/path/with:::bad:chars' => 'some::path::with___bad_chars',
+ '/some/path/...foobar' => 'some::path::___foobar',
+ 'C:\\Windows\\Temp\\SomeFile.bat' => 'C_::Windows::Temp::SomeFile_bat',
+);
+
+sub handler {
+ my $r = shift;
+ my $p = $r->pool;
+
+ plan $r, test => scalar(keys(%test));
+
+ foreach my $f (sort keys %test) {
+ ok t_cmp($test{$f}, ModPerl::Util::file2package($p, $f), $f);
+ }
+
+ Apache::OK;
+}
+
+1;
+__END__
+
Index: xs/ModPerl/Util/ModPerl__Util.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/ModPerl/Util/ModPerl__Util.h,v
retrieving revision 1.4
diff -u -I$Id: -r1.4 ModPerl__Util.h
--- xs/ModPerl/Util/ModPerl__Util.h 17 Feb 2003 09:03:17 -0000 1.4
+++ xs/ModPerl/Util/ModPerl__Util.h 11 Dec 2003 19:42:00 -0000
@@ -13,5 +13,6 @@
#define mpxs_Apache_current_callback modperl_callback_current_callback_get
+#define mpxs_ModPerl__Util_file2package(pool, filename) modperl_file2package(pool, filename)
Index: xs/maps/modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.61
diff -u -I$Id: -r1.61 modperl_functions.map
--- xs/maps/modperl_functions.map 1 Dec 2003 17:14:16 -0000 1.61
+++ xs/maps/modperl_functions.map 11 Dec 2003 19:42:00 -0000
@@ -3,6 +3,7 @@
MODULE=ModPerl::Util
mpxs_ModPerl__Util_untaint | | ...
DEFINE_exit | | int:status=0
+ char *:DEFINE_file2package | | apr_pool_t *:p, char *:filename
PACKAGE=Apache
char *:DEFINE_current_callback
Index: docs/api/ModPerl/Util.pod
===================================================================
RCS file: /home/cvs/modperl-docs/src/docs/2.0/api/ModPerl/Util.pod,v
retrieving revision 1.1
diff -u -I$Id: -r1.1 Util.pod
--- docs/api/ModPerl/Util.pod 11 Mar 2003 07:33:52 -0000 1.1
+++ docs/api/ModPerl/Util.pod 11 Dec 2003 19:42:00 -0000
@@ -11,11 +11,30 @@
ModPerl::Util::exit();
ModPerl::Util::untaint($) # secret API?
+
+ $package = ModPerl::Util::file2package($p, $filename);
=head1 DESCRIPTION
C<ModPerl::Util> provides mod_perl 2.0 util functions.
-META: complete
+=head1 API
+
+=over
+
+=item * current_callback
+
+Returns the currently running callback, like 'PerlResponseHandler'
+
+=item * file2package(pool, filename)
+
+Will build a safe package name from a filename or path.
+
+=item * exit
+
+Used internally to replace CORE::exit and terminate the request,
+not the whole children.
+
+=back
=cut
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 11 Dec 2003 19:42:00 -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] #2 PerlSections namespace
Posted by Stas Bekman <st...@stason.org>.
Geoffrey Young wrote:
>
> Stas Bekman wrote:
>
>>Philippe M. Chiasson wrote:
>>
>>
>>>Following this discussion:
>>>http://marc.theaimsgroup.com/?t=107100040400003&r=1&w=2
>>>
>>>I've made a few adjustements and cleanups.
>>>
>>>The following patch adds ModPerl::Util::file2package() to build a safe
>>>package from a pathname or filename.
>>
>>
>>Do you think we should really expose it in the public API?
>>package2filename is clear and generic, but file2package does a few
>>assumptions that might not be suitable to users. Do you think it'll
>>really speed up registry? If not I'd keep it as an internal util function.
>
>
> I haven't looked inside the cooker recently, so I really don't remember how
> it all works...
>
> but if we use package2file and/or file2package in registry someplace, then
> there's the potential that users will want to subclass registry and will
> thus require either function to emulate core.
>
> as I said, I'm not sure how we use either at the moment - bringing it up
> just in case :)
They have that function. As you can see it doesn't do the same as Phillipe's one.
#########################################################################
# func: make_namespace
# dflt: make_namespace
# desc: prepares the namespace
# args: $self - registry blessed object
# rtrn: the namespace
# efct: initializes the field: PACKAGE
#########################################################################
sub make_namespace {
my $self = shift;
my $package = $self->namespace_from;
# Escape everything into valid perl identifiers
$package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", unpack("C", $1))/eg;
# make sure that the sub-package doesn't start with a digit
$package =~ s/^(\d)/_$1/;
# prepend root
$package = $self->namespace_root() . "::$package";
$self->{PACKAGE} = $package;
return $package;
}
Again I'm fine with exposing package2file since it's deterministic. But not
with file2package. In fact we shouldn't expose any of these, they have very
little to do with mod_perl. The problem with exposing any functions is that
you can't change them later. So if we don't have to expose them, let's not do it.
__________________________________________________________________
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] #2 PerlSections namespace
Posted by Geoffrey Young <ge...@modperlcookbook.org>.
Stas Bekman wrote:
> Philippe M. Chiasson wrote:
>
>> Following this discussion:
>> http://marc.theaimsgroup.com/?t=107100040400003&r=1&w=2
>>
>> I've made a few adjustements and cleanups.
>>
>> The following patch adds ModPerl::Util::file2package() to build a safe
>> package from a pathname or filename.
>
>
> Do you think we should really expose it in the public API?
> package2filename is clear and generic, but file2package does a few
> assumptions that might not be suitable to users. Do you think it'll
> really speed up registry? If not I'd keep it as an internal util function.
I haven't looked inside the cooker recently, so I really don't remember how
it all works...
but if we use package2file and/or file2package in registry someplace, then
there's the potential that users will want to subclass registry and will
thus require either function to emulate core.
as I said, I'm not sure how we use either at the moment - bringing it up
just in case :)
--Geoff
---------------------------------------------------------------------
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 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
[Patch mp2] #3 PerlSections namespace
Posted by "Philippe M. Chiasson" <go...@cpan.org>.
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] #2 PerlSections namespace
Posted by Stas Bekman <st...@stason.org>.
Philippe M. Chiasson wrote:
> On Thu, 2003-12-11 at 15:49, Stas Bekman wrote:
>
>>Philippe M. Chiasson wrote:
>>
>>>Following this discussion:
>>>http://marc.theaimsgroup.com/?t=107100040400003&r=1&w=2
>>>
>>>I've made a few adjustements and cleanups.
>>>
>>>The following patch adds ModPerl::Util::file2package() to build a safe
>>>package from a pathname or filename.
>>
>>Do you think we should really expose it in the public API? package2filename is
>>clear and generic, but file2package does a few assumptions that might not be
>>suitable to users. Do you think it'll really speed up registry? If not I'd
>>keep it as an internal util function.
>
>
> After some thinking, I've come to agree with your opinion on this one.
> It's easy to expose too many things, and you end up with a big
> commitment to a big API. And in this case, there is so little to gain
> from it.
good ;)
>>>This is in turn used by <Perl> sections to put each block in it's own
>>>namespace.
>>>
>>>Configuration data placed in Apache::ReadConfig:: directly is processed
>>>after the end of each <Perl> blocks to preserve current behaviour.
>>>Should be marked as deprecated as soon as users can feed their own
>>>configuration to Apache::PerlSections (not possible quite yet)
>>
>>I'd deprecate it for a few releases to let people time to make the transition
>>and then completely drop the support (at the latest by 2.0 release).
>
>
> I'll work up a patch that will warn if Apache::ReadConfig:: is used
> directly. How does that sound?
>
> "[warn] Direct usage of %Apache::ReadConfig:: is deprecated"
>
> But for this to be any use, I'd also implement the alternatives to
> add_config() we discussed last week (add_hash, add_namespace, add_glob,
> etc)
+1
>>ayi, why does it look so much simpler in perl:
>>
>> # Escape everything into valid perl identifiers
>> $package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", unpack("C", $1))/eg;
>>
>> # make sure that the sub-package doesn't start with a digit
>> $package =~ s/^(\d)/_$1/;
>
>
> Because perl rocks!
>
>
>>can't we mirror this 1:1 with much simpler code?
>
>
> Wish we could, but I don't think I'd feel good about calling back into
> perl-land from perldo just for this.
I didn't suggest to eval_pv into perl, just asking whether we can do the above
in C in the same way?
>>kudos on docs and tests!
>
>
> Working up on the next patch, and already checked in the small doc patch
> to ModPerl::Util without filename2package
gozer++
__________________________________________________________________
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] #2 PerlSections namespace
Posted by "Philippe M. Chiasson" <go...@cpan.org>.
On Thu, 2003-12-11 at 15:49, Stas Bekman wrote:
> Philippe M. Chiasson wrote:
> > Following this discussion:
> > http://marc.theaimsgroup.com/?t=107100040400003&r=1&w=2
> >
> > I've made a few adjustements and cleanups.
> >
> > The following patch adds ModPerl::Util::file2package() to build a safe
> > package from a pathname or filename.
>
> Do you think we should really expose it in the public API? package2filename is
> clear and generic, but file2package does a few assumptions that might not be
> suitable to users. Do you think it'll really speed up registry? If not I'd
> keep it as an internal util function.
After some thinking, I've come to agree with your opinion on this one.
It's easy to expose too many things, and you end up with a big
commitment to a big API. And in this case, there is so little to gain
from it.
> > This is in turn used by <Perl> sections to put each block in it's own
> > namespace.
> >
> > Configuration data placed in Apache::ReadConfig:: directly is processed
> > after the end of each <Perl> blocks to preserve current behaviour.
> > Should be marked as deprecated as soon as users can feed their own
> > configuration to Apache::PerlSections (not possible quite yet)
>
> I'd deprecate it for a few releases to let people time to make the transition
> and then completely drop the support (at the latest by 2.0 release).
I'll work up a patch that will warn if Apache::ReadConfig:: is used
directly. How does that sound?
"[warn] Direct usage of %Apache::ReadConfig:: is deprecated"
But for this to be any use, I'd also implement the alternatives to
add_config() we discussed last week (add_hash, add_namespace, add_glob,
etc)
> > How about this?
>
> haven't tested, but conceptually looks good.
>
> > Index: src/modules/perl/modperl_cmd.c
>
> > + namespace = modperl_file2package(p, parms->directive->filename);
> > +
> > + package_name = apr_psprintf(p, "%s::%s::line_%d",
> > + package_name,
> ^^^^^^^^^^^^^
> > + namespace,
> > + parms->directive->line_num);
>
> can this be a different name? It doesn't feel very good when you use
> 'package_name' to create 'package_name', e.g. call the component as
> package_base_name?
noted!
> > +#define MP_VALID_PATH_DELIM(c) ((c) == '/' || (c) =='\\')
>
> is it always '\\'? couldn't it be "\\\\"?
Just stripping any occurences of those, so \\\\ becomes __, that's all.
> > +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 = '_';
> > + }
> > + }
>
> ayi, why does it look so much simpler in perl:
>
> # Escape everything into valid perl identifiers
> $package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", unpack("C", $1))/eg;
>
> # make sure that the sub-package doesn't start with a digit
> $package =~ s/^(\d)/_$1/;
Because perl rocks!
> can't we mirror this 1:1 with much simpler code?
Wish we could, but I don't think I'd feel good about calling back into
perl-land from perldo just for this.
> [...]
>
> kudos on docs and tests!
Working up on the next patch, and already checked in the small doc patch
to ModPerl::Util without filename2package
> __________________________________________________________________
> 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
--
--------------------------------------------------------------------------------
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] #2 PerlSections namespace
Posted by Stas Bekman <st...@stason.org>.
Philippe M. Chiasson wrote:
> Following this discussion:
> http://marc.theaimsgroup.com/?t=107100040400003&r=1&w=2
>
> I've made a few adjustements and cleanups.
>
> The following patch adds ModPerl::Util::file2package() to build a safe
> package from a pathname or filename.
Do you think we should really expose it in the public API? package2filename is
clear and generic, but file2package does a few assumptions that might not be
suitable to users. Do you think it'll really speed up registry? If not I'd
keep it as an internal util function.
> This is in turn used by <Perl> sections to put each block in it's own
> namespace.
>
> Configuration data placed in Apache::ReadConfig:: directly is processed
> after the end of each <Perl> blocks to preserve current behaviour.
> Should be marked as deprecated as soon as users can feed their own
> configuration to Apache::PerlSections (not possible quite yet)
I'd deprecate it for a few releases to let people time to make the transition
and then completely drop the support (at the latest by 2.0 release).
> How about this?
haven't tested, but conceptually looks good.
> Index: src/modules/perl/modperl_cmd.c
> + namespace = modperl_file2package(p, parms->directive->filename);
> +
> + package_name = apr_psprintf(p, "%s::%s::line_%d",
> + package_name,
^^^^^^^^^^^^^
> + namespace,
> + parms->directive->line_num);
can this be a different name? It doesn't feel very good when you use
'package_name' to create 'package_name', e.g. call the component as
package_base_name?
> +#define MP_VALID_PATH_DELIM(c) ((c) == '/' || (c) =='\\')
is it always '\\'? couldn't it be "\\\\"?
> +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 = '_';
> + }
> + }
ayi, why does it look so much simpler in perl:
# Escape everything into valid perl identifiers
$package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", unpack("C", $1))/eg;
# make sure that the sub-package doesn't start with a digit
$package =~ s/^(\d)/_$1/;
can't we mirror this 1:1 with much simpler code?
[...]
kudos on docs and tests!
__________________________________________________________________
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