![]() ![]() | ![]() |
- the great ENV -> env switch has commenced
# The LearningOnline Network with CAPA # A debugging harness. # # $Id: lontest.pm,v 1.15 2005/04/05 20:43:27 albertel Exp $ # # 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/ # # package Apache::lontest; use strict; use Apache::Constants qw(:common :http); use GDBM_File; 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 { my ($name) = @_; return $1 if $name =~ m/\A([^.]*)\./; return ''; } sub print_hash { my ($r,$hash)=@_; 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 my $envkey (sort(keys(%{$hash}))) { if (not ($i % $interval)) { $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 = $hash->{$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>'); } sub handler { my $r = shift; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK if $r->header_only; my $html=&Apache::lonxml::xmlbegin(); my $bodytag=&Apache::loncommon::bodytag("List Environment","admin"); $r->print($html.'<head></head>'.$bodytag); $r->print("<hr /><h1>Debugging</h1><hr />\n"); $r->print("<font face='Courier'>"); my %differences=%ENV; foreach my $key (sort(keys(%env))) { if ($env{$key} eq $differences{$key}) { delete($differences{$key}); } } &print_hash($r,\%differences); &print_hash($r,\%env); &print_hash($r,\%ENV); # ------------------------------------------------ If in a course, print hashes if ($ENV{'request.course.id'}) { my %parmhash; my %symbhash; my %hash; my $fn=$ENV{'request.course.fn'}; if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) { $r->print('<h2>Big Hash</h2>'); foreach (sort keys %hash) { $r->print("\n<br />".$_.': '.$hash{$_}); } untie %hash; } else { $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 $r->print('</body></html>'); return OK; } 1; __END__