--- loncom/interface/lontest.pm 2001/01/03 18:54:04 1.1 +++ loncom/interface/lontest.pm 2005/02/17 08:29:43 1.13 @@ -1,36 +1,154 @@ - +# The LearningOnline Network with CAPA +# A debugging harness. +# +# $Id: lontest.pm,v 1.13 2005/02/17 08:29:43 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/ +# # -# Just Junk Just Junk Just Junk -# package Apache::lontest; use strict; 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 { my $r = shift; $r->content_type('text/html'); $r->send_http_header; return OK if $r->header_only; - - - $r->print(''); + my $html=&Apache::lonxml::xmlbegin(); + my $bodytag=&Apache::loncommon::bodytag("List Environment","admin"); + $r->print($html.''.$bodytag); + my $envkey; - $->print("

Debugging

\n"); + $r->print("

Debugging

\n"); + $r->print(""); + 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) { - $r->print("$envkey ---- $ENV{$envkey}
"); + if (not ($i % $interval)) + { + $r->print('') unless $i eq 0; + $r->print('') + } + my $sec = section($envkey); + + if ($prevSection ne $sec) # new section, print header + { + $r->print(''); + $prevSection = $sec; + } + + my $envVal = $ENV{$envkey}; + $envVal =~ s/(.{50})/$1\/g; + $envkey =~ s/(.{30})/$1\/g; + + $r->print(""); + $r->print("\n"); + $i++; } - -# ------------------------------------------------------------------- End Debug + $r->print('
'); + $r->print("

$sec

"); + $r->print('
$envkey$envVal

Total Number of Elements: '.$i.'

'); + +# ------------------------------------------------ If in a course, print hashes + if ($ENV{'request.course.id'}) { - $r->print(''); + my %parmhash; + my %symbhash; + my %hash; + + my $fn=$ENV{'request.course.fn'}; + + if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) { + $r->print('

Big Hash

'); + foreach (sort keys %hash) { + $r->print("\n
".$_.': '.$hash{$_}); + } + untie %hash; + } else { + $r->print('

Count not tie big hash

'); + } + if (tie(%parmhash,'GDBM_File', + $ENV{'request.course.fn'}.'_parms.db', + &GDBM_READER(),0640)) { + $r->print('

Parm Hash

'); + foreach (sort keys %parmhash) { + $r->print("\n
".$_.': '.$parmhash{$_}); + } + untie %parmhash; + } else { + $r->print('

Could not tie parmhash

'); + } + if (tie(%symbhash,'GDBM_File',"$fn\_symb.db",&GDBM_READER(),0640)) { + $r->print('

Symb Hash

'); + foreach (sort keys %symbhash) { + $r->print("\n
".$_.': '.$symbhash{$_}); + } + untie %symbhash; + } else { + $r->print('

Could not tie symbhash

'); + } + if (-e $fn.'.state') { + $r->print('

State

'); + my @conditions=(); + { + my $fh=Apache::File->new($fn.'.state'); + @conditions=<$fh>; + } + foreach (@conditions) { + $r->print(''.$_.'
'); + } + } } + +# ------------------------------------------------------------------- End Debug + $r->print(''); + return OK; + } + + 1; __END__