--- 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