--- loncom/lonnet/perl/lonnet.pm	2004/05/19 17:13:39	1.502
+++ 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.502 2004/05/19 17:13:39 matthew Exp $
+# $Id: lonnet.pm,v 1.512 2004/06/18 20:35:18 banghart Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1615,21 +1615,22 @@ sub courseidput {
 }
 
 sub courseiddump {
-    my ($domfilter,$descfilter,$sincefilter)=@_;
+    my ($domfilter,$descfilter,$sincefilter,$hostidflag,$hostidref)=@_;
     my %returnhash=();
     unless ($domfilter) { $domfilter=''; }
     foreach my $tryserver (keys %libserv) {
-	if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
-	    foreach (
-             split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
+        if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) {
+	    if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
+	        foreach (
+                 split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
 			       $sincefilter.':'.&escape($descfilter),
                                $tryserver))) {
-		my ($key,$value)=split(/\=/,$_);
-                if (($key) && ($value)) {
-		    $returnhash{&unescape($key)}=&unescape($value);
+		    my ($key,$value)=split(/\=/,$_);
+                    if (($key) && ($value)) {
+		        $returnhash{&unescape($key)}=&unescape($value);
+                    }
                 }
             }
-
         }
     }
     return %returnhash;
@@ -1638,6 +1639,28 @@ sub courseiddump {
 #
 # ----------------------------------------------------------- Check out an item
 
+sub get_first_access {
+    my ($type,$argsymb)=@_;
+    my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
+    if ($argsymb) { $symb=$argsymb; }
+    my ($map,$id,$res)=&decode_symb($symb);
+    if ($type eq 'map') { $res=$map; }
+    my %times=&get('firstaccesstimes',[$res],$udom,$uname);
+    return $times{$res};
+}
+
+sub set_first_access {
+    my ($type)=@_;
+    my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
+    my ($map,$id,$res)=&decode_symb($symb);
+    if ($type eq 'map') { $res=$map; }
+    my $firstaccess=&get_first_access($type);
+    if (!$firstaccess) {
+	return &put('firstaccesstimes',{$res=>time},$udom,$uname);
+    }
+    return 'already_set';
+}
+
 sub checkout {
     my ($symb,$tuname,$tudom,$tcrsid)=@_;
     my $now=time;
@@ -3031,6 +3054,54 @@ sub log_query {
     return get_query_reply($queryid);
 }
 
+# ------- Request retrieval of institutional classlists for course(s)
+
+sub fetch_enrollment_query {
+    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 =~ s/%%$//;
+    $cmd = &escape($cmd);
+    my $query = 'fetchenrollment';
+    my $queryid=&reply("querysend:".$query.':'.$dom.':'.$ENV{'user.name'}.':'.$cmd,$homeserver);
+    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 $pathname = $perlvar{'lonDaemons'}.'/tmp';
+            foreach (@responses) {
+                my ($key,$value) = split/=/,$_;
+                $$replyref{$key} = $value;
+                if ($value > 0) {
+                    foreach (@{$$affiliatesref{$key}}) {
+                        my $filename = $dom.'_'.$key.'_'.$_.'_classlist.xml';
+                        my $destname = $pathname.'/'.$filename;
+                        my $xml_classlist = &reply("autoretrieve:".$filename,$homeserver);
+                        unless ($xml_classlist =~ /^error/) {
+                            if ( open(FILE,">$destname") ) {
+                                print FILE &unescape($xml_classlist);
+                                close(FILE);
+                            }
+                        }
+                    }
+                }
+            }
+        }
+        return 'ok';
+    }
+    return 'error';
+}
+
 sub get_query_reply {
     my $queryid=shift;
     my $replyfile=$perlvar{'lonDaemons'}.'/tmp/'.$queryid;
@@ -3075,6 +3146,54 @@ sub userlog_query {
     return &log_query($uname,$udom,'userlog',%filters);
 }
 
+#--------- Call auto-enrollment subs in localenroll.pm for homeserver for course 
+
+sub auto_run {
+    my ($cnum,$cdom) = @_;
+    my $homeserver = &homeserver($cnum,$cdom);
+    my $response = &reply('autorun:'.$cdom,$homeserver);
+    return $response;
+}
+                                                                                   
+sub auto_get_sections {
+    my ($cnum,$cdom,$inst_coursecode) = @_;
+    my $homeserver = &homeserver($cnum,$cdom);
+    my @secs = ();
+    my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
+    unless ($response eq 'refused') {
+        @secs = split/:/,$response;
+    }
+    return @secs;
+}
+                                                                                   
+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));
+    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.':'.$cdom,$homeserver));
+    return $response;
+}
+                                                                                   
+sub auto_create_password {
+    my ($cnum,$cdom,$authparam) = @_;
+    my $homeserver = &homeserver($cnum,$cdom); 
+    my $create_passwd = 0;
+    my $authchk = '';
+    my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));
+    if ($response eq 'refused') {
+        $authchk = 'refused';
+    } else {
+        ($authparam,$create_passwd,$authchk) = split/:/,$response;
+    }
+    return ($authparam,$create_passwd,$authchk);
+}
+
 # ------------------------------------------------------------------ Plain Text
 
 sub plaintext {
@@ -3456,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 '<strong>'.$listing.'</strong><br />';
+}
+
+
 # ------------------------------------------------------------ Directory lister
 
 sub dirlist {
@@ -4251,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; }
@@ -4261,6 +4397,7 @@ sub symbverify {
     unless ($url eq $thisfn) { return 0; }
 
     $symb=&symbclean($symb);
+    $thisurl=&deversion($thisurl);
     $thisfn=&deversion($thisfn);
 
     my %bighash;
@@ -4268,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)
@@ -4299,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;
 }
 
@@ -4465,6 +4605,15 @@ sub latest_rnd_algorithm_id {
     return '64bit3';
 }
 
+sub get_rand_alg {
+    my ($courseid)=@_;
+    if (!$courseid) { $courseid=(&Apache::lonxml::whichuser())[1]; }
+    if ($courseid) {
+	return $ENV{"course.$courseid.rndseed"};
+    }
+    return &latest_rnd_algorithm_id();
+}
+
 sub getCODE {
     if (defined($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; }
     if (defined($Apache::lonhomework::parsing_a_problem) &&
@@ -4484,7 +4633,7 @@ sub rndseed {
     if (!$courseid) { $courseid=$wcourseid; }
     if (!$domain) { $domain=$wdomain; }
     if (!$username) { $username=$wusername }
-    my $which=$ENV{"course.$courseid.rndseed"};
+    my $which=&get_rand_alg();
     if (defined(&getCODE())) {
 	return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit3') {
@@ -4574,7 +4723,7 @@ sub rndseed_64bit3 {
 	my $num2=$nameseed+$domainseed+$courseseed;
 	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
 	#&Apache::lonxml::debug("rndseed :$num:$symb");
-	return "$num1,$num2";
+	return "$num1:$num2";
     }
 }
 
@@ -4591,14 +4740,14 @@ sub rndseed_CODE_64bit {
 	my $num2=$CODEseed+$courseseed+$symbchck;
 	#&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck");
 	#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
-	return "$num1,$num2";
+	return "$num1:$num2";
     }
 }
 
 sub setup_random_from_rndseed {
     my ($rndseed)=@_;
-    if ($rndseed =~/,/) {
-	my ($num1,$num2)=split(/,/,$rndseed);
+    if ($rndseed =~/([,:])/) {
+	my ($num1,$num2)=split(/[,:]/,$rndseed);
 	&Math::Random::random_set_seed(abs($num1),abs($num2));
     } else {
 	&Math::Random::random_set_seed_from_phrase($rndseed);
@@ -4845,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;