--- loncom/lonnet/perl/lonnet.pm 2000/11/20 19:04:15 1.66
+++ loncom/lonnet/perl/lonnet.pm 2000/11/25 19:56:04 1.70
@@ -52,6 +52,15 @@
# from the directory dir
# hreflocation(dir,file) : same as filelocation, but for hrefs
# log(domain,user,home,msg) : write to permanent log for user
+# usection(domain,user,courseid) : output of section name/number or '' for
+# "not in course" and '-1' for "no section"
+# userenvironment(domain,user,what) : puts out any environment parameter
+# for a user
+# idput(domain,hash) : writes IDs for users from hash (name=>id,name=>id)
+# idget(domain,array): returns hash with usernames (id=>name,id=>name) for
+# an array of IDs
+# idrget(domain,array): returns hash with IDs for usernames (name=>id,...) for
+# an array of names
#
# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
# 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,
@@ -67,7 +76,7 @@
# 10/04 Gerd Kortemeyer
# 10/04 Guy Albertelli
# 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29,
-# 10/30,10/31,11/2,11/14,11/15,11/16,11/20 Gerd Kortemeyer
+# 10/30,10/31,11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25 Gerd Kortemeyer
package Apache::lonnet;
@@ -356,6 +365,111 @@ sub homeserver {
return 'no_host';
}
+# ------------------------------------- Find the usernames behind a list of IDs
+
+sub idget {
+ my ($udom,@ids)=@_;
+ my %returnhash=();
+
+ my $tryserver;
+ foreach $tryserver (keys %libserv) {
+ if ($hostdom{$tryserver} eq $udom) {
+ my $idlist=join('&',@ids);
+ $idlist=~tr/A-Z/a-z/;
+ my $reply=&reply("idget:$udom:".$idlist,$tryserver);
+ my @answer=();
+ if ($reply ne 'con_lost') {
+ @answer=split(/\&/,$reply);
+ } ;
+ my $i;
+ for ($i=0;$i<=$#ids;$i++) {
+ if ($answer[$i]) {
+ $returnhash{$ids[$i]}=$answer[$i];
+ }
+ }
+ }
+ }
+ return %returnhash;
+}
+
+# ------------------------------------- Find the IDs behind a list of usernames
+
+sub idrget {
+ my ($udom,@unames)=@_;
+ my %returnhash=();
+ map {
+ $returnhash{$_}=(&userenvironment($udom,$_,'id'))[1];
+ } @unames;
+ return %returnhash;
+}
+
+# ------------------------------- Store away a list of names and associated IDs
+
+sub idput {
+ my ($udom,%ids)=@_;
+ my %servers=();
+ map {
+ my $uhom=&homeserver($_,$udom);
+ if ($uhom ne 'no_host') {
+ my $id=&escape($ids{$_});
+ $id=~tr/A-Z/a-z/;
+ my $unam=&escape($_);
+ if ($servers{$uhom}) {
+ $servers{$uhom}.='&'.$id.'='.$unam;
+ } else {
+ $servers{$uhom}=$id.'='.$unam;
+ }
+ &critical('put:'.$udom.':'.$unam.':environment:id='.$id,$uhom);
+ }
+ } keys %ids;
+ map {
+ &critical('idput:'.$udom.':'.$servers{$_},$_);
+ } keys %servers;
+}
+
+# ------------------------------------- Find the section of student in a course
+
+sub usection {
+ my ($udom,$unam,$courseid)=@_;
+ $courseid=~s/\_/\//g;
+ $courseid=~s/^(\w)/\/$1/;
+ map {
+ my ($key,$value)=split(/\=/,$_);
+ $key=&unescape($key);
+ if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
+ my $section=$1;
+ if ($key eq $courseid.'_st') { $section=''; }
+ my ($dummy,$end,$start)=split(/\_/,&unescape($value));
+ my $now=time;
+ my $notactive=0;
+ if ($start) {
+ if ($now<$start) { $notactive=1; }
+ }
+ if ($end) {
+ if ($now>$end) { $notactive=1; }
+ }
+ unless ($notactive) { return $section; }
+ }
+ } split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
+ &homeserver($unam,$udom)));
+ return '-1';
+}
+
+# ------------------------------------- Read an entry from a user's environment
+
+sub userenvironment {
+ my ($udom,$unam,@what)=@_;
+ my %returnhash=();
+ my @answer=split(/\&/,
+ &reply('get:'.$udom.':'.$unam.':environment:'.join('&',@what),
+ &homeserver($unam,$udom)));
+ my $i;
+ for ($i=0;$i<=$#what;$i++) {
+ $returnhash{$what[$i]}=&unescape($answer[$i]);
+ }
+ return %returnhash;
+}
+
# ----------------------------- Subscribe to a resource, return URL if possible
sub subscribe {
@@ -1194,6 +1308,7 @@ sub condval {
sub EXT {
my $varname=shift;
+ unless ($varname) { return ''; }
my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
my $rest;
if ($therest[0]) {
@@ -1258,21 +1373,41 @@ sub EXT {
} elsif ($realm eq 'resource') {
if ($ENV{'request.course.id'}) {
# ----------------------------------------------------- Cascading lookup scheme
- my $symbparm=&symbread().'.'.$spacequalifierrest;
- my $reslevel=
- $ENV{'request.course.id'}.'.'.$symbparm;
+ my $symbp=&symbread();
+ my $mapp=(split(/\_\_\_/,$symbp))[0];
+
+ my $symbparm=$symbp.'.'.$spacequalifierrest;
+ my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
+
my $seclevel=
- $ENV{'request.course.id'}.'.'.
- $ENV{'request.course.sec'}.'.'.$spacequalifierrest;
+ $ENV{'request.course.id'}.'.['.
+ $ENV{'request.course.sec'}.'].'.$spacequalifierrest;
+ my $seclevelr=
+ $ENV{'request.course.id'}.'.['.
+ $ENV{'request.course.sec'}.'].'.$symbparm;
+ my $seclevelm=
+ $ENV{'request.course.id'}.'.['.
+ $ENV{'request.course.sec'}.'].'.$mapparm;
+
my $courselevel=
$ENV{'request.course.id'}.'.'.$spacequalifierrest;
+ my $courselevelr=
+ $ENV{'request.course.id'}.'.'.$symbparm;
+ my $courselevelm=
+ $ENV{'request.course.id'}.'.'.$mapparm;
+
# ----------------------------------------------------------- first, check user
- my %resourcedata=get('resourcedata',($reslevel,$seclevel,$courselevel));
- if ($resourcedata{$reslevel}!~/^error\:/) {
- if ($resourcedata{$reslevel}) { return $resourcedata{$reslevel}; }
- if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }
+ my %resourcedata=get('resourcedata',
+ ($courselevelr,$courselevelm,$courselevel));
+ if ($resourcedata{$courselevelr}!~/^error\:/) {
+
+ if ($resourcedata{$courselevelr}) {
+ return $resourcedata{$courselevelr}; }
+ if ($resourcedata{$courselevelm}) {
+ return $resourcedata{$courselevelm}; }
if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+
}
# -------------------------------------------------------- second, check course
my $section='';
@@ -1283,16 +1418,25 @@ sub EXT {
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'.
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.
':resourcedata:'.
- escape($reslevel).':'.escape($seclevel).':'.escape($courselevel),
+ escape($seclevelr).':'.escape($seclevelm).':'.escape($seclevel).':'.
+ escape($courselevelr).':'.escape($courselevelm).':'.escape($courselevel),
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'});
if ($reply!~/^error\:/) {
map {
my ($name,$value)=split(/\=/,$_);
$resourcedata{unescape($name)}=unescape($value);
} split(/\&/,$reply);
- if ($resourcedata{$reslevel}) { return $resourcedata{$reslevel}; }
- if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }
+
+ if ($resourcedata{$seclevelr}) { return $resourcedata{$seclevelr}; }
+ if ($resourcedata{$seclevelm}) { return $resourcedata{$seclevelm}; }
+ if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }
+
+ if ($resourcedata{$courselevelr}) {
+ return $resourcedata{$courselevelr}; }
+ if ($resourcedata{$courselevelm}) {
+ return $resourcedata{$courselevelm}; }
if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+
}
# ------------------------------------------------------ third, check map parms
@@ -1308,7 +1452,7 @@ sub EXT {
# --------------------------------------------- last, look in resource metadata
my $uri=&declutter($ENV{'request.filename'});
- my $filename=$perlvar{'lonDocRoot'}.'/res/'.$ENV.'.meta';
+ my $filename=$perlvar{'lonDocRoot'}.'/res/'.$uri.'.meta';
if (-e $filename) {
my @content;
{