gozer 2003/10/20 10:44:48
Modified: . STATUS
src/modules/perl modperl_cmd.c
Added: lib/Apache PerlSections.pm
Removed: lib/Apache PerlSection.pm
Log:
Standardize the Apache::PerlSections package name to it's plural form for
clarity and so that the pod gets glued in it's proper place
Revision Changes Path
1.68 +1 -9 modperl-2.0/STATUS
Index: STATUS
===================================================================
RCS file: /home/cvs/modperl-2.0/STATUS,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -r1.67 -r1.68
--- STATUS 9 Oct 2003 05:34:02 -0000 1.67
+++ STATUS 20 Oct 2003 17:44:48 -0000 1.68
@@ -90,14 +90,6 @@
Needs Patch or Further Investigation:
-------------------------------------
-* <Perl> section package name:
- Looks like the package name is Apache::PerlSection, but inside of it
- we have Apache::PerlSections. And the docs manpage is
- Apache/PerlSections.pod (notices the trailing 's'), so it doesn't get
- its pod glued to Apache/PerlSection.pm on install. Inside the
- package there are variables whose name is PerlSections. Need to
- decide on one and stick to it.
-
* <Perl> sections:
A few issues with <Perl> sections:
http://marc.theaimsgroup.com/?l=apache-modperl-dev&m=106074969831522&w=2
1.1 modperl-2.0/lib/Apache/PerlSections.pm
Index: PerlSections.pm
===================================================================
package Apache::PerlSections;
use strict;
use warnings FATAL => 'all';
our $VERSION = '0.01';
use Apache::CmdParms ();
use Apache::Directive ();
use APR::Table ();
use Apache::Server ();
use Apache::ServerUtil ();
use Apache::Const -compile => qw(OK);
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 package { return shift->{'args'}->{'package'} }
sub handler : method {
my($self, $parms, $args) = @_;
unless (ref $self) {
$self = $self->new('parms' => $parms, 'args' => $args);
}
my $special = $self->SPECIAL_NAME;
for my $entry ($self->symdump()) {
if ($entry->[0] !~ /$special/) {
$self->dump(@$entry);
}
}
{
no strict 'refs';
my $package = $self->package;
$self->dump_special(${"${package}::$special"},
@{"${package}::$special"} );
}
$self->post_config();
Apache::OK;
}
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, [EMAIL PROTECTED];
}
if (defined $val && defined *ENTRY{HASH} && $key !~ /::/) {
push @{$self->{symbols}}, [$key, \%ENTRY];
}
}
}
return @{$self->{symbols}};
}
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.49 +1 -1 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.48
retrieving revision 1.49
diff -u -r1.48 -r1.49
--- modperl_cmd.c 16 Sep 2003 01:57:27 -0000 1.48
+++ modperl_cmd.c 20 Oct 2003 17:44:48 -0000 1.49
@@ -345,7 +345,7 @@
return NULL;
}
-#define MP_DEFAULT_PERLSECTION_HANDLER "Apache::PerlSection"
+#define MP_DEFAULT_PERLSECTION_HANDLER "Apache::PerlSections"
#define MP_DEFAULT_PERLSECTION_PACKAGE "Apache::ReadConfig"
#define MP_STRICT_PERLSECTIONS_SV \
get_sv("Apache::Server::StrictPerlSections", FALSE)
