Following patch renames Apache::PerlSection to Apache::PerlSections to fix the existing ambiguity between singular and plural PerlSection(s)
Index: STATUS =================================================================== RCS file: /home/cvs/modperl-2.0/STATUS,v retrieving revision 1.67 diff -u -I$Id: -r1.67 STATUS --- STATUS 9 Oct 2003 05:34:02 -0000 1.67 +++ STATUS 17 Oct 2003 18:53:24 -0000 @@ -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 Index: lib/Apache/PerlSection.pm =================================================================== RCS file: lib/Apache/PerlSection.pm diff -N lib/Apache/PerlSection.pm --- lib/Apache/PerlSection.pm 20 May 2003 01:20:09 -0000 1.4 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,176 +0,0 @@ -package Apache::PerlSection; - -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__ Index: lib/Apache/PerlSections.pm =================================================================== RCS file: lib/Apache/PerlSections.pm diff -N lib/Apache/PerlSections.pm --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lib/Apache/PerlSections.pm 17 Oct 2003 18:53:24 -0000 @@ -0,0 +1,176 @@ +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__ Index: src/modules/perl/modperl_cmd.c =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v retrieving revision 1.48 diff -u -I$Id: -r1.48 modperl_cmd.c --- src/modules/perl/modperl_cmd.c 16 Sep 2003 01:57:27 -0000 1.48 +++ src/modules/perl/modperl_cmd.c 17 Oct 2003 18:53:24 -0000 @@ -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) -- -------------------------------------------------------------------------------- Philippe M. Chiasson /gozer\@(cpan|ectoplasm)\.org/ 88C3A5A5 (122FF51B/C634E37B) http://gozer.ectoplasm.org/ F9BF E0C2 480E 7680 1AE5 3631 CB32 A107 88C3 A5A5 Q: It is impossible to make anything foolproof because fools are so ingenious. perl -e'$$=\${gozer};{$_=unpack(P7,pack(L,$$));/^JAm_pH\n$/&&print||$$++&&redo}'
signature.asc
Description: This is a digitally signed message part
