--- loncom/lonnet/perl/lonnet.pm 2005/04/15 20:46:04 1.623 +++ loncom/lonnet/perl/lonnet.pm 2005/04/15 22:03:23 1.624 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.623 2005/04/15 20:46:04 albertel Exp $ +# $Id: lonnet.pm,v 1.624 2005/04/15 22:03:23 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4085,13 +4085,14 @@ sub devalidatecourseresdata { # --------------------------------------------------- Course Resourcedata Query -sub courseresdata { - my ($coursenum,$coursedomain,@which)=@_; +sub get_courseresdata { + my ($coursenum,$coursedomain)=@_; my $coursehom=&homeserver($coursenum,$coursedomain); my $hashid=$coursenum.':'.$coursedomain; my ($result,$cached)=&is_cached_new('courseres',$hashid); + my %dumpreply; unless (defined($cached)) { - my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum); + %dumpreply=&dump('resourcedata',$coursedomain,$coursenum); $result=\%dumpreply; my ($tmp) = keys(%dumpreply); if ($tmp !~ /^(con_lost|error|no_such_host)/i) { @@ -4103,6 +4104,46 @@ sub courseresdata { &do_cache_new('courseres',$hashid,$result,600); } } + return $result; +} + +sub get_userresdata { + my ($uname,$udom)=@_; + #most student don\'t have any data set, check if there is some data + if (&EXT_cache_status($udom,$uname)) { return undef; } + + my $hashid="$udom:$uname"; + my ($result,$cached)=&is_cached_new('userres',$hashid); + if (!defined($cached)) { + my %resourcedata=&dump('resourcedata',$udom,$uname); + $result=\%resourcedata; + &do_cache_new('userres',$hashid,$result,600); + } + my ($tmp)=keys(%$result); + if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) { + return $result; + } + #error 2 occurs when the .db doesn't exist + if ($tmp!~/error: 2 /) { + &logthis("WARNING:". + " Trying to get resource data for ". + $uname." at ".$udom.": ". + $tmp.""); + } elsif ($tmp=~/error: 2 /) { + &EXT_cache_set($udom,$uname); + } + return $tmp; +} + +sub resdata { + my ($name,$domain,$type,@which)=@_; + my $result; + if ($type eq 'course') { + $result=&get_courseresdata($name,$domain); + } elsif ($type eq 'user') { + $result=&get_userresdata($name,$domain); + } + if (!ref($result)) { return $result; } foreach my $item (@which) { if (defined($result->{$item})) { return $result->{$item}; @@ -4288,44 +4329,20 @@ sub EXT { $courselevelm=$courseid.'.'.$mapparm; # ----------------------------------------------------------- first, check user - #most student don\'t have any data set, check if there is some data - if (! &EXT_cache_status($udom,$uname)) { - my $hashid="$udom:$uname"; - my ($result,$cached)=&is_cached_new('userres',$hashid); - if (!defined($cached)) { - my %resourcedata=&dump('resourcedata',$udom,$uname); - $result=\%resourcedata; - &do_cache_new('userres',$hashid,$result,600); - } - my ($tmp)=keys(%$result); - if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) { - if ($$result{$courselevelr}) { - return $$result{$courselevelr}; } - if ($$result{$courselevelm}) { - return $$result{$courselevelm}; } - if ($$result{$courselevel}) { - return $$result{$courselevel}; } - } else { - #error 2 occurs when the .db doesn't exist - if ($tmp!~/error: 2 /) { - &logthis("WARNING:". - " Trying to get resource data for ". - $uname." at ".$udom.": ". - $tmp.""); - } elsif ($tmp=~/error: 2 /) { - &EXT_cache_set($udom,$uname); - } elsif ($tmp =~ /^(con_lost|no_such_host)/) { - return $tmp; - } - } - } + + my $userreply=&resdata($uname,$udom,'user', + ($courselevelr,$courselevelm, + $courselevel)); + + if (defined($userreply)) { return $userreply; } # ------------------------------------------------ second, check some of course - my $coursereply=&courseresdata($env{'course.'.$courseid.'.num'}, - $env{'course.'.$courseid.'.domain'}, - ($seclevelr,$seclevelm,$seclevel, - $courselevelr)); + my $coursereply=&resdata($env{'course.'.$courseid.'.num'}, + $env{'course.'.$courseid.'.domain'}, + 'course', + ($seclevelr,$seclevelm,$seclevel, + $courselevelr)); if (defined($coursereply)) { return $coursereply; } # ------------------------------------------------------ third, check map parms @@ -4357,9 +4374,10 @@ sub EXT { # ---------------------------------------------- fourth, look in rest pf course if ($symbparm && defined($courseid) && $courseid eq $env{'request.course.id'}) { - my $coursereply=&courseresdata($env{'course.'.$courseid.'.num'}, - $env{'course.'.$courseid.'.domain'}, - ($courselevelm,$courselevel)); + my $coursereply=&resdata($env{'course.'.$courseid.'.num'}, + $env{'course.'.$courseid.'.domain'}, + 'course', + ($courselevelm,$courselevel)); if (defined($coursereply)) { return $coursereply; } } # ------------------------------------------------------------------ Cascade up @@ -6143,9 +6161,10 @@ coursedescription($courseid) : course de =item * -courseresdata($coursenum,$coursedomain,@which) : request for current -parameter setting for a specific course, @what should be a list of -parameters to ask about. This routine caches answers for 5 minutes. +resdata($name,$domain,$type,@which) : request for current parameter +setting for a specific $type, where $type is either 'course' or 'user', +@what should be a list of parameters to ask about. This routine caches +answers for 5 minutes. =back