version 1.778, 2006/09/05 20:42:15
|
version 1.782, 2006/09/19 19:03:24
|
Line 293 sub error {
|
Line 293 sub error {
|
} |
} |
|
|
# ------------------------------------------- Transfer profile into environment |
# ------------------------------------------- Transfer profile into environment |
|
my $env_loaded; |
sub transfer_profile_to_env { |
sub transfer_profile_to_env { |
|
if ($env_loaded) { return; } |
|
|
my ($lonidsdir,$handle)=@_; |
my ($lonidsdir,$handle)=@_; |
if (!defined($lonidsdir)) { |
if (!defined($lonidsdir)) { |
$lonidsdir = $perlvar{'lonIDsDir'}; |
$lonidsdir = $perlvar{'lonIDsDir'}; |
Line 325 sub transfer_profile_to_env {
|
Line 327 sub transfer_profile_to_env {
|
} |
} |
} |
} |
$env{'user.environment'} = "$lonidsdir/$handle.id"; |
$env{'user.environment'} = "$lonidsdir/$handle.id"; |
|
$env_loaded=1; |
foreach my $expired_key (keys(%Remove)) { |
foreach my $expired_key (keys(%Remove)) { |
&delenv($expired_key); |
&delenv($expired_key); |
} |
} |
Line 344 sub appenv {
|
Line 347 sub appenv {
|
$env{$key}=$newenv{$key}; |
$env{$key}=$newenv{$key}; |
} |
} |
} |
} |
|
foreach my $key (keys(%newenv)) { |
|
my $value = &escape($newenv{$key}); |
|
delete($newenv{$key}); |
|
$newenv{&escape($key)}=$value; |
|
} |
|
|
my $lockfh; |
my $lockfh; |
unless (open($lockfh,"$env{'user.environment'}")) { |
unless (open($lockfh,"$env{'user.environment'}")) { |
Line 369 sub appenv {
|
Line 377 sub appenv {
|
chomp($oldenv[$i]); |
chomp($oldenv[$i]); |
if ($oldenv[$i] ne '') { |
if ($oldenv[$i] ne '') { |
my ($name,$value)=split(/=/,$oldenv[$i],2); |
my ($name,$value)=split(/=/,$oldenv[$i],2); |
$name=&unescape($name); |
|
$value=&unescape($value); |
|
unless (defined($newenv{$name})) { |
unless (defined($newenv{$name})) { |
$newenv{$name}=$value; |
$newenv{$name}=$value; |
} |
} |
Line 383 sub appenv {
|
Line 389 sub appenv {
|
} |
} |
my $newname; |
my $newname; |
foreach $newname (keys %newenv) { |
foreach $newname (keys %newenv) { |
print $fh &escape($newname).'='.&escape($newenv{$newname})."\n"; |
print $fh $newname.'='.$newenv{$newname}."\n"; |
} |
} |
close($fh); |
close($fh); |
} |
} |
Line 891 sub save_cache {
|
Line 897 sub save_cache {
|
&purge_remembered(); |
&purge_remembered(); |
#&Apache::loncommon::validate_page(); |
#&Apache::loncommon::validate_page(); |
undef(%env); |
undef(%env); |
|
undef($env_loaded); |
} |
} |
|
|
my $to_remember=-1; |
my $to_remember=-1; |
Line 1184 sub ssi_body {
|
Line 1191 sub ssi_body {
|
|
|
# --------------------------------------------------------- Server Side Include |
# --------------------------------------------------------- Server Side Include |
|
|
|
sub absolute_url { |
|
my ($host_name) = @_; |
|
my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://'); |
|
if ($host_name eq '') { |
|
$host_name = $ENV{'SERVER_NAME'}; |
|
} |
|
return $protocol.$host_name; |
|
} |
|
|
sub ssi { |
sub ssi { |
|
|
my ($fn,%form)=@_; |
my ($fn,%form)=@_; |
Line 1195 sub ssi {
|
Line 1211 sub ssi {
|
$form{'no_update_last_known'}=1; |
$form{'no_update_last_known'}=1; |
|
|
if (%form) { |
if (%form) { |
$request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn); |
$request=new HTTP::Request('POST',&absolute_url().$fn); |
$request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form)); |
$request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form)); |
} else { |
} else { |
$request=new HTTP::Request('GET',"http://".$ENV{'HTTP_HOST'}.$fn); |
$request=new HTTP::Request('GET',&absolute_url().$fn); |
} |
} |
|
|
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
Line 7110 BEGIN {
|
Line 7126 BEGIN {
|
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf |
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf |
unless ($readit) { |
unless ($readit) { |
{ |
{ |
# FIXME: Use LONCAPA::Configuration::read_conf here and omit next block |
my $configvars = LONCAPA::Configuration::read_conf('loncapa.conf'); |
open(my $config,"</etc/httpd/conf/loncapa.conf"); |
%perlvar = (%perlvar,%{$configvars}); |
|
|
while (my $configline=<$config>) { |
|
if ($configline=~/\S/ && $configline =~ /^[^\#]*PerlSetVar/) { |
|
my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); |
|
chomp($varvalue); |
|
$perlvar{$varname}=$varvalue; |
|
} |
|
} |
|
close($config); |
|
} |
|
{ |
|
open(my $config,"</etc/httpd/conf/loncapa_apache.conf"); |
|
|
|
while (my $configline=<$config>) { |
|
if ($configline =~ /^[^\#]*PerlSetVar/) { |
|
my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); |
|
chomp($varvalue); |
|
$perlvar{$varname}=$varvalue; |
|
} |
|
} |
|
close($config); |
|
} |
} |
|
|
# ------------------------------------------------------------ Read domain file |
# ------------------------------------------------------------ Read domain file |