dougm 2002/10/06 22:01:44
Modified: lib/Apache PerlSection.pm
Removed: lib/ModPerl Symdump.pm
Log:
Submitted by: gozer
Reviewed by: dougm
remove need for ModPerl::Symdump (copy of Devel::Symdump)
Revision Changes Path
1.2 +34 -14 modperl-2.0/lib/Apache/PerlSection.pm
Index: PerlSection.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/PerlSection.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- PerlSection.pm 7 Oct 2002 02:35:18 -0000 1.1
+++ PerlSection.pm 7 Oct 2002 05:01:44 -0000 1.2
@@ -5,7 +5,6 @@
our $VERSION = '0.01';
-use ModPerl::Symdump ();
use Apache::CmdParms ();
use Apache::Directive ();
@@ -19,6 +18,7 @@
sub server { return shift->{'parms'}->server() }
sub directives { return shift->{'directives'} ||= [] }
+sub package { return shift->{'args'}->get('package') }
sub handler : method {
my($self, $parms, $args) = @_;
@@ -27,26 +27,18 @@
$self = $self->new('parms' => $parms, 'args' => $args);
}
- my $package = $args->get('package');
my $special = $self->SPECIAL_NAME;
-
- my $root = ModPerl::Symdump->new($package);
- my %convert = (
- 'scalars' => sub { no strict 'refs'; return ${ $_[0] } },
- 'arrays' => sub { no strict 'refs'; return \@{ $_[0] } },
- 'hashes' => sub { no strict 'refs'; return \%{ $_[0] } },
- );
-
- for my $type (sort keys %convert) {
- for my $entry (grep { !/$special/ } $root->$type()) {
- (my $name = $entry) =~ s/${package}:://;
- $self->dump($name, $convert{$type}->($entry));
+ 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"} );
}
@@ -54,6 +46,34 @@
$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 {
