[LON-CAPA-cvs] cvs: loncom /interface lonnavmaps.pm /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Fri, 15 Apr 2005 22:03:24 -0000
This is a MIME encoded message
--albertel1113602604
Content-Type: text/plain
albertel Fri Apr 15 18:03:24 2005 EDT
Modified files:
/loncom/interface lonnavmaps.pm
/loncom/lonnet/perl lonnet.pm
Log:
- making it easier to reuse the parm data caching in lonnet
- making lonnavmaps use lonnet to get the parm data
--albertel1113602604
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20050415180324.txt"
Index: loncom/interface/lonnavmaps.pm
diff -u loncom/interface/lonnavmaps.pm:1.325 loncom/interface/lonnavmaps.pm:1.326
--- loncom/interface/lonnavmaps.pm:1.325 Fri Apr 15 17:28:54 2005
+++ loncom/interface/lonnavmaps.pm Fri Apr 15 18:03:23 2005
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Navigate Maps Handler
#
-# $Id: lonnavmaps.pm,v 1.325 2005/04/15 21:28:54 albertel Exp $
+# $Id: lonnavmaps.pm,v 1.326 2005/04/15 22:03:23 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2112,39 +2112,36 @@
my $uname=$env{'user.name'};
my $udom=$env{'user.domain'};
- my $uhome=$env{'user.home'};
my $cid=$env{'request.course.id'};
- my ($cdom,$cnum)=split(/\_/,$cid);
+ my $cdom=$env{'course.'.$cid.'.domain'};
+ my $cnum=$env{'course.'.$cid.'.num'};
- my %useropt; my %courseopt;
- unless ($uhome eq 'no_host') {
-# ------------------------------------------------- Get coursedata (if present)
- %courseopt=&Apache::lonnet::dump('resourcedata',$cdom,$cnum);
- # Check for network failure
- my ($tmp)=keys(%courseopt);
+ my $useropt; my $courseopt;
- if ( $tmp =~ /no.such.host/i || $tmp =~ /con_lost/i) {
+# ------------------------------------------------- Get coursedata (if present)
+ my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
+ # Check for network failure
+ if (!ref($courseopt)) {
+ if ( $courseopt =~ /no.such.host/i || $courseopt =~ /con_lost/i) {
$self->{NETWORK_FAILURE} = 1;
- undef(%courseopt);
- } elsif ($tmp=~/^error\:/) {
- undef(%courseopt);
}
+ undef($courseopt);
+ }
# --------------------------------------------------- Get userdata (if present)
- %useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname);
- ($tmp)=keys(%courseopt);
- if ($tmp=~/^error\:/) {
- undef(%useropt);
- } elsif ( $tmp=~/no.such.host/i || $tmp=~/con.lost/i ) {
- # check to see if network failed
+ my $useropt=&Apache::lonnet::get_userresdata($uname,$udom);
+ # Check for network failure
+ if (!ref($useropt)) {
+ if ( $useropt =~ /no.such.host/i || $useropt =~ /con_lost/i) {
$self->{NETWORK_FAILURE} = 1;
- undef(%useropt);
}
- $self->{COURSE_OPT} = \%courseopt;
- $self->{USER_OPT} = \%useropt;
+ undef($useropt);
}
+ $self->{COURSE_OPT} = $courseopt;
+ $self->{USER_OPT} = $useropt;
+
$self->{COURSE_USER_OPT_GENERATED} = 1;
return;
@@ -2156,7 +2153,8 @@
if ($self->{EMAIL_DISCUSS_GENERATED}) { return; }
my $cid=$env{'request.course.id'};
- my ($cdom,$cnum)=split(/\_/,$cid);
+ my $cdom=$env{'course.'.$cid.'.domain'};
+ my $cnum=$env{'course.'.$cid.'.num'};
my %emailstatus = &Apache::lonnet::dump('email_status');
my $logoutTime = $emailstatus{'logout'};
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.623 loncom/lonnet/perl/lonnet.pm:1.624
--- loncom/lonnet/perl/lonnet.pm:1.623 Fri Apr 15 16:46:04 2005
+++ loncom/lonnet/perl/lonnet.pm Fri Apr 15 18:03:23 2005
@@ -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 @@
# --------------------------------------------------- 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 @@
&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("<font color=blue>WARNING:".
+ " Trying to get resource data for ".
+ $uname." at ".$udom.": ".
+ $tmp."</font>");
+ } 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 @@
$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("<font color=blue>WARNING:".
- " Trying to get resource data for ".
- $uname." at ".$udom.": ".
- $tmp."</font>");
- } 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 @@
# ---------------------------------------------- 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 @@
=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
--albertel1113602604--