--- loncom/interface/loncommon.pm 2002/08/07 15:39:58 1.49
+++ loncom/interface/loncommon.pm 2002/09/13 20:46:09 1.67
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.49 2002/08/07 15:39:58 ng Exp $
+# $Id: loncommon.pm,v 1.67 2002/09/13 20:46:09 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -80,7 +80,7 @@ package Apache::loncommon;
use strict;
use Apache::lonnet();
use GDBM_File;
-use POSIX qw(strftime);
+use POSIX qw(strftime mktime);
use Apache::Constants qw(:common);
use Apache::lonmsg();
my $readit;
@@ -98,6 +98,10 @@ my %cprtag;
my %fe; my %fd;
my %category_extensions;
+# ---------------------------------------------- Designs
+
+my %designhash;
+
# ---------------------------------------------- Thesaurus variables
=pod
@@ -166,6 +170,30 @@ BEGIN {
}
}
}
+
+# -------------------------------------------------------------- domain designs
+
+ my $filename;
+ my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
+ opendir(DIR,$designdir);
+ while ($filename=readdir(DIR)) {
+ my ($domain)=($filename=~/^(\w+)\./);
+ {
+ my $fh=Apache::File->new($designdir.'/'.$filename);
+ if ($fh) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$val)=(split(/\=/,$_));
+ if ($val) { $designhash{$domain.'.'.$key}=$val; }
+ }
+ }
+ }
+
+ }
+ closedir(DIR);
+
+
# ------------------------------------------------------------- file categories
{
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
@@ -242,7 +270,7 @@ of the element the selection from the se
###############################################################
sub browser_and_searcher_javascript {
return <<END;
- var editbrowser;
+ var editbrowser = null;
function openbrowser(formname,elementname,only,omit) {
var url = '/res/?';
if (editbrowser == null) {
@@ -480,7 +508,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 +586,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 +595,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 +620,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 +763,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 +779,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 +799,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 +817,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 +835,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 +874,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 +915,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 +931,6 @@ Uses global $thesaurus_db_file.
=cut
###############################################################
-
sub get_related_words {
my $keyword = shift;
my %thesaurus_db;
@@ -957,7 +940,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=();
@@ -977,6 +960,71 @@ 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);
+ my $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
+ $names{'lastname'}.' '.$names{'generation'};
+ $name=~s/\s+$//;
+ $name=~s/\s+/ /g;
+ return $name;
+}
+
+# -------------------------------------------------------------------- Nickname
+
+
+sub nickname {
+ my ($uname,$udom)=@_;
+ my %names=&Apache::lonnet::get('environment',
+ ['nickname','firstname','middlename','lastname','generation'],$udom,$uname);
+ my $name=&Apache::lonnet::unescape($names{'nickname'});
+ if ($name) {
+ $name='"'.$name.'"';
+ } else {
+ $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
+ $names{'lastname'}.' '.$names{'generation'};
+ $name=~s/\s+$//;
+ $name=~s/\s+/ /g;
+ }
+ return $name;
+}
+
+
+# ------------------------------------------------------------------ Screenname
+
+sub screenname {
+ my ($uname,$udom)=@_;
+ my %names=
+ &Apache::lonnet::get('environment',['screenname'],$udom,$uname);
+ return &Apache::lonnet::unescape($names{'screenname'});
+}
+
+# ------------------------------------------------------------- Message Wrapper
+
+sub messagewrapper {
+ my ($link,$un,$do)=@_;
+ return
+"<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";
+}
+# ------------------------------------------------------------- Aboutme Wrapper
+
+sub aboutmewrapper {
+ my ($link,$un,$do)=@_;
+ return "<a href='/adm/$do/$un/aboutme'>$link</a>";
+}
+
+# ------------------------------------------------------------ Syllabus Wrapper
+
+
+sub syllabuswrapper {
+ my ($link,$un,$do)=@_;
+ return "<a href='/public/$do/$un/syllabus'>$link</a>";
+}
+
# ---------------------------------------------------------------- Language IDs
sub languageids {
return sort(keys(%language));
@@ -1106,7 +1154,7 @@ sub get_previous_attempt {
}
sub get_student_view {
- my ($symb,$username,$domain,$courseid) = @_;
+ my ($symb,$username,$domain,$courseid,$target) = @_;
my ($map,$id,$feedurl) = split(/___/,$symb);
my (%old,%moreenv);
my @elements=('symb','courseid','domain','username');
@@ -1114,6 +1162,7 @@ sub get_student_view {
$old{$element}=$ENV{'form.grade_'.$element};
$moreenv{'form.grade_'.$element}=eval '$'.$element #'
}
+ if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';}
&Apache::lonnet::appenv(%moreenv);
my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
&Apache::lonnet::delenv('form.grade_');
@@ -1151,6 +1200,217 @@ sub get_student_answers {
###############################################
+
+sub timehash {
+ my @ltime=localtime(shift);
+ return ( 'seconds' => $ltime[0],
+ 'minutes' => $ltime[1],
+ 'hours' => $ltime[2],
+ 'day' => $ltime[3],
+ 'month' => $ltime[4]+1,
+ 'year' => $ltime[5]+1900,
+ 'weekday' => $ltime[6],
+ 'dayyear' => $ltime[7]+1,
+ 'dlsav' => $ltime[8] );
+}
+
+sub maketime {
+ my %th=@_;
+ return POSIX::mktime(
+ ($th{'seconds'},$th{'minutes'},$th{'hours'},
+ $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));
+}
+
+
+sub findallcourses {
+ my %courses=();
+ my $now=time;
+ foreach (keys %ENV) {
+ if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {
+ my ($starttime,$endtime)=$ENV{$_};
+ my $active=1;
+ if ($starttime) {
+ if ($now<$starttime) { $active=0; }
+ }
+ if ($endtime) {
+ if ($now>$endtime) { $active=0; }
+ }
+ if ($active) { $courses{$1.'_'.$2}=1; }
+ }
+ }
+ return keys %courses;
+}
+
+###############################################
+###############################################
+
+=pod
+
+=item &determinedomain()
+
+Inputs: $domain (usually will be undef)
+
+Returns: Determines which domain should be used for designs
+
+=cut
+
+###############################################
+sub determinedomain {
+ my $domain=shift;
+ 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'};
+ }
+ }
+ return $domain;
+}
+###############################################
+=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 = &determinedomain(shift);
+ # See if there is a logo
+ if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
+ return '<img src="/adm/lonDomLogos/'.$domain.'.gif" />';
+ } elsif(exists($Apache::lonnet::domaindescription{$domain})) {
+ return $Apache::lonnet::domaindescription{$domain};
+ } else {
+ return '';
+ }
+}
+##############################################
+
+=pod
+
+=item &designparm()
+
+Inputs: $which parameter; $domain (usually will be undef)
+
+Returns: value of designparamter $which
+
+=cut
+##############################################
+sub designparm {
+ my ($which,$domain)=@_;
+ $domain=&determinedomain($domain);
+ if ($designhash{$domain.'.'.$which}) {
+ return $designhash{$domain.'.'.$which};
+ } else {
+ return $designhash{'default.'.$which};
+ }
+}
+
+###############################################
+###############################################
+
+=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 <body> tag.
+ $bodyonly, if defined, only return the <body> 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 <body> tag will be returned.
+If $bodyonly is undef or zero, an html string containing a <body> tag and
+other decorations will be returned.
+
+=cut
+
+###############################################
+
+
+###############################################
+sub bodytag {
+ 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=&designparm($function.'.img',$domain);
+ my $pgbg=&designparm($function.'.pgbg',$domain);
+ my $tabbg=&designparm($function.'.tabbg',$domain);
+ my $font=&designparm($function.'.font',$domain);
+ my $link=&designparm($function.'.link',$domain);
+ my $alink=&designparm($function.'.alink',$domain);
+ my $vlink=&designparm($function.'.vlink',$domain);
+ my $sidebg=&designparm($function.'.sidebg',$domain);
+
+ # 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=&domainlogo($domain);
+# Output
+ my $bodytag = <<END;
+<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
+$addentries>
+END
+ if ($bodyonly) {
+ return $bodytag;
+ } else {
+ return(<<ENDBODY);
+$bodytag
+<table width="100%" cellspacing="0" border="0" cellpadding="0">
+<tr><td bgcolor="$font">
+<img src="$img" /></td>
+<td bgcolor="$font"><font color='$sidebg'>$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 {
@@ -1236,6 +1496,8 @@ sub upfile_store {
return $datatoken;
}
+=pod
+
=item load_tmp_file($r)
Load uploaded file from tmp, $r should be the HTTP Request object,
@@ -1257,6 +1519,8 @@ sub load_tmp_file {
$ENV{'form.upfile'}=join('',@studentdata);
}
+=pod
+
=item upfile_record_sep()
Separate uploaded file into records
@@ -1272,6 +1536,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'}
@@ -1322,6 +1588,8 @@ sub record_sep {
return %components;
}
+=pod
+
=item upfile_select_html()
return HTML code to select file and specify its type
@@ -1330,7 +1598,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>
@@ -1340,6 +1608,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
@@ -1370,6 +1640,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.
@@ -1402,6 +1674,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.
@@ -1527,7 +1801,7 @@ will result in $ENV{'form.uname'} and $E
returns cache-controlling header code
-=item nocache()
+=item no_cache($r)
specifies header code to not have cache