--- loncom/lonnet/perl/lonnet.pm 2004/06/18 20:35:18 1.512
+++ loncom/lonnet/perl/lonnet.pm 2004/06/29 04:30:00 1.515
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.512 2004/06/18 20:35:18 banghart Exp $
+# $Id: lonnet.pm,v 1.515 2004/06/29 04:30:00 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3076,8 +3076,13 @@ sub fetch_enrollment_query {
unless ($queryid=~/^\Q$host\E\_/) { return 'error: '.$queryid; }
my $reply = &get_query_reply($queryid);
unless ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
- unless ($homeserver eq $perlvar{'lonHostID'}) {
- my @responses = split/:/,$reply;
+ my @responses = split/:/,$reply;
+ if ($homeserver eq $perlvar{'lonHostID'}) {
+ foreach (@responses) {
+ my ($key,$value) = split/=/,$_;
+ $$replyref{$key} = $value;
+ }
+ } else {
my $pathname = $perlvar{'lonDaemons'}.'/tmp';
foreach (@responses) {
my ($key,$value) = split/=/,$_;
@@ -3169,7 +3174,7 @@ sub auto_get_sections {
sub auto_new_course {
my ($cnum,$cdom,$inst_course_id,$owner) = @_;
my $homeserver = &homeserver($cnum,$cdom);
- my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner,':'.$cdom,$homeserver));
+ my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner.':'.$cdom,$homeserver));
return $response;
}
@@ -3384,7 +3389,7 @@ sub modifyuser {
sub modifystudent {
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
- $end,$start,$forceid,$desiredhome,$email,$type,$cid)=@_;
+ $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid)=@_;
if (!$cid) {
unless ($cid=$ENV{'request.course.id'}) {
return 'not_in_class';
@@ -3399,13 +3404,12 @@ sub modifystudent {
# students environment
$uid = undef if (!$forceid);
$reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
- $gene,$usec,$end,$start,$type,$cid);
+ $gene,$usec,$end,$start,$type,$locktype,$cid);
return $reply;
}
sub modify_student_enrollment {
- my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,
- $cid) = @_;
+ my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid) = @_;
my ($cdom,$cnum,$chome);
if (!$cid) {
unless ($cid=$ENV{'request.course.id'}) {
@@ -3451,7 +3455,7 @@ sub modify_student_enrollment {
$first,$middle);
my $reply=cput('classlist',
{"$uname:$udom" =>
- join(':',$end,$start,$uid,$usec,$fullname,$type) },
+ join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype) },
$cdom,$cnum);
unless (($reply eq 'ok') || ($reply eq 'delayed')) {
return 'error: '.$reply;
@@ -3578,14 +3582,33 @@ sub revokecustomrole {
# ------------------------------------------------------------ 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.'
';
+#FIXME us the ls: command instead please
+#FIXME uhome should never be an argument to any lonnet functions
+ # 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;
+}
+
+sub portfoliomanage {
+
+#FIXME please user the existing remove userfile function instead and
+#add a userfilerename functions.
+#FIXME uhome should never be an argument to any lonnet functions
+
+ # handles deleting and renaming files in user's userfiles/portfolio/ directory
+ #
+ my ($filename, $fileaction, $filenewname) = @_;
+ my ($udom, $uname, $uhome);
+ $uname=$ENV{'user.name'};
+ $udom=$ENV{'user.domain'};
+ $uhome=$ENV{'user.home'};
+ my $listing = reply('portfoliomanage:'.$uname.':'.$udom.':'.$filename.':'.$fileaction.':'.$filenewname, $uhome);
+ return $listing;
}