version 1.2, 2001/01/06 17:15:22
|
version 1.8, 2002/08/21 17:18:08
|
Line 1
|
Line 1
|
|
# The LearningOnline Network with CAPA |
|
# A debugging harness. |
|
# |
|
# $Id$ |
|
# |
|
# Copyright Michigan State University Board of Trustees |
|
# |
|
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
|
# |
|
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# LON-CAPA is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with LON-CAPA; if not, write to the Free Software |
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
# |
|
# /home/httpd/html/adm/gpl.txt |
|
# |
|
# http://www.lon-capa.org/ |
|
# |
# |
# |
# Just Junk Just Junk Just Junk |
|
# |
|
|
|
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 Apache::loncommon; |
|
|
|
# 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 |
|
{ |
|
my ($name) = @_; |
|
return $1 if $name =~ m/\A([^.]*)\./; |
|
return ''; |
|
} |
|
|
sub handler { |
sub handler { |
my $r = shift; |
my $r = shift; |
$r->content_type('text/html'); |
$r->content_type('text/html'); |
$r->send_http_header; |
$r->send_http_header; |
return OK if $r->header_only; |
return OK if $r->header_only; |
|
|
|
|
$r->print('<html><body>'); |
|
|
|
|
my $bodytag=&Apache::loncommon::bodytag("List Environment","admin"); |
|
$r->print('<html>'.$bodytag); |
|
|
my $envkey; |
my $envkey; |
|
|
$->print("<hr><h1>Debugging</h1><hr>\n"); |
$->print("<hr><h1>Debugging</h1><hr>\n"); |
|
$->print("<font face='Courier'>"); |
|
|
my $i=0; |
my $i=0; |
|
my $interval = 20; # change this to change how many keys/table |
|
my $prevSection = ''; # keeps track of the section we're in. |
foreach $envkey (sort keys %ENV) { |
foreach $envkey (sort keys %ENV) { |
$r->print("$envkey ---- $ENV{$envkey}<br>"); |
if (not ($i % $interval)) |
$i++; |
{ |
|
$r->print('</table>') unless $i eq 0; |
|
$r->print('<table border="0">') |
|
} |
|
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("<td valign='top'>$envVal</td></tr>\n"); |
|
$i++; |
|
} |
|
|
|
$r->print('</table></font><h1>Total Number of Elements: '.$i.'</h1>'); |
|
|
|
# ------------------------------------------------ If in a course, print hashes |
|
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)) && |
|
(tie(%parmhash,'GDBM_File', |
|
$ENV{'request.course.fn'}.'_parms.db', |
|
&GDBM_READER(),0640))) { |
|
$r->print('<h2>Big Hash</h2>'); |
|
foreach (sort keys %hash) { |
|
$r->print("\n<br>".$_.': '.$hash{$_}); |
|
} |
|
$r->print('<h2>Parm Hash</h2>'); |
|
foreach (sort keys %parmhash) { |
|
$r->print("\n<br>".$_.': '.$parmhash{$_}); |
|
} |
|
untie %hash; |
|
untie %parmhash; |
} |
} |
|
|
$r->print('<h1>Total Number of Elements: '.$i.'</h1>'); |
|
|
} |
|
|
# ------------------------------------------------------------------- End Debug |
# ------------------------------------------------------------------- End Debug |
$r->print('</body></html>'); |
$r->print('</body></html>'); |
} |
} |
|
|
|
|
1; |
1; |
__END__ |
__END__ |
|
|