loncom/lonnet/perl/lonnet.pm - diff

Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.431 and 1.444

version 1.431, 2003/10/22 18:29:28	version 1.444, 2003/11/10 21:50:21
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 4037 sub symblist {	Line 3992 sub symblist {

sub symbverify {	sub symbverify {
my ($symb,$thisfn)=@_;	my ($symb,$thisfn)=@_;
$thisfn=&symbclean(&declutter($thisfn));	$thisfn=&declutter($thisfn);
# direct jump to resource in page or to a sequence - will construct own symbs	# direct jump to resource in page or to a sequence - will construct own symbs
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 ($url eq $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;
Line 4100 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') \|\|
	($version==&getversion($uri))) {
	$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 4204 sub numval {	Line 4183 sub numval {
}	}

sub latest_rnd_algorithm_id {	sub latest_rnd_algorithm_id {
return '64bit';	return '64bit2';
}	}

sub rndseed {	sub rndseed {
Line 4221 sub rndseed {	Line 4200 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 4264 sub rndseed_64bit {	Line 4245 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 4412 sub mod_perl_version {	Line 4415 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;

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

Removed from v.1.431
changed lines
	Added in v.1.444