--- loncom/lonnet/perl/lonnet.pm 2003/05/04 07:38:32 1.368 +++ loncom/lonnet/perl/lonnet.pm 2003/05/08 21:35:48 1.369 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.368 2003/05/04 07:38:32 albertel Exp $ +# $Id: lonnet.pm,v 1.369 2003/05/08 21:35:48 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -347,6 +347,29 @@ sub delenv { return 'ok'; } +# ------------------------------------------ Find out current server userload +# there is a copy in lond +sub userload { + my $numusers=0; + { + opendir(LONIDS,$perlvar{'lonIDsDir'}); + my $filename; + my $curtime=time; + while ($filename=readdir(LONIDS)) { + if ($filename eq '.' || $filename eq '..') {next;} + my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8]; + if ($curtime-$atime < 3600) { $num_users++; } + } + closedir(LONIDS); + } + my $userloadpercent=0; + my $maxuserload=$perlvar{'lonUserLoadLim'}; + if ($maxuserload) { + $userloadpercent=100*$num_users/$maxuserload; + } + return $userloadpercent; +} + # ------------------------------------------ Fight off request when overloaded sub overloaderror {