Diff for /loncom/interface/lontest.pm between versions 1.3 and 1.7

version 1.3, 2001/12/19 17:17:46 version 1.7, 2002/08/20 21:29:34
Line 31  package Apache::lontest; Line 31  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("admin","List Environment");
        $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('<h1>Total Number of Elements: '.$i.'</h1>');       $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;
        }
   
   
    }
     
 # ------------------------------------------------------------------- End Debug  # ------------------------------------------------------------------- End Debug
      $r->print('</body></html>');               $r->print('</body></html>');        
  }   }
   
   
 1;  1;
 __END__  __END__
   

Removed from v.1.3  
changed lines
  Added in v.1.7


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>