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

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

version 1.3, 2001/12/19 17:17:46 version 1.15, 2005/04/05 20:43:27
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;
  sub handler {  use Apache::loncommon;
      my $r = shift;  use Apache::lonnet;
      $r->content_type('text/html');  
      $r->send_http_header;  # section takes one env var name as input, and returns
      return OK if $r->header_only;  # 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',
      $r->print('<html><body>');  # which is normal for the standard ENV vars like REQUEST_URI.
   sub section
      my $envkey;  {
       my ($name) = @_;
       return $1 if $name =~ m/\A([^.]*)\./;
       return '';
   }
   
   sub print_hash {
       my ($r,$hash)=@_;
       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 my $envkey (sort(keys(%{$hash}))) {
    if (not ($i % $interval)) {
       $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 = $hash->{$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('</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);
     
      $->print("<hr><h1>Debugging</h1><hr>\n");      $r->print("<hr /><h1>Debugging</h1><hr />\n");
       $r->print("<font face='Courier'>");
             
      my $i=0;      my %differences=%ENV;
      foreach $envkey (sort keys %ENV) {      foreach my $key (sort(keys(%env))) {
   $r->print("$envkey ---- $ENV{$envkey}<br>");   if ($env{$key} eq $differences{$key}) {
         $i++;      delete($differences{$key});
      }   }
       }
      $r->print('<h1>Total Number of Elements: '.$i.'</h1>');      &print_hash($r,\%differences);
       &print_hash($r,\%env);
       &print_hash($r,\%ENV);
   # ------------------------------------------------ If in a course, print hashes
       if ($ENV{'request.course.id'}) {
   
    my %parmhash;
    my %symbhash;
    my %hash;
   
    my $fn=$ENV{'request.course.fn'};
   
    if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER(),0640)) {
       $r->print('<h2>Big Hash</h2>');
       foreach (sort keys %hash) {
    $r->print("\n<br />".$_.': '.$hash{$_});
       }
       untie %hash;
    } else {
       $r->print('<h2>Count not tie big hash</h2>');
    }
    if (tie(%parmhash,'GDBM_File',
    $ENV{'request.course.fn'}.'_parms.db',
    &GDBM_READER(),0640)) {
       $r->print('<h2>Parm Hash</h2>');
       foreach (sort keys %parmhash) {
           $r->print("\n<br />".$_.': '.$parmhash{$_});
       }
       untie %parmhash;
    } else {
               $r->print('<h2>Could not tie parmhash</h2>');
    }
    if (tie(%symbhash,'GDBM_File',"$fn\_symb.db",&GDBM_READER(),0640)) {
               $r->print('<h2>Symb Hash</h2>');
               foreach (sort keys %symbhash) {
    $r->print("\n<br />".$_.': '.$symbhash{$_});
               }
               untie %symbhash;
    } else {
               $r->print('<h2>Could not tie symbhash</h2>');
    }
    if (-e $fn.'.state') {
       $r->print('<h2>State</h2>');
       my @conditions=();
       {
    my $fh=Apache::File->new($fn.'.state');
    @conditions=<$fh>;
       }
       foreach (@conditions) {
    $r->print('<tt>'.$_.'</tt><br />');
       }
    }
       }
     
 # ------------------------------------------------------------------- End Debug  # ------------------------------------------------------------------- End Debug
      $r->print('</body></html>');               $r->print('</body></html>');    
        return OK;
  }   }
   
   
 1;  1;
 __END__  __END__
   
Removed from v.1.3  
changed lines
  Added in v.1.15

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