![]() ![]() | ![]() |
- the great ENV -> env switch has commenced
1: # The LearningOnline Network with CAPA 2: # A debugging harness. 3: # 4: # $Id: lontest.pm,v 1.15 2005/04/05 20:43:27 albertel Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: # 29: 30: package Apache::lontest; 31: 32: use strict; 33: use Apache::Constants qw(:common :http); 34: use GDBM_File; 35: use Apache::loncommon; 36: use Apache::lonnet; 37: 38: # section takes one env var name as input, and returns 39: # what section the given env var is in, which is the part 40: # of the env var before the first period. 41: # Returns the section, or blank string for 'no section', 42: # which is normal for the standard ENV vars like REQUEST_URI. 43: sub section 44: { 45: my ($name) = @_; 46: return $1 if $name =~ m/\A([^.]*)\./; 47: return ''; 48: } 49: 50: sub print_hash { 51: my ($r,$hash)=@_; 52: my $i=0; 53: my $interval = 20; # change this to change how many keys/table 54: my $prevSection = ''; # keeps track of the section we're in. 55: 56: foreach my $envkey (sort(keys(%{$hash}))) { 57: if (not ($i % $interval)) { 58: $r->print('</table>') unless $i eq 0; 59: $r->print('<table border="0">'); 60: } 61: my $sec = section($envkey); 62: 63: if ($prevSection ne $sec) { # new section, print header 64: $r->print('<tr><td colspan="2">'); 65: $r->print("<br /><br /><h2 style='color: #008800'><u>$sec</u></h2>"); 66: $r->print('</td></tr>'); 67: $prevSection = $sec; 68: } 69: 70: my $envVal = $hash->{$envkey}; 71: $envVal =~ s/(.{50})/$1\<wbr\>/g; 72: $envkey =~ s/(.{30})/$1\<wbr\>/g; 73: 74: $r->print("<tr><td valign='top'><b>$envkey</b></td>"); 75: $r->print("<td valign='top'>$envVal</td></tr>\n"); 76: $i++; 77: } 78: 79: $r->print('</table></font><h1>Total Number of Elements: '.$i.'</h1>'); 80: } 81: sub handler { 82: my $r = shift; 83: &Apache::loncommon::content_type($r,'text/html'); 84: $r->send_http_header; 85: return OK if $r->header_only; 86: 87: my $html=&Apache::lonxml::xmlbegin(); 88: my $bodytag=&Apache::loncommon::bodytag("List Environment","admin"); 89: $r->print($html.'<head></head>'.$bodytag); 90: 91: $r->print("<hr /><h1>Debugging</h1><hr />\n"); 92: $r->print("<font face='Courier'>"); 93: 94: my %differences=%ENV; 95: foreach my $key (sort(keys(%env))) { 96: if ($env{$key} eq $differences{$key}) { 97: delete($differences{$key}); 98: } 99: } 100: &print_hash($r,\%differences); 101: &print_hash($r,\%env); 102: &print_hash($r,\%ENV); 103: # ------------------------------------------------ If in a course, print hashes 104: if ($ENV{'request.course.id'}) { 105: 106: my %parmhash; 107: my %symbhash; 108: my %hash; 109: 110: my $fn=$ENV{'request.course.fn'}; 111: 112: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) { 113: $r->print('<h2>Big Hash</h2>'); 114: foreach (sort keys %hash) { 115: $r->print("\n<br />".$_.': '.$hash{$_}); 116: } 117: untie %hash; 118: } else { 119: $r->print('<h2>Count not tie big hash</h2>'); 120: } 121: if (tie(%parmhash,'GDBM_File', 122: $ENV{'request.course.fn'}.'_parms.db', 123: &GDBM_READER(),0640)) { 124: $r->print('<h2>Parm Hash</h2>'); 125: foreach (sort keys %parmhash) { 126: $r->print("\n<br />".$_.': '.$parmhash{$_}); 127: } 128: untie %parmhash; 129: } else { 130: $r->print('<h2>Could not tie parmhash</h2>'); 131: } 132: if (tie(%symbhash,'GDBM_File',"$fn\_symb.db",&GDBM_READER(),0640)) { 133: $r->print('<h2>Symb Hash</h2>'); 134: foreach (sort keys %symbhash) { 135: $r->print("\n<br />".$_.': '.$symbhash{$_}); 136: } 137: untie %symbhash; 138: } else { 139: $r->print('<h2>Could not tie symbhash</h2>'); 140: } 141: if (-e $fn.'.state') { 142: $r->print('<h2>State</h2>'); 143: my @conditions=(); 144: { 145: my $fh=Apache::File->new($fn.'.state'); 146: @conditions=<$fh>; 147: } 148: foreach (@conditions) { 149: $r->print('<tt>'.$_.'</tt><br />'); 150: } 151: } 152: } 153: 154: # ------------------------------------------------------------------- End Debug 155: $r->print('</body></html>'); 156: return OK; 157: } 158: 159: 160: 1; 161: __END__ 162: 163: 164: 165: