--- loncom/interface/loncommon.pm 2002/12/30 14:10:58 1.74
+++ loncom/interface/loncommon.pm 2003/03/03 13:03:58 1.86
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.74 2002/12/30 14:10:58 www Exp $
+# $Id: loncommon.pm,v 1.86 2003/03/03 13:03:58 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
@@ -520,6 +519,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;
@@ -540,14 +542,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;
}
@@ -711,11 +715,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 +769,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 +825,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;
}
@@ -839,7 +862,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;
}
@@ -875,7 +898,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;
}
@@ -885,6 +908,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 +1104,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 +1128,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)=@_;
@@ -1033,6 +1163,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 +1482,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 +1530,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 +1545,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 +1580,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="http://$ENV{'HTTP_HOST'}:8080/$img" /></td>
+<img src="http://$ENV{'HTTP_HOST'}:$lonhttpdPort$img" /></td>
<td bgcolor="$font"><font color='$sidebg'>$messages</font></td>
</tr>
<tr>
@@ -1775,6 +1923,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__;