home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Dump.pm < prev    next >
Encoding:
Perl POD Document  |  2004-03-04  |  2.2 KB  |  99 lines
  1. # Copyright 2004 The Apache Software Foundation
  2. #
  3. # Licensed under the Apache License, Version 2.0 (the "License");
  4. # you may not use this file except in compliance with the License.
  5. # You may obtain a copy of the License at
  6. #
  7. #     http://www.apache.org/licenses/LICENSE-2.0
  8. #
  9. # Unless required by applicable law or agreed to in writing, software
  10. # distributed under the License is distributed on an "AS IS" BASIS,
  11. # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  12. # See the License for the specific language governing permissions and
  13. # limitations under the License.
  14. #
  15. package Apache::PerlSections::Dump;
  16.  
  17. use strict;
  18. use warnings FATAL => 'all';
  19.  
  20. our $VERSION = '0.01';
  21.  
  22. use Apache::PerlSections;
  23. our @ISA = qw(Apache::PerlSections);
  24.  
  25. use Data::Dumper;
  26.  
  27. # Process all saved packages
  28. sub package     { return shift->saved }
  29.  
  30. # We don't want to save anything
  31. sub save        { return }
  32.  
  33. # We don't want to post any config to apache, we are dumping
  34. sub post_config { return }
  35.  
  36. sub dump {
  37.     my $self = shift;
  38.     unless (ref $self) {
  39.         $self = $self->new;
  40.     }
  41.     $self->handler();
  42.     return join "\n", @{$self->directives}, '1;', '__END__', '';
  43. }
  44.  
  45. sub store {
  46.     my ($class, $filename) = @_;
  47.     require IO::File;
  48.  
  49.     my $fh = IO::File->new(">$filename") or die "can't open $filename $!\n";
  50.  
  51.     $fh->print($class->dump);
  52.  
  53.     $fh->close;
  54. }
  55.  
  56. sub dump_array {
  57.      my($self, $name, $entry) = @_;
  58.      $self->add_config(Data::Dumper->Dump([$entry], ["*$name"]));
  59. }
  60.  
  61. sub dump_hash {
  62.     my($self, $name, $entry) = @_;
  63.     for my $elem (sort keys %{$entry}) {
  64.         $self->add_config(Data::Dumper->Dump([$entry->{$elem}], ["\$$name"."{'$elem'}"])); 
  65.     }
  66.     
  67. }
  68.  
  69. sub dump_entry {
  70.     my($self, $name, $entry) = @_;
  71.     
  72.     return if not defined $entry;
  73.     my $type = ref($entry);
  74.     
  75.     if ($type eq 'SCALAR') {
  76.         $self->add_config(Data::Dumper->Dump([$$entry],[$name]));
  77.     }
  78.     if ($type eq 'ARRAY') {
  79.         $self->dump_array($name,$entry);
  80.     }
  81.     else {
  82.         $self->add_config(Data::Dumper->Dump([$entry],[$name]));
  83.     }
  84. }
  85.  
  86. sub dump_special {
  87.     my($self, @data) = @_;
  88.     
  89.     my @dump = grep { defined } @data;
  90.     return unless @dump;
  91.  
  92.     $self->add_config(Data::Dumper->Dump([\@dump],['*'.$self->SPECIAL_NAME]));
  93. }
  94.  
  95.  
  96.  
  97. 1;
  98. __END__
  99.