--- loncom/lonnet/perl/lonnet.pm	2008/06/06 04:53:51	1.960
+++ loncom/lonnet/perl/lonnet.pm	2008/09/11 14:47:23	1.967
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.960 2008/06/06 04:53:51 raeburn Exp $
+# $Id: lonnet.pm,v 1.967 2008/09/11 14:47:23 bisitz Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1890,7 +1890,7 @@ sub process_coursefile {
             print $fh $env{'form.'.$source};
             close($fh);
             if ($parser eq 'parse') {
-                my $parse_result = &extract_embedded_items($filepath,$fname,$allfiles,$codebase);
+                my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase);
                 unless ($parse_result eq 'ok') {
                     &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
                 }
@@ -2098,7 +2098,7 @@ sub finishuserfileupload {
 	close(FH);
     }
     if ($parser eq 'parse') {
-        my $parse_result = &extract_embedded_items($filepath,$file,$allfiles,
+        my $parse_result = &extract_embedded_items($filepath.'/'.$file,$allfiles,
 						   $codebase);
         unless ($parse_result eq 'ok') {
             &logthis('Failed to parse '.$filepath.$file.
@@ -2138,7 +2138,7 @@ sub finishuserfileupload {
 }
 
 sub extract_embedded_items {
-    my ($filepath,$file,$allfiles,$codebase,$content) = @_;
+    my ($fullpath,$allfiles,$codebase,$content) = @_;
     my @state = ();
     my %javafiles = (
                       codebase => '',
@@ -2153,7 +2153,7 @@ sub extract_embedded_items {
     if ($content) {
         $p = HTML::LCParser->new($content);
     } else {
-        $p = HTML::LCParser->new($filepath.'/'.$file);
+        $p = HTML::LCParser->new($fullpath);
     }
     while (my $t=$p->get_token()) {
 	if ($t->[0] eq 'S') {
@@ -2766,7 +2766,7 @@ sub courseidput {
 sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
         $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
-        $selfenrollonly,$catfilter)=@_;
+        $selfenrollonly,$catfilter,$showhidden,$caller)=@_;
     my $as_hash = 1;
     my %returnhash;
     if (!$domfilter) { $domfilter=''; }
@@ -2784,7 +2784,8 @@ sub courseiddump {
                          &escape($instcodefilter).':'.&escape($ownerfilter).
                          ':'.&escape($coursefilter).':'.&escape($typefilter).
                          ':'.&escape($regexp_ok).':'.$as_hash.':'.
-                         &escape($selfenrollonly).':'.&escape($catfilter),$tryserver);
+                         &escape($selfenrollonly).':'.&escape($catfilter).':'.
+                         $showhidden.':'.$caller,$tryserver);
                 my @pairs=split(/\&/,$rep);
                 foreach my $item (@pairs) {
                     my ($key,$value)=split(/\=/,$item,2);
@@ -3560,12 +3561,13 @@ sub privileged {
 
 sub rolesinit {
     my ($domain,$username,$authhost)=@_;
+    my %userroles;
     my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
-    if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
+    if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return \%userroles; }
     my %allroles=();
     my %allgroups=();   
     my $now=time;
-    my %userroles = ('user.login.time' => $now);
+    %userroles = ('user.login.time' => $now);
     my $group_privs;
 
     if ($rolesdump ne '') {
@@ -5557,7 +5559,7 @@ sub modifyuser {
     my ($udom,    $uname, $uid,
         $umode,   $upass, $first,
         $middle,  $last,  $gene,
-        $forceid, $desiredhome, $email)=@_;
+        $forceid, $desiredhome, $email, $inststatus)=@_;
     $udom= &LONCAPA::clean_domain($udom);
     $uname=&LONCAPA::clean_username($uname);
     &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
@@ -5618,7 +5620,7 @@ sub modifyuser {
 # -------------------------------------------------------------- Add names, etc
     my @tmp=&get('environment',
 		   ['firstname','middlename','lastname','generation','id',
-                    'permanentemail'],
+                    'permanentemail','inststatus'],
 		   $udom,$uname);
     my %names;
     if ($tmp[0] =~ m/^error:.*/) { 
@@ -5636,19 +5638,23 @@ sub modifyuser {
     if (defined($gene))   { $names{'generation'} = $gene; }
     if ($email) {
        $email=~s/[^\w\@\.\-\,]//gs;
-       if ($email=~/\@/) { $names{'notification'} = $email;
-			   $names{'critnotification'} = $email;
-			   $names{'permanentemail'} = $email; }
+       if ($email=~/\@/) { $names{'permanentemail'} = $email; }
     }
     if ($uid) { $names{'id'}  = $uid; }
+    if (defined($inststatus)) { $names{'inststatus'} = $inststatus; } 
     my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }
     my $sqlresult = &update_allusers_table($uname,$udom,\%names);
     &devalidate_cache_new('namescache',$uname.':'.$udom);
-    &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
-             $umode.', '.$first.', '.$middle.', '.
-	     $last.', '.$gene.' by '.
-             $env{'user.name'}.' at '.$env{'user.domain'});
+    my $logmsg = 'Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
+                 $umode.', '.$first.', '.$middle.', '.
+	         $last.', '.$gene.', '.$email.', '.$inststatus;
+    if ($env{'user.name'} ne '' && $env{'user.domain'}) {
+        $logmsg .= ' by '.$env{'user.name'}.' at '.$env{'user.domain'};
+    } else {
+        $logmsg .= ' during self creation';
+    }
+    &logthis($logmsg);
     return 'ok';
 }
 
@@ -5874,7 +5880,7 @@ sub assigncustomrole {
 sub revokerole {
     my ($udom,$uname,$url,$role,$deleteflag,$selfenroll,$context)=@_;
     my $now=time;
-    return &assignrole($udom,$uname,$url,$role,$now,$deleteflag,$selfenroll,$context);
+    return &assignrole($udom,$uname,$url,$role,$now,undef,$deleteflag,$selfenroll,$context);
 }
 
 # ---------------------------------------------------------- Revoke Custom Role
@@ -8979,7 +8985,7 @@ when the connection is brought back up
 =item * B<con_failed>: unable to contact remote host and unable to save message
 for later delivery
 
-=item * B<error:>: an error a occured, a description of the error follows the :
+=item * B<error:>: an error a occurred, a description of the error follows the :
 
 =item * B<no_such_host>: unable to fund a host associated with the user/domain
 that was requested
@@ -9146,7 +9152,8 @@ modifyuserauth($udom,$uname,$umode,$upas
 
 =item *
 
-modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene) : 
+modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,
+           $forceid,$desiredhome,$email,$inststatus) : 
 modify user
 
 =item *
@@ -9169,7 +9176,7 @@ Inputs:
 
 =item B<$uname> Student's loncapa login name
 
-=item B<$uid> Student's id/student number
+=item B<$uid> Student/Employee ID
 
 =item B<$umode> Student's authentication mode
 
@@ -9197,13 +9204,15 @@ Inputs:
 
 =item B<$type> Type of enrollment (auto or manual)
 
-=item B<$locktype>
+=item B<$locktype> boolean - enrollment type locked to prevent Autoenroll.pl changing manual to auto    
+
+=item B<$cid> courseID - needed if a course role is assigned by a user whose current role is DC
 
-=item B<$cid>
+=item B<$selfenroll> boolean - 1 if user role change occurred via self-enrollment
 
-=item B<$selfenroll>
+=item B<$context> role change context (shown in User Management Logs display in a course)
 
-=item B<$context>
+=item B<$inststatus> institutional status of user - : separated string of escaped status types  
 
 =back
 
@@ -9556,7 +9565,7 @@ Returns:
  'key_exists: <key>' -> failed to anything out of $storehash, as at
                         least <key> already existed in the db (other
                         requested keys may also already exist)
- 'error: <msg>' -> unable to tie the DB or other erorr occured
+ 'error: <msg>' -> unable to tie the DB or other error occurred
  'con_lost' -> unable to contact request server
  'refused' -> action was not allowed by remote machine