[Patch mp2] PerlSections dump & store

[Philippe M. Chiasson]

Finally got around implementing Apache::PerlSections->(dump|store);

Comments ?

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 02:38:56 -0000
@@ -24,6 +24,10 @@
 sub directives { return shift->{'directives'} ||= [] }
 sub package    { return shift->{'args'}->{'package'} }
 
+our @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 02:38:56 -0000
@@ -0,0 +1,79 @@
+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;
+
+sub package     { return shift->saved }
+sub save        { return }
+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__
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 02:38:56 -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;
 }

-- 
--------------------------------------------------------------------------------
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