--- loncom/interface/loncommon.pm 2003/08/20 18:18:45 1.112
+++ loncom/interface/loncommon.pm 2004/01/13 18:54:07 1.159.2.1
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.112 2003/08/20 18:18:45 bowersj2 Exp $
+# $Id: loncommon.pm,v 1.159.2.1 2004/01/13 18:54:07 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,13 +25,6 @@
#
# http://www.lon-capa.org/
#
-# YEAR=2001
-# 2/13-12/7 Guy Albertelli
-# 12/21 Gerd Kortemeyer
-# 12/25,12/28 Gerd Kortemeyer
-# YEAR=2002
-# 1/4 Gerd Kortemeyer
-# 6/24,7/2 H. K. Ng
# Makes a table out of the previous attempts
# Inputs result_from_symbread, user, domain, course_id
@@ -68,16 +61,18 @@ use POSIX qw(strftime mktime);
use Apache::Constants qw(:common :http :methods);
use Apache::lonmsg();
use Apache::lonmenu();
-my $readit;
-
-=pod
+use Apache::lonlocal;
+use HTML::Entities;
-=head1 Global Variables
+my $readit;
-=cut
+##
+## Global Variables
+##
# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;
+my %supported_language;
my %cprtag;
my %fe; my %fd;
my %category_extensions;
@@ -87,50 +82,19 @@ my %category_extensions;
my %designhash;
# ---------------------------------------------- Thesaurus variables
-
-# FIXME: I don't think it's necessary to document these things;
-# they're privately used - Jeremy
-
-=pod
-
-=over 4
-
-=item * %Keywords
-
-A hash used by &keyword to determine if a word is considered a keyword.
-
-=item * $thesaurus_db_file
-
-Scalar containing the full path to the thesaurus database.
-
-=back
-
-=cut
+#
+# %Keywords:
+# A hash used by &keyword to determine if a word is considered a keyword.
+# $thesaurus_db_file
+# Scalar containing the full path to the thesaurus database.
my %Keywords;
my $thesaurus_db_file;
-# ----------------------------------------------------------------------- BEGIN
-
-# FIXME: I don't think this needs to be documented, it prepares
-# private data structures - Jeremy
-=pod
-
-=head1 General Subroutines
-
-=over 4
-
-=item * BEGIN()
-
-Initialize values from language.tab, copyright.tab, filetypes.tab,
-thesaurus.tab, and filecategories.tab.
-
-=back
-
-=cut
-
-# ----------------------------------------------------------------------- BEGIN
-
+#
+# Initialize values from language.tab, copyright.tab, filetypes.tab,
+# thesaurus.tab, and filecategories.tab.
+#
BEGIN {
# Variable initialization
$thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
@@ -138,29 +102,34 @@ BEGIN {
unless ($readit) {
# ------------------------------------------------------------------- languages
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
- '/language.tab');
- if ($fh) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($key,$two,$country,$three,$enc,$val)=(split(/\t/,$_));
- $language{$key}=$val.' - '.$enc;
- }
- }
+ my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/language.tab';
+ if ( open(my $fh,"<$langtabfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));
+ $language{$key}=$val.' - '.$enc;
+ if ($sup) {
+ $supported_language{$key}=$sup;
+ }
+ }
+ close($fh);
+ }
}
# ------------------------------------------------------------------ copyrights
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
- '/copyright.tab');
- if ($fh) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($key,$val)=(split(/\s+/,$_,2));
- $cprtag{$key}=$val;
- }
- }
+ my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
+ '/copyright.tab';
+ if ( open (my $fh,"<$copyrightfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$val)=(split(/\s+/,$_,2));
+ $cprtag{$key}=$val;
+ }
+ close($fh);
+ }
}
# -------------------------------------------------------------- domain designs
@@ -171,15 +140,16 @@ BEGIN {
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; }
- }
- }
+ my $designfile = $designdir.'/'.$filename;
+ if ( open (my $fh,"<$designfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$val)=(split(/\=/,$_));
+ if ($val) { $designhash{$domain.'.'.$key}=$val; }
+ }
+ close($fh);
+ }
}
}
@@ -188,32 +158,35 @@ BEGIN {
# ------------------------------------------------------------- file categories
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
- '/filecategories.tab');
- if ($fh) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($extension,$category)=(split(/\s+/,$_,2));
- push @{$category_extensions{lc($category)}},$extension;
- }
- }
+ my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/filecategories.tab';
+ if ( open (my $fh,"<$categoryfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($extension,$category)=(split(/\s+/,$_,2));
+ push @{$category_extensions{lc($category)}},$extension;
+ }
+ close($fh);
+ }
+
}
# ------------------------------------------------------------------ file types
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
- '/filetypes.tab');
- if ($fh) {
+ my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/filetypes.tab';
+ if ( open (my $fh,"<$typesfile") ) {
while (<$fh>) {
- next if (/^\#/);
- chomp;
- my ($ending,$emb,$descr)=split(/\s+/,$_,3);
- if ($descr ne '') {
- $fe{$ending}=lc($emb);
- $fd{$ending}=$descr;
- }
- }
- }
+ next if (/^\#/);
+ chomp;
+ my ($ending,$emb,$descr)=split(/\s+/,$_,3);
+ if ($descr ne '') {
+ $fe{$ending}=lc($emb);
+ $fd{$ending}=$descr;
+ }
+ }
+ close($fh);
+ }
}
&Apache::lonnet::logthis(
"<font color=yellow>INFO: Read file types</font>");
@@ -239,8 +212,6 @@ containing javascript with two functions
C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
tags.
-=over 4
-
=item * openbrowser(formname,elementname,only,omit) [javascript]
inputs: formname, elementname, only, omit
@@ -261,14 +232,12 @@ Inputs: formname, elementname
formname and elementname specify the name of the html form and the name
of the element the selection from the search results will be placed in.
-=back
-
=cut
sub browser_and_searcher_javascript {
return <<END;
var editbrowser = null;
- function openbrowser(formname,elementname,only,omit) {
+ function openbrowser(formname,elementname,only,omit,titleelement) {
var url = '/res/?';
if (editbrowser == null) {
url += 'launch=1&';
@@ -282,6 +251,9 @@ sub browser_and_searcher_javascript {
if (omit != null) {
url += 'omit=' + omit + '&';
}
+ if (titleelement != null) {
+ url += 'titleelement=' + titleelement + '&';
+ }
url += 'element=' + elementname + '';
var title = 'Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';
@@ -290,7 +262,7 @@ sub browser_and_searcher_javascript {
editbrowser.focus();
}
var editsearcher;
- function opensearcher(formname,elementname) {
+ function opensearcher(formname,elementname,titleelement) {
var url = '/adm/searchcat?';
if (editsearcher == null) {
url += 'launch=1&';
@@ -298,6 +270,9 @@ sub browser_and_searcher_javascript {
url += 'catalogmode=interactive&';
url += 'mode=edit&';
url += 'form=' + formname + '&';
+ if (titleelement != null) {
+ url += 'titleelement=' + titleelement + '&';
+ }
url += 'element=' + elementname + '';
var title = 'Search';
var options = 'scrollbars=1,resizable=1,menubar=0';
@@ -346,17 +321,18 @@ sub selectstudent_link {
return '';
}
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
- '","'.$udomele.'");'."'>Select User</a>";
+ '","'.$udomele.'");'."'>".&mt('Select User')."</a>";
}
if ($ENV{'request.role'}=~/^(au|dc|su)/) {
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
- '","'.$udomele.'",1);'."'>Select User</a>";
+ '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
}
return '';
}
sub coursebrowser_javascript {
- return (<<'ENDSTDBRW');
+ my ($domainfilter)=@_;
+ return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >
var stdeditbrowser;
function opencrsbrowser(formname,uname,udom) {
@@ -367,6 +343,12 @@ sub coursebrowser_javascript {
url += 'filter='+filter+'&';
}
}
+ var domainfilter='$domainfilter';
+ if (domainfilter != null) {
+ if (domainfilter != '') {
+ url += 'domainfilter='+domainfilter+'&';
+ }
+ }
url += 'form=' + formname + '&cnumelement='+uname+
'&cdomelement='+udom;
var title = 'Course_Browser';
@@ -382,7 +364,7 @@ ENDSTDBRW
sub selectcourse_link {
my ($form,$unameele,$udomele)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
- '","'.$udomele.'");'."'>Select Course</a>";
+ '","'.$udomele.'");'."'>".&mt('Select Course')."</a>";
}
=pod
@@ -501,6 +483,7 @@ function select1_changed() {
// in with the nuclear
for (i=0;i<values.length; i++) {
$second.options[i] = new Option(values[i]);
+ $second.options[i].value = values[i];
$second.options[i].text = texts[i];
if (values[i] == select2def) {
$second.options[i].selected = true;
@@ -514,7 +497,7 @@ END
foreach my $value (sort(keys(%$hashref))) {
$result.=" <option value=\"$value\" ";
$result.=" selected=\"true\" " if ($value eq $firstdefault);
- $result.=">$hashref->{$value}->{'text'}</option>\n";
+ $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
}
$result .= "</select>\n";
my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
@@ -524,7 +507,7 @@ END
foreach my $value (sort(keys(%select2))) {
$result.=" <option value=\"$value\" ";
$result.=" selected=\"true\" " if ($value eq $seconddefault);
- $result.=">$select2{$value}</option>\n";
+ $result.=">".&mt($select2{$value})."</option>\n";
}
$result .= "</select>\n";
# return $debug;
@@ -571,6 +554,8 @@ sub help_open_topic {
my $template = "";
my $link;
+ $topic=~s/\W/\_/g;
+
if (!$stayOnPage)
{
$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
@@ -624,8 +609,6 @@ sub helpLatexCheatsheet {
Translate $text to allow it to be output as a 'comma seperated values'
format.
-=back
-
=cut
sub csv_translate {
@@ -635,6 +618,91 @@ sub csv_translate {
return $text;
}
+=pod
+
+=item * change_content_javascript():
+
+This and the next function allow you to create small sections of an
+otherwise static HTML page that you can update on the fly with
+Javascript, even in Netscape 4.
+
+The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
+must be written to the HTML page once. It will prove the Javascript
+function "change(name, content)". Calling the change function with the
+name of the section
+you want to update, matching the name passed to C<changable_area>, and
+the new content you want to put in there, will put the content into
+that area.
+
+B<Note>: Netscape 4 only reserves enough space for the changable area
+to contain room for the original contents. You need to "make space"
+for whatever changes you wish to make, and be B<sure> to check your
+code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
+it's adequate for updating a one-line status display, but little more.
+This script will set the space to 100% width, so you only need to
+worry about height in Netscape 4.
+
+Modern browsers are much less limiting, and if you can commit to the
+user not using Netscape 4, this feature may be used freely with
+pretty much any HTML.
+
+=cut
+
+sub change_content_javascript {
+ # If we're on Netscape 4, we need to use Layer-based code
+ if ($ENV{'browser.type'} eq 'netscape' &&
+ $ENV{'browser.version'} =~ /^4\./) {
+ return (<<NETSCAPE4);
+ function change(name, content) {
+ doc = document.layers[name+"___escape"].layers[0].document;
+ doc.open();
+ doc.write(content);
+ doc.close();
+ }
+NETSCAPE4
+ } else {
+ # Otherwise, we need to use semi-standards-compliant code
+ # (technically, "innerHTML" isn't standard but the equivalent
+ # is really scary, and every useful browser supports it
+ return (<<DOMBASED);
+ function change(name, content) {
+ element = document.getElementById(name);
+ element.innerHTML = content;
+ }
+DOMBASED
+ }
+}
+
+=pod
+
+=item * changable_area($name, $origContent):
+
+This provides a "changable area" that can be modified on the fly via
+the Javascript code provided in C<change_content_javascript>. $name is
+the name you will use to reference the area later; do not repeat the
+same name on a given HTML page more then once. $origContent is what
+the area will originally contain, which can be left blank.
+
+=cut
+
+sub changable_area {
+ my ($name, $origContent) = @_;
+
+ if ($ENV{'browser.type'} eq 'netscape' &&
+ $ENV{'browser.version'} =~ /^4\./) {
+ # If this is netscape 4, we need to use the Layer tag
+ return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
+ } else {
+ return "<span id='$name'>$origContent</span>";
+ }
+}
+
+=pod
+
+=back
+
+=cut
+
###############################################################
## Home server <option> list generating code ##
###############################################################
@@ -679,10 +747,16 @@ See lonrights.pm for an example invocati
sub select_form {
my ($def,$name,%hash) = @_;
my $selectform = "<select name=\"$name\" size=\"1\">\n";
- foreach (sort keys %hash) {
+ my @keys;
+ if (exists($hash{'select_form_order'})) {
+ @keys=@{$hash{'select_form_order'}};
+ } else {
+ @keys=sort(keys(%hash));
+ }
+ foreach (@keys) {
$selectform.="<option value=\"$_\" ".
($_ eq $def ? 'selected' : '').
- ">".$hash{$_}."</option>\n";
+ ">".&mt($hash{$_})."</option>\n";
}
$selectform.="</select>";
return $selectform;
@@ -804,6 +878,8 @@ Outputs:
=back
+=back
+
=cut
###############################################################
@@ -842,12 +918,6 @@ sub decode_user_agent {
$clientunicode,$clientos,);
}
-=pod
-
-=back
-
-=cut
-
###############################################################
## Authentication changing form generation subroutines ##
###############################################################
@@ -888,6 +958,8 @@ See loncreateuser.pm for invocation and
=back
+=back
+
=cut
#-------------------------------------------
@@ -978,10 +1050,10 @@ END
sub authform_authorwarning{
my $result='';
- $result=<<"END";
-<i>As a general rule, only authors or co-authors should be filesystem
-authenticated (which allows access to the server filesystem).</i>
-END
+ $result='<i>'.
+ &mt('As a general rule, only authors or co-authors should be '.
+ 'filesystem authenticated '.
+ '(which allows access to the server filesystem).')."</i>\n";
return $result;
}
@@ -991,12 +1063,10 @@ sub authform_nochange{
kerb_def_dom => 'MSU.EDU',
@_,
);
- my $result='';
- $result.=<<"END";
-<input type="radio" name="login" value="nochange" checked="checked"
- onclick="javascript:changed_radio('nochange',$in{'formname'});" />
-Do not change login data
-END
+ my $result = &mt('[_1] Do not change login data',
+ '<input type="radio" name="login" value="nochange" '.
+ 'checked="checked" onclick="'.
+ "javascript:changed_radio('nochange',$in{'formname'});".'" />');
return $result;
}
@@ -1007,24 +1077,23 @@ sub authform_kerberos{
kerb_def_auth => 'krb4',
@_,
);
- my $result='';
- my $check4;
- my $check5;
+ my ($check4,$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="$in{'kerb_def_dom'}"
- onchange="javascript:changed_text('krb',$in{'formname'});" />
-<input type="radio" name="krbver" value="4" $check4 />Version 4
-<input type="radio" name="krbver" value="5" $check5 />Version 5
-END
+ my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
+ my $result .= &mt
+ ('[_1] Kerberos authenticated with domain [_2] '.
+ '[_3] Version 4 [_4] Version 5',
+ '<input type="radio" name="login" value="krb" '.
+ 'onclick="'.$jscall.'" onchange="'.$jscall.'" />',
+ '<input type="text" size="10" name="krbarg" '.
+ 'value="'.$in{'kerb_def_dom'}.'" '.
+ 'onchange="'.$jscall.'" />',
+ '<input type="radio" name="krbver" value="4" '.$check4.' />',
+ '<input type="radio" name="krbver" value="5" '.$check5.' />');
return $result;
}
@@ -1034,15 +1103,13 @@ sub authform_internal{
kerb_def_dom => 'MSU.EDU',
@_,
);
- my $result='';
- $result.=<<"END";
-<input type="radio" name="login" value="int"
- onchange="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'});" />)
-END
+ my $jscall = "javascript:changed_radio('int',$args{'formname'});";
+ my $result.=&mt
+ ('[_1] Internally authenticated (with initial password [_2])',
+ '<input type="radio" name="login" value="int" '.
+ 'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
+ '<input type="text" size="10" name="intarg" value="" '.
+ 'onchange="'.$jscall.'" />');
return $result;
}
@@ -1052,15 +1119,12 @@ sub authform_local{
kerb_def_dom => 'MSU.EDU',
@_,
);
- my $result='';
- $result.=<<"END";
-<input type="radio" name="login" value="loc"
- onchange="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'});" />
-END
+ my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
+ my $result.=&mt('[_1] Local Authentication with arguement [_2]',
+ '<input type="radio" name="login" value="loc" '.
+ 'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
+ '<input type="text" size="10" name="locarg" value="" '.
+ 'onchange="'.$jscall.'" />');
return $result;
}
@@ -1070,24 +1134,16 @@ sub authform_filesystem{
kerb_def_dom => 'MSU.EDU',
@_,
);
- my $result='';
- $result.=<<"END";
-<input type="radio" name="login" value="fsys"
- onchange="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'});">)
-END
+ my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
+ my $result.= &mt
+ ('[_1] Filesystem Authenticated (with initial password [_2])',
+ '<input type="radio" name="login" value="fsys" '.
+ 'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
+ '<input type="text" size="10" name="fsysarg" value="" '.
+ 'onchange="'.$jscall.'" />');
return $result;
}
-=pod
-
-=back
-
-=cut
-
###############################################################
## Get Authentication Defaults for Domain ##
###############################################################
@@ -1420,7 +1476,20 @@ returns description of a specified langu
=cut
sub languagedescription {
- return $language{shift(@_)};
+ my $code=shift;
+ return ($supported_language{$code}?'* ':'').
+ $language{$code}.
+ ($supported_language{$code}?' ('.&mt('interface available').')':'');
+}
+
+sub plainlanguagedescription {
+ my $code=shift;
+ return $language{$code};
+}
+
+sub supportedlanguagecode {
+ my $code=shift;
+ return $supported_language{$code};
}
=pod
@@ -1528,16 +1597,8 @@ sub fileextensions {
sub display_languages {
my %languages=();
- if ($ENV{'environment.languages'}) {
- foreach (split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'})) {
- $languages{$_}=1;
- }
- }
- if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {
- foreach (split(/\s*(\,|\;|\:)\s*/,
- $ENV{'course.'.$ENV{'request.course.id'}.'.languages'})) {
- $languages{$_}=1;
- }
+ foreach (&preferred_languages()) {
+ $languages{$_}=1;
}
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
if ($ENV{'form.displaylanguage'}) {
@@ -1548,6 +1609,45 @@ sub display_languages {
return %languages;
}
+sub preferred_languages {
+ my @languages=();
+ if ($ENV{'environment.languages'}) {
+ @languages=split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'});
+ }
+ if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {
+ @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
+ $ENV{'course.'.$ENV{'request.course.id'}.'.languages'}));
+ }
+ my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];
+ if ($browser) {
+ @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));
+ }
+ if ($Apache::lonnet::domain_lang_def{$ENV{'user.domain'}}) {
+ @languages=(@languages,
+ $Apache::lonnet::domain_lang_def{$ENV{'user.domain'}});
+ }
+ if ($Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}}) {
+ @languages=(@languages,
+ $Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}});
+ }
+ if ($Apache::lonnet::domain_lang_def{
+ $Apache::lonnet::perlvar{'lonDefDomain'}}) {
+ @languages=(@languages,
+ $Apache::lonnet::domain_lang_def{
+ $Apache::lonnet::perlvar{'lonDefDomain'}});
+ }
+# turn "en-ca" into "en-ca,en"
+ my @genlanguages;
+ foreach (@languages) {
+ unless ($_=~/\w/) { next; }
+ push (@genlanguages,$_);
+ if ($_=~/(\-|\_)/) {
+ push (@genlanguages,(split(/(\-|\_)/,$_))[0]);
+ }
+ }
+ return @genlanguages;
+}
+
###############################################################
## Student Answer Attempts ##
###############################################################
@@ -1628,7 +1728,7 @@ sub get_previous_attempt {
} else {
$value=$returnhash{$version.':'.$_};
}
- $prevattempts.='<td>'.$value.' </td>';
+ $prevattempts.='<td>'.&Apache::lonnet::unescape($value).' </td>';
}
}
}
@@ -1640,6 +1740,7 @@ sub get_previous_attempt {
} else {
$value=$lasthash{$_};
}
+ $value=&Apache::lonnet::unescape($value);
if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
$prevattempts.='<td>'.$value.' </td>';
}
@@ -1697,7 +1798,7 @@ show a snapshot of what student was look
sub get_student_view {
my ($symb,$username,$domain,$courseid,$target) = @_;
- my ($map,$id,$feedurl) = split(/___/,$symb);
+ my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
my (%old,%moreenv);
my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {
@@ -1733,7 +1834,7 @@ show a snapshot of how student was answe
sub get_student_answers {
my ($symb,$username,$domain,$courseid,%form) = @_;
- my ($map,$id,$feedurl) = split(/___/,$symb);
+ my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
my (%old,%moreenv);
my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {
@@ -1752,6 +1853,30 @@ sub get_student_answers {
=pod
+=item * &submlink()
+
+Inputs: $text $uname $udom $symb
+
+Returns: A link to grades.pm such as to see the SUBM view of a student
+
+=cut
+
+###############################################
+sub submlink {
+ my ($text,$uname,$udom,$symb)=@_;
+ if (!($uname && $udom)) {
+ (my $cursymb, my $courseid,$udom,$uname)=
+ &Apache::lonxml::whichuser($symb);
+ if (!$symb) { $symb=$cursymb; }
+ }
+ if (!$symb) { $symb=&symbread(); }
+ return '<a href="/adm/grades?symb='.$symb.'&student='.$uname.
+ '&userdom='.$udom.'&command=submission">'.$text.'</a>';
+}
+##############################################
+
+=pod
+
=back
=cut
@@ -1865,7 +1990,7 @@ sub domainlogo {
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
- '/adm/lonDomLogos/'.$domain.'.gif" />';
+ '/adm/lonDomLogos/'.$domain.'.gif" alt="'.$domain.'" />';
} elsif(exists($Apache::lonnet::domaindescription{$domain})) {
return $Apache::lonnet::domaindescription{$domain};
} else {
@@ -1952,6 +2077,7 @@ other decorations will be returned.
sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;
+ $title=&mt($title);
unless ($function) {
$function='student';
if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
@@ -1975,8 +2101,9 @@ sub bodytag {
my $sidebg=&designparm($function.'.sidebg',$domain);
# Accessibility font enhance
unless ($addentries) { $addentries=''; }
+ my $addstyle='';
if ($ENV{'browser.fontenhance'} eq 'on') {
- $addentries.=' style="font-size: x-large"';
+ $addstyle=' font-size: x-large;';
}
# role and realm
my ($role,$realm)
@@ -1994,11 +2121,15 @@ sub bodytag {
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
# construct main body tag
my $bodytag = <<END;
+<style>
+h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
+a:focus { color: red; background: yellow }
+</style>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
-$addentries>
+style="margin-top: 0px;$addstyle" $addentries>
END
my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
- $lonhttpdPort.$img.'" />';
+ $lonhttpdPort.$img.'" alt="'.$function.'" />';
if ($bodyonly) {
return $bodytag;
} elsif ($ENV{'browser.interface'} eq 'textual') {
@@ -2010,7 +2141,7 @@ END
# No Remote
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
$forcereg).
- '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font size="+3" color="'.$font.'"><b>'.$title.
+ '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font face="Arial, Helvetica, sans-serif" size="+3" color="'.$font.'"><b>'.$title.
'</b></font></td></tr></table>';
}
@@ -2026,9 +2157,9 @@ $upperleft</td>
</tr>
<tr>
<td rowspan="3" bgcolor="$tabbg">
- <font size="5"><b>$title</b></font>
-<td bgcolor="$tabbg" align="right">
-<font size="2">
+ <font size="5" face="Arial, Helvetica, sans-serif"><b>$title</b></font>
+<td bgcolor="$tabbg" align="right">
+<font size="2" face="Arial, Helvetica, sans-serif">
$ENV{'environment.firstname'}
$ENV{'environment.middlename'}
$ENV{'environment.lastname'}
@@ -2037,10 +2168,10 @@ $upperleft</td>
</td>
</tr>
<tr><td bgcolor="$tabbg" align="right">
-<font size="2">$role</font>
+<font size="2" face="Arial, Helvetica, sans-serif">$role</font>
</td></tr>
<tr>
-<td bgcolor="$tabbg" align="right"><font size="2">$realm</font> </td></tr>
+<td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font> </td></tr>
</table><br>
ENDBODY
}
@@ -2180,6 +2311,14 @@ sub no_cache {
#$r->header_out("Expires" => $date);
}
+sub content_type {
+ my ($r,$type,$charset) = @_;
+ unless ($charset) {
+ $charset=&Apache::lonlocal::current_encoding;
+ }
+ $r->content_type($type.($charset?'; charset='.$charset:''));
+}
+
=pod
=item * add_to_env($name,$value)
@@ -2209,6 +2348,32 @@ sub add_to_env {
=pod
+=item * get_env_multiple($name)
+
+gets $name from the %ENV hash, it seemlessly handles the cases where multiple
+values may be defined and end up as an array ref.
+
+returns an array of values
+
+=cut
+
+sub get_env_multiple {
+ my ($name) = @_;
+ my @values;
+ if (defined($ENV{$name})) {
+ # exists is it an array
+ if (ref($ENV{$name})) {
+ @values=@{ $ENV{$name} };
+ } else {
+ $values[0]=$ENV{$name};
+ }
+ }
+ return(@values);
+}
+
+
+=pod
+
=back
=head1 CSV Upload/Handling functions
@@ -2233,9 +2398,12 @@ sub upfile_store {
my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
{
- my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
- '/tmp/'.$datatoken.'.tmp');
- print $fh $ENV{'form.upfile'};
+ my $datafile = $r->dir_config('lonDaemons').
+ '/tmp/'.$datatoken.'.tmp';
+ if ( open(my $fh,">$datafile") ) {
+ print $fh $ENV{'form.upfile'};
+ close($fh);
+ }
}
return $datatoken;
}
@@ -2254,11 +2422,12 @@ sub load_tmp_file {
my $r=shift;
my @studentdata=();
{
- my $fh;
- if ($fh=Apache::File->new($r->dir_config('lonDaemons').
- '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {
- @studentdata=<$fh>;
- }
+ my $studentfile = $r->dir_config('lonDaemons').
+ '/tmp/'.$ENV{'form.datatoken'}.'.tmp';
+ if ( open(my $fh,"<$studentfile") ) {
+ @studentdata=<$fh>;
+ close($fh);
+ }
}
$ENV{'form.upfile'}=join('',@studentdata);
}
@@ -2303,7 +2472,7 @@ sub record_sep {
}
} elsif ($ENV{'form.upfiletype'} eq 'tab') {
my $i=0;
- foreach (split(/\t+/,$record)) {
+ foreach (split(/\t/,$record)) {
my $field=$_;
$field=~s/^(\"|\')//;
$field=~s/(\"|\')$//;
@@ -2332,26 +2501,39 @@ sub record_sep {
return %components;
}
+######################################################
+######################################################
+
=pod
=item * upfile_select_html()
-return HTML code to select file and specify its type
+Return HTML code to select a file from the users machine and specify
+the file type.
=cut
+######################################################
+######################################################
sub upfile_select_html {
- return (<<'ENDUPFORM');
-<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>
-<option value="tab">Tabulator separated</option>
-<option value="xml">HTML/XML</option>
-</select>
-ENDUPFORM
+ my %Types = (
+ csv => &mt('CSV (comma separated values, spreadsheet)'),
+ space => &mt('Space separated'),
+ tab => &mt('Tabulator separated'),
+# xml => &mt('HTML/XML'),
+ );
+ my $Str = '<input type="file" name="upfile" size="50" />'.
+ '<br />Type: <select name="upfiletype">';
+ foreach my $type (sort(keys(%Types))) {
+ $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
+ }
+ $Str .= "</select>\n";
+ return $Str;
}
+######################################################
+######################################################
+
=pod
=item * csv_print_samples($r,$records)
@@ -2362,15 +2544,18 @@ Apache Request ref, $records is an array
=cut
+######################################################
+######################################################
sub csv_print_samples {
my ($r,$records) = @_;
my (%sone,%stwo,%sthree);
%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
-
- $r->print('Samples<br /><table border="2"><tr>');
- foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column '.($_+1).'</th>'); }
+ #
+ $r->print(&mt('Samples').'<br /><table border="2"><tr>');
+ foreach (sort({$a <=> $b} keys(%sone))) {
+ $r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); }
$r->print('</tr>');
foreach my $hash (\%sone,\%stwo,\%sthree) {
$r->print('<tr>');
@@ -2384,23 +2569,31 @@ 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.
+
$r is an Apache Request ref,
$records is an arrayref from &Apache::loncommon::upfile_record_sep,
$d is an array of 2 element arrays (internal name, displayed name)
=cut
+######################################################
+######################################################
sub csv_print_select_table {
my ($r,$records,$d) = @_;
my $i=0;my %sone;
%sone=&record_sep($$records[0]);
- $r->print('Associate columns with student attributes.'."\n".
- '<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");
+ $r->print(&mt('Associate columns with student attributes.')."\n".
+ '<table border="2"><tr>'.
+ '<th>'.&mt('Attribute').'</th>'.
+ '<th>'.&mt('Column').'</th></tr>'."\n");
foreach (@$d) {
my ($value,$display)=@{ $_ };
$r->print('<tr><td>'.$display.'</td>');
@@ -2418,6 +2611,9 @@ sub csv_print_select_table {
return $i;
}
+######################################################
+######################################################
+
=pod
=item * csv_samples_select_table($r,$records,$d)
@@ -2430,22 +2626,25 @@ $d is an array of 2 element arrays (inte
=cut
+######################################################
+######################################################
sub csv_samples_select_table {
my ($r,$records,$d) = @_;
my %sone; my %stwo; my %sthree;
my $i=0;
-
- $r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>');
+ #
+ $r->print('<table border=2><tr><th>'.
+ &mt('Field').'</th><th>'.&mt('Samples').'</th></tr>');
%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
-
+ #
foreach (sort keys %sone) {
- $r->print('<tr><td><select name=f'.$i.
+ $r->print('<tr><td><select name="f'.$i.'"'.
' onchange="javascript:flip(this.form,'.$i.');">');
foreach (@$d) {
my ($value,$display)=@{ $_ };
- $r->print('<option value='.$value.'>'.$display.'</option>');
+ $r->print('<option value="'.$value.'">'.$display.'</option>');
}
$r->print('</select></td><td>');
if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
@@ -2458,6 +2657,28 @@ sub csv_samples_select_table {
return($i);
}
+######################################################
+######################################################
+
+=pod
+
+=item clean_excel_name($name)
+
+Returns a replacement for $name which does not contain any illegal characters.
+
+=cut
+
+######################################################
+######################################################
+sub clean_excel_name {
+ my ($name) = @_;
+ $name =~ s/[:\*\?\/\\]//g;
+ if (length($name) > 31) {
+ $name = substr($name,0,31);
+ }
+ return $name;
+}
+
=pod
=item * check_if_partid_hidden($id,$symb,$udom,$uname)
@@ -2477,15 +2698,529 @@ $uname, optional the username of the use
sub check_if_partid_hidden {
my ($id,$symb,$udom,$uname) = @_;
- my $hiddenparts=&Apache::lonnet::EXT('resource.0.parameter_hiddenparts',
+ my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
$symb,$udom,$uname);
+ my $truth=1;
+ #if the string starts with !, then the list is the list to show not hide
+ if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
my @hiddenlist=split(/,/,$hiddenparts);
foreach my $checkid (@hiddenlist) {
- if ($checkid =~ /^\s*\Q$id\E\s*$/) { return 1; }
+ if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
}
- return undef;
+ return !$truth;
}
+
+############################################################
+############################################################
+
+=pod
+
+=back
+
+=head1 cgi-bin script and graphing routines
+
+=over 4
+
+=item get_cgi_id
+
+Inputs: none
+
+Returns an id which can be used to pass environment variables
+to various cgi-bin scripts. These environment variables will
+be removed from the users environment after a given time by
+the routine &Apache::lonnet::transfer_profile_to_env.
+
+=cut
+
+############################################################
+############################################################
+my $uniq=0;
+sub get_cgi_id {
+ $uniq=($uniq+1)%100000;
+ return (time.'_'.$uniq);
+}
+
+############################################################
+############################################################
+
+=pod
+
+=item DrawBarGraph
+
+Facilitates the plotting of data in a (stacked) bar graph.
+Puts plot definition data into the users environment in order for
+graph.png to plot it. Returns an <img> tag for the plot.
+The bars on the plot are labeled '1','2',...,'n'.
+
+Inputs:
+
+=over 4
+
+=item $Title: string, the title of the plot
+
+=item $xlabel: string, text describing the X-axis of the plot
+
+=item $ylabel: string, text describing the Y-axis of the plot
+
+=item $Max: scalar, the maximum Y value to use in the plot
+If $Max is < any data point, the graph will not be rendered.
+
+=item $colors: array ref holding the colors to be used for the data sets when
+they are plotted. If undefined, default values will be used.
+
+=item @Values: An array of array references. Each array reference holds data
+to be plotted in a stacked bar chart.
+
+=back
+
+Returns:
+
+An <img> tag which references graph.png and the appropriate identifying
+information for the plot.
+
+=cut
+
+############################################################
+############################################################
+sub DrawBarGraph {
+ my ($Title,$xlabel,$ylabel,$Max,$colors,@Values)=@_;
+ #
+ if (! defined($colors)) {
+ $colors = ['#33ff00',
+ '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
+ '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
+ ];
+ }
+ #
+ my $identifier = &get_cgi_id();
+ my $id = 'cgi.'.$identifier;
+ if (! @Values || ref($Values[0]) ne 'ARRAY') {
+ return '';
+ }
+ my $NumBars = scalar(@{$Values[0]});
+ my %ValuesHash;
+ my $NumSets=1;
+ foreach my $array (@Values) {
+ next if (! ref($array));
+ $ValuesHash{$id.'.data.'.$NumSets++} =
+ join(',',@$array);
+ }
+ #
+ my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
+ if ($NumBars < 10) {
+ $width = 120+$NumBars*15;
+ $xskip = 1;
+ $bar_width = 15;
+ } elsif ($NumBars <= 25) {
+ $width = 120+$NumBars*11;
+ $xskip = 5;
+ $bar_width = 8;
+ } elsif ($NumBars <= 50) {
+ $width = 120+$NumBars*8;
+ $xskip = 5;
+ $bar_width = 4;
+ } else {
+ $width = 120+$NumBars*8;
+ $xskip = 5;
+ $bar_width = 4;
+ }
+ #
+ my @Labels;
+ for (my $i=0;$i<@{$Values[0]};$i++) {
+ push (@Labels,$i+1);
+ }
+ #
+ $Max = 1 if ($Max < 1);
+ if ( int($Max) < $Max ) {
+ $Max++;
+ $Max = int($Max);
+ }
+ $Title = '' if (! defined($Title));
+ $xlabel = '' if (! defined($xlabel));
+ $ylabel = '' if (! defined($ylabel));
+ $ValuesHash{$id.'.title'} = &Apache::lonnet::escape($Title);
+ $ValuesHash{$id.'.xlabel'} = &Apache::lonnet::escape($xlabel);
+ $ValuesHash{$id.'.ylabel'} = &Apache::lonnet::escape($ylabel);
+ $ValuesHash{$id.'.y_max_value'} = $Max;
+ $ValuesHash{$id.'.NumBars'} = $NumBars;
+ $ValuesHash{$id.'.NumSets'} = $NumSets;
+ $ValuesHash{$id.'.PlotType'} = 'bar';
+ $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
+ $ValuesHash{$id.'.height'} = $height;
+ $ValuesHash{$id.'.width'} = $width;
+ $ValuesHash{$id.'.xskip'} = $xskip;
+ $ValuesHash{$id.'.bar_width'} = $bar_width;
+ $ValuesHash{$id.'.labels'} = join(',',@Labels);
+ #
+ &Apache::lonnet::appenv(%ValuesHash);
+ return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
+}
+
+############################################################
+############################################################
+
+=pod
+
+=item DrawXYGraph
+
+Facilitates the plotting of data in an XY graph.
+Puts plot definition data into the users environment in order for
+graph.png to plot it. Returns an <img> tag for the plot.
+
+Inputs:
+
+=over 4
+
+=item $Title: string, the title of the plot
+
+=item $xlabel: string, text describing the X-axis of the plot
+
+=item $ylabel: string, text describing the Y-axis of the plot
+
+=item $Max: scalar, the maximum Y value to use in the plot
+If $Max is < any data point, the graph will not be rendered.
+
+=item $colors: Array ref containing the hex color codes for the data to be
+plotted in. If undefined, default values will be used.
+
+=item $Xlabels: Array ref containing the labels to be used for the X-axis.
+
+=item $Ydata: Array ref containing Array refs.
+Each of the contained arrays will be plotted as a seperate curve.
+
+=item %Values: hash indicating or overriding any default values which are
+passed to graph.png.
+Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
+
+=back
+
+Returns:
+
+An <img> tag which references graph.png and the appropriate identifying
+information for the plot.
+
+=cut
+
+############################################################
+############################################################
+sub DrawXYGraph {
+ my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
+ #
+ # Create the identifier for the graph
+ my $identifier = &get_cgi_id();
+ my $id = 'cgi.'.$identifier;
+ #
+ $Title = '' if (! defined($Title));
+ $xlabel = '' if (! defined($xlabel));
+ $ylabel = '' if (! defined($ylabel));
+ my %ValuesHash =
+ (
+ $id.'.title' => &Apache::lonnet::escape($Title),
+ $id.'.xlabel' => &Apache::lonnet::escape($xlabel),
+ $id.'.ylabel' => &Apache::lonnet::escape($ylabel),
+ $id.'.y_max_value'=> $Max,
+ $id.'.labels' => join(',',@$Xlabels),
+ $id.'.PlotType' => 'XY',
+ );
+ #
+ if (defined($colors) && ref($colors) eq 'ARRAY') {
+ $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
+ }
+ #
+ if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
+ return '';
+ }
+ my $NumSets=1;
+ foreach my $array (@{$Ydata}){
+ next if (! ref($array));
+ $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
+ }
+ $ValuesHash{$id.'.NumSets'} = $NumSets-1;
+ #
+ # Deal with other parameters
+ while (my ($key,$value) = each(%Values)) {
+ $ValuesHash{$id.'.'.$key} = $value;
+ }
+ #
+ &Apache::lonnet::appenv(%ValuesHash);
+ return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
+}
+
+############################################################
+############################################################
+
+=pod
+
+=item DrawXYYGraph
+
+Facilitates the plotting of data in an XY graph with two Y axes.
+Puts plot definition data into the users environment in order for
+graph.png to plot it. Returns an <img> tag for the plot.
+
+Inputs:
+
+=over 4
+
+=item $Title: string, the title of the plot
+
+=item $xlabel: string, text describing the X-axis of the plot
+
+=item $ylabel: string, text describing the Y-axis of the plot
+
+=item $colors: Array ref containing the hex color codes for the data to be
+plotted in. If undefined, default values will be used.
+
+=item $Xlabels: Array ref containing the labels to be used for the X-axis.
+
+=item $Ydata1: The first data set
+
+=item $Min1: The minimum value of the left Y-axis
+
+=item $Max1: The maximum value of the left Y-axis
+
+=item $Ydata2: The second data set
+
+=item $Min2: The minimum value of the right Y-axis
+
+=item $Max2: The maximum value of the left Y-axis
+
+=item %Values: hash indicating or overriding any default values which are
+passed to graph.png.
+Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
+
+=back
+
+Returns:
+
+An <img> tag which references graph.png and the appropriate identifying
+information for the plot.
+
+=cut
+
+############################################################
+############################################################
+sub DrawXYYGraph {
+ my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
+ $Ydata2,$Min2,$Max2,%Values)=@_;
+ #
+ # Create the identifier for the graph
+ my $identifier = &get_cgi_id();
+ my $id = 'cgi.'.$identifier;
+ #
+ $Title = '' if (! defined($Title));
+ $xlabel = '' if (! defined($xlabel));
+ $ylabel = '' if (! defined($ylabel));
+ my %ValuesHash =
+ (
+ $id.'.title' => &Apache::lonnet::escape($Title),
+ $id.'.xlabel' => &Apache::lonnet::escape($xlabel),
+ $id.'.ylabel' => &Apache::lonnet::escape($ylabel),
+ $id.'.labels' => join(',',@$Xlabels),
+ $id.'.PlotType' => 'XY',
+ $id.'.NumSets' => 2,
+ $id.'.two_axes' => 1,
+ $id.'.y1_max_value' => $Max1,
+ $id.'.y1_min_value' => $Min1,
+ $id.'.y2_max_value' => $Max2,
+ $id.'.y2_min_value' => $Min2,
+ );
+ #
+ if (defined($colors) && ref($colors) eq 'ARRAY') {
+ $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
+ }
+ #
+ if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
+ ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
+ return '';
+ }
+ my $NumSets=1;
+ foreach my $array ($Ydata1,$Ydata2){
+ next if (! ref($array));
+ $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
+ }
+ #
+ # Deal with other parameters
+ while (my ($key,$value) = each(%Values)) {
+ $ValuesHash{$id.'.'.$key} = $value;
+ }
+ #
+ &Apache::lonnet::appenv(%ValuesHash);
+ return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
+}
+
+############################################################
+############################################################
+
+=pod
+
+=back
+
+=head1 Statistics helper routines?
+
+Bad place for them but what the hell.
+
+=over 4
+
+=item &chartlink
+
+Returns a link to the chart for a specific student.
+
+Inputs:
+
+=over 4
+
+=item $linktext: The text of the link
+
+=item $sname: The students username
+
+=item $sdomain: The students domain
+
+=back
+
+=back
+
+=cut
+
+############################################################
+############################################################
+sub chartlink {
+ my ($linktext, $sname, $sdomain) = @_;
+ my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
+ '&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).
+ '&chartoutputmode='.HTML::Entities::encode('html, with all links').
+ '">'.$linktext.'</a>';
+}
+
+#######################################################
+#######################################################
+
+=pod
+
+=head1 Course Environment Routines
+
+=over 4
+
+=item &restore_course_settings
+
+=item &store_course_settings
+
+Restores/Store indicated form parameters from the course environment.
+Will not overwrite existing values of the form parameters.
+
+Inputs:
+a scalar describing the data (e.g. 'chart', 'problem_analysis')
+
+a hash ref describing the data to be stored. For example:
+
+%Save_Parameters = ('Status' => 'scalar',
+ 'chartoutputmode' => 'scalar',
+ 'chartoutputdata' => 'scalar',
+ 'Section' => 'array',
+ 'StudentData' => 'array',
+ 'Maps' => 'array');
+
+Returns: both routines return nothing
+
+=cut
+
+#######################################################
+#######################################################
+sub store_course_settings {
+ # save to the environment
+ # appenv the same items, just to be safe
+ my $courseid = $ENV{'request.course.id'};
+ my $coursedom = $ENV{'course.'.$courseid.'.domain'};
+ my ($prefix,$Settings) = @_;
+ my %SaveHash;
+ my %AppHash;
+ while (my ($setting,$type) = each(%$Settings)) {
+ my $basename = 'env.internal.'.$prefix.'.'.$setting;
+ my $envname = 'course.'.$courseid.'.'.$basename;
+ if (exists($ENV{'form.'.$setting})) {
+ # Save this value away
+ if ($type eq 'scalar' &&
+ (! exists($ENV{$envname}) ||
+ $ENV{$envname} ne $ENV{'form.'.$setting})) {
+ $SaveHash{$basename} = $ENV{'form.'.$setting};
+ $AppHash{$envname} = $ENV{'form.'.$setting};
+ } elsif ($type eq 'array') {
+ my $stored_form;
+ if (ref($ENV{'form.'.$setting})) {
+ $stored_form = join(',',
+ map {
+ &Apache::lonnet::escape($_);
+ } sort(@{$ENV{'form.'.$setting}}));
+ } else {
+ $stored_form =
+ &Apache::lonnet::escape($ENV{'form.'.$setting});
+ }
+ # Determine if the array contents are the same.
+ if ($stored_form ne $ENV{$envname}) {
+ $SaveHash{$basename} = $stored_form;
+ $AppHash{$envname} = $stored_form;
+ }
+ }
+ }
+ }
+ my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
+ $coursedom,
+ $ENV{'course.'.$courseid.'.num'});
+ if ($put_result !~ /^(ok|delayed)/) {
+ &Apache::lonnet::logthis('unable to save form parameters, '.
+ 'got error:'.$put_result);
+ }
+ # Make sure these settings stick around in this session, too
+ &Apache::lonnet::appenv(%AppHash);
+ return;
+}
+
+sub restore_course_settings {
+ my $courseid = $ENV{'request.course.id'};
+ my ($prefix,$Settings) = @_;
+ while (my ($setting,$type) = each(%$Settings)) {
+ next if (exists($ENV{'form.'.$setting}));
+ my $envname = 'course.'.$courseid.'.env.internal.'.$prefix.
+ '.'.$setting;
+ if (exists($ENV{$envname})) {
+ if ($type eq 'scalar') {
+ $ENV{'form.'.$setting} = $ENV{$envname};
+ } elsif ($type eq 'array') {
+ $ENV{'form.'.$setting} = [
+ map {
+ &Apache::lonnet::unescape($_);
+ } split(',',$ENV{$envname})
+ ];
+ }
+ }
+ }
+}
+
+############################################################
+############################################################
+
+sub propath {
+ my ($udom,$uname)=@_;
+ $udom=~s/\W//g;
+ $uname=~s/\W//g;
+ my $subdir=$uname.'__';
+ $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
+ my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
+ return $proname;
+}
+
+sub icon {
+ my ($file)=@_;
+ my @file_ext = split(/\./,$file);
+ my $curfext = $file_ext[-1];
+ my $iconname="unknown.gif";
+ my $embstyle = &Apache::loncommon::fileembstyle($curfext);
+ # The unless conditional that follows is a bit of overkill
+ $iconname = $curfext.".gif" unless
+ (!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn');
+ return $Apache::lonnet::perlvar{'lonIconsURL'}."/$iconname";
+}
+
=pod
=back