version 1.7, 2002/08/20 21:29:34
|
version 1.21, 2008/11/20 15:19:39
|
Line 27
|
Line 27
|
# |
# |
# |
# |
|
|
|
|
package Apache::lontest; |
package Apache::lontest; |
|
|
use strict; |
use strict; |
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
use GDBM_File; |
use GDBM_File; |
use Apache::loncommon; |
use Apache::loncommon; |
|
use Apache::lonnet; |
|
|
# section takes one env var name as input, and returns |
|
# what section the given env var is in, which is the part |
|
# of the env var before the first period. |
|
# Returns the section, or blank string for 'no section', |
|
# which is normal for the standard ENV vars like REQUEST_URI. |
|
sub section |
sub section |
{ |
{ |
my ($name) = @_; |
my ($name) = @_; |
Line 46 sub section
|
Line 43 sub section
|
return ''; |
return ''; |
} |
} |
|
|
sub handler { |
sub print_hash { |
my $r = shift; |
my ($r,$hash)=@_; |
$r->content_type('text/html'); |
my $i=0; |
$r->send_http_header; |
my $interval = 20; # change this to change how many keys/table |
return OK if $r->header_only; |
my $prevSection = ''; # keeps track of the section we're in. |
|
|
my $bodytag=&Apache::loncommon::bodytag("admin","List Environment"); |
foreach my $envkey (sort(keys(%{$hash}))) { |
$r->print('<html>'.$bodytag); |
if (not ($i % $interval)) { |
|
$r->print('</table>') unless $i eq 0; |
my $envkey; |
$r->print('<table border="0">'); |
|
} |
$->print("<hr><h1>Debugging</h1><hr>\n"); |
my $sec = section($envkey); |
$->print("<font face='Courier'>"); |
|
|
if ($prevSection ne $sec) { # new section, print header |
my $i=0; |
$r->print('<tr><td colspan="2">'); |
my $interval = 20; # change this to change how many keys/table |
$r->print("<br /><br /><h2 style='color: #008800'><u>$sec</u></h2>"); |
my $prevSection = ''; # keeps track of the section we're in. |
$r->print('</td></tr>'); |
foreach $envkey (sort keys %ENV) { |
$prevSection = $sec; |
if (not ($i % $interval)) |
} |
{ |
|
$r->print('</table>') unless $i eq 0; |
my $envVal = $hash->{$envkey}; |
$r->print('<table border="0">') |
$envVal =~ s/(.{50})/$1\<wbr\>/g; |
} |
$envkey =~ s/(.{30})/$1\<wbr\>/g; |
my $sec = section($envkey); |
|
|
|
if ($prevSection ne $sec) # new section, print header |
|
{ |
|
$r->print('<tr><td colspan="2">'); |
|
$r->print("<br><br><h2 style='color: #008800'><u>$sec</u></h2>"); |
|
$r->print('</td></tr>'); |
|
$prevSection = $sec; |
|
} |
|
|
|
my $envVal = $ENV{$envkey}; |
|
$envVal =~ s/(.{50})/\1\<wbr\>/g; |
|
$envkey =~ s/(.{30})/\1\<wbr\>/g; |
|
|
|
$r->print("<tr><td valign='top'><b>$envkey</b></td>"); |
$r->print("<tr><td valign='top'><b>$envkey</b></td>"); |
$r->print("<td valign='top'>$envVal</td></tr>\n"); |
$r->print("<td valign='top'>$envVal</td></tr>\n"); |
$i++; |
$i++; |
} |
} |
|
|
$r->print('</table></font><h1>Total Number of Elements: '.$i.'</h1>'); |
|
|
|
|
$r->print('</table></font><h1>Total Number of Elements: '.$i.'</h1>'); |
|
} |
|
sub handler { |
|
my $r = shift; |
|
&Apache::loncommon::content_type($r,'text/html'); |
|
$r->send_http_header; |
|
return OK if $r->header_only; |
|
|
|
$r->print(&Apache::loncommon::start_page("List Environment",undef, |
|
{'function' => 'admin'})); |
|
|
|
$r->print("<hr /><h1>Debugging</h1><hr />\n"); |
|
$r->print("<font face='Courier'>"); |
|
$r->print("<hr /><h2>ENV</h2><hr />\n"); |
|
&print_hash($r,\%ENV); |
|
$r->print("<hr /><h2>env</h2><hr />\n"); |
|
&print_hash($r,\%env); |
# ------------------------------------------------ If in a course, print hashes |
# ------------------------------------------------ If in a course, print hashes |
if ($ENV{'request.course.id'}) { |
if ($env{'request.course.id'}) { |
|
|
my %parmhash; |
|
my %hash; |
|
|
|
my $fn=$ENV{'request.course.fn'}; |
|
|
|
if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) && |
my %parmhash; |
(tie(%parmhash,'GDBM_File', |
my %symbhash; |
$ENV{'request.course.fn'}.'_parms.db', |
my %hash; |
&GDBM_READER(),0640))) { |
|
$r->print('<h2>Big Hash</h2>'); |
my $fn=$env{'request.course.fn'}; |
foreach (sort keys %hash) { |
|
$r->print("\n<br>".$_.': '.$hash{$_}); |
if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) { |
} |
$r->print('<h2>Big Hash</h2>'); |
$r->print('<h2>Parm Hash</h2>'); |
foreach (sort keys %hash) { |
foreach (sort keys %parmhash) { |
$r->print("\n<br />".$_.': '.$hash{$_}); |
$r->print("\n<br>".$_.': '.$parmhash{$_}); |
} |
} |
untie %hash; |
untie %hash; |
} else { |
untie %parmhash; |
$r->print('<h2>Count not tie big hash</h2>'); |
} |
} |
|
if (tie(%parmhash,'GDBM_File', |
|
$env{'request.course.fn'}.'_parms.db', |
} |
&GDBM_READER(),0640)) { |
|
$r->print('<h2>Parm Hash</h2>'); |
|
foreach (sort keys %parmhash) { |
|
$r->print("\n<br />".$_.': '.$parmhash{$_}); |
|
} |
|
untie %parmhash; |
|
} else { |
|
$r->print('<h2>Could not tie parmhash</h2>'); |
|
} |
|
if (tie(%symbhash,'GDBM_File',"$fn\_symb.db",&GDBM_READER(),0640)) { |
|
$r->print('<h2>Symb Hash</h2>'); |
|
foreach (sort keys %symbhash) { |
|
$r->print("\n<br />".$_.': '.$symbhash{$_}); |
|
} |
|
untie %symbhash; |
|
} else { |
|
$r->print('<h2>Could not tie symbhash</h2>'); |
|
} |
|
if (-e $fn.'.state') { |
|
$r->print('<h2>State</h2>'); |
|
my @conditions=(); |
|
{ |
|
my $fh=Apache::File->new($fn.'.state'); |
|
@conditions=<$fh>; |
|
} |
|
foreach (@conditions) { |
|
$r->print('<tt>'.$_.'</tt><br />'); |
|
} |
|
} |
|
} |
|
|
# ------------------------------------------------------------------- End Debug |
# ------------------------------------------------------------------- End Debug |
$r->print('</body></html>'); |
$r->print(&Apache::loncommon::end_page()); |
|
return OK; |
} |
} |
|
|
|
|
Line 127 __END__
|
Line 151 __END__
|
|
|
|
|
|
|
|
=head1 NAME |
|
|
|
Apache::lontest; |
|
|
|
=head1 SYNOPSIS |
|
|
|
Used for debugging and testing the LONCAPA |
|
system. |
|
|
|
This is part of the LearningOnline Network with CAPA project |
|
described at http://www.lon-capa.org. |
|
|
|
=head1 HANDLER SUBROUTINE |
|
|
|
handler() |
|
|
|
=head1 OTHER SUBROUTINES |
|
|
|
=over |
|
|
|
=item section() : |
|
|
|
section takes one env var name as input, and returns |
|
what section the given env var is in, which is the part |
|
of the env var before the first period. |
|
Returns the section, or blank string for 'no section', |
|
which is normal for the standard env vars like REQUEST_URI. |
|
|
|
=item print_hash() |
|
|
|
=back |
|
|
|
=cut |
|
|
|
|
|
|