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

Diff for /loncom/interface/lontest.pm between versions 1.11 and 1.23

version 1.11, 2003/04/01 20:12:02 version 1.23, 2014/12/15 00:59:40
Line 27 Line 27
 #  #
 #  #
   
   
 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 43  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 $bodytag=&Apache::loncommon::bodytag("List Environment","admin");      foreach my $envkey (sort(keys(%{$hash}))) {
      $r->print('<html>'.$bodytag);   if (not ($i % $interval)) {
            $r->print('</table>') unless $i eq 0;
      my $envkey;      $r->print('<table border="0">');
     }
      $r->print("<hr><h1>Debugging</h1><hr>\n");   my $sec = section($envkey);
      $r->print("<font face='Courier'>");  
         if ($prevSection ne $sec) { # new section, print header 
      my $i=0;      $r->print('<tr><td colspan="2">');
      my $interval = 20; # change this to change how many keys/table      $r->print("<br /><br /><h2 style='color: #008800'><u>$sec</u></h2>");
      my $prevSection = ''; # keeps track of the section we're in.      $r->print('</td></tr>');
      foreach $envkey (sort keys %ENV) {      $prevSection = $sec;
  if (not ($i % $interval))   }
          {  
      $r->print('</table>') unless $i eq 0;   my $envVal = $hash->{$envkey};
      $r->print('<table border="0">')   $envVal =~ s/(.{50})/$1\<wbr\>/g;
          }   $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 my $key (sort(keys(%hash))) {
          $r->print("\n<br>".$_.': '.$hash{$_});   $r->print("\n<br />".$key.': '.$hash{$key});
              }      }
              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 my $param (sort(keys(%parmhash))) {
         $r->print("\n<br>".$_.': '.$parmhash{$_});          $r->print("\n<br />".$param.': '.$parmhash{$param});
              }      }
              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 my $symb (sort(keys(%symbhash))) {
        $r->print("\n<br>".$_.': '.$symbhash{$_});   $r->print("\n<br />".$symb.': '.$symbhash{$symb});
             }              }
             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 my $cond (@conditions) {
                  $r->print('<tt>'.$_.'</tt><br />');   $r->print('<tt>'.$cond.'</tt><br />');
      }      }
        }   }
  }      }
   
     
 # ------------------------------------------------------------------- End Debug  # ------------------------------------------------------------------- End Debug
      $r->print('</body></html>');               $r->print(&Apache::loncommon::end_page());    
        return OK;
  }   }
   
   
 1;  1;
 __END__  __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
   
   
   
Removed from v.1.11  
changed lines
  Added in v.1.23

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