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 go...@apache.org on 2004/02/29 06:28:44 UTC
cvs commit: modperl-2.0/todo features_missing
gozer 2004/02/28 21:28:44
Modified: . Changes
src/docs/2.0/api/Apache PerlSections.pod
lib/Apache PerlSections.pm
t/response/TestDirective perldo.pm
todo features_missing
Added: lib/Apache/PerlSections Dump.pm
Log:
Implemented :
+ Apache::PerlSections->dump()
+ Apache::PerlSections->store("filename")
Reviewed by: stas, geoff
Revision Changes Path
1.335 +2 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.334
retrieving revision 1.335
diff -u -r1.334 -r1.335
--- Changes 26 Feb 2004 23:29:06 -0000 1.334
+++ Changes 29 Feb 2004 05:28:43 -0000 1.335
@@ -12,6 +12,8 @@
=item 1.99_13-dev
+Apache::PerlSections->dump() and store(filename) [Gozer]
+
expose $c->keepalive related constants [Stas]
Perl handlers are now guaranteed to run before core C handlers for
1.8 +72 -0 modperl-docs/src/docs/2.0/api/Apache/PerlSections.pod
Index: PerlSections.pod
===================================================================
RCS file: /home/cvs/modperl-docs/src/docs/2.0/api/Apache/PerlSections.pod,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- PerlSections.pod 14 Jan 2004 09:23:47 -0000 1.7
+++ PerlSections.pod 29 Feb 2004 05:28:43 -0000 1.8
@@ -146,8 +146,80 @@
+=head1 PerlSections dumping
+=head2 Apache::PerlSections->dump
+This method will dump out all the configuration variables mod_perl
+will be feeding to the apache config gears. The output is suitable to
+read back in via C<eval>
+
+Example:
+
+ <Perl>
+
+ $Port = 8529;
+
+ $Location{"/perl"} = {
+ SetHandler => "perl-script",
+ PerlHandler => "Apache::Registry",
+ Options => "ExecCGI",
+ };
+
+ @DirectoryIndex = qw(index.htm index.html);
+
+ $VirtualHost{"www.foo.com"} = {
+ DocumentRoot => "/tmp/docs",
+ ErrorLog => "/dev/null",
+ Location => {
+ "/" => {
+ Allowoverride => 'All',
+ Order => 'deny,allow',
+ Deny => 'from all',
+ Allow => 'from foo.com',
+ },
+ },
+ };
+
+ print Apache::PerlSections->dump;
+
+ </Perl>
+
+This will print something like this:
+
+ $Port = 8529;
+
+ @DirectoryIndex = (
+ 'index.htm',
+ 'index.html'
+ );
+
+ $Location{'/perl'} = (
+ PerlHandler => 'Apache::Registry',
+ SetHandler => 'perl-script',
+ Options => 'ExecCGI'
+ );
+
+ $VirtualHost{'www.foo.com'} = (
+ Location => {
+ '/' => {
+ Deny => 'from all',
+ Order => 'deny,allow',
+ Allow => 'from foo.com',
+ Allowoverride => 'All'
+ }
+ },
+ DocumentRoot => '/tmp/docs',
+ ErrorLog => '/dev/null'
+ );
+
+ 1;
+ __END__
+
+=head2 Apache::PerlSections->store
+
+This method will call the C<dump> method, writing the output
+to a file, suitable to be pulled in via C<require> or C<do>.
=head1 Advanced API
1.3 +26 -6 modperl-2.0/lib/Apache/PerlSections.pm
Index: PerlSections.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/PerlSections.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- PerlSections.pm 19 Dec 2003 01:17:31 -0000 1.2
+++ PerlSections.pm 29 Feb 2004 05:28:43 -0000 1.3
@@ -24,6 +24,10 @@
sub directives { return shift->{'directives'} ||= [] }
sub package { return shift->{'args'}->{'package'} }
+my @saved;
+sub save { return $Apache::Server::SaveConfig }
+sub saved { return @saved }
+
sub handler : method {
my($self, $parms, $args) = @_;
@@ -31,20 +35,24 @@
$self = $self->new('parms' => $parms, 'args' => $args);
}
+ if ($self->save) {
+ push @saved, $self->package;
+ }
+
my $special = $self->SPECIAL_NAME;
for my $entry ($self->symdump()) {
if ($entry->[0] !~ /$special/) {
- $self->dump(@$entry);
+ $self->dump_any(@$entry);
}
}
{
no strict 'refs';
- my $package = $self->package;
-
- $self->dump_special(${"${package}::$special"},
- @{"${package}::$special"} );
+ foreach my $package ($self->package) {
+ $self->dump_special(${"${package}::$special"},
+ @{"${package}::$special"} );
+ }
}
$self->post_config();
@@ -89,7 +97,7 @@
$self->add_config(@data);
}
-sub dump {
+sub dump_any {
my($self, $name, $entry) = @_;
my $type = ref $entry;
@@ -175,6 +183,18 @@
my($self) = @_;
my $errmsg = $self->server->add_config($self->directives);
die $errmsg if $errmsg;
+}
+
+sub dump {
+ my $class = shift;
+ require Apache::PerlSections::Dump;
+ return Apache::PerlSections::Dump->dump(@_);
+}
+
+sub store {
+ my $class = shift;
+ require Apache::PerlSections::Dump;
+ return Apache::PerlSections::Dump->store(@_);
}
1;
1.1 modperl-2.0/lib/Apache/PerlSections/Dump.pm
Index: Dump.pm
===================================================================
package Apache::PerlSections::Dump;
use strict;
use warnings FATAL => 'all';
our $VERSION = '0.01';
use Apache::PerlSections;
our @ISA = qw(Apache::PerlSections);
use Data::Dumper;
# Process all saved packages
sub package { return shift->saved }
# We don't want to save anything
sub save { return }
# We don't want to post any config to apache, we are dumping
sub post_config { return }
sub dump {
my $self = shift;
unless (ref $self) {
$self = $self->new;
}
$self->handler();
return join "\n", @{$self->directives}, '1;', '__END__', '';
}
sub store {
my ($class, $filename) = @_;
require IO::File;
my $fh = IO::File->new(">$filename") or die "can't open $filename $!\n";
$fh->print($class->dump);
$fh->close;
}
sub dump_array {
my($self, $name, $entry) = @_;
$self->add_config(Data::Dumper->Dump([$entry], ["*$name"]));
}
sub dump_hash {
my($self, $name, $entry) = @_;
for my $elem (sort keys %{$entry}) {
$self->add_config(Data::Dumper->Dump([$entry->{$elem}], ["\$$name"."{'$elem'}"]));
}
}
sub dump_entry {
my($self, $name, $entry) = @_;
return if not defined $entry;
my $type = ref($entry);
if ($type eq 'SCALAR') {
$self->add_config(Data::Dumper->Dump([$$entry],[$name]));
}
if ($type eq 'ARRAY') {
$self->dump_array($name,$entry);
}
else {
$self->add_config(Data::Dumper->Dump([$entry],[$name]));
}
}
sub dump_special {
my($self, @data) = @_;
my @dump = grep { defined } @data;
return unless @dump;
$self->add_config(Data::Dumper->Dump([\@dump],['*'.$self->SPECIAL_NAME]));
}
1;
__END__
1.7 +10 -1 modperl-2.0/t/response/TestDirective/perldo.pm
Index: perldo.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestDirective/perldo.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- perldo.pm 19 Dec 2003 01:17:32 -0000 1.6
+++ perldo.pm 29 Feb 2004 05:28:43 -0000 1.7
@@ -6,11 +6,12 @@
use Apache::Test;
use Apache::TestUtil;
use Apache::Const -compile => 'OK';
+use Apache::PerlSections;
sub handler {
my $r = shift;
- plan $r, tests => 11;
+ plan $r, tests => 14;
ok t_cmp('yes', $TestDirective::perl::worked);
@@ -38,6 +39,14 @@
ok t_cmp("-e", $0, '$0');
ok t_cmp(1, $TestDirective::perl::Included, "Include");
+
+ my $dump = Apache::PerlSections->dump;
+ ok t_cmp(qr/__END__/, $dump, "Apache::PerlSections->dump");
+
+ eval "package TestDirective::perldo::test;\nno strict;\n$dump";
+ ok t_cmp("", $@, "PerlSections dump syntax check");
+
+ ok t_cmp(qr/perlsection.conf/, $TestDirective::perldo::test::Include);
Apache::OK;
}
1.3 +0 -6 modperl-2.0/todo/features_missing
Index: features_missing
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/features_missing,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- features_missing 18 Nov 2003 21:45:18 -0000 1.2
+++ features_missing 29 Feb 2004 05:28:43 -0000 1.3
@@ -2,12 +2,6 @@
# mp1 missing features #
########################
-* Apache::PerlSections->dump
- It does exist, but it's a completely internal function, not dumping existing configuration
- as it used to be in 1.x. (needed by Apache::Status, for instance). Need to be implemented
- and the existing dump method must be moved out of the way
-
-
* directive handlers are supported but need some work for 1.x compat
- Apache::ModuleConfig->get needs a compat method mapping to
Apache::Module->get_config