--- loncom/interface/loncommon.pm	2003/02/12 17:57:27	1.78
+++ loncom/interface/loncommon.pm	2003/04/03 21:32:23	1.94
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.78 2003/02/12 17:57:27 www Exp $
+# $Id: loncommon.pm,v 1.94 2003/04/03 21:32:23 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -81,6 +81,7 @@ use GDBM_File;
 use POSIX qw(strftime mktime);
 use Apache::Constants qw(:common);
 use Apache::lonmsg();
+use Apache::lonmenu();
 my $readit;
 
 =pod 
@@ -345,7 +346,37 @@ sub selectstudent_link {
         return '';
    }
     return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
-        '","'.$udomele.'");'."'>Select</a>";
+        '","'.$udomele.'");'."'>Select User</a>";
+}
+
+sub coursebrowser_javascript {
+   return (<<'ENDSTDBRW');
+<script type="text/javascript" language="Javascript" >
+    var stdeditbrowser;
+    function opencrsbrowser(formname,uname,udom) {
+        var url = '/adm/pickcourse?';
+        var filter;
+        if (filter != null) {
+           if (filter != '') {
+               url += 'filter='+filter+'&';
+	   }
+        }
+        url += 'form=' + formname + '&cnumelement='+uname+
+                                    '&cdomelement='+udom;
+        var title = 'Course Browser';
+        var options = 'scrollbars=1,resizable=1,menubar=0';
+        options += ',width=700,height=600';
+        stdeditbrowser = open(url,title,options,'1');
+        stdeditbrowser.focus();
+    }
+</script>
+ENDSTDBRW
+}
+
+sub selectcourse_link {
+   my ($form,$unameele,$udomele)=@_;
+    return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
+        '","'.$udomele.'");'."'>Select Course</a>";
 }
 
 ###############################################################
@@ -518,6 +549,9 @@ sub help_open_topic {
     my ($topic, $text, $stayOnPage, $width, $height) = @_;
     $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);
+    if ($ENV{'browser.interface'} eq 'textual') {
+	$stayOnPage=1;
+    }
     $width = 350 if (not defined $width);
     $height = 400 if (not defined $height);
     my $filename = $topic;
