Hello,
here's a patch that makes Apache::Status' out-of-the-box experience more
user-friendly, avoiding some 500's when required modules are not
available, as well as has some cleanups and a doc typo fix. The patch
is against the current (as of now) mod_perl snapshot,
modperl_20020609042123.tar.gz.
--- Status.pm.orig Sun Jun 9 12:53:33 2002
+++ Status.pm Sun Jun 9 12:58:10 2002
@@ -7,9 +7,16 @@
my $Is_Win32 = ($^O eq "MSWin32");
{
local $SIG{__DIE__};
+
%is_installed = map {
$_, (eval("require $_") || 0);
- } qw (Data::Dumper Devel::Symdump B Apache::Request Apache::Peek Apache::Symbol);
+ } qw (Data::Dumper Devel::Symdump B Apache::Request Apache::Peek B::Fathom
+ Apache::Symbol B::Terse B::LexInfo B::Deparse B::Graph B::TerseSize);
+
+ delete($is_installed{'B::Deparse'})
+ if ($is_installed{'B::Deparse'} && $B::Deparse::VERSION < 0.59);
+ delete($is_installed{'B::Fathom'})
+ if ($is_installed{'B::Fathom'} && $B::Fathom::VERSION < 0.05);
}
use vars qw($newQ);
@@ -25,16 +32,16 @@
my $CPAN_base = "http://www.perl.com/CPAN/modules/by-module";;
my(%status) = (
- script => "PerlRequire'd Files",
- inc => "Loaded Modules",
- rgysubs => "Compiled Registry Scripts",
- 'symdump' => "Symbol Table Dump",
- inh_tree => "Inheritance Tree",
- isa_tree => "ISA Tree",
- env => "Environment",
- sig => "Signal Handlers",
- myconfig => "Perl Configuration",
- hooks => "Enabled mod_perl Hooks",
+ 'script' => "PerlRequire'd Files",
+ 'inc' => "Loaded Modules",
+ 'rgysubs' => "Compiled Registry Scripts",
+ 'symdump' => "Symbol Table Dump",
+ 'inh_tree' => "Inheritance Tree",
+ 'isa_tree' => "ISA Tree",
+ 'env' => "Environment",
+ 'sig' => "Signal Handlers",
+ 'myconfig' => "Perl Configuration",
+ 'hooks' => "Enabled mod_perl Hooks",
);
delete $status{'sig'} if $Is_Win32;
@@ -210,7 +217,7 @@
}
}
"$_ = $val\n" }
- sort keys %SIG),
+ sort keys %SIG),
"</pre>"];
}
@@ -219,10 +226,22 @@
["<pre>", Config::myconfig(), "</pre>"]
}
-sub status_inh_tree { ["<pre>", Devel::Symdump->inh_tree, "</pre>"] }
-sub status_isa_tree { ["<pre>", Devel::Symdump->isa_tree, "</pre>"] }
+sub status_inh_tree {
+ if ($is_installed{'Devel::Symdump'}) {
+ return ['<pre>', Devel::Symdump->inh_tree, '</pre>'];
+ } else {
+ return ["<p>Please install the <a
+href=\"$CPAN_base/Devel/\">Devel::Symdump</a> module.</p>"];
+ }
+}
+sub status_isa_tree {
+ if ($is_installed{'Devel::Symdump'}) {
+ return ['<pre>', Devel::Symdump->isa_tree, '</pre>'];
+ } else {
+ return ["<p>Please install the <a
+href=\"$CPAN_base/Devel/\">Devel::Symdump</a> module.</p>"];
+ }
+}
-sub status_data_dump {
+sub status_data_dump {
my($r,$q) = @_;
my($name,$type) = (split "/", $r->uri)[-2,-1];
my $script = $q->script_name;
@@ -287,7 +306,7 @@
sub b_graph_link {
my($r,$q,$name) = @_;
return unless status_config($r, "StatusGraph");
- return unless eval { require B::Graph };
+ return unless $is_installed{'B::Graph'};
B::Graph->UNIVERSAL::VERSION('0.03');
my $script = $q->script_name;
return qq(\n<a href="$script/$name?noh_b_graph">OP Tree Graph</a>\n);
@@ -296,7 +315,7 @@
sub b_lexinfo_link {
my($r, $q, $name) = @_;
return unless status_config($r, "StatusLexInfo");
- return unless eval { require B::LexInfo };
+ return unless $is_installed{'B::LexInfo'};
my $script = $q->script_name;
return qq(\n<a href="$script/$name?noh_b_lexinfo">Lexical Info</a>\n);
}
@@ -317,7 +336,7 @@
sub b_terse_link {
my($r, $q, $name) = @_;
return unless status_config($r, "StatusTerse");
- return unless eval { require B::Terse };
+ return unless $is_installed{'B::Terse'};
my $script = $q->script_name;
my @retval;
for (qw(exec slow)) {
@@ -340,7 +359,7 @@
sub b_terse_size_link {
my($r, $q, $name) = @_;
return unless status_config($r, "StatusTerseSize");
- return unless eval { require B::TerseSize };
+ return unless $is_installed{'B::TerseSize'};
my $script = $q->script_name;
my @retval;
for (qw(exec slow)) {
@@ -365,7 +384,7 @@
sub b_package_size_link {
my($r, $q, $name) = @_;
return unless status_config($r, "StatusPackageSize");
- return unless eval { require B::TerseSize };
+ return unless $is_installed{'B::TerseSize'};
my $script = $q->script_name;
qq(<a href="$script/$name?noh_b_package_size">Memory Usage</a>\n);
}
@@ -410,8 +429,7 @@
sub b_deparse_link {
my($r, $q, $name) = @_;
return unless status_config($r, "StatusDeparse");
- return unless eval { require B::Deparse };
- return unless $B::Deparse::VERSION >= 0.59;
+ return unless $is_installed{'B::Deparse'};
my $script = $q->script_name;
return qq(\n<a href="$script/$name?noh_b_deparse">Deparse</a>\n);
}
@@ -430,8 +448,7 @@
sub b_fathom_link {
my($r, $q, $name) = @_;
return unless status_config($r, "StatusFathom");
- return unless eval { require B::Fathom };
- return unless $B::Fathom::VERSION >= 0.05;
+ return unless $is_installed{'B::Fathom'};
my $script = $q->script_name;
return qq(\n<a href="$script/$name?noh_b_fathom">Fathom Score</a>\n);
}
@@ -489,10 +506,9 @@
sub noh_b_graph {
my $r = shift;
- require B::Graph;
untie *STDOUT;
-
+
my $dir = $r->server_root_relative(
$r->dir_config("GraphDir") || "logs/b_graphs");
@@ -501,7 +517,7 @@
(my $thing = $r->path_info) =~ s:^/::;
my $type = "dot";
my $file = "$dir/$thing.$$.gif";
-
+
unless (-e $file) {
tie *STDOUT, "B::Graph", $r, $file;
B::Graph::compile("-$type", $thing)->();
@@ -668,7 +684,7 @@
=item StatusDumper
-When browsing symbol tables, the values of arrays, hashes ans calars
+When browsing symbol tables, the values of arrays, hashes and scalars
can be viewed via B<Data::Dumper> if this configuration variable is set
to On:
--
Ville Skytt�
ville.skytta at iki.fi
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
