--- loncom/interface/loncommon.pm 2002/08/20 21:29:34 1.54
+++ loncom/interface/loncommon.pm 2002/08/27 16:49:20 1.61
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.54 2002/08/20 21:29:34 www Exp $
+# $Id: loncommon.pm,v 1.61 2002/08/27 16:49:20 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -480,7 +480,7 @@ sub help_open_topic {
# Add the graphic
$template .= <<"ENDTEMPLATE";
-
+
ENDTEMPLATE
return $template;
@@ -735,7 +735,7 @@ sub authform_nochange{
my $result='';
$result.=<<"END";
+ onclick="javascript:changed_radio('nochange',$in{'formname'});" />
Do not change login data
END
return $result;
@@ -751,10 +751,12 @@ sub authform_kerberos{
$result.=<<"END";
+ onchange="javascript:changed_radio('krb',$in{'formname'});" />
Kerberos authenticated with domain
+ onchange="javascript:changed_text('krb',$in{'formname'});" />
+Version 4
+Version 5
END
return $result;
}
@@ -769,10 +771,10 @@ sub authform_internal{
$result.=<<"END";
+ onclick="javascript:changed_radio('int',$args{'formname'});" />
Internally authenticated (with initial password
+ onchange="javascript:changed_text('int',$args{'formname'});" />
END
return $result;
}
@@ -787,10 +789,10 @@ sub authform_local{
$result.=<<"END";
+ onclick="javascript:changed_radio('loc',$in{'formname'});" />
Local Authentication with argument
+ onchange="javascript:changed_text('loc',$in{'formname'});" />
END
return $result;
}
@@ -805,7 +807,7 @@ sub authform_filesystem{
$result.=<<"END";
+ onclick="javascript:changed_radio('fsys',$in{'formname'});" />
Filesystem authenticated (with initial password
@@ -885,52 +887,6 @@ sub keyword {
return exists($Keywords{$word});
}
-###################################################
-# Old code, to be removed soon #
-###################################################
-# -------------------------------------------------------- Return related words
-#sub related {
-# my $newword=shift;
-# $newword=~s/\W//g;
-# $newword=~tr/A-Z/a-z/;
-# my $tindex=$theindex{$newword};
-# if ($tindex) {
-# my %found=();
-# foreach (split(/\,/,$therelated[$tindex])) {
-## - Related word found
-# my ($ridx,$rcount)=split(/\:/,$_);
-## - Direct relation index
-# my $directrel=$rcount/$thecount[$tindex];
-# if ($directrel>$thethreshold) {
-# foreach (split(/\,/,$therelated[$ridx])) {
-# my ($rridx,$rrcount)=split(/\:/,$_);
-# if ($rridx==$tindex) {
-## - Determine reverse relation index
-# my $revrel=$rrcount/$thecount[$ridx];
-## - Calculate full index
-# $found{$ridx}=$directrel*$revrel;
-# if ($found{$ridx}>$thethreshold) {
-# foreach (split(/\,/,$therelated[$ridx])) {
-# my ($rrridx,$rrrcount)=split(/\:/,$_);
-# unless ($found{$rrridx}) {
-# my $revrevrel=$rrrcount/$thecount[$ridx];
-# if (
-# $directrel*$revrel*$revrevrel>$thethreshold
-# ) {
-# $found{$rrridx}=
-# $directrel*$revrel*$revrevrel;
-# }
-# }
-# }
-# }
-# }
-# }
-# }
-# }
-# }
-# return ();
-#}
-
###############################################################
=pod
@@ -947,7 +903,6 @@ Uses global $thesaurus_db_file.
=cut
###############################################################
-
sub get_related_words {
my $keyword = shift;
my %thesaurus_db;
@@ -977,6 +932,26 @@ sub get_related_words {
## End Thesaurus Functions ##
###############################################################
+# -------------------------------------------------------------- Plaintext name
+
+sub plainname {
+ my ($uname,$udom)=@_;
+ my %names=&Apache::lonnet::get('environment',
+ ['firstname','middlename','lastname','generation'],
+ $udom,$uname);
+ return $names{'firstname'}.' '.$names{'middlename'}.' '.
+ $names{'lastname'}.' '.$names{'generation'};
+}
+
+# ------------------------------------------------------------------ Screenname
+
+sub screenname {
+ my ($uname,$udom)=@_;
+ my %names=
+ &Apache::lonnet::get('environment',['screenname'],$udom,$uname);
+ return $names{'screenname'};
+}
+
# ---------------------------------------------------------------- Language IDs
sub languageids {
return sort(keys(%language));
@@ -1193,9 +1168,82 @@ sub findallcourses {
}
###############################################
+###############################################
+
+=pod
+
+=item &domainlogo()
+
+Inputs: $domain (usually will be undef)
+
+Returns: A link to a domain logo, if the domain logo exists.
+If the domain logo does not exist, a description of the domain.
+
+=cut
+
+###############################################
+###############################################
+sub domainlogo {
+ my ($domain) = @_;
+ if (! $domain) {
+ # Determine domain if we have not been given one
+ $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
+ if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; }
+ if ($ENV{'request.role.domain'}) {
+ $domain=$ENV{'request.role.domain'};
+ }
+ }
+ # See if there is a logo
+ if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
+ return '';
+ } elsif(exists($Apache::lonnet::domaindescription{$domain})) {
+ return $Apache::lonnet::domaindescription{$domain};
+ } else {
+ return '';
+ }
+}
+
+###############################################
+###############################################
+
+=pod
+
+=item &bodytag()
+
+Returns a uniform header for LON-CAPA web pages.
+Inputs:
+
+ $title, A title to be displayed on the page.
+ $function, the current role (can be undef).
+ $addentries, extra parameters for the
tag.
+ $bodyonly, if defined, only return the tag.
+ $domain, if defined, force a given domain.
+
+Returns: A uniform header for LON-CAPA web pages.
+If $bodyonly is nonzero, a string containing a tag will be returned.
+If $bodyonly is undef or zero, an html string containing a tag and
+other decorations will be returned.
+
+=cut
+
+###############################################
+###############################################
sub bodytag {
- my ($function,$title,$addentries)=@_;
+ my ($title,$function,$addentries,$bodyonly,$domain)=@_;
+ unless ($function) {
+ $function='student';
+ if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
+ $function='coordinator';
+ }
+ if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
+ $function='admin';
+ }
+ if (($ENV{'request.role'}=~/^(au|ca)/) ||
+ ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
+ $function='author';
+ }
+ }
my $img='';
my $pgbg='';
my $tabbg='';
@@ -1214,51 +1262,70 @@ sub bodytag {
$img='coordinator';
$pgbg='#CCFFFF';
$tabbg='#CCCCFF';
- $font='#000033';
+ $font='#000044';
$link='#003333';
$vlink='#006633';
} elsif ($function eq 'author') {
$img='author';
$pgbg='#CCFFFF';
$tabbg='#CCFFCC';
- $font='#003300';
+ $font='#004400';
$link='#003333';
$vlink='#006666';
} else {
$img='student';
- $pgbg='#FFFF99';
+ $pgbg='#FFFFAA';
$tabbg='#FF9900';
$font='#991100';
$link='#993300';
$vlink='#996600';
}
- my $role=&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
+# role and realm
+ my ($role,$realm)
+ =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
+# realm
if ($ENV{'request.course.id'}) {
- $role.=' '.$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
+ $realm=
+ $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
}
- return(<
-
ENDBODY
+ }
}
###############################################
@@ -1345,6 +1412,8 @@ sub upfile_store {
return $datatoken;
}
+=pod
+
=item load_tmp_file($r)
Load uploaded file from tmp, $r should be the HTTP Request object,
@@ -1366,6 +1435,8 @@ sub load_tmp_file {
$ENV{'form.upfile'}=join('',@studentdata);
}
+=pod
+
=item upfile_record_sep()
Separate uploaded file into records
@@ -1381,6 +1452,8 @@ sub upfile_record_sep {
}
}
+=pod
+
=item record_sep($record)
Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}
@@ -1431,6 +1504,8 @@ sub record_sep {
return %components;
}
+=pod
+
=item upfile_select_html()
return HTML code to select file and specify its type
@@ -1439,7 +1514,7 @@ return HTML code to select file and spec
sub upfile_select_html {
return (<<'ENDUPFORM');
-
+
Type: