[BACK]Return to lontest.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lontest.pm between versions 1.13 and 1.17

version 1.13, 2005/02/17 08:29:43 version 1.17, 2005/04/07 08:15:41
Line 33  use strict; Line 33  use strict;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use GDBM_File;  use GDBM_File;
 use Apache::loncommon;  use Apache::loncommon;
   use Apache::lonnet;
   
 # section takes one env var name as input, and returns  # section takes one env var name as input, and returns
 # what section the given env var is in, which is the part  # what section the given env var is in, which is the part
 # of the env var before the first period.  # of the env var before the first period.
 # Returns the section, or blank string for 'no section',  # Returns the section, or blank string for 'no section',
 # which is normal for the standard ENV vars like REQUEST_URI.  # which is normal for the standard env vars like REQUEST_URI.
 sub section  sub section
 {  {
     my ($name) = @_;      my ($name) = @_;
Line 46  sub section Line 47  sub section
     return '';      return '';
 }  }
   
  sub handler {  sub print_hash {
      my $r = shift;      my ($r,$hash)=@_;
      $r->content_type('text/html');      my $i=0;
      $r->send_http_header;      my $interval = 20; # change this to change how many keys/table
      return OK if $r->header_only;      my $prevSection = ''; # keeps track of the section we're in.
   
      my $html=&Apache::lonxml::xmlbegin();      foreach my $envkey (sort(keys(%{$hash}))) {
      my $bodytag=&Apache::loncommon::bodytag("List Environment","admin");   if (not ($i % $interval)) {
      $r->print($html.'<head></head>'.$bodytag);      $r->print('</table>') unless $i eq 0;
            $r->print('<table border="0">');
      my $envkey;   }
     my $sec = section($envkey);
      $r->print("<hr /><h1>Debugging</h1><hr />\n");  
      $r->print("<font face='Courier'>");   if ($prevSection ne $sec) { # new section, print header 
            $r->print('<tr><td colspan="2">');
      my $i=0;      $r->print("<br /><br /><h2 style='color: #008800'><u>$sec</u></h2>");
      my $interval = 20; # change this to change how many keys/table      $r->print('</td></tr>');
      my $prevSection = ''; # keeps track of the section we're in.      $prevSection = $sec;
      foreach $envkey (sort keys %ENV) {   }
  if (not ($i % $interval))  
          {   my $envVal = $hash->{$envkey};
      $r->print('</table>') unless $i eq 0;   $envVal =~ s/(.{50})/$1\<wbr\>/g;
      $r->print('<table border="0">')   $envkey =~ s/(.{30})/$1\<wbr\>/g;
          }  
  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("<tr><td valign='top'><b>$envkey</b></td>");
          $r->print("<td valign='top'>$envVal</td></tr>\n");   $r->print("<td valign='top'>$envVal</td></tr>\n");
  $i++;   $i++;
      }      }
   
      $r->print('</table></font><h1>Total Number of Elements: '.$i.'</h1>');  
   
       $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'>");
       $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 in a course, print hashes
    if ($ENV{'request.course.id'}) {      if ($env{'request.course.id'}) {
   
      my %parmhash;   my %parmhash;
      my %symbhash;   my %symbhash;
      my %hash;   my %hash;
   
      my $fn=$ENV{'request.course.fn'};   my $fn=$env{'request.course.fn'};
   
          if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {   if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
              $r->print('<h2>Big Hash</h2>');      $r->print('<h2>Big Hash</h2>');
              foreach (sort keys %hash) {      foreach (sort keys %hash) {
          $r->print("\n<br />".$_.': '.$hash{$_});   $r->print("\n<br />".$_.': '.$hash{$_});
              }      }
              untie %hash;      untie %hash;
          } else {   } else {
              $r->print('<h2>Count not tie big hash</h2>');      $r->print('<h2>Count not tie big hash</h2>');
          }   }
          if (tie(%parmhash,'GDBM_File',   if (tie(%parmhash,'GDBM_File',
      $ENV{'request.course.fn'}.'_parms.db',   $env{'request.course.fn'}.'_parms.db',
      &GDBM_READER(),0640)) {   &GDBM_READER(),0640)) {
              $r->print('<h2>Parm Hash</h2>');      $r->print('<h2>Parm Hash</h2>');
              foreach (sort keys %parmhash) {      foreach (sort keys %parmhash) {
         $r->print("\n<br />".$_.': '.$parmhash{$_});          $r->print("\n<br />".$_.': '.$parmhash{$_});
              }      }
              untie %parmhash;      untie %parmhash;
          } else {   } else {
             $r->print('<h2>Could not tie parmhash</h2>');              $r->print('<h2>Could not tie parmhash</h2>');
  }   }
          if (tie(%symbhash,'GDBM_File',"$fn\_symb.db",&GDBM_READER(),0640)) {   if (tie(%symbhash,'GDBM_File',"$fn\_symb.db",&GDBM_READER(),0640)) {
             $r->print('<h2>Symb Hash</h2>');              $r->print('<h2>Symb Hash</h2>');
             foreach (sort keys %symbhash) {              foreach (sort keys %symbhash) {
        $r->print("\n<br />".$_.': '.$symbhash{$_});   $r->print("\n<br />".$_.': '.$symbhash{$_});
             }              }
             untie %symbhash;              untie %symbhash;
  } else {   } else {
             $r->print('<h2>Could not tie symbhash</h2>');              $r->print('<h2>Could not tie symbhash</h2>');
  }   }
          if (-e $fn.'.state') {   if (-e $fn.'.state') {
      $r->print('<h2>State</h2>');      $r->print('<h2>State</h2>');
      my @conditions=();      my @conditions=();
      {      {
  my $fh=Apache::File->new($fn.'.state');   my $fh=Apache::File->new($fn.'.state');
  @conditions=<$fh>;   @conditions=<$fh>;
      }      }
      foreach (@conditions) {      foreach (@conditions) {
                  $r->print('<tt>'.$_.'</tt><br />');   $r->print('<tt>'.$_.'</tt><br />');
      }      }
        }   }
  }      }
   
     
 # ------------------------------------------------------------------- End Debug  # ------------------------------------------------------------------- End Debug
      $r->print('</body></html>');           $r->print('</body></html>');    
Removed from v.1.13  
changed lines
  Added in v.1.17

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.