--- loncom/interface/loncommon.pm	2006/10/03 20:14:35	1.461
+++ loncom/interface/loncommon.pm	2006/10/31 22:05:53	1.466
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.461 2006/10/03 20:14:35 albertel Exp $
+# $Id: loncommon.pm,v 1.466 2006/10/31 22:05:53 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2067,6 +2067,25 @@ sub getnames {
     }
 }
 
+sub getemails {
+    my ($uname,$udom)=@_;
+    if ($udom eq 'public' && $uname eq 'public') {
+	return;
+    }
+    my $id=$uname.':'.$udom;
+    my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
+    if ($cached) {
+	return %{$names};
+    } else {
+	my %loadnames=&Apache::lonnet::get('environment',
+                    			   ['notification','critnotification',
+					    'permanentemail'],
+					   $udom,$uname);
+	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
+	return %loadnames;
+    }
+}
+
 # ------------------------------------------------------------------ Screenname
 
 =pod
@@ -2596,7 +2615,7 @@ sub submlink {
     my ($text,$uname,$udom,$symb,$target)=@_;
     if (!($uname && $udom)) {
 	(my $cursymb, my $courseid,$udom,$uname)=
-	    &Apache::lonxml::whichuser($symb);
+	    &Apache::lonnet::whichuser($symb);
 	if (!$symb) { $symb=$cursymb; }
     }
     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
@@ -2642,7 +2661,7 @@ sub pprmlink {
     my ($text,$uname,$udom,$symb,$target)=@_;
     if (!($uname && $udom)) {
 	(my $cursymb, my $courseid,$udom,$uname)=
-	    &Apache::lonxml::whichuser($symb);
+	    &Apache::lonnet::whichuser($symb);
 	if (!$symb) { $symb=$cursymb; }
     }
     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
@@ -3388,6 +3407,10 @@ table.LC_whatsnew tr.LC_empty_row td {
   text-align: center;
   padding: 8px;
 }
+table.LC_whatsnew tr.LC_empty_row td {
+  padding: 4ex
+}
+
 
 table.LC_whatsnew {
 }
@@ -3728,6 +3751,7 @@ Inputs: $title - optional title for the
             bgcolor        -> override the default page bgcolor
             no_auto_mt_title
                            -> prevent &mt()ing the title arg
+
 =back
 
 =cut
@@ -4676,7 +4700,7 @@ sub get_env_multiple {
 
 =pod
 
-=back 
+=back
 
 =head1 CSV Upload/Handling functions
 
@@ -6001,6 +6025,171 @@ sub escape_url {
     my $lastitem = &escape(pop(@urlslices));
     return join('/',@urlslices).'/'.$lastitem;
 }
+
+# -------------------------------------------------------- Initliaze user login
+sub init_user_environment {
+    my ($r, $username, $domain, $authhost, $form, $args) = @_;
+    my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
+
+    my $public=($username eq 'public' && $domain eq 'public');
+
+# See if old ID present, if so, remove
+
+    my ($filename,$cookie,$userroles);
+    my $now=time;
+
+    if ($public) {
+	my $max_public=100;
+	my $oldest;
+	my $oldest_time=0;
+	for(my $next=1;$next<=$max_public;$next++) {
+	    if (-e $lonids."/publicuser_$next.id") {
+		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
+		if ($mtime<$oldest_time || !$oldest_time) {
+		    $oldest_time=$mtime;
+		    $oldest=$next;
+		}
+	    } else {
+		$cookie="publicuser_$next";
+		last;
+	    }
+	}
+	if (!$cookie) { $cookie="publicuser_$oldest"; }
+    } else {
+	# if this isn't a robot, kill any existing non-robot sessions
+	if (!$args->{'robot'}) {
+	    opendir(DIR,$lonids);
+	    while ($filename=readdir(DIR)) {
+		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
+		    unlink($lonids.'/'.$filename);
+		}
+	    }
+	    closedir(DIR);
+	}
+# Give them a new cookie
+	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
+		                   : $now);
+	$cookie="$username\_$id\_$domain\_$authhost";
+    
+# Initialize roles
+
+	$userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
+    }
+# ------------------------------------ Check browser type and MathML capability
+
+    my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
+        $clientunicode,$clientos) = &decode_user_agent($r);
+
+# -------------------------------------- Any accessibility options to remember?
+    if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
+	foreach my $option ('imagesuppress','appletsuppress',
+			    'embedsuppress','fontenhance','blackwhite') {
+	    if ($form->{$option} eq 'true') {
+		&Apache::lonnet::put('environment',{$option => 'on'},
+				     $domain,$username);
+	    } else {
+		&Apache::lonnet::del('environment',[$option],
+				     $domain,$username);
+	    }
+	}
+    }
+# ------------------------------------------------------------- Get environment
+
+    my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
+    my ($tmp) = keys(%userenv);
+    if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
+	# default remote control to off
+	if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
+    } else {
+	undef(%userenv);
+    }
+    if (($userenv{'interface'}) && (!$form->{'interface'})) {
+	$form->{'interface'}=$userenv{'interface'};
+    }
+    $env{'environment.remote'}=$userenv{'remote'};
+    if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
+
+# --------------- Do not trust query string to be put directly into environment
+    foreach my $option ('imagesuppress','appletsuppress',
+			'embedsuppress','fontenhance','blackwhite',
+			'interface','localpath','localres') {
+	$form->{$option}=~s/[\n\r\=]//gs;
+    }
+# --------------------------------------------------------- Write first profile
+
+    {
+	my %initial_env = 
+	    ("user.name"          => $username,
+	     "user.domain"        => $domain,
+	     "user.home"          => $authhost,
+	     "browser.type"       => $clientbrowser,
+	     "browser.version"    => $clientversion,
+	     "browser.mathml"     => $clientmathml,
+	     "browser.unicode"    => $clientunicode,
+	     "browser.os"         => $clientos,
+	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
+	     "request.course.fn"  => '',
+	     "request.course.uri" => '',
+	     "request.course.sec" => '',
+	     "request.role"       => 'cm',
+	     "request.role.adv"   => $env{'user.adv'},
+	     "request.host"       => $ENV{'REMOTE_ADDR'},);
+
+        if ($form->{'localpath'}) {
+	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
+	    $initial_env{"browser.localres"}   = $form->{'localres'};
+        }
+	
+	if ($public) {
+	    $initial_env{"environment.remote"} = "off";
+	}
+	if ($form->{'interface'}) {
+	    $form->{'interface'}=~s/\W//gs;
+	    $initial_env{"browser.interface"} = $form->{'interface'};
+	    $env{'browser.interface'}=$form->{'interface'};
+	    foreach my $option ('imagesuppress','appletsuppress',
+				'embedsuppress','fontenhance','blackwhite') {
+		if (($form->{$option} eq 'true') ||
+		    ($userenv{$option} eq 'on')) {
+		    $initial_env{"browser.$option"} = "on";
+		}
+	    }
+	}
+
+	$env{'user.environment'} = "$lonids/$cookie.id";
+	
+	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
+		 &GDBM_WRCREAT(),0640)) {
+	    &_add_to_env(\%disk_env,\%initial_env);
+	    &_add_to_env(\%disk_env,\%userenv,'environment.');
+	    &_add_to_env(\%disk_env,$userroles);
+	    if (ref($args->{'extra_env'})) {
+		&_add_to_env(\%disk_env,$args->{'extra_env'});
+	    }
+	    untie(%disk_env);
+	} else {
+	    &Apache::lonnet::logthis("<font color=\"blue\">WARNING: ".
+			   'Could not create environment storage in lonauth: '.$!.'</font>');
+	    return 'error: '.$!;
+	}
+    }
+    $env{'request.role'}='cm';
+    $env{'request.role.adv'}=$env{'user.adv'};
+    $env{'browser.type'}=$clientbrowser;
+
+    return $cookie;
+
+}
+
+sub _add_to_env {
+    my ($idf,$env_data,$prefix) = @_;
+    while (my ($key,$value) = each(%$env_data)) {
+	$idf->{$prefix.$key} = $value;
+	$env{$prefix.$key}   = $value;
+    }
+}
+
+
 =pod
 
 =back