--- loncom/lonnet/perl/lonnet.pm	2004/06/10 22:15:53	1.509
+++ 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.509 2004/06/10 22:15:53 albertel Exp $
+# $Id: lonnet.pm,v 1.515 2004/06/29 04:30:00 raeburn 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}.':'.
@@ -3057,7 +3057,7 @@ sub log_query {
 # ------- Request retrieval of institutional classlists for course(s)
 
 sub fetch_enrollment_query {
-    my ($context,$affiliatesref,$replyref,$cnum,$dom) = @_;
+    my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_;
     my $homeserver;
     if ($context eq 'automated') {
         $homeserver = $perlvar{'lonHostID'};
@@ -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/=/,$_;
@@ -3151,7 +3156,7 @@ sub userlog_query {
 sub auto_run {
     my ($cnum,$cdom) = @_;
     my $homeserver = &homeserver($cnum,$cdom);
-    my $response = &reply('autorun',$homeserver);
+    my $response = &reply('autorun:'.$cdom,$homeserver);
     return $response;
 }
                                                                                    
@@ -3159,7 +3164,7 @@ sub auto_get_sections {
     my ($cnum,$cdom,$inst_coursecode) = @_;
     my $homeserver = &homeserver($cnum,$cdom);
     my @secs = ();
-    my $response=&unescape(&reply('autogetsections:'.$inst_coursecode,$homeserver));
+    my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
     unless ($response eq 'refused') {
         @secs = split/:/,$response;
     }
@@ -3169,14 +3174,14 @@ 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,$homeserver));
+    my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner.':'.$cdom,$homeserver));
     return $response;
 }
                                                                                    
 sub auto_validate_courseID {
     my ($cnum,$cdom,$inst_course_id) = @_;
     my $homeserver = &homeserver($cnum,$cdom);
-    my $response=&unescape(&reply('autovalidatecourse:'.$inst_course_id,$homeserver));
+    my $response=&unescape(&reply('autovalidatecourse:'.$inst_course_id.':'.$cdom,$homeserver));
     return $response;
 }
                                                                                    
@@ -3185,7 +3190,7 @@ sub auto_create_password {
     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 {
@@ -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;
@@ -3575,6 +3579,39 @@ sub revokecustomrole {
            $deleteflag);
 }
 
+
+# ------------------------------------------------------------ Portfolio Director Lister
+sub portfoliolist {
+#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;
+}
+
+
 # ------------------------------------------------------------ Directory lister
 
 sub dirlist {
@@ -4370,7 +4407,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; }
@@ -4380,6 +4420,7 @@ sub symbverify {
     unless ($url eq $thisfn) { return 0; }
 
     $symb=&symbclean($symb);
+    $thisurl=&deversion($thisurl);
     $thisfn=&deversion($thisfn);
 
     my %bighash;
@@ -4387,9 +4428,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)
@@ -4420,7 +4461,7 @@ sub symbclean {
 
 # remove wrapper
 
-    $symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\//$1/;
+    $symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/;
     return $symb;
 }