[LON-CAPA-cvs] cvs: loncom /cgi loncgi.pm /interface lontest.pm /lonnet/perl lonnet.pm

albertel lon-capa-cvs@mail.lon-capa.org
Tue, 05 Apr 2005 20:43:27 -0000


This is a MIME encoded message

--albertel1112733807
Content-Type: text/plain

albertel		Tue Apr  5 16:43:27 2005 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
    /loncom/cgi	loncgi.pm 
    /loncom/interface	lontest.pm 
  Log:
  - the great ENV -> env switch has commenced
  
  
--albertel1112733807
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20050405164327.txt"

Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.618 loncom/lonnet/perl/lonnet.pm:1.619
--- loncom/lonnet/perl/lonnet.pm:1.618	Thu Mar 31 10:55:47 2005
+++ loncom/lonnet/perl/lonnet.pm	Tue Apr  5 16:43:27 2005
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.618 2005/03/31 15:55:47 albertel Exp $
+# $Id: lonnet.pm,v 1.619 2005/04/05 20:43:27 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -40,7 +40,8 @@
    %courselogs %accesshash %userrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf
    %domaindescription %domain_auth_def %domain_auth_arg_def 
-   %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit);
+   %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit
+   %env);
 
 use IO::Socket;
 use GDBM_File;
@@ -54,6 +55,11 @@
 my $readit;
 my $max_connection_retries = 10;     # Or some such value.
 
+require Exporter;
+
+our @ISA = qw (Exporter);
+our @EXPORT = qw(%env);
+
 =pod
 
 =head1 Package Variables
@@ -279,6 +285,7 @@
 	chomp($profile[$envi]);
 	my ($envname,$envvalue)=split(/=/,$profile[$envi]);
 	$ENV{$envname} = $envvalue;
+	$env{$envname} = $envvalue;
         if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {
             if ($time < time-300) {
                 $Remove{$key}++;
@@ -286,6 +293,7 @@
         }
     }
     $ENV{'user.environment'} = "$lonidsdir/$handle.id";
+    $env{'user.environment'} = "$lonidsdir/$handle.id";
     foreach my $expired_key (keys(%Remove)) {
         &delenv($expired_key);
     }
@@ -303,6 +311,7 @@
 	    delete($newenv{$_});
         } else {
             $ENV{$_}=$newenv{$_};
+            $env{$_}=$newenv{$_};
         }
     }
 
@@ -390,6 +399,7 @@
 	    if ($_=~/^$delthis/) { 
                 my ($key,undef) = split('=',$_);
                 delete($ENV{$key});
+                delete($env{$key});
             } else {
                 print $fh $_; 
             }
@@ -5653,6 +5663,8 @@
        }
     }
     close($config);
+    # FIXME: dev server don't want this, production servers _do_ want this
+    #&get_iphost();
 }
 
 sub get_iphost {
Index: loncom/cgi/loncgi.pm
diff -u loncom/cgi/loncgi.pm:1.1 loncom/cgi/loncgi.pm:1.2
--- loncom/cgi/loncgi.pm:1.1	Thu Oct  9 18:04:37 2003
+++ loncom/cgi/loncgi.pm	Tue Apr  5 16:43:27 2005
@@ -1,7 +1,7 @@
 #
 # LON-CAPA helpers for cgi-bin scripts
 #
-# $Id: loncgi.pm,v 1.1 2003/10/09 22:04:37 matthew Exp $
+# $Id: loncgi.pm,v 1.2 2005/04/05 20:43:27 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -52,10 +52,16 @@
 use strict;
 use warnings FATAL=>'all';
 no warnings 'uninitialized';
+use vars qw(%env);
+
 use CGI();
 use CGI::Cookie();
 use Fcntl qw(:flock);
 use LONCAPA::Configuration();
+require Exporter;
+
+our @ISA = qw (Exporter);
+our @EXPORT = qw(%env);
 
 my $lonidsdir;
 
@@ -151,8 +157,10 @@
         chomp($envrow);
         my ($envname,$envvalue)=split(/=/,$envrow);
         $ENV{$envname} = $envvalue;
+        $env{$envname} = $envvalue;
     }
     $ENV{'user.environment'} = "$lonidsdir/$handle.id";
+    $env{'user.environment'} = "$lonidsdir/$handle.id";
     return undef;
 }
 
Index: loncom/interface/lontest.pm
diff -u loncom/interface/lontest.pm:1.14 loncom/interface/lontest.pm:1.15
--- loncom/interface/lontest.pm:1.14	Thu Feb 17 03:50:20 2005
+++ loncom/interface/lontest.pm	Tue Apr  5 16:43:27 2005
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # A debugging harness.
 #
-# $Id: lontest.pm,v 1.14 2005/02/17 08:50:20 albertel Exp $
+# $Id: lontest.pm,v 1.15 2005/04/05 20:43:27 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -33,6 +33,7 @@
 use Apache::Constants qw(:common :http);
 use GDBM_File;
 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
@@ -46,102 +47,109 @@
     return '';
 }
 
- 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);
-     
-     my $envkey;
- 
-     $r->print("<hr /><h1>Debugging</h1><hr />\n");
-     $r->print("<font face='Courier'>");
-     
-     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 $envkey (sort keys %ENV) {
-	 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 = $ENV{$envkey};
-	 $envVal =~ s/(.{50})/$1\<wbr\>/g;
-	 $envkey =~ s/(.{30})/$1\<wbr\>/g;
+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>');
+	$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);
+ 
+    $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 ($ENV{'request.course.id'}) {
+    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) {
+	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 {
+	    }
+	    untie %parmhash;
+	} else {
             $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>');
             foreach (sort keys %symbhash) {
-	       $r->print("\n<br />".$_.': '.$symbhash{$_});
+		$r->print("\n<br />".$_.': '.$symbhash{$_});
             }
             untie %symbhash;
-	 } else {
+	} 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 />');
-	     }
-       }
- }
-
+	}
+	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
      $r->print('</body></html>');    

--albertel1112733807--