version 1.433, 2003/10/27 21:59:34
|
version 1.437, 2003/10/30 22:52:25
|
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 405 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 869 sub devalidate_cache {
|
Line 831 sub devalidate_cache {
|
delete($hash{$id}); |
delete($hash{$id}); |
delete($hash{$id.'.time'}); |
delete($hash{$id.'.time'}); |
} else { |
} else { |
&logthis("Unable to tie hash"); |
&logthis("Unable to tie hash (devalidate cache): $name"); |
} |
} |
untie(%hash); |
untie(%hash); |
flock(DB,LOCK_UN); |
flock(DB,LOCK_UN); |
Line 887 sub is_cached {
|
Line 849 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 967 sub save_cache_item {
|
Line 929 sub save_cache_item {
|
$hash{$id.'.time'}=$$cache{$id.'.time'}; |
$hash{$id.'.time'}=$$cache{$id.'.time'}; |
$hash{$id}=freeze({'item'=>$$cache{$id}}); |
$hash{$id}=freeze({'item'=>$$cache{$id}}); |
} else { |
} else { |
&logthis("Unable to tie hash"); |
&logthis("Unable to tie hash (save cache item): $name"); |
} |
} |
untie(%hash); |
untie(%hash); |
flock(DB,LOCK_UN); |
flock(DB,LOCK_UN); |
Line 1002 sub load_cache_item {
|
Line 964 sub load_cache_item {
|
$$cache{$id.'.time'}=$hash{$id.'.time'}; |
$$cache{$id.'.time'}=$hash{$id.'.time'}; |
} |
} |
} else { |
} else { |
&logthis("Unable to tie hash"); |
&logthis("Unable to tie hash (load cache item): $name"); |
} |
} |
untie(%hash); |
untie(%hash); |
flock(DB,LOCK_UN); |
flock(DB,LOCK_UN); |
Line 2772 sub allowed {
|
Line 2734 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 2783 sub is_on_map {
|
Line 2746 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 4116 sub decode_symb {
|
Line 4076 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; |
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 $fn; |
return &declutter($uri); |
} |
} |
|
|
# ------------------------------------------------------ Return symb list entry |
# ------------------------------------------------------ Return symb list entry |
Line 4428 sub mod_perl_version {
|
Line 4396 sub mod_perl_version {
|
} |
} |
return 1; |
return 1; |
} |
} |
|
|
|
sub correct_line_ends { |
|
my ($result)=@_; |
|
&logthis("Wha $result"); |
|
$$result =~s/\r\n/\n/mg; |
|
$$result =~s/\r/\n/mg; |
|
} |
# ================================================================ Main Program |
# ================================================================ Main Program |
|
|
sub goodbye { |
sub goodbye { |