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