Tweak which stack frames WebGUI::Middleware::StackTrace skips for HTML and text output; add the modules it uses to testEnvironment.pl; comment out the dumping of the asset tree for now; silence a warning in testEnvironment.pl by tweaking module test/load order
This commit is contained in:
Scott Walters
parent
81b69f8cba
commit
617ca066dc
2 changed files with 64 additions and 64 deletions
|
|
@ -16,6 +16,7 @@ BEGIN {
|
||||||
|
|
||||||
our $StackTraceClass = "Devel::StackTrace";
|
our $StackTraceClass = "Devel::StackTrace";
|
||||||
if (try { require Devel::StackTrace::WithLexicals; 1 }) {
|
if (try { require Devel::StackTrace::WithLexicals; 1 }) {
|
||||||
|
# Optional since it needs PadWalker
|
||||||
$StackTraceClass = "Devel::StackTrace::WithLexicals";
|
$StackTraceClass = "Devel::StackTrace::WithLexicals";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -31,8 +32,6 @@ BEGIN {
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# Optional since it needs PadWalker
|
|
||||||
|
|
||||||
sub call {
|
sub call {
|
||||||
my($self, $env) = @_;
|
my($self, $env) = @_;
|
||||||
|
|
||||||
|
|
@ -62,7 +61,8 @@ sub trace_as_string {
|
||||||
|
|
||||||
my $st = '';
|
my $st = '';
|
||||||
my $first = 1;
|
my $first = 1;
|
||||||
foreach my $f ( $trace->frames() ) {
|
$trace->reset_pointer;
|
||||||
|
while( my $f = $trace->next_frame ) {
|
||||||
$st .= "\t" unless $first;
|
$st .= "\t" unless $first;
|
||||||
$st .= $f->as_string($first) . "\n";
|
$st .= $f->as_string($first) . "\n";
|
||||||
$first = 0;
|
$first = 0;
|
||||||
|
|
@ -78,7 +78,6 @@ do {
|
||||||
*_build_context = *Devel::StackTrace::AsHTML::_build_context{CODE};
|
*_build_context = *Devel::StackTrace::AsHTML::_build_context{CODE};
|
||||||
*_build_arguments = *Devel::StackTrace::AsHTML::_build_arguments{CODE};
|
*_build_arguments = *Devel::StackTrace::AsHTML::_build_arguments{CODE};
|
||||||
*_build_lexicals = *Devel::StackTrace::AsHTML::_build_lexicals{CODE};
|
*_build_lexicals = *Devel::StackTrace::AsHTML::_build_lexicals{CODE};
|
||||||
# XXX what else?
|
|
||||||
};
|
};
|
||||||
|
|
||||||
sub trace_as_html {
|
sub trace_as_html {
|
||||||
|
|
@ -87,9 +86,8 @@ sub trace_as_html {
|
||||||
my $session = shift or die;
|
my $session = shift or die;
|
||||||
my %opt = @_;
|
my %opt = @_;
|
||||||
|
|
||||||
# replaces: my $ret = $trace->as_html;
|
# copied and modified render() from Devel::StackTrace::WithLexicals
|
||||||
# ... which just did __PACKAGE__->render
|
# "$trace->as_html" just does "__PACKAGE__->render" in D::ST::WL
|
||||||
# render copied and inlined here
|
|
||||||
|
|
||||||
my $extras = sub { $session->url->extras(@_) };
|
my $extras = sub { $session->url->extras(@_) };
|
||||||
|
|
||||||
|
|
@ -141,14 +139,16 @@ function toggleLexicals(ref) {
|
||||||
toggleThing(ref, 'lexicals', 'Hide lexical variables', 'Show lexical variables');
|
toggleThing(ref, 'lexicals', 'Hide lexical variables', 'Show lexical variables');
|
||||||
}
|
}
|
||||||
</script>
|
</script>
|
||||||
|
<!--
|
||||||
|
not doing asset dump right now
|
||||||
<link rel="stylesheet" type="text/css" href="@{[ $extras->('yui/build/treeview/assets/skins/sam/treeview.css') ]}" />
|
<link rel="stylesheet" type="text/css" href="@{[ $extras->('yui/build/treeview/assets/skins/sam/treeview.css') ]}" />
|
||||||
<link rel="stylesheet" type="text/css" href="@{[ $extras->('yui/build/button/assets/skins/sam/button.css') ]}" />
|
<script type="text/javascript" src="@{[ $extras->('yui/build/treeview/treeview-min.js') ]}"></script>
|
||||||
|
-->
|
||||||
<link rel="stylesheet" type="text/css" href="@{[ $extras->('yui/build/button/assets/skins/sam/button.css') ]}" />
|
<link rel="stylesheet" type="text/css" href="@{[ $extras->('yui/build/button/assets/skins/sam/button.css') ]}" />
|
||||||
<script type="text/javascript" src="@{[ $extras->('yui/build/yahoo-dom-event/yahoo-dom-event.js') ]}"></script>
|
<script type="text/javascript" src="@{[ $extras->('yui/build/yahoo-dom-event/yahoo-dom-event.js') ]}"></script>
|
||||||
<script type="text/javascript" src="@{[ $extras->('yui/build/yuiloader/yuiloader-min.js') ]}"></script>
|
<script type="text/javascript" src="@{[ $extras->('yui/build/yuiloader/yuiloader-min.js') ]}"></script>
|
||||||
<script type="text/javascript" src="@{[ $extras->('yui/build/event/event-min.js') ]}"></script>
|
<script type="text/javascript" src="@{[ $extras->('yui/build/event/event-min.js') ]}"></script>
|
||||||
<script type="text/javascript" src="@{[ $extras->('yui/build/dom/dom-min.js') ]}"></script>
|
<script type="text/javascript" src="@{[ $extras->('yui/build/dom/dom-min.js') ]}"></script>
|
||||||
<script type="text/javascript" src="@{[ $extras->('yui/build/treeview/treeview-min.js') ]}"></script>
|
|
||||||
<script type="text/javascript" src="@{[ $extras->('yui/build/element/element-min.js') ]}"></script>
|
<script type="text/javascript" src="@{[ $extras->('yui/build/element/element-min.js') ]}"></script>
|
||||||
<script type="text/javascript" src="@{[ $extras->('yui/build/button/button-min.js') ]}"></script>
|
<script type="text/javascript" src="@{[ $extras->('yui/build/button/button-min.js') ]}"></script>
|
||||||
|
|
||||||
|
|
@ -157,11 +157,10 @@ function toggleLexicals(ref) {
|
||||||
<h1>Error trace</h1><pre class="message">$msg</pre><ol>
|
<h1>Error trace</h1><pre class="message">$msg</pre><ol>
|
||||||
HEAD
|
HEAD
|
||||||
|
|
||||||
warn "came up with URL to treeview-min.js: @{[ $extras->('yui/build/treeview/treeview-min.js') ]}";
|
|
||||||
|
|
||||||
my $accumulated_asset_info = []; # record the stack frames from when we find an asset on the call stack
|
my $accumulated_asset_info = []; # record the stack frames from when we find an asset on the call stack
|
||||||
|
|
||||||
$trace->next_frame; # ignore the head
|
$trace->reset_pointer;
|
||||||
|
$trace->next_frame; # for 1..2;
|
||||||
my $i = 0;
|
my $i = 0;
|
||||||
while (my $frame = $trace->next_frame) {
|
while (my $frame = $trace->next_frame) {
|
||||||
|
|
||||||
|
|
@ -185,57 +184,57 @@ warn "came up with URL to treeview-min.js: @{[ $extras->('yui/build/treeview/tre
|
||||||
}
|
}
|
||||||
$out .= qq{</ol>};
|
$out .= qq{</ol>};
|
||||||
|
|
||||||
# dump the asset tree
|
# # dump the asset tree
|
||||||
|
#
|
||||||
my $assets = WebGUI::Asset->getRoot($session)->getLineage(['descendants'], {returnObjects=>1});
|
# my $assets = WebGUI::Asset->getRoot($session)->getLineage(['descendants'], {returnObjects=>1});
|
||||||
|
#
|
||||||
my $tree = { type => 'text', label => 'root', children => [], };
|
# my $tree = { type => 'text', label => 'root', children => [], };
|
||||||
|
#
|
||||||
for my $asset (@$assets) {
|
# for my $asset (@$assets) {
|
||||||
# create a tree structure of assets matching their lineage
|
# # create a tree structure of assets matching their lineage
|
||||||
# the format (arrays, hashes, fields) matches what YAHOO.treeview expects
|
# # the format (arrays, hashes, fields) matches what YAHOO.treeview expects
|
||||||
# when we find an asset mentioned in one of the stack trace frames above, we add the saved file/line/etc info to the label
|
# # when we find an asset mentioned in one of the stack trace frames above, we add the saved file/line/etc info to the label
|
||||||
my $lineage = $asset->get('lineage');
|
# my $lineage = $asset->get('lineage');
|
||||||
my @parts = $lineage =~ m/(.{6})/g;
|
# my @parts = $lineage =~ m/(.{6})/g;
|
||||||
# warn "asset: $asset lineage: $lineage parts: @parts";
|
# # warn "asset: $asset lineage: $lineage parts: @parts";
|
||||||
my $node = $tree;
|
# my $node = $tree;
|
||||||
while(@parts) {
|
# while(@parts) {
|
||||||
my $part = shift @parts;
|
# my $part = shift @parts;
|
||||||
if((my $child_node) = grep $_->{lineage_chunk} eq $part, @{$node->{children}}) {
|
# if((my $child_node) = grep $_->{lineage_chunk} eq $part, @{$node->{children}}) {
|
||||||
$node = $child_node;
|
# $node = $child_node;
|
||||||
} else {
|
# } else {
|
||||||
my $label = $asset->get('title') . ': Id: ' . $asset->getId . ' Class: ' . ref($asset);
|
# my $label = $asset->get('title') . ': Id: ' . $asset->getId . ' Class: ' . ref($asset);
|
||||||
for my $message ( map $_->{message}, grep $_->{asset_id} eq $asset->getId, @$accumulated_asset_info ) {
|
# for my $message ( map $_->{message}, grep $_->{asset_id} eq $asset->getId, @$accumulated_asset_info ) {
|
||||||
$label .= " <----- $message";
|
# $label .= " <----- $message";
|
||||||
}
|
# }
|
||||||
my $child_node = {
|
# my $child_node = {
|
||||||
type => 'text',
|
# type => 'text',
|
||||||
label => $label,
|
# label => $label,
|
||||||
lineage_chunk => $part,
|
# lineage_chunk => $part,
|
||||||
children => [ ],
|
# children => [ ],
|
||||||
};
|
# };
|
||||||
push @{$node->{children}}, $child_node;
|
# push @{$node->{children}}, $child_node;
|
||||||
$node = $child_node;
|
# $node = $child_node;
|
||||||
}
|
# }
|
||||||
}
|
# }
|
||||||
}
|
# }
|
||||||
|
#
|
||||||
use JSON::PP; # JSON::XS creates something that's mangled
|
# use JSON::PP; # JSON::XS creates something that's mangled
|
||||||
my $json_tree = JSON::PP->new->ascii->pretty->encode( [ $tree ] );
|
# my $json_tree = JSON::PP->new->ascii->pretty->encode( [ $tree ] );
|
||||||
|
#
|
||||||
# warn "json_tree: $json_tree";
|
# warn "json_tree: $json_tree";
|
||||||
# do { open my $fh, '>', 'json.debug2.js' or die $!; $fh->print($json_tree); };
|
# do { open my $fh, '>', 'json.debug2.js' or die $!; $fh->print($json_tree); };
|
||||||
|
#
|
||||||
$out .= qq{
|
# $out .= qq{
|
||||||
<ol><li>
|
# <ol><li>
|
||||||
<div id="treeDiv1"></div>
|
# <div id="treeDiv1"></div>
|
||||||
</ol></li>
|
# </ol></li>
|
||||||
<script language="javascript">
|
# <script language="javascript">
|
||||||
var tree = new YAHOO.widget.TreeView("treeDiv1", $json_tree);
|
# var tree = new YAHOO.widget.TreeView("treeDiv1", $json_tree);
|
||||||
tree.expandAll();
|
# tree.expandAll();
|
||||||
tree.draw();
|
# tree.draw();
|
||||||
</script>
|
# </script>
|
||||||
};
|
# };
|
||||||
|
|
||||||
$out .= "</body></html>";
|
$out .= "</body></html>";
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -61,6 +61,7 @@ if ($] >= 5.010) {
|
||||||
##Doing this as a global is not nice, but it works
|
##Doing this as a global is not nice, but it works
|
||||||
my $missingModule = 0;
|
my $missingModule = 0;
|
||||||
|
|
||||||
|
checkModule("Test::Tester", "0" );
|
||||||
checkModule("LWP", 5.833 );
|
checkModule("LWP", 5.833 );
|
||||||
checkModule("HTTP::Request", 1.40 );
|
checkModule("HTTP::Request", 1.40 );
|
||||||
checkModule("HTTP::Headers", 1.61 );
|
checkModule("HTTP::Headers", 1.61 );
|
||||||
|
|
@ -152,7 +153,6 @@ checkModule("Locales", "0.10" );
|
||||||
checkModule("Test::Harness", "3.17" );
|
checkModule("Test::Harness", "3.17" );
|
||||||
checkModule("DateTime::Event::ICal", "0.10" );
|
checkModule("DateTime::Event::ICal", "0.10" );
|
||||||
checkModule("Cache::FastMmap", "1.35" );
|
checkModule("Cache::FastMmap", "1.35" );
|
||||||
checkModule("Test::Tester", "0" );
|
|
||||||
checkModule("Test::Log::Dispatch", "0" );
|
checkModule("Test::Log::Dispatch", "0" );
|
||||||
checkModule("CHI", "0.34" );
|
checkModule("CHI", "0.34" );
|
||||||
checkModule('IO::Socket::SSL', );
|
checkModule('IO::Socket::SSL', );
|
||||||
|
|
@ -168,8 +168,9 @@ checkModule('Search::QueryParser', );
|
||||||
checkModule('Monkey::Patch', '0.03' );
|
checkModule('Monkey::Patch', '0.03' );
|
||||||
checkModule('UUID::Tiny', '1.03' );
|
checkModule('UUID::Tiny', '1.03' );
|
||||||
checkModule('Starman', '0.2010', 2);
|
checkModule('Starman', '0.2010', 2);
|
||||||
checkModule('App::Cmd', '0.311' );
|
checkModule('App::Cmd', '0.311' );
|
||||||
|
checkModule('Devel::StackTrace', '1.27' );
|
||||||
|
checkModule('Devel::StackTrace::WithLexicals', '0.03' );
|
||||||
|
|
||||||
failAndExit("Required modules are missing, running no more checks.") if $missingModule;
|
failAndExit("Required modules are missing, running no more checks.") if $missingModule;
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue