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([EMAIL PROTECTED],['*'.$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