--- loncom/interface/loncommon.pm 2002/08/08 13:43:04 1.51
+++ loncom/interface/loncommon.pm 2002/08/22 21:05:25 1.58
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.51 2002/08/08 13:43:04 www Exp $
+# $Id: loncommon.pm,v 1.58 2002/08/22 21:05:25 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -480,7 +480,7 @@ sub help_open_topic {
# 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
return $template;
@@ -558,7 +558,7 @@ sub select_dom_form {
=pod
-=item get_home_servers($domain)
+=item get_library_servers($domain)
Returns a hash which contains keys like '103l3' and values like
'kirk.lite.msu.edu'. All of the keys will be for machines in the
@@ -567,15 +567,15 @@ given $domain.
=cut
#-------------------------------------------
-sub get_home_servers {
+sub get_library_servers {
my $domain = shift;
- my %home_servers;
+ my %library_servers;
foreach (keys(%Apache::lonnet::libserv)) {
if ($Apache::lonnet::hostdom{$_} eq $domain) {
- $home_servers{$_} = $Apache::lonnet::hostname{$_};
+ $library_servers{$_} = $Apache::lonnet::hostname{$_};
}
}
- return %home_servers;
+ return %library_servers;
}
#-------------------------------------------
@@ -592,7 +592,7 @@ returns a string which contains an <opti
#-------------------------------------------
sub home_server_option_list {
my $domain = shift;
- my %servers = &get_home_servers($domain);
+ my %servers = &get_library_servers($domain);
my $result = '';
foreach (sort keys(%servers)) {
$result.=
@@ -735,7 +735,7 @@ sub authform_nochange{
my $result='';
$result.=<<"END";
<input type="radio" name="login" value="nochange" checked="checked"
- onclick="javascript:changed_radio('nochange',$in{'formname'});">
+ onclick="javascript:changed_radio('nochange',$in{'formname'});" />
Do not change login data
END
return $result;
@@ -751,10 +751,12 @@ sub authform_kerberos{
$result.=<<"END";
<input type="radio" name="login" value="krb"
onclick="javascript:changed_radio('krb',$in{'formname'});"
- onchange="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=""
- onchange="javascript:changed_text('krb',$in{'formname'});">
+ 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
END
return $result;
}
@@ -769,10 +771,10 @@ sub authform_internal{
$result.=<<"END";
<input type="radio" name="login" value="int"
onchange="javascript:changed_radio('int',$args{'formname'});"
- onclick="javascript:changed_radio('int',$args{'formname'});">
+ 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;
}
@@ -787,10 +789,10 @@ sub authform_local{
$result.=<<"END";
<input type="radio" name="login" value="loc"
onchange="javascript:changed_radio('loc',$in{'formname'});"
- onclick="javascript:changed_radio('loc',$in{'formname'});">
+ onclick="javascript:changed_radio('loc',$in{'formname'});" />
Local Authentication with argument
<input type="text" size="10" name="locarg" value=""
- onchange="javascript:changed_text('loc',$in{'formname'});">
+ onchange="javascript:changed_text('loc',$in{'formname'});" />
END
return $result;
}
@@ -805,7 +807,7 @@ sub authform_filesystem{
$result.=<<"END";
<input type="radio" name="login" value="fsys"
onchange="javascript:changed_radio('fsys',$in{'formname'});"
- onclick="javascript:changed_radio('fsys',$in{'formname'});">
+ 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'});">
@@ -844,7 +846,7 @@ sub initialize_keywords {
# Set up the hash as a database
my %thesaurus_db;
if (! tie(%thesaurus_db,'GDBM_File',
- $thesaurus_db_file,&GDBM_READER,0640)){
+ $thesaurus_db_file,&GDBM_READER(),0640)){
&Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
$thesaurus_db_file);
return 0;
@@ -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;
@@ -957,7 +912,7 @@ sub get_related_words {
return ();
}
if (! tie(%thesaurus_db,'GDBM_File',
- $thesaurus_db_file,&GDBM_READER,0640)){
+ $thesaurus_db_file,&GDBM_READER(),0640)){
return ();
}
my @Words=();
@@ -1194,6 +1149,99 @@ sub findallcourses {
###############################################
+sub bodytag {
+ my ($title,$function,$addentries)=@_;
+ 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='';
+ my $font='';
+ my $link='';
+ my $alink='#CC0000';
+ my $vlink='';
+ if ($function eq 'admin') {
+ $img='admin';
+ $pgbg='#FFFFCC';
+ $tabbg='#CCCC99';
+ $font='#772200';
+ $link='#663300';
+ $vlink='#666600';
+ } elsif ($function eq 'coordinator') {
+ $img='coordinator';
+ $pgbg='#CCFFFF';
+ $tabbg='#CCCCFF';
+ $font='#000044';
+ $link='#003333';
+ $vlink='#006633';
+ } elsif ($function eq 'author') {
+ $img='author';
+ $pgbg='#CCFFFF';
+ $tabbg='#CCFFCC';
+ $font='#004400';
+ $link='#003333';
+ $vlink='#006666';
+ } else {
+ $img='student';
+ $pgbg='#FFFFAA';
+ $tabbg='#FF9900';
+ $font='#991100';
+ $link='#993300';
+ $vlink='#996600';
+ }
+# role and realm
+ my ($role,$realm)
+ =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
+# realm
+ if ($ENV{'request.course.id'}) {
+ $realm=
+ $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
+ }
+ unless ($realm) { $realm=' '; }
+# Set messages
+ my $messages=localtime();
+# Output
+ return(<<ENDBODY);
+<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
+$addentries>
+<table width="100%" cellspacing="0" border="0" cellpadding="0">
+<tr><td bgcolor="$font">
+<img src="/adm/lonInterFace/$img.jpg" /></td>
+<td bgcolor="$font"><font color='$pgbg'>$messages</font></td>
+</tr>
+<tr>
+<td rowspan="3" bgcolor="$tabbg">
+ <font size="5"><b>$title</b></font>
+<td bgcolor="$tabbg" align="right">
+<font size="2">
+ $ENV{'environment.firstname'}
+ $ENV{'environment.middlename'}
+ $ENV{'environment.lastname'}
+ $ENV{'environment.generation'}
+ </font>
+</td>
+</tr>
+<tr><td bgcolor="$tabbg" align="right">
+<font size="2">$role</font>
+</td></tr>
+<tr>
+<td bgcolor="$tabbg" align="right"><font size="2">$realm</font> </td></tr>
+</table><br>
+ENDBODY
+}
+###############################################
+
sub get_unprocessed_cgi {
my ($query,$possible_names)= @_;
# $Apache::lonxml::debug=1;
@@ -1277,6 +1325,8 @@ sub upfile_store {
return $datatoken;
}
+=pod
+
=item load_tmp_file($r)
Load uploaded file from tmp, $r should be the HTTP Request object,
@@ -1298,6 +1348,8 @@ sub load_tmp_file {
$ENV{'form.upfile'}=join('',@studentdata);
}
+=pod
+
=item upfile_record_sep()
Separate uploaded file into records
@@ -1313,6 +1365,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'}
@@ -1363,6 +1417,8 @@ sub record_sep {
return %components;
}
+=pod
+
=item upfile_select_html()
return HTML code to select file and specify its type
@@ -1371,7 +1427,7 @@ return HTML code to select file and spec
sub upfile_select_html {
return (<<'ENDUPFORM');
-<input type="file" name="upfile" size="50">
+<input type="file" name="upfile" size="50" />
<br />Type: <select name="upfiletype">
<option value="csv">CSV (comma separated values, spreadsheet)</option>
<option value="space">Space separated</option>
@@ -1381,6 +1437,8 @@ sub upfile_select_html {
ENDUPFORM
}
+=pod
+
=item csv_print_samples($r,$records)
Prints a table of sample values from each column uploaded $r is an
@@ -1411,6 +1469,8 @@ sub csv_print_samples {
$r->print('</tr></table><br />'."\n");
}
+=pod
+
=item csv_print_select_table($r,$records,$d)
Prints a table to create associations between values and table columns.
@@ -1443,6 +1503,8 @@ sub csv_print_select_table {
return $i;
}
+=pod
+
=item csv_samples_select_table($r,$records,$d)
Prints a table of sample values from the upload and can make associate samples to internal names.