--- loncom/lonnet/perl/lonnet.pm 2005/04/15 20:46:04 1.623
+++ loncom/lonnet/perl/lonnet.pm 2005/04/18 21:19:53 1.626
@@ -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.626 2005/04/18 21:19:53 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2639,6 +2639,21 @@ sub cput {
return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
}
+# ------------------------------------------------------ critical inc interface
+
+sub cinc {
+ my ($namespace,$storehash,$udomain,$uname)=@_;
+ if (!$udomain) { $udomain=$env{'user.domain'}; }
+ if (!$uname) { $uname=$env{'user.name'}; }
+ my $uhome=&homeserver($uname,$udomain);
+ my $items='';
+ foreach (keys %$storehash) {
+ $items.=escape($_).'='.&freeze_escape($$storehash{$_}).'&';
+ }
+ $items=~s/\&$//;
+ return &critical("inc:$udomain:$uname:$namespace:$items",$uhome);
+}
+
# -------------------------------------------------------------- eget interface
sub eget {
@@ -4085,13 +4100,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 +4119,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 +4344,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 +4389,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
@@ -4919,7 +4952,8 @@ sub symbread {
if ($#possibilities==0) {
# ----------------------------------------------- There is only one possibility
my ($mapid,$resid)=split(/\./,$ids);
- $syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;
+ $syval=&encode_symb($bighash{'map_id_'.$mapid},
+ $resid,$thisfn);
} elsif (!$donotrecurse) {
# ------------------------------------------ There is more than one possibility
my $realpossible=0;
@@ -4929,8 +4963,8 @@ sub symbread {
my ($mapid,$resid)=split(/\./,$_);
if ($bighash{'map_type_'.$mapid} ne 'page') {
$realpossible++;
- $syval=declutter($bighash{'map_id_'.$mapid}).
- '___'.$resid;
+ $syval=&encode_symb($bighash{'map_id_'.$mapid},
+ $resid,$thisfn);
}
}
}
@@ -4944,7 +4978,6 @@ sub symbread {
}
if ($syval) {
return $env{$cache_str}=$syval;
- #return $env{$cache_str}=&symbclean($syval.'___'.$thisfn);
}
}
&appenv('request.ambiguous' => $thisfn);
@@ -6143,9 +6176,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