--- loncom/lonnet/perl/lonnet.pm 2002/12/04 15:23:39 1.304 +++ loncom/lonnet/perl/lonnet.pm 2003/01/09 22:45:51 1.314 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.304 2002/12/04 15:23:39 www Exp $ +# $Id: lonnet.pm,v 1.314 2003/01/09 22:45:51 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -80,7 +80,8 @@ use vars qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom %libserv %pr %prp %metacache %packagetab %titlecache %courselogs %accesshash $processmarker $dumpcount - %coursedombuf %coursehombuf %courseresdatacache %domaindescription); + %coursedombuf %coursehombuf %courseresdatacache + %domaindescription); use IO::Socket; use GDBM_File; use Apache::Constants qw(:common :http); @@ -142,9 +143,9 @@ sub reply { unless (defined($hostname{$server})) { return 'no_such_host'; } my $answer=subreply($cmd,$server); if ($answer eq 'con_lost') { - #sleep 5; - #$answer=subreply($cmd,$server); - #if ($answer eq 'con_lost') { + #sleep 5; + #$answer=subreply($cmd,$server); + #if ($answer eq 'con_lost') { # &logthis("Second attempt con_lost on $server"); # my $peerfile="$perlvar{'lonSockDir'}/$server"; # my $client=IO::Socket::UNIX->new(Peer =>"$peerfile", @@ -215,7 +216,8 @@ sub critical { $middlename=substr($middlename,0,16); $middlename=~s/\W//g; my $dfilename= - "$perlvar{'lonSockDir'}/delayed/$now.$middlename.$server"; + "$perlvar{'lonSockDir'}/delayed/$now.$dumpcount.$$.$middlename.$server"; + $dumpcount++; { my $dfh; if ($dfh=Apache::File->new(">$dfilename")) { @@ -727,6 +729,7 @@ sub currentversion { sub subscribe { my $fname=shift; + if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; } my $author=$fname; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); @@ -1861,6 +1864,12 @@ sub allowed { $thisallowed.=$1; } +# URI is an uploaded document for this course + + if (($priv eq 'bre') && + ($uri=~/^uploaded\/$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}\/$ENV{'course.'.$ENV{'request.course.id'}.'.num'}/)) { + return 'F'; + } # Full access at system, domain or course-wide level? Exit. if ($thisallowed=~/F/) { @@ -2347,10 +2356,15 @@ sub modifyuser { } } # -------------------------------------------------------------- Add names, etc - my %names=&get('environment', + my @tmp=&get('environment', ['firstname','middlename','lastname','generation'], $udom,$uname); - if ($names{'firstname'} =~ m/^error:.*/) { %names=(); } + my %names; + if ($tmp[0] =~ m/^error:.*/) { + %names=(); + } else { + %names = @tmp; + } if ($first) { $names{'firstname'} = $first; } if ($middle) { $names{'middlename'} = $middle; } if ($last) { $names{'lastname'} = $last; } @@ -2718,6 +2732,8 @@ sub courseresdata { if ($tmp !~ /^(con_lost|error|no_such_host)/i) { $courseresdatacache{$hashid.'.time'}=time; $courseresdatacache{$hashid}=\%dumpreply; + } elsif ($tmp =~ /^(con_lost|no_such_host)/) { + return $tmp; } } foreach my $item (@which) { @@ -2844,24 +2860,35 @@ sub EXT { my $courselevelm=$courseid.'.'.$mapparm; # ----------------------------------------------------------- first, check user - my %resourcedata=&get('resourcedata', - [$courselevelr,$courselevelm,$courselevel], - $udom,$uname); - if (($resourcedata{$courselevelr}!~/^error\:/) && - ($resourcedata{$courselevelr}!~/^con_lost/)) { - - if ($resourcedata{$courselevelr}) { - return $resourcedata{$courselevelr}; } - if ($resourcedata{$courselevelm}) { - return $resourcedata{$courselevelm}; } - if ($resourcedata{$courselevel}) { - return $resourcedata{$courselevel}; } - } else { - if ($resourcedata{$courselevelr}!~/No such file/) { - &logthis("WARNING:". - " Trying to get resource data for ". - $uname." at ".$udom.": ". - $resourcedata{$courselevelr}.""); + #most student don't have any data set, check if there is some data + #every thirty minutes + if (! + (exists($ENV{'cache.studentresdata'}) + && (($ENV{'cache.studentresdata'}+1800) > time))) { + my %resourcedata=&get('resourcedata', + [$courselevelr,$courselevelm,$courselevel], + $udom,$uname); + my ($tmp)=keys(%resourcedata); + if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) { + if ($resourcedata{$courselevelr}) { + return $resourcedata{$courselevelr}; } + if ($resourcedata{$courselevelm}) { + return $resourcedata{$courselevelm}; } + if ($resourcedata{$courselevel}) { + return $resourcedata{$courselevel}; } + } else { + if ($tmp!~/No such file/) { + &logthis("WARNING:". + " Trying to get resource data for ". + $uname." at ".$udom.": ". + $tmp.""); + } elsif ($tmp=~/error:No such file/) { + $ENV{'cache.studentresdata'}=time; + &appenv(('cache.studentresdata'=> + $ENV{'cache.studentresdata'})); + } elsif ($tmp =~ /^(con_lost|no_such_host)/) { + return $tmp; + } } }