[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.20

version 1.14, 2005/02/17 08:50:20 version 1.20, 2008/11/14 21:26:54
Line 27 Line 27
 #  #
 #  #
   
   =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()
   
   =item *
   
   
   
   
   =back
   
   =cut
   
 package Apache::lontest;  package Apache::lontest;
   
 use strict;  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  
 # 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  sub section
 {  {
     my ($name) = @_;      my ($name) = @_;
Line 46  sub section Line 85  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;
   
       $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 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(&Apache::loncommon::end_page());    
      return OK;       return OK;
  }   }
   
Removed from v.1.14  
changed lines
  Added in v.1.20

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