--- loncom/lonnet/perl/lonnet.pm 2004/06/08 22:09:44 1.506
+++ loncom/lonnet/perl/lonnet.pm 2004/06/18 20:35:18 1.512
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.506 2004/06/08 22:09:44 raeburn Exp $
+# $Id: lonnet.pm,v 1.512 2004/06/18 20:35:18 banghart Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1615,11 +1615,11 @@ sub courseidput {
}
sub courseiddump {
- my ($domfilter,$descfilter,$sincefilter,$hostid)=@_;
+ my ($domfilter,$descfilter,$sincefilter,$hostidflag,$hostidref)=@_;
my %returnhash=();
unless ($domfilter) { $domfilter=''; }
foreach my $tryserver (keys %libserv) {
- if (($hostid && $tryserver eq $hostid) || (!$hostid)) {
+ if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) {
if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
foreach (
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
@@ -3054,14 +3054,20 @@ sub log_query {
return get_query_reply($queryid);
}
-# ------- Request retrieval of institutional classlists from course homerserver
+# ------- Request retrieval of institutional classlists for course(s)
sub fetch_enrollment_query {
- my ($homeserver,$dom,$affiliatesref,$replyref) = @_;
+ my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_;
+ my $homeserver;
+ if ($context eq 'automated') {
+ $homeserver = $perlvar{'lonHostID'};
+ } else {
+ $homeserver = &homeserver($cnum,$dom);
+ }
my $host=$hostname{$homeserver};
my $cmd = '';
foreach (keys %{$affiliatesref}) {
- $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%';
+ $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%';
}
$cmd =~ s/%%$//;
$cmd = &escape($cmd);
@@ -3143,15 +3149,17 @@ sub userlog_query {
#--------- Call auto-enrollment subs in localenroll.pm for homeserver for course
sub auto_run {
- my $homeserver = shift;
- my $response = &reply('autorun',$homeserver);
+ my ($cnum,$cdom) = @_;
+ my $homeserver = &homeserver($cnum,$cdom);
+ my $response = &reply('autorun:'.$cdom,$homeserver);
return $response;
}
sub auto_get_sections {
- my ($homeserver,$coursecode) = @_;
+ my ($cnum,$cdom,$inst_coursecode) = @_;
+ my $homeserver = &homeserver($cnum,$cdom);
my @secs = ();
- my $response=&unescape(&reply('autogetsections:'.$coursecode,$homeserver));
+ my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
unless ($response eq 'refused') {
@secs = split/:/,$response;
}
@@ -3159,22 +3167,25 @@ sub auto_get_sections {
}
sub auto_new_course {
- my ($homeserver,$course_id,$owner) = @_;
- my $response=&unescape(&reply('autonewcourse:'.$course_id.':'.$owner,$homeserver));
+ my ($cnum,$cdom,$inst_course_id,$owner) = @_;
+ my $homeserver = &homeserver($cnum,$cdom);
+ my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner,':'.$cdom,$homeserver));
return $response;
}
sub auto_validate_courseID {
- my ($homeserver,$course_id) = @_;
- my $response=&unescape(&reply('autovalidatecourse:'.$course_id,$homeserver));
+ my ($cnum,$cdom,$inst_course_id) = @_;
+ my $homeserver = &homeserver($cnum,$cdom);
+ my $response=&unescape(&reply('autovalidatecourse:'.$inst_course_id.':'.$cdom,$homeserver));
return $response;
}
sub auto_create_password {
- my ($homeserver,$authparam) = @_;
+ my ($cnum,$cdom,$authparam) = @_;
+ my $homeserver = &homeserver($cnum,$cdom);
my $create_passwd = 0;
my $authchk = '';
- my $response=&unescape(&reply('autocreatepassword:'.$authparam,$homeserver));
+ my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));
if ($response eq 'refused') {
$authchk = 'refused';
} else {
@@ -3564,6 +3575,20 @@ sub revokecustomrole {
$deleteflag);
}
+
+# ------------------------------------------------------------ Portfolio Director Lister
+sub portfoliolist {
+ # returns listing of contents of user's /userfiles/portfolio/ directory
+ #
+ my ($udom, $uname, $uhome);
+ $uname=$ENV{'user.name'};
+ $udom=$ENV{'user.domain'};
+ $uhome=$ENV{'user.home'};
+ my $listing = reply('portls:'.$uname.':'.$udom, $uhome);
+ return ''.$listing.'
';
+}
+
+
# ------------------------------------------------------------ Directory lister
sub dirlist {
@@ -4359,7 +4384,10 @@ sub symblist {
# --------------------------------------------------------------- Verify a symb
sub symbverify {
- my ($symb,$thisfn)=@_;
+ my ($symb,$thisurl)=@_;
+ my $thisfn=$thisurl;
+# wrapper not part of symbs
+ $thisfn=~s/^\/adm\/wrapper//;
$thisfn=&declutter($thisfn);
# direct jump to resource in page or to a sequence - will construct own symbs
if ($thisfn=~/\.(page|sequence)$/) { return 1; }
@@ -4369,6 +4397,7 @@ sub symbverify {
unless ($url eq $thisfn) { return 0; }
$symb=&symbclean($symb);
+ $thisurl=&deversion($thisurl);
$thisfn=&deversion($thisfn);
my %bighash;
@@ -4376,9 +4405,9 @@ sub symbverify {
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
&GDBM_READER(),0640)) {
- my $ids=$bighash{'ids_'.&clutter($thisfn)};
+ my $ids=$bighash{'ids_'.&clutter($thisurl)};
unless ($ids) {
- $ids=$bighash{'ids_/'.$thisfn};
+ $ids=$bighash{'ids_/'.$thisurl};
}
if ($ids) {
# ------------------------------------------------------------------- Has ID(s)
@@ -4407,6 +4436,9 @@ sub symbclean {
# remove version from URL
$symb=~s/\.(\d+)\.(\w+)$/\.$2/;
+# remove wrapper
+
+ $symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/;
return $symb;
}
@@ -4962,7 +4994,7 @@ sub declutter {
sub clutter {
my $thisfn='/'.&declutter(shift);
- unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv)\//) {
+ unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv|public)\//) {
$thisfn='/res'.$thisfn;
}
return $thisfn;