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

Diff for /loncom/interface/lontest.pm between versions 1.14 and 1.15

version 1.14, 2005/02/17 08:50:20 version 1.15, 2005/04/05 20:43:27
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
Line 46  sub section Line 47  sub section
     return '';      return '';
 }  }
   
  sub handler {  sub print_hash {
      my $r = shift;      my ($r,$hash)=@_;
      &Apache::loncommon::content_type($r,'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'>");
        
       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 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.14  
changed lines
  Added in v.1.15

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