You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by "Philippe M. Chiasson" <go...@cpan.org> on 2004/02/28 23:39:02 UTC
[Patch mp2] PerlSections dump & store #2
Improvements to my previous patch:
- Small cleanups as suggested.
- Documented
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.334
diff -u -I$Id -r1.334 Changes
--- Changes 26 Feb 2004 23:29:06 -0000 1.334
+++ Changes 28 Feb 2004 22:37:03 -0000
@@ -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
Index: docs/api/Apache/PerlSections.pod
===================================================================
RCS file: /home/cvs/modperl-docs/src/docs/2.0/api/Apache/PerlSections.pod,v
retrieving revision 1.7
diff -u -I$Id -r1.7 PerlSections.pod
--- docs/api/Apache/PerlSections.pod 14 Jan 2004 09:23:47 -0000 1.7
+++ docs/api/Apache/PerlSections.pod 28 Feb 2004 22:37:03 -0000
@@ -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
Index: lib/Apache/PerlSections.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/PerlSections.pm,v
retrieving revision 1.2
diff -u -I$Id -r1.2 PerlSections.pm
--- lib/Apache/PerlSections.pm 19 Dec 2003 01:17:31 -0000 1.2
+++ lib/Apache/PerlSections.pm 28 Feb 2004 22:37:03 -0000
@@ -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;
Index: lib/Apache/PerlSections/Dump.pm
===================================================================
RCS file: lib/Apache/PerlSections/Dump.pm
diff -N lib/Apache/PerlSections/Dump.pm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ lib/Apache/PerlSections/Dump.pm 28 Feb 2004 22:37:03 -0000
@@ -0,0 +1,84 @@
+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__
Index: t/response/TestDirective/perldo.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestDirective/perldo.pm,v
retrieving revision 1.6
diff -u -I$Id -r1.6 perldo.pm
--- t/response/TestDirective/perldo.pm 19 Dec 2003 01:17:32 -0000 1.6
+++ t/response/TestDirective/perldo.pm 28 Feb 2004 22:37:03 -0000
@@ -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,16 @@
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");
+
+
+ print STDERR Dumper($TestDirective::perldo::test::Include); use Data::Dumper;
+ ok t_cmp(qr/perlsection.conf/, $TestDirective::perldo::test::Include);
Apache::OK;
}
Index: todo/features_missing
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/features_missing,v
retrieving revision 1.2
diff -u -I$Id -r1.2 features_missing
--- todo/features_missing 18 Nov 2003 21:45:18 -0000 1.2
+++ todo/features_missing 28 Feb 2004 22:37:03 -0000
@@ -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
--
--------------------------------------------------------------------------------
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}'
Re: [Patch mp2] PerlSections dump & store #2
Posted by "Philippe M. Chiasson" <go...@cpan.org>.
On Sat, 2004-02-28 at 14:46, Stas Bekman wrote:
> Philippe M. Chiasson wrote:
> > Improvements to my previous patch:
> >
> > - Small cleanups as suggested.
> > - Documented
>
> [...]
> > Index: lib/Apache/PerlSections/Dump.pm
> [...]
> > +#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 }
>
> can you please separate # and text with a space? thanks.
>
> # We don't want ...
Sure thing.
> otherwise +1
Thanks for the extra eyes ;-)
Committed!
> __________________________________________________________________
> Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
> http://stason.org/ mod_perl Guide ---> http://perl.apache.org
> mailto:stas@stason.org http://use.perl.org http://apacheweek.com
> http://modperlbook.org http://apache.org http://ticketmaster.com
--
--------------------------------------------------------------------------------
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}'
Re: [Patch mp2] PerlSections dump & store #2
Posted by Stas Bekman <st...@stason.org>.
Philippe M. Chiasson wrote:
> Improvements to my previous patch:
>
> - Small cleanups as suggested.
> - Documented
[...]
> Index: lib/Apache/PerlSections/Dump.pm
[...]
> +#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 }
can you please separate # and text with a space? thanks.
# We don't want ...
otherwise +1
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org