perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From go...@apache.org
Subject cvs commit: modperl-2.0/src/modules/perl modperl_cmd.c
Date Mon, 20 Oct 2003 17:44:48 GMT
gozer       2003/10/20 10:44:48

  Modified:    .        STATUS
               src/modules/perl modperl_cmd.c
  Added:       lib/Apache PerlSections.pm
  Removed:     lib/Apache PerlSection.pm
  Log:
  Standardize the Apache::PerlSections package name to it's plural form for
  clarity and so that the pod gets glued in it's proper place
  
  Revision  Changes    Path
  1.68      +1 -9      modperl-2.0/STATUS
  
  Index: STATUS
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/STATUS,v
  retrieving revision 1.67
  retrieving revision 1.68
  diff -u -r1.67 -r1.68
  --- STATUS	9 Oct 2003 05:34:02 -0000	1.67
  +++ STATUS	20 Oct 2003 17:44:48 -0000	1.68
  @@ -90,14 +90,6 @@
   Needs Patch or Further Investigation:
   -------------------------------------
   
  -* <Perl> section package name:
  -  Looks like the package name is Apache::PerlSection, but inside of it
  -  we have Apache::PerlSections. And the docs manpage is
  -  Apache/PerlSections.pod (notices the trailing 's'), so it doesn't get
  -  its pod glued to Apache/PerlSection.pm on install. Inside the
  -  package there are variables whose name is PerlSections. Need to
  -  decide on one and stick to it.
  -
   * <Perl> sections:
     A few issues with <Perl> sections:
     http://marc.theaimsgroup.com/?l=apache-modperl-dev&m=106074969831522&w=2
  
  
  
  1.1                  modperl-2.0/lib/Apache/PerlSections.pm
  
  Index: PerlSections.pm
  ===================================================================
  package Apache::PerlSections;
  
  use strict;
  use warnings FATAL => 'all';
  
  our $VERSION = '0.01';
  
  use Apache::CmdParms ();
  use Apache::Directive ();
  use APR::Table ();
  use Apache::Server ();
  use Apache::ServerUtil ();
  use Apache::Const -compile => qw(OK);
  
  use constant SPECIAL_NAME => 'PerlConfig';
  
  sub new {
      my($package, @args) = @_;
      return bless { @args }, ref($package) || $package;
  }
  
  sub server     { return shift->{'parms'}->server() }
  sub directives { return shift->{'directives'} ||= [] }
  sub package    { return shift->{'args'}->{'package'} }
  
  sub handler : method {
      my($self, $parms, $args) = @_;
  
      unless (ref $self) {
          $self = $self->new('parms' => $parms, 'args' => $args);
      }
  
      my $special = $self->SPECIAL_NAME;
  
      for my $entry ($self->symdump()) {
          if ($entry->[0] !~ /$special/) {
              $self->dump(@$entry);
          }
      }
  
      {
          no strict 'refs';
          my $package = $self->package;
  
          $self->dump_special(${"${package}::$special"},
            @{"${package}::$special"} );
      }
  
      $self->post_config();
  
      Apache::OK;
  }
  
  sub symdump {
      my($self) = @_;
  
      my $pack = $self->package;
  
      unless ($self->{symbols}) {
          $self->{symbols} = [];
  
          no strict;
  
          #XXX: Shamelessly borrowed from Devel::Symdump;
          while (my ($key, $val) = each(%{ *{"$pack\::"} })) {
              local (*ENTRY) = $val;
              if (defined $val && defined *ENTRY{SCALAR}) {
                  push @{$self->{symbols}}, [$key, $ENTRY];
              }
              if (defined $val && defined *ENTRY{ARRAY}) {
                  push @{$self->{symbols}}, [$key, \@ENTRY];
              }
              if (defined $val && defined *ENTRY{HASH} && $key !~ /::/) {
                  push @{$self->{symbols}}, [$key, \%ENTRY];
              }
          }
      }
  
      return @{$self->{symbols}};
  }
  
  sub dump_special {
      my($self, @data) = @_;
      $self->add_config(@data);
  }
  
  sub dump {
      my($self, $name, $entry) = @_;
      my $type = ref $entry;
  
      if ($type eq 'ARRAY') {
          $self->dump_array($name, $entry);
      }
      elsif ($type eq 'HASH') {
          $self->dump_hash($name, $entry);
      }
      else {
          $self->dump_entry($name, $entry);
      }
  }
  
  sub dump_hash {
      my($self, $name, $hash) = @_;
  
      for my $entry (sort keys %{ $hash || {} }) {
          my $item = $hash->{$entry};
          my $type = ref($item);
  
          if ($type eq 'HASH') {
              $self->dump_section($name, $entry, $item);
          }
          elsif ($type eq 'ARRAY') {
              for my $e (@$item) {
                  $self->dump_section($name, $entry, $e);
              }
          }
      }
  }
  
  sub dump_section {
      my($self, $name, $loc, $hash) = @_;
  
      $self->add_config("<$name $loc>\n");
  
      for my $entry (sort keys %{ $hash || {} }) {
          $self->dump_entry($entry, $hash->{$entry});
      }
  
      $self->add_config("</$name>\n");
  }
  
  sub dump_array {
      my($self, $name, $entries) = @_;
  
      for my $entry (@$entries) {
          $self->dump_entry($name, $entry);
      }
  }
  
  sub dump_entry {
      my($self, $name, $entry) = @_;
      my $type = ref $entry;
  
      if ($type eq 'SCALAR') {
          $self->add_config("$name $$entry\n");
      }
      elsif ($type eq 'ARRAY') {
          $self->add_config("$name @$entry\n");
      }
      elsif ($type eq 'HASH') {
          $self->dump_hash($name, $entry);
      }
      elsif ($type) {
          #XXX: Could do $type->can('httpd_config') here on objects ???
          die "Unknown type '$type' for directive $name";
      }
      elsif (defined $entry) {
          $self->add_config("$name $entry\n");
      }
  }
  
  sub add_config {
      my($self, $config) = @_;
      return unless defined $config;
      chomp($config);
      push @{ $self->directives }, $config;
  }
  
  sub post_config {
      my($self) = @_;
      my $errmsg = $self->server->add_config($self->directives);
      die $errmsg if $errmsg;
  }
  
  1;
  __END__
  
  
  
  1.49      +1 -1      modperl-2.0/src/modules/perl/modperl_cmd.c
  
  Index: modperl_cmd.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
  retrieving revision 1.48
  retrieving revision 1.49
  diff -u -r1.48 -r1.49
  --- modperl_cmd.c	16 Sep 2003 01:57:27 -0000	1.48
  +++ modperl_cmd.c	20 Oct 2003 17:44:48 -0000	1.49
  @@ -345,7 +345,7 @@
       return NULL;
   }
   
  -#define MP_DEFAULT_PERLSECTION_HANDLER "Apache::PerlSection"
  +#define MP_DEFAULT_PERLSECTION_HANDLER "Apache::PerlSections"
   #define MP_DEFAULT_PERLSECTION_PACKAGE "Apache::ReadConfig"
   #define MP_STRICT_PERLSECTIONS_SV \
       get_sv("Apache::Server::StrictPerlSections", FALSE)
  
  
  

Mime
View raw message