@@ -597,18 +631,48 @@ sub get_domains {
 
 =pod
 
-=item select_dom_form($defdom,$name)
+=item select_form($defdom,$name,%hash)
+
+Returns a string containing a <select name='$name' size='1'> form to 
+allow a user to select options from a hash option_name => displayed text.  
+See lonrights.pm for an example invocation and use.
+
+=cut
+
+#-------------------------------------------
+sub select_form {
+    my ($def,$name,%hash) = @_;
+    my $selectform = "<select name=\"$name\" size=\"1\">\n";
+    foreach (sort keys %hash) {
+        $selectform.="<option value=\"$_\" ".
+            ($_ eq $def ? 'selected' : '').
+                ">".$hash{$_}."</option>\n";
+    }
+    $selectform.="</select>";
+    return $selectform;
+}
+
+
+#-------------------------------------------
+
+=pod
+
+=item select_dom_form($defdom,$name,$includeempty)
 
 Returns a string containing a <select name='$name' size='1'> form to 
 allow a user to select the domain to preform an operation in.  
 See loncreateuser.pm for an example invocation and use.
 
+If the $includeempty flag is set, it also includes an empty choice ("no domain
+selected");
+
 =cut
 
 #-------------------------------------------
 sub select_dom_form {
-    my ($defdom,$name) = @_;
+    my ($defdom,$name,$includeempty) = @_;
     my @domains = get_domains();
+    if ($includeempty) { @domains=('',@domains); }
     my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
     foreach (@domains) {
         $selectdomain.="<option value=\"$_\" ".
@@ -670,6 +734,75 @@ sub home_server_option_list {
 ###############################################################
 
 ###############################################################
+###############################################################
+
+=pod
+
+=item &decode_user_agent()
+
+Inputs: $r
+
+Outputs:
+
+=over 4
+
+=item $httpbrowser
+
+=item $clientbrowser
+
+=item $clientversion
+
+=item $clientmathml
+
+=item $clientunicode
+
+=item $clientos
+
+=back
+
+=cut
+
+###############################################################
+###############################################################
+sub decode_user_agent {
+    my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
+    my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
+    my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
+    my $clientbrowser='unknown';
+    my $clientversion='0';
+    my $clientmathml='';
+    my $clientunicode='0';
+    for (my $i=0;$i<=$#browsertype;$i++) {
+        my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
+	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
+	    $clientbrowser=$bname;
+            $httpbrowser=~/$vreg/i;
+	    $clientversion=$1;
+            $clientmathml=($clientversion>=$minv);
+            $clientunicode=($clientversion>=$univ);
+	}
+    }
+    my $clientos='unknown';
+    if (($httpbrowser=~/linux/i) ||
+        ($httpbrowser=~/unix/i) ||
+        ($httpbrowser=~/ux/i) ||
+        ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
+    if (($httpbrowser=~/vax/i) ||
+        ($httpbrowser=~/vms/i)) { $clientos='vms'; }
+    if ($httpbrowser=~/next/i) { $clientos='next'; }
+    if (($httpbrowser=~/mac/i) ||
+        ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
+    if ($httpbrowser=~/win/i) { $clientos='win'; }
+    if ($httpbrowser=~/embed/i) { $clientos='pda'; }
+    return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
+            $clientunicode,$clientos,);
+}
+
+###############################################################
+###############################################################
+
+
+###############################################################
 ##    Authentication changing form generation subroutines    ##
 ###############################################################
 ##
@@ -711,11 +844,27 @@ See loncreateuser.pm for invocation and
 sub authform_header{  
     my %in = (
         formname => 'cu',
-        kerb_def_dom => 'MSU.EDU',
+        kerb_def_dom => '',
         @_,
     );
     $in{'formname'} = 'document.' . $in{'formname'};
     my $result='';
+
+#---------------------------------------------- Code for upper case translation
+    my $Javascript_toUpperCase;
+    unless ($in{kerb_def_dom}) {
+        $Javascript_toUpperCase =<<"END";
+        switch (choice) {
+           case 'krb': currentform.elements[choicearg].value =
+               currentform.elements[choicearg].value.toUpperCase();
+               break;
+           default:
+        }
+END
+    } else {
+        $Javascript_toUpperCase = "";
+    }
+
     $result.=<<"END";
 var current = new Object();
 current.radiovalue = 'nochange';
@@ -749,12 +898,7 @@ function changed_radio(choice,currentfor
 function changed_text(choice,currentform) {
     var choicearg = choice + 'arg';
     if (currentform.elements[choicearg].value !='') {
-        switch (choice) {
-            case 'krb': currentform.elements[choicearg].value =
-                currentform.elements[choicearg].value.toUpperCase();
-                break;
-            default:
-        }
+        $Javascript_toUpperCase
         // clear old field
         if ((current.argfield != choicearg) && (current.argfield != null)) {
             currentform.elements[current.argfield].value = '';
@@ -810,18 +954,26 @@ sub authform_kerberos{
     my %in = (
               formname => 'document.cu',
               kerb_def_dom => 'MSU.EDU',
+              kerb_def_auth => 'krb4',
               @_,
               );
     my $result='';
+    my $check4;
+    my $check5;
+    if ($in{'kerb_def_auth'} eq 'krb5') {
+       $check5 = " checked=\"on\"";
+    } else {
+       $check4 = " checked=\"on\"";
+    }
     $result.=<<"END";
 <input type="radio" name="login" value="krb" 
        onclick="javascript:changed_radio('krb',$in{'formname'});"
        onchange="javascript:changed_radio('krb',$in{'formname'});" />
 Kerberos authenticated with domain
-<input type="text" size="10" name="krbarg" value=""
+<input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}"
        onchange="javascript:changed_text('krb',$in{'formname'});" />
-<input type="radio" name="krbver" value="4" checked="on" />Version 4
-<input type="radio" name="krbver" value="5" />Version 5
+<input type="radio" name="krbver" value="4" $check4 />Version 4
+<input type="radio" name="krbver" value="5" $check5 />Version 5
 END
     return $result;
 }
@@ -885,6 +1037,89 @@ END
 ###############################################################
 
 ###############################################################
+##    Get Authentication Defaults for Domain                 ##
+###############################################################
+##
+## Returns default authentication type and an associated argument
+## as listed in file domain.tab
+##
+#-------------------------------------------
+
+=pod
+
+=item get_auth_defaults
+
+get_auth_defaults($target_domain) returns the default authentication
+type and an associated argument (initial password or a kerberos domain).
+These values are stored in lonTabs/domain.tab
+
+($def_auth, $def_arg) = &get_auth_defaults($target_domain);
+
+If target_domain is not found in domain.tab, returns nothing ('').
+
+=over 4
+
+=item get_auth_defaults
+
+=back
+
+=cut
+
+#-------------------------------------------
+sub get_auth_defaults {
+    my $domain=shift;
+    return ($Apache::lonnet::domain_auth_def{$domain},$Apache::lonnet::domain_auth_arg_def{$domain});
+}
+###############################################################
+##   End Get Authentication Defaults for Domain              ##
+###############################################################
+
+###############################################################
+##    Get Kerberos Defaults for Domain                 ##
+###############################################################
+##
+## Returns default kerberos version and an associated argument
+## as listed in file domain.tab. If not listed, provides
+## appropriate default domain and kerberos version.
+##
+#-------------------------------------------
+
+=pod
+
+=item get_kerberos_defaults
+
+get_kerberos_defaults($target_domain) returns the default kerberos
+version and domain. If not found in domain.tabs, it defaults to
+version 4 and the domain of the server.
+
+($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
+
+=over 4
+
+=item get_kerberos_defaults
+
+=back
+
+=cut
+
+#-------------------------------------------
+sub get_kerberos_defaults {
+    my $domain=shift;
+    my ($krbdef,$krbdefdom) =
+        &Apache::loncommon::get_auth_defaults($domain);
+    unless ($krbdef =~/^krb/ && $krbdefdom) {
+        $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
+        my $krbdefdom=$1;
+        $krbdefdom=~tr/a-z/A-Z/;
+        $krbdef = "krb4";
+    }
+    return ($krbdef,$krbdefdom);
+}
+###############################################################
+##   End Get Kerberos Defaults for Domain              ##
+###############################################################
+
+###############################################################
 ##                Thesaurus Functions                        ##
 ###############################################################
 
@@ -998,7 +1233,17 @@ sub get_related_words {
 ###############################################################
 
 # -------------------------------------------------------------- Plaintext name
+=pod
 
+=item plainname($uname,$udom)
+
+Gets a users name and returns it as a string in
+"first middle last generation"
+form
+
+=cut
+
+###############################################################
 sub plainname {
     my ($uname,$udom)=@_;
     my %names=&Apache::lonnet::get('environment',
@@ -1012,7 +1257,21 @@ sub plainname {
 }
 
 # -------------------------------------------------------------------- Nickname
+=pod
+
+=item nickname($uname,$udom)
+
+Gets a users name and returns it as a string as
+
+"&quot;nickname&quot;"
+
+if the user has a nickname or
+
+"first middle last generation"
 
+if the user does not
+
+=cut
 
 sub nickname {
     my ($uname,$udom)=@_;
@@ -1033,6 +1292,14 @@ sub nickname {
 
 # ------------------------------------------------------------------ Screenname
 
+=pod
+
+=item screenname($uname,$udom)
+
+Gets a users screenname and returns it as a string
+
+=cut
+
 sub screenname {
     my ($uname,$udom)=@_;
     my %names=
@@ -1344,8 +1611,10 @@ sub domainlogo {
     my $domain = &determinedomain(shift);    
      # See if there is a logo
     if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
-        return '<img src="http://'.$ENV{'HTTP_HOST'}.':8080/adm/lonDomLogos/'.
-               $domain.'.gif" />';
+	my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
+	if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
+        return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
+	    '/adm/lonDomLogos/'.$domain.'.gif" />';
     } elsif(exists($Apache::lonnet::domaindescription{$domain})) {
         return $Apache::lonnet::domaindescription{$domain};
     } else {
@@ -1390,6 +1659,8 @@ Inputs:
  $addentries, extra parameters for the <body> tag.
  $bodyonly, if defined, only return the <body> tag.
  $domain, if defined, force a given domain.
+ $forcereg, if page should register as content page (relevant for 
+            text interface only)
 
 Returns: A uniform header for LON-CAPA web pages.  
 If $bodyonly is nonzero, a string containing a <body> tag will be returned.
@@ -1403,7 +1674,7 @@ other decorations will be returned.
 
 ###############################################
 sub bodytag {
-    my ($title,$function,$addentries,$bodyonly,$domain)=@_;
+    my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;
     unless ($function) {
 	$function='student';
         if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
@@ -1438,18 +1709,38 @@ sub bodytag {
 # Set messages
     my $messages=&domainlogo($domain);
 # Output
+    my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
+    if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
     my $bodytag = <<END;
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
 $addentries>
 END
+    my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
+                   $lonhttpdPort.$img.'" />';
     if ($bodyonly) {
         return $bodytag;
-    } else {
-        return(<<ENDBODY);
+    } elsif ($ENV{'browser.interface'} eq 'textual') {
+#
+# Accessibility rendering
+#
+        return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
+                                                      $forcereg).
+               '<h1>LON-CAPA: '.$title.'</h1>';
+    } elsif ($ENV{'environment.remote'} eq 'off') {
+#
+# No-Remote rendering
+#
+        $upperleft=&Apache::lonmenu::menubuttons($forcereg,'web',
+						 $forcereg);
+    }
+#
+# Top frame rendering
+#
+    return(<<ENDBODY);
 $bodytag
 <table width="100%" cellspacing="0" border="0" cellpadding="0">
 <tr><td bgcolor="$font">
-<img src="http://$ENV{'HTTP_HOST'}:8080/$img" /></td>
+$upperleft</td>
 <td bgcolor="$font"><font color='$sidebg'>$messages</font></td>
 </tr>
 <tr>
@@ -1471,7 +1762,6 @@ $bodytag
 <td bgcolor="$tabbg" align="right"><font size="2">$realm</font>&nbsp;</td></tr>
 </table><br>
 ENDBODY
-    }
 }
 ###############################################
 
@@ -1775,6 +2065,37 @@ sub csv_samples_select_table {
     $i--;
     return($i);
 }
+
+=pod
+
+=item check_if_partid_hidden($id,$symb,$udom,$uname)
+
+Returns either 1 or undef
+
+1 if the part is to be hidden, undef if it is to be shown
+
+Arguments are:
+
+$id the id of the part to be checked
+$symb, optional the symb of the resource to check
+$udom, optional the domain of the user to check for
+$uname, optional the username of the user to check for
+
+=cut
+
+sub check_if_partid_hidden {
+    my ($id,$symb,$udom,$uname) = @_;
+    my $hiddenparts=&Apache::lonnet::EXT('resource.0.parameter_hiddenparts',
+					 $symb,$udom,$uname);
+    my @hiddenlist=split(/,/,$hiddenparts);
+    foreach my $checkid (@hiddenlist) {
+	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return 1; }
+    }
+    return undef;
+}
+
+
+
 1;
 __END__;