Return to lontest.pm CVS log

Up to [LON-CAPA] / loncom / interface

- Coding style:
 - keys(), sort()
 - for readability eliminate use of $_

# The LearningOnline Network with CAPA
# A debugging harness.
#
# $Id: lontest.pm,v 1.23 2014/12/15 00:59:40 raeburn 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;

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;

    $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 ($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 my $key (sort(keys(%hash))) {
		$r->print("\n<br />".$key.': '.$hash{$key});
	    }
	    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 my $param (sort(keys(%parmhash))) {
	        $r->print("\n<br />".$param.': '.$parmhash{$param});
	    }
	    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 my $symb (sort(keys(%symbhash))) {
		$r->print("\n<br />".$symb.': '.$symbhash{$symb});
            }
            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 my $cond (@conditions) {
		$r->print('<tt>'.$cond.'</tt><br />');
	    }
	}
    }
 
# ------------------------------------------------------------------- End Debug
     $r->print(&Apache::loncommon::end_page());    
     return OK;
 }


1;
__END__

=pod

=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