You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@apache.org on 2002/10/07 04:35:18 UTC
cvs commit: modperl-2.0/todo possible_new_features.txt
dougm 2002/10/06 19:35:18
Modified: . Changes STATUS
lib/ModPerl TestRun.pm
src/modules/perl mod_perl.c modperl_cmd.c modperl_cmd.h
t/conf modperl_extra.pl
t/directive .cvsignore
todo possible_new_features.txt
Added: lib/Apache PerlSection.pm
t/response/TestDirective perldo.pm
Log:
Submitted by: gozer
Reviewed by: dougm
add default <Perl> handler Apache::PerlSection.
make <Perl> blocks to be EXEC_ON_READ so apache does not parse the contents.
add "Perl" directive for general use and for which <Perl> sections are
stuffed into.
Revision Changes Path
1.51 +6 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -r1.50 -r1.51
--- Changes 7 Oct 2002 02:05:43 -0000 1.50
+++ Changes 7 Oct 2002 02:35:18 -0000 1.51
@@ -10,6 +10,12 @@
=item 1.99_08-dev
+add default <Perl> handler Apache::PerlSection.
+make <Perl> blocks to be EXEC_ON_READ so apache does not parse the contents.
+add "Perl" directive for general use and for which <Perl> sections are
+stuffed into.
+[Philippe M. Chiasson <go...@cpan.org>]
+
rename overloaded LoadModule directive to PerlLoadModule
=item 1.99_07 - September 25, 2002
1.13 +1 -5 modperl-2.0/STATUS
Index: STATUS
===================================================================
RCS file: /home/cvs/modperl-2.0/STATUS,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- STATUS 17 Sep 2002 02:46:20 -0000 1.12
+++ STATUS 7 Oct 2002 02:35:18 -0000 1.13
@@ -54,10 +54,6 @@
Needs Patch or Further Investigation:
-------------------------------------
-* pluggable <Perl> sections have been implemented but need a default
- handler to actually convert the Perl code into apache config
- [Philippe M. Chiasson <go...@cpan.org> is working on one]
-
* Apache->httpd_conf compat method mapping to Apache::Server->add_config
* directive handlers are supported but need some work for 1.x compat
1.1 modperl-2.0/lib/Apache/PerlSection.pm
Index: PerlSection.pm
===================================================================
package Apache::PerlSection;
use strict;
use warnings FATAL => 'all';
our $VERSION = '0.01';
use ModPerl::Symdump ();
use Apache::CmdParms ();
use Apache::Directive ();
use constant SPECIAL_NAME => 'PerlConfig';
sub new {
my($package, @args) = @_;
return bless { @args }, ref($package) || $package;
}
sub server { return shift->{'parms'}->server() }
sub directives { return shift->{'directives'} ||= [] }
sub handler : method {
my($self, $parms, $args) = @_;
unless (ref $self) {
$self = $self->new('parms' => $parms, 'args' => $args);
}
my $package = $args->get('package');
my $special = $self->SPECIAL_NAME;
my $root = ModPerl::Symdump->new($package);
my %convert = (
'scalars' => sub { no strict 'refs'; return ${ $_[0] } },
'arrays' => sub { no strict 'refs'; return \@{ $_[0] } },
'hashes' => sub { no strict 'refs'; return \%{ $_[0] } },
);
for my $type (sort keys %convert) {
for my $entry (grep { !/$special/ } $root->$type()) {
(my $name = $entry) =~ s/${package}:://;
$self->dump($name, $convert{$type}->($entry));
}
}
{
no strict 'refs';
$self->dump_special(${"${package}::$special"},
@{"${package}::$special"} );
}
$self->post_config();
Apache::OK;
}
sub dump_special {
my($self, @data) = @_;
$self->add_config(@data);
}
sub dump {
my($self, $name, $entry) = @_;
my $type = ref $entry;
if ($type eq 'ARRAY') {
$self->dump_array($name, $entry);
}
elsif ($type eq 'HASH') {
$self->dump_hash($name, $entry);
}
else {
$self->dump_entry($name, $entry);
}
}
sub dump_hash {
my($self, $name, $hash) = @_;
for my $entry (sort keys %{ $hash || {} }) {
my $item = $hash->{$entry};
my $type = ref($item);
if ($type eq 'HASH') {
$self->dump_section($name, $entry, $item);
}
elsif ($type eq 'ARRAY') {
for my $e (@$item) {
$self->dump_section($name, $entry, $e);
}
}
}
}
sub dump_section {
my($self, $name, $loc, $hash) = @_;
$self->add_config("<$name $loc>\n");
for my $entry (sort keys %{ $hash || {} }) {
$self->dump_entry($entry, $hash->{$entry});
}
$self->add_config("</$name>\n");
}
sub dump_array {
my($self, $name, $entries) = @_;
for my $entry (@$entries) {
$self->dump_entry($name, $entry);
}
}
sub dump_entry {
my($self, $name, $entry) = @_;
my $type = ref $entry;
if ($type eq 'SCALAR') {
$self->add_config("$name $$entry\n");
}
elsif ($type eq 'ARRAY') {
$self->add_config("$name @$entry\n");
}
elsif ($type eq 'HASH') {
$self->dump_hash($name, $entry);
}
elsif ($type) {
#XXX: Could do $type->can('httpd_config') here on objects ???
die "Unknown type '$type' for directive $name";
}
elsif (defined $entry) {
$self->add_config("$name $entry\n");
}
}
sub add_config {
my($self, $config) = @_;
return unless defined $config;
chomp($config);
push @{ $self->directives }, $config;
}
sub post_config {
my($self) = @_;
my $errmsg = $self->server->add_config($self->directives);
die $errmsg if $errmsg;
}
1;
__END__
1.6 +15 -3 modperl-2.0/lib/ModPerl/TestRun.pm
Index: TestRun.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/TestRun.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- TestRun.pm 7 Oct 2002 02:05:43 -0000 1.5
+++ TestRun.pm 7 Oct 2002 02:35:18 -0000 1.6
@@ -30,9 +30,16 @@
#XXX: issue for these is they need to happen after PerlSwitches
#XXX: this should only be done for the modperl-2.0 tests
- $self->postamble(<<'EOF');
-<Perl handler=ModPerl::Test::perl_section>
- $Foo = 'bar';
+ my $htdocs = $self->{vars}{documentroot};
+ $self->postamble(<<"EOF");
+<Perl >
+push \@Alias, ['/perl_sections', '$htdocs'],
+\$Location{'/perl_sections'} = {
+ 'PerlInitHandler' => 'ModPerl::Test::add_config',
+ 'AuthType' => 'Basic',
+ 'AuthName' => 'PerlSection',
+ 'PerlAuthenHandler' => 'TestHooks::authen',
+ };
</Perl>
EOF
@@ -46,6 +53,11 @@
<Location /TestDirective::loadmodule>
MyOtherTest value
</Location>
+EOF
+
+ #XXX: this should only be done for the modperl-2.0 tests
+ $self->postamble(<<'EOF');
+ Perl $TestDirective::perl::worked="yes";
EOF
#XXX: this should only be done for the modperl-2.0 tests
1.143 +2 -1 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.142
retrieving revision 1.143
diff -u -r1.142 -r1.143
--- mod_perl.c 7 Oct 2002 02:05:43 -0000 1.142
+++ mod_perl.c 7 Oct 2002 02:35:18 -0000 1.143
@@ -629,7 +629,8 @@
MP_CMD_DIR_ITERATE2("PerlAddVar", add_var, "PerlAddVar"),
MP_CMD_DIR_TAKE2("PerlSetEnv", set_env, "PerlSetEnv"),
MP_CMD_SRV_TAKE1("PerlPassEnv", pass_env, "PerlPassEnv"),
- MP_CMD_SRV_RAW_ARGS("<Perl", perl, "NOT YET IMPLEMENTED"),
+ MP_CMD_SRV_RAW_ARGS_ON_READ("<Perl", perl, "Perl Code"),
+ MP_CMD_SRV_RAW_ARGS("Perl", perldo, "Perl Code"),
MP_CMD_DIR_RAW_ARGS_ON_READ("=pod", pod, "Start of POD"),
MP_CMD_DIR_RAW_ARGS_ON_READ("=back", pod, "End of =over"),
1.32 +93 -35 modperl-2.0/src/modules/perl/modperl_cmd.c
Index: modperl_cmd.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- modperl_cmd.c 7 Oct 2002 02:05:43 -0000 1.31
+++ modperl_cmd.c 7 Oct 2002 02:35:18 -0000 1.32
@@ -245,26 +245,24 @@
return modperl_cmd_post_read_request_handlers(parms, mconfig, arg);
}
-static const char *modperl_cmd_parse_args(pTHX_ apr_pool_t *p,
+static const char *modperl_cmd_parse_args(apr_pool_t *p,
const char *args,
- HV **hv)
+ apr_table_t **t)
{
const char *orig_args = args;
char *pair, *key, *val;
- *hv = newHV();
+ *t = apr_table_make(p, 2);
while (*(pair = ap_getword(p, &args, ',')) != '\0') {
key = ap_getword_nc(p, &pair, '=');
val = pair;
if (!(*key && *val)) {
- SvREFCNT_dec(*hv);
- *hv = Nullhv;
return apr_pstrcat(p, "invalid args spec: ",
orig_args, NULL);
}
- hv_store(*hv, key, strlen(key), newSVpv(val,0), 0);
+ apr_table_set(*t, key, val);
}
return NULL;
@@ -273,21 +271,67 @@
MP_CMD_SRV_DECLARE(perl)
{
apr_pool_t *p = parms->pool;
- server_rec *s = parms->server;
const char *endp = ap_strrchr_c(arg, '>');
const char *errmsg;
- modperl_handler_t *handler;
- AV *args = Nullav;
- HV *hv = Nullhv;
- SV **handler_name;
+ char *code = "";
+ char line[MAX_STRING_LEN];
+ apr_table_t *args;
+ ap_directive_t **current = mconfig;
+
+ if (!endp) {
+ return modperl_cmd_unclosed_directive(parms);
+ }
+
+ arg = apr_pstrndup(p, arg, endp - arg);
+
+ if ((errmsg = modperl_cmd_parse_args(p, arg, &args))) {
+ return errmsg;
+ }
+
+ while (!ap_cfg_getline(line, sizeof(line), parms->config_file)) {
+ /*XXX: Not sure how robust this is */
+ if (strEQ(line, "</Perl>")) {
+ break;
+ }
+
+ /*XXX: Less than optimal */
+ code = apr_pstrcat(p, code, line, NULL);
+ }
+
+ /* Here, we have to replace our current config node for the next pass */
+ if (!*current) {
+ *current = apr_pcalloc(p, sizeof(**current));
+ }
+
+ (*current)->filename = parms->config_file->name;
+ (*current)->line_num = parms->config_file->line_number;
+ (*current)->directive = apr_pstrdup(p, "Perl");
+ (*current)->args = code;
+ (*current)->data = args;
+
+ return NULL;
+}
+
+#define MP_DEFAULT_PERLSECTION_HANDLER "Apache::PerlSection"
+#define MP_DEFAULT_PERLSECTION_PACKAGE "Apache::ReadConfig"
+
+MP_CMD_SRV_DECLARE(perldo)
+{
+ apr_pool_t *p = parms->pool;
+ server_rec *s = parms->server;
+ apr_table_t *options = NULL;
+ const char *handler_name = NULL;
+ modperl_handler_t *handler = NULL;
+ const char *package_name = NULL;
int status = OK;
+ AV *args = Nullav;
#ifdef USE_ITHREADS
MP_dSCFG(s);
pTHX;
#endif
- if (endp == NULL) {
- return modperl_cmd_unclosed_directive(parms);
+ if (!(arg && *arg)) {
+ return NULL;
}
/* we must init earlier than normal */
@@ -302,32 +346,46 @@
aTHX = scfg->mip->parent->perl;
#endif
- arg = apr_pstrndup(p, arg, endp - arg);
-
- if ((errmsg = modperl_cmd_parse_args(aTHX_ p, arg, &hv))) {
- return errmsg;
- }
+ /* data will be set by a <Perl> section */
+ if ((options = parms->directive->data)) {
+ if (!(handler_name = apr_table_get(options, "handler"))) {
+ handler_name = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_HANDLER);
+ apr_table_set(options, "handler", handler_name);
+ }
+
+ 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 (!(handler_name = hv_fetch(hv, "handler", strlen("handler"), 0))) {
- /* XXX: we will have a default handler in the future */
- return "no <Perl> handler specified";
+ /* put the code about to be executed in the configured package */
+ arg = apr_pstrcat(p, "package ", package_name, ";", arg, NULL);
}
- handler = modperl_handler_new(p, SvPVX(*handler_name));
-
- modperl_handler_make_args(aTHX_ &args,
- "Apache::CmdParms", parms,
- "HV", hv,
- NULL);
+ eval_pv(arg, FALSE);
- status = modperl_callback(aTHX_ handler, p, NULL, s, args);
-
- SvREFCNT_dec((SV*)args);
-
- if (status != OK) {
- return SvTRUE(ERRSV) ? SvPVX(ERRSV) :
- apr_psprintf(p, "<Perl> handler %s failed with status=%d",
- handler->name, status);
+ if (SvTRUE(ERRSV)) {
+ return SvPVX(ERRSV);
+ }
+
+ if (handler) {
+ /*XXX: This will return a blessed APR::Table, but not a tied one ;-( */
+ modperl_handler_make_args(aTHX_ &args,
+ "Apache::CmdParms", parms,
+ "APR::Table", options,
+ NULL);
+
+ status = modperl_callback(aTHX_ handler, p, NULL, s, args);
+
+ SvREFCNT_dec((SV*)args);
+
+ if (status != OK) {
+ return SvTRUE(ERRSV) ? SvPVX(ERRSV) :
+ apr_psprintf(p, "<Perl> handler %s failed with status=%d",
+ handler->name, status);
+ }
}
return NULL;
1.20 +5 -0 modperl-2.0/src/modules/perl/modperl_cmd.h
Index: modperl_cmd.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.h,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- modperl_cmd.h 16 Sep 2002 19:14:16 -0000 1.19
+++ modperl_cmd.h 7 Oct 2002 02:35:18 -0000 1.20
@@ -27,6 +27,7 @@
MP_CMD_SRV_DECLARE(options);
MP_CMD_SRV_DECLARE(init_handlers);
MP_CMD_SRV_DECLARE(perl);
+MP_CMD_SRV_DECLARE(perldo);
MP_CMD_SRV_DECLARE(pod);
MP_CMD_SRV_DECLARE(pod_cut);
MP_CMD_SRV_DECLARE(END);
@@ -69,6 +70,10 @@
#define MP_CMD_SRV_RAW_ARGS(name, item, desc) \
AP_INIT_RAW_ARGS( name, modperl_cmd_##item, NULL, \
RSRC_CONF, desc )
+
+#define MP_CMD_SRV_RAW_ARGS_ON_READ(name, item, desc) \
+ AP_INIT_RAW_ARGS( name, modperl_cmd_##item, NULL, \
+ RSRC_CONF|EXEC_ON_READ, desc )
#define MP_CMD_SRV_FLAG(name, item, desc) \
AP_INIT_FLAG( name, modperl_cmd_##item, NULL, \
1.20 +0 -37 modperl-2.0/t/conf/modperl_extra.pl
Index: modperl_extra.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/t/conf/modperl_extra.pl,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- modperl_extra.pl 5 Sep 2002 01:49:32 -0000 1.19
+++ modperl_extra.pl 7 Oct 2002 02:35:18 -0000 1.20
@@ -72,43 +72,6 @@
Apache::OK;
}
-#<Perl handler=ModPerl::Test::perl_section>
-# ...
-#</Perl>
-sub ModPerl::Test::perl_section {
- my($parms, $args) = @_;
-
- require Apache::CmdParms;
- require Apache::Directive;
-
- my $code = $parms->directive->as_string;
- my $package = $args->{package} || 'Apache::ReadConfig';
-
-## a real handler would do something like:
-# eval "package $package; $code";
-# die $@ if $@;
-## feed %Apache::ReadConfig:: to Apache::Server->add_config
-
- my $htdocs = Apache::server_root_relative($parms->pool, 'htdocs');
-
- my @cfg = (
- "Alias /perl_sections $htdocs",
- "<Location /perl_sections>",
-# " require valid-user",
- " PerlInitHandler ModPerl::Test::add_config",
- " AuthType Basic",
- " AuthName PerlSection",
- " PerlAuthenHandler TestHooks::authen",
- "</Location>",
- );
-
- my $errmsg = $parms->server->add_config(\@cfg);
-
- die $errmsg if $errmsg;
-
- Apache::OK;
-}
-
END {
warn "END in modperl_extra.pl, pid=$$\n";
}
1.3 +1 -0 modperl-2.0/t/directive/.cvsignore
Index: .cvsignore
===================================================================
RCS file: /home/cvs/modperl-2.0/t/directive/.cvsignore,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- .cvsignore 16 Sep 2002 19:14:17 -0000 1.2
+++ .cvsignore 7 Oct 2002 02:35:18 -0000 1.3
@@ -1,3 +1,4 @@
env.t
loadmodule.t
pod.t
+perldo.t
1.1 modperl-2.0/t/response/TestDirective/perldo.pm
Index: perldo.pm
===================================================================
package TestDirective::perldo;
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use Apache::Const -compile => 'OK';
sub handler {
my $r = shift;
plan $r, tests => 1;
ok t_cmp('yes', $TestDirective::perl::worked);
Apache::OK;
}
1;
1.14 +0 -6 modperl-2.0/todo/possible_new_features.txt
Index: possible_new_features.txt
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/possible_new_features.txt,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- possible_new_features.txt 9 Apr 2002 07:32:56 -0000 1.13
+++ possible_new_features.txt 7 Oct 2002 02:35:18 -0000 1.14
@@ -14,12 +14,6 @@
- allow <Perl></Perl> configuration sections to have read access to internal
configuration structures (would be nice if we could tie a %namespace::)
-- allow things like <Perl main> -- the code will be placed into 'main'
- package. Of course any package can be specified and the default is
- Apache::ReadConfig. That would place a little meme-fleck into
- people's brains to remind them that the default package is
- Apache::ReadConfig.
-
- setuid/gid before running any Perl code
- implement PerlINC (or similar) as a nicer interface for the working