--- loncom/interface/loncommon.pm 2002/10/18 13:49:49 1.70
+++ loncom/interface/loncommon.pm 2003/03/28 01:53:55 1.92
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.70 2002/10/18 13:49:49 www Exp $
+# $Id: loncommon.pm,v 1.92 2003/03/28 01:53:55 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -27,9 +27,7 @@
#
# YEAR=2001
# 2/13-12/7 Guy Albertelli
-# 12/11,12/12,12/17 Scott Harrison
# 12/21 Gerd Kortemeyer
-# 12/21 Scott Harrison
# 12/25,12/28 Gerd Kortemeyer
# YEAR=2002
# 1/4 Gerd Kortemeyer
@@ -83,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
@@ -311,7 +310,74 @@ sub browser_and_searcher_javascript {
END
}
+sub studentbrowser_javascript {
+ unless ($ENV{'request.course.id'}) { return ''; }
+ unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
+ return '';
+ }
+ return (<<'ENDSTDBRW');
+<script type="text/javascript" language="Javascript" >
+ var stdeditbrowser;
+ function openstdbrowser(formname,uname,udom) {
+ var url = '/adm/pickstudent?';
+ var filter;
+ eval('filter=document.'+formname+'.'+uname+'.value;');
+ if (filter != null) {
+ if (filter != '') {
+ url += 'filter='+filter+'&';
+ }
+ }
+ url += 'form=' + formname + '&unameelement='+uname+
+ '&udomelement='+udom;
+ var title = 'Student 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 selectstudent_link {
+ my ($form,$unameele,$udomele)=@_;
+ unless ($ENV{'request.course.id'}) { return ''; }
+ unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
+ return '';
+ }
+ return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
+ '","'.$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>";
+}
###############################################################
@@ -483,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;
@@ -493,7 +562,7 @@ sub help_open_topic {
if (!$stayOnPage)
{
- $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height'))";
+ $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
}
else
{
@@ -503,14 +572,16 @@ sub help_open_topic {
# Add the text
if ($text ne "")
{
- $template .= "<a href=\"$link\">$text</a> ";
+ $template .=
+ "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
+ "<td bgcolor='#5555FF'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
}
# Add the graphic
$template .= <<"ENDTEMPLATE";
-<a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>
+ <a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>
ENDTEMPLATE
-
+ if ($text ne '') { $template.='</td></tr></table>' };
return $template;
}
@@ -560,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=\"$_\" ".
@@ -633,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 ##
###############################################################
##
@@ -674,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';
@@ -712,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 = '';
@@ -773,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;
}
@@ -802,7 +991,7 @@ sub authform_internal{
onclick="javascript:changed_radio('int',$args{'formname'});" />
Internally authenticated (with initial password
<input type="text" size="10" name="intarg" value=""
- onchange="javascript:changed_text('int',$args{'formname'});" />
+ onchange="javascript:changed_text('int',$args{'formname'});" />)
END
return $result;
}
@@ -838,7 +1027,7 @@ sub authform_filesystem{
onclick="javascript:changed_radio('fsys',$in{'formname'});" />
Filesystem authenticated (with initial password
<input type="text" size="10" name="fsysarg" value=""
- onchange="javascript:changed_text('fsys',$in{'formname'});">
+ onchange="javascript:changed_text('fsys',$in{'formname'});">)
END
return $result;
}
@@ -848,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 ##
###############################################################
@@ -961,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',
@@ -975,7 +1257,21 @@ sub plainname {
}
# -------------------------------------------------------------------- Nickname
+=pod
+
+=item nickname($uname,$udom)
+
+Gets a users name and returns it as a string as
+
+""nickname""
+if the user has a nickname or
+
+"first middle last generation"
+
+if the user does not
+
+=cut
sub nickname {
my ($uname,$udom)=@_;
@@ -996,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=
@@ -1010,6 +1314,13 @@ sub messagewrapper {
return
"<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";
}
+# --------------------------------------------------------------- Notes Wrapper
+
+sub noteswrapper {
+ my ($link,$un,$do)=@_;
+ return
+"<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
+}
# ------------------------------------------------------------- Aboutme Wrapper
sub aboutmewrapper {
@@ -1021,7 +1332,8 @@ sub aboutmewrapper {
sub syllabuswrapper {
- my ($link,$un,$do)=@_;
+ my ($link,$un,$do,$tf)=@_;
+ if ($tf) { $link='<font color="'.$tf.'">'.$link.'</font>'; }
return "<a href='/public/$do/$un/syllabus'>$link</a>";
}
@@ -1299,7 +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="/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 {
@@ -1344,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.
@@ -1357,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)/) {
@@ -1392,18 +1709,24 @@ 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
if ($bodyonly) {
return $bodytag;
+ } elsif ($ENV{'browser.interface'} eq 'textual') {
+ return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
+ $forcereg).
+ '<h1>LON-CAPA: '.$title.'</h1>';
} else {
return(<<ENDBODY);
$bodytag
<table width="100%" cellspacing="0" border="0" cellpadding="0">
<tr><td bgcolor="$font">
-<img src="$img" /></td>
+<img src="http://$ENV{'HTTP_HOST'}:$lonhttpdPort$img" /></td>
<td bgcolor="$font"><font color='$sidebg'>$messages</font></td>
</tr>
<tr>
@@ -1729,6 +2052,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__;