version 1.430, 2003/10/12 22:02:44
|
version 1.443, 2003/11/10 20:27:32
|
Line 25
|
Line 25
|
# |
# |
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30, |
|
# 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19, |
|
# 11/8,11/16,11/18,11/22,11/23,12/22, |
|
# 01/06,01/13,02/24,02/28,02/29, |
|
# 03/01,03/02,03/06,03/07,03/13, |
|
# 04/05,05/29,05/31,06/01, |
|
# 06/05,06/26 Gerd Kortemeyer |
|
# 06/26 Ben Tyszka |
|
# 06/30,07/15,07/17,07/18,07/20,07/21,07/22,07/25 Gerd Kortemeyer |
|
# 08/14 Ben Tyszka |
|
# 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer |
|
# 10/04 Gerd Kortemeyer |
|
# 10/04 Guy Albertelli |
|
# 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, |
|
# 10/30,10/31, |
|
# 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27, |
|
# 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer |
|
# 05/01/01 Guy Albertelli |
|
# 05/01,06/01,09/01 Gerd Kortemeyer |
|
# 09/01 Guy Albertelli |
|
# 09/01,10/01,11/01 Gerd Kortemeyer |
|
# YEAR=2001 |
|
# 3/2 Gerd Kortemeyer |
|
# 3/19,3/20 Gerd Kortemeyer |
|
# 5/26,5/28 Gerd Kortemeyer |
|
# 5/30 H. K. Ng |
|
# 6/1 Gerd Kortemeyer |
|
# July Guy Albertelli |
|
# 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26, |
|
# 10/2 Gerd Kortemeyer |
|
# 11/17,11/20,11/22,11/29 Gerd Kortemeyer |
|
# 12/5 Matthew Hall |
|
# 12/5 Guy Albertelli |
|
# 12/6,12/7,12/12 Gerd Kortemeyer |
|
# 12/21,12/22,12/27,12/28 Gerd Kortemeyer |
|
# YEAR=2002 |
|
# 1/4,2/4,2/7 Gerd Kortemeyer |
|
# |
|
### |
### |
|
|
package Apache::lonnet; |
package Apache::lonnet; |
Line 73 use LWP::UserAgent();
|
Line 35 use LWP::UserAgent();
|
use HTTP::Headers; |
use HTTP::Headers; |
use vars |
use vars |
qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom |
qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom |
%libserv %pr %prp %metacache %packagetab %titlecache |
%libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache |
%courselogs %accesshash %userrolehash $processmarker $dumpcount |
%courselogs %accesshash %userrolehash $processmarker $dumpcount |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache |
%userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def |
%userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def |
Line 274 sub transfer_profile_to_env {
|
Line 236 sub transfer_profile_to_env {
|
$idf->close(); |
$idf->close(); |
} |
} |
my $envi; |
my $envi; |
|
my %Remove; |
for ($envi=0;$envi<=$#profile;$envi++) { |
for ($envi=0;$envi<=$#profile;$envi++) { |
chomp($profile[$envi]); |
chomp($profile[$envi]); |
my ($envname,$envvalue)=split(/=/,$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}++; |
|
} |
|
} |
|
} |
|
foreach my $expired_key (keys(%Remove)) { |
|
&delenv($expired_key); |
} |
} |
$ENV{'user.environment'} = "$lonidsdir/$handle.id"; |
$ENV{'user.environment'} = "$lonidsdir/$handle.id"; |
} |
} |
Line 396 sub userload {
|
Line 367 sub userload {
|
while ($filename=readdir(LONIDS)) { |
while ($filename=readdir(LONIDS)) { |
if ($filename eq '.' || $filename eq '..') {next;} |
if ($filename eq '.' || $filename eq '..') {next;} |
my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9]; |
my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9]; |
if ($curtime-$mtime < 3600) { $numusers++; } |
if ($curtime-$mtime < 1800) { $numusers++; } |
} |
} |
closedir(LONIDS); |
closedir(LONIDS); |
} |
} |
Line 852 sub devalidate_cache {
|
Line 823 sub devalidate_cache {
|
my ($cache,$id,$name) = @_; |
my ($cache,$id,$name) = @_; |
delete $$cache{$id.'.time'}; |
delete $$cache{$id.'.time'}; |
delete $$cache{$id}; |
delete $$cache{$id}; |
my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db"; |
my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db"; |
open(DB,"$filename.lock"); |
open(DB,"$filename.lock"); |
flock(DB,LOCK_EX); |
flock(DB,LOCK_EX); |
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) { |
if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) { |
delete($hash{$id}); |
eval <<'EVALBLOCK'; |
delete($hash{$id.'.time'}); |
delete($hash{$id}); |
|
delete($hash{$id.'.time'}); |
|
EVALBLOCK |
|
if ($@) { |
|
&logthis("<font color='red'>devalidate_cache blew up :$@:$name</font>"); |
|
unlink($filename); |
|
} |
} else { |
} else { |
&logthis("Unable to tie hash"); |
if (-e $filename) { |
|
&logthis("Unable to tie hash (devalidate cache): $name"); |
|
unlink($filename); |
|
} |
} |
} |
untie(%hash); |
untie(%hash); |
flock(DB,LOCK_UN); |
flock(DB,LOCK_UN); |
Line 878 sub is_cached {
|
Line 858 sub is_cached {
|
return (undef,undef); |
return (undef,undef); |
} else { |
} else { |
if (time-($$cache{$id.'.time'})>$time) { |
if (time-($$cache{$id.'.time'})>$time) { |
# &logthis("Devailidating $id - ".time-($$cache{$id.'.time'})); |
# &logthis("Devalidating $id - ".time-($$cache{$id.'.time'})); |
&devalidate_cache($cache,$id,$name); |
&devalidate_cache($cache,$id,$name); |
return (undef,undef); |
return (undef,undef); |
} |
} |
Line 896 sub do_cache {
|
Line 876 sub do_cache {
|
$$cache{$id}; |
$$cache{$id}; |
} |
} |
|
|
sub save_cache { |
|
my ($cache,$name)=@_; |
|
my $starttime=&Time::HiRes::time(); |
|
# &logthis("Saving :$name:"); |
|
eval lock_store($cache,$perlvar{'lonDaemons'}.'/tmp/'.$name.".storable"); |
|
if ($@) { &logthis("lock_store threw a die ".$@); } |
|
# &logthis("save_cache took ".(&Time::HiRes::time()-$starttime)); |
|
} |
|
|
|
sub load_cache { |
|
my ($cache,$name)=@_; |
|
my $starttime=&Time::HiRes::time(); |
|
# &logthis("Before Loading $name size is ".scalar(%$cache)); |
|
my $tmpcache; |
|
eval { |
|
$tmpcache=lock_retrieve($perlvar{'lonDaemons'}.'/tmp/'.$name.".storable"); |
|
}; |
|
if ($@) { &logthis("lock_retreive threw a die ".$@); return; } |
|
if (!%$cache) { |
|
my $count; |
|
while (my ($key,$value)=each(%$tmpcache)) { |
|
$count++; |
|
$$cache{$key}=$value; |
|
} |
|
# &logthis("Initial load: $count"); |
|
} else { |
|
my $key; |
|
my $count; |
|
while ($key=each(%$tmpcache)) { |
|
if ($key !~/^(.*)\.time$/) { next; } |
|
my $name=$1; |
|
if (exists($$cache{$key})) { |
|
if ($$tmpcache{$key} >= $$cache{$key}) { |
|
$$cache{$key}=$$tmpcache{$key}; |
|
$$cache{$name}=$$tmpcache{$name}; |
|
} else { |
|
# &logthis("Would have overwritten $name with is set to expire at ".$$cache{$key}." with ".$$tmpcache{$key}." Whew!"); |
|
} |
|
} else { |
|
$count++; |
|
$$cache{$key}=$$tmpcache{$key}; |
|
$$cache{$name}=$$tmpcache{$name}; |
|
} |
|
} |
|
# &logthis("Additional load: $count"); |
|
} |
|
# &logthis("After Loading $name size is ".scalar(%$cache)); |
|
# &logthis("load_cache took ".(&Time::HiRes::time()-$starttime)); |
|
} |
|
|
|
sub save_cache_item { |
sub save_cache_item { |
my ($cache,$name,$id)=@_; |
my ($cache,$name,$id)=@_; |
my $starttime=&Time::HiRes::time(); |
my $starttime=&Time::HiRes::time(); |
# &logthis("Saving :$name:$id"); |
# &logthis("Saving :$name:$id"); |
my %hash; |
my %hash; |
my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db"; |
my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db"; |
open(DB,"$filename.lock"); |
open(DB,"$filename.lock"); |
flock(DB,LOCK_EX); |
flock(DB,LOCK_EX); |
if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) { |
if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) { |
$hash{$id.'.time'}=$$cache{$id.'.time'}; |
eval <<'EVALBLOCK'; |
$hash{$id}=freeze({'item'=>$$cache{$id}}); |
$hash{$id.'.time'}=$$cache{$id.'.time'}; |
|
$hash{$id}=freeze({'item'=>$$cache{$id}}); |
|
EVALBLOCK |
|
if ($@) { |
|
&logthis("<font color='red'>save_cache blew up :$@:$name</font>"); |
|
unlink($filename); |
|
} |
} else { |
} else { |
&logthis("Unable to tie hash"); |
if (-e $filename) { |
|
&logthis("Unable to tie hash (save cache item): $name"); |
|
unlink($filename); |
|
} |
} |
} |
untie(%hash); |
untie(%hash); |
flock(DB,LOCK_UN); |
flock(DB,LOCK_UN); |
Line 971 sub load_cache_item {
|
Line 910 sub load_cache_item {
|
my $starttime=&Time::HiRes::time(); |
my $starttime=&Time::HiRes::time(); |
# &logthis("Before Loading $name for $id size is ".scalar(%$cache)); |
# &logthis("Before Loading $name for $id size is ".scalar(%$cache)); |
my %hash; |
my %hash; |
my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db"; |
my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db"; |
open(DB,"$filename.lock"); |
open(DB,"$filename.lock"); |
flock(DB,LOCK_SH); |
flock(DB,LOCK_SH); |
if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) { |
if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) { |
if (!%$cache) { |
eval <<'EVALBLOCK'; |
my $count; |
if (!%$cache) { |
while (my ($key,$value)=each(%hash)) { |
my $count; |
$count++; |
while (my ($key,$value)=each(%hash)) { |
if ($key =~ /\.time$/) { |
$count++; |
$$cache{$key}=$value; |
if ($key =~ /\.time$/) { |
} else { |
$$cache{$key}=$value; |
my $hashref=thaw($value); |
} else { |
$$cache{$key}=$hashref->{'item'}; |
my $hashref=thaw($value); |
|
$$cache{$key}=$hashref->{'item'}; |
|
} |
} |
} |
} |
|
# &logthis("Initial load: $count"); |
# &logthis("Initial load: $count"); |
} else { |
} else { |
my $hashref=thaw($hash{$id}); |
my $hashref=thaw($hash{$id}); |
$$cache{$id}=$hashref->{'item'}; |
$$cache{$id}=$hashref->{'item'}; |
$$cache{$id.'.time'}=$hash{$id.'.time'}; |
$$cache{$id.'.time'}=$hash{$id.'.time'}; |
} |
} |
|
EVALBLOCK |
|
if ($@) { |
|
&logthis("<font color='red'>load_cache blew up :$@:$name</font>"); |
|
unlink($filename); |
|
} |
} else { |
} else { |
&logthis("Unable to tie hash"); |
if (-e $filename) { |
|
&logthis("Unable to tie hash (load cache item): $name"); |
|
unlink($filename); |
|
} |
} |
} |
untie(%hash); |
untie(%hash); |
flock(DB,LOCK_UN); |
flock(DB,LOCK_UN); |
Line 1071 sub getversion {
|
Line 1019 sub getversion {
|
|
|
sub currentversion { |
sub currentversion { |
my $fname=shift; |
my $fname=shift; |
|
my ($result,$cached)=&is_cached(\%resversioncache,$fname,'resversion',600); |
|
if (defined($cached)) { return $result; } |
my $author=$fname; |
my $author=$fname; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
my ($udom,$uname)=split(/\//,$author); |
my ($udom,$uname)=split(/\//,$author); |
Line 1082 sub currentversion {
|
Line 1032 sub currentversion {
|
if (($answer eq 'con_lost') || ($answer eq 'rejected')) { |
if (($answer eq 'con_lost') || ($answer eq 'rejected')) { |
return -1; |
return -1; |
} |
} |
return $answer; |
return &do_cache(\%resversioncache,$fname,$answer,'resversion'); |
} |
} |
|
|
# ----------------------------- Subscribe to a resource, return URL if possible |
# ----------------------------- Subscribe to a resource, return URL if possible |
Line 1117 sub repcopy {
|
Line 1067 sub repcopy {
|
&logthis("Subscribe returned $remoteurl: $filename"); |
&logthis("Subscribe returned $remoteurl: $filename"); |
return HTTP_SERVICE_UNAVAILABLE; |
return HTTP_SERVICE_UNAVAILABLE; |
} elsif ($remoteurl eq 'not_found') { |
} elsif ($remoteurl eq 'not_found') { |
&logthis("Subscribe returned not_found: $filename"); |
#&logthis("Subscribe returned not_found: $filename"); |
return HTTP_NOT_FOUND; |
return HTTP_NOT_FOUND; |
} elsif ($remoteurl =~ /^rejected by/) { |
} elsif ($remoteurl =~ /^rejected by/) { |
&logthis("Subscribe returned $remoteurl: $filename"); |
&logthis("Subscribe returned $remoteurl: $filename"); |
Line 2478 sub customaccess {
|
Line 2428 sub customaccess {
|
|
|
sub allowed { |
sub allowed { |
my ($priv,$uri)=@_; |
my ($priv,$uri)=@_; |
|
$uri=&deversion($uri); |
my $orguri=$uri; |
my $orguri=$uri; |
$uri=&declutter($uri); |
$uri=&declutter($uri); |
|
|
Line 2763 sub allowed {
|
Line 2713 sub allowed {
|
|
|
sub is_on_map { |
sub is_on_map { |
my $uri=&declutter(shift); |
my $uri=&declutter(shift); |
|
$uri=~s/\.\d+\.(\w+)$/\.$1/; |
my @uriparts=split(/\//,$uri); |
my @uriparts=split(/\//,$uri); |
my $filename=$uriparts[$#uriparts]; |
my $filename=$uriparts[$#uriparts]; |
my $pathname=$uri; |
my $pathname=$uri; |
Line 2774 sub is_on_map {
|
Line 2725 sub is_on_map {
|
if ($match) { |
if ($match) { |
return (1,$1); |
return (1,$1); |
} else { |
} else { |
my ($name,$ext)=($filename=~/^(.+)\.(\w+)$/); |
return (0,0); |
$ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ |
|
/\&(\Q$name\E\.\d+\.$ext)\:([\d\|]+)\&/; |
|
return (0,$2,$pathname.'/'.$1); |
|
} |
} |
} |
} |
|
|
Line 3848 sub metadata {
|
Line 3796 sub metadata {
|
$lcmetacache{':packages'}=$package.$keyroot; |
$lcmetacache{':packages'}=$package.$keyroot; |
} |
} |
foreach (keys %packagetab) { |
foreach (keys %packagetab) { |
if ($_=~/^$package\&/) { |
my $part=$keyroot; |
|
$part=~s/^\_//; |
|
if ($_=~/^\Q$package\E\&/ || |
|
$_=~/^\Q$package\E_0\&/) { |
my ($pack,$name,$subp)=split(/\&/,$_); |
my ($pack,$name,$subp)=split(/\&/,$_); |
# ignore package.tab specified default values |
# ignore package.tab specified default values |
# here &package_tab_default() will fetch those |
# here &package_tab_default() will fetch those |
if ($subp eq 'default') { next; } |
if ($subp eq 'default') { next; } |
my $value=$packagetab{$_}; |
my $value=$packagetab{$_}; |
my $part=$keyroot; |
my $unikey; |
$part=~s/^\_//; |
if ($pack =~ /_0$/) { |
|
$unikey='parameter_0_'.$name; |
|
$part=0; |
|
} else { |
|
$unikey='parameter'.$keyroot.'_'.$name; |
|
} |
if ($subp eq 'display') { |
if ($subp eq 'display') { |
$value.=' [Part: '.$part.']'; |
$value.=' [Part: '.$part.']'; |
} |
} |
my $unikey='parameter'.$keyroot.'_'.$name; |
|
$lcmetacache{':'.$unikey.'.part'}=$part; |
$lcmetacache{':'.$unikey.'.part'}=$part; |
$metathesekeys{$unikey}=1; |
$metathesekeys{$unikey}=1; |
unless (defined($lcmetacache{':'.$unikey.'.'.$subp})) { |
unless (defined($lcmetacache{':'.$unikey.'.'.$subp})) { |
Line 4017 sub gettitle {
|
Line 3972 sub gettitle {
|
|
|
sub symblist { |
sub symblist { |
my ($mapname,%newhash)=@_; |
my ($mapname,%newhash)=@_; |
$mapname=declutter($mapname); |
$mapname=&deversion(&declutter($mapname)); |
my %hash; |
my %hash; |
if (($ENV{'request.course.fn'}) && (%newhash)) { |
if (($ENV{'request.course.fn'}) && (%newhash)) { |
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', |
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', |
&GDBM_WRCREAT(),0640)) { |
&GDBM_WRCREAT(),0640)) { |
foreach (keys %newhash) { |
foreach (keys %newhash) { |
$hash{declutter($_)}=$mapname.'___'.$newhash{$_}; |
$hash{declutter($_)}=$mapname.'___'.&deversion($newhash{$_}); |
} |
} |
if (untie(%hash)) { |
if (untie(%hash)) { |
return 'ok'; |
return 'ok'; |
Line 4042 sub symbverify {
|
Line 3997 sub symbverify {
|
if ($thisfn=~/\.(page|sequence)$/) { return 1; } |
if ($thisfn=~/\.(page|sequence)$/) { return 1; } |
# check URL part |
# check URL part |
my ($map,$resid,$url)=&decode_symb($symb); |
my ($map,$resid,$url)=&decode_symb($symb); |
unless (&symbclean($url) eq &symbclean($thisfn)) { return 0; } |
|
|
unless ($url eq $thisfn) { return 0; } |
|
|
$symb=&symbclean($symb); |
$symb=&symbclean($symb); |
|
$thisfn=&deversion($thisfn); |
|
|
my %bighash; |
my %bighash; |
my $okay=0; |
my $okay=0; |
|
|
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
&GDBM_READER(),0640)) { |
&GDBM_READER(),0640)) { |
my $ids=$bighash{'ids_'.&clutter($thisfn)}; |
my $ids=$bighash{'ids_'.&clutter($thisfn)}; |
Line 4099 sub decode_symb {
|
Line 4057 sub decode_symb {
|
sub fixversion { |
sub fixversion { |
my $fn=shift; |
my $fn=shift; |
if ($fn=~/^(adm|uploaded|public)/) { return $fn; } |
if ($fn=~/^(adm|uploaded|public)/) { return $fn; } |
my ($match,$cond,$versioned)=&is_on_map($fn); |
my %bighash; |
unless ($match) { |
my $uri=&clutter($fn); |
$fn=$versioned; |
my $key=$ENV{'request.course.id'}.'_'.$uri; |
} |
# is this cached? |
return $fn; |
my ($result,$cached)=&is_cached(\%courseresversioncache,$key, |
|
'courseresversion',600); |
|
if (defined($cached)) { return $result; } |
|
# unfortunately not cached, or expired |
|
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
|
&GDBM_READER(),0640)) { |
|
if ($bighash{'version_'.$uri}) { |
|
my $version=$bighash{'version_'.$uri}; |
|
unless ($version eq 'mostrecent') { |
|
$uri=~s/\.(\w+)$/\.$version\.$1/; |
|
} |
|
} |
|
untie %bighash; |
|
} |
|
return &do_cache |
|
(\%courseresversioncache,$key,&declutter($uri),'courseresversion'); |
|
} |
|
|
|
sub deversion { |
|
my $url=shift; |
|
$url=~s/\.\d+\.(\w+)$/\.$1/; |
|
return $url; |
} |
} |
|
|
# ------------------------------------------------------ Return symb list entry |
# ------------------------------------------------------ Return symb list entry |
Line 4203 sub numval {
|
Line 4182 sub numval {
|
} |
} |
|
|
sub latest_rnd_algorithm_id { |
sub latest_rnd_algorithm_id { |
return '64bit'; |
return '64bit2'; |
} |
} |
|
|
sub rndseed { |
sub rndseed { |
Line 4220 sub rndseed {
|
Line 4199 sub rndseed {
|
my $CODE=$ENV{'scantron.CODE'}; |
my $CODE=$ENV{'scantron.CODE'}; |
if (defined($CODE)) { |
if (defined($CODE)) { |
&rndseed_CODE_64bit($symb,$courseid,$domain,$username); |
&rndseed_CODE_64bit($symb,$courseid,$domain,$username); |
|
} elsif ($which eq '64bit2') { |
|
return &rndseed_64bit2($symb,$courseid,$domain,$username); |
} elsif ($which eq '64bit') { |
} elsif ($which eq '64bit') { |
return &rndseed_64bit($symb,$courseid,$domain,$username); |
return &rndseed_64bit($symb,$courseid,$domain,$username); |
} |
} |
Line 4263 sub rndseed_64bit {
|
Line 4244 sub rndseed_64bit {
|
} |
} |
} |
} |
|
|
|
sub rndseed_64bit2 { |
|
my ($symb,$courseid,$domain,$username)=@_; |
|
{ |
|
use integer; |
|
# strings need to be an even # of cahracters long, it it is odd the |
|
# last characters gets thrown away |
|
my $symbchck=unpack("%32S*",$symb.' ') << 21; |
|
my $symbseed=numval($symb) << 10; |
|
my $namechck=unpack("%32S*",$username.' '); |
|
|
|
my $nameseed=numval($username) << 21; |
|
my $domainseed=unpack("%32S*",$domain.' ') << 10; |
|
my $courseseed=unpack("%32S*",$courseid.' '); |
|
|
|
my $num1=$symbchck+$symbseed+$namechck; |
|
my $num2=$nameseed+$domainseed+$courseseed; |
|
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
|
#&Apache::lonxml::debug("rndseed :$num:$symb"); |
|
return "$num1,$num2"; |
|
} |
|
} |
|
|
sub rndseed_CODE_64bit { |
sub rndseed_CODE_64bit { |
my ($symb,$courseid,$domain,$username)=@_; |
my ($symb,$courseid,$domain,$username)=@_; |
{ |
{ |
use integer; |
use integer; |
my $symbchck=unpack("%32S*",$symb) << 16; |
my $symbchck=unpack("%32S*",$symb.' ') << 16; |
my $symbseed=numval($symb); |
my $symbseed=numval($symb); |
my $CODEseed=numval($ENV{'scantron.CODE'}) << 16; |
my $CODEseed=numval($ENV{'scantron.CODE'}) << 16; |
my $courseseed=unpack("%32S*",$courseid); |
my $courseseed=unpack("%32S*",$courseid.' '); |
my $num1=$symbseed+$CODEseed; |
my $num1=$symbseed+$CODEseed; |
my $num2=$courseseed+$symbchck; |
my $num2=$courseseed+$symbchck; |
#&Apache::lonxml::debug("$symbseed:$CODEseed|$courseseed:$symbchck"); |
#&Apache::lonxml::debug("$symbseed:$CODEseed|$courseseed:$symbchck"); |
Line 4411 sub mod_perl_version {
|
Line 4414 sub mod_perl_version {
|
} |
} |
return 1; |
return 1; |
} |
} |
|
|
|
sub correct_line_ends { |
|
my ($result)=@_; |
|
$$result =~s/\r\n/\n/mg; |
|
$$result =~s/\r/\n/mg; |
|
} |
# ================================================================ Main Program |
# ================================================================ Main Program |
|
|
sub goodbye { |
sub goodbye { |
&logthis("Starting Shut down"); |
&logthis("Starting Shut down"); |
#not converted to using infrastruture |
#not converted to using infrastruture and probably shouldn't be |
&logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache))); |
|
&logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache))); |
&logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache))); |
&logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache))); |
|
#converted |
#converted |
|
&logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache))); |
|
&logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache))); |
&logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache))); |
&logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache))); |
&logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache))); |
&logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache))); |
#1.1 only |
#1.1 only |
&logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache))); |
&logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache))); |
&logthis(sprintf("%-20s is %s",'%usectioncache',scalar(%usectioncache))); |
&logthis(sprintf("%-20s is %s",'%usectioncache',scalar(%usectioncache))); |
|
&logthis(sprintf("%-20s is %s",'%courseresversioncache',scalar(%courseresversioncache))); |
|
&logthis(sprintf("%-20s is %s",'%resversioncache',scalar(%resversioncache))); |
&flushcourselogs(); |
&flushcourselogs(); |
&logthis("Shutting down"); |
&logthis("Shutting down"); |
return DONE; |
return DONE; |