loncom/interface/loncommon.pm - diff

Return to loncommon.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.107 and 1.152

version 1.107, 2003/06/24 22:16:32	version 1.152, 2003/11/10 23:25:52
Line 47 Apache::loncommon - pile of common routi	Line 47 Apache::loncommon - pile of common routi

=head1 SYNOPSIS	=head1 SYNOPSIS

Referenced by other mod_perl Apache modules.	Common routines for manipulating connections, student answers,
	domains, common Javascript fragments, etc.

Invocation:	=head1 OVERVIEW
&Apache::loncommon::SUBROUTINENAME(ARGUMENTS);

=head1 INTRODUCTION	A collection of commonly used subroutines that don't have a natural
	home anywhere else. This collection helps remove
Common collection of used subroutines. This collection helps remove
redundancy from other modules and increase efficiency of memory usage.	redundancy from other modules and increase efficiency of memory usage.

Current things done:

Makes a table out of the previous homework attempts
Inputs result_from_symbread, user, domain, course_id
Reads in non-network-related .tab files

This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.

=head2 General Subroutines

=over 4

=cut	=cut

# End of POD header	# End of POD header
Line 82 use POSIX qw(strftime mktime);	Line 68 use POSIX qw(strftime mktime);
use Apache::Constants qw(:common :http :methods);	use Apache::Constants qw(:common :http :methods);
use Apache::lonmsg();	use Apache::lonmsg();
use Apache::lonmenu();	use Apache::lonmenu();
	use Apache::lonlocal;
	use HTML::Entities;

my $readit;	my $readit;

=pod	=pod

=item Global Variables	=head1 Global Variables

=over 4

=cut	=cut

# ----------------------------------------------- Filetypes/Languages/Copyright	# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;	my %language;
	my %supported_language;
my %cprtag;	my %cprtag;
my %fe; my %fd;	my %fe; my %fd;
my %category_extensions;	my %category_extensions;
Line 102 my %category_extensions;	Line 91 my %category_extensions;
my %designhash;	my %designhash;

# ---------------------------------------------- Thesaurus variables	# ---------------------------------------------- Thesaurus variables
	#
=pod	# %Keywords:
	# A hash used by &keyword to determine if a word is considered a keyword.
=item %Keywords	# $thesaurus_db_file
	# Scalar containing the full path to the thesaurus database.
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.

=cut

my %Keywords;	my %Keywords;
my $thesaurus_db_file;	my $thesaurus_db_file;

	#
=pod	# Initialize values from language.tab, copyright.tab, filetypes.tab,
	# thesaurus.tab, and filecategories.tab.
=back	#

=cut

# ----------------------------------------------------------------------- BEGIN

=pod

=item BEGIN()

Initialize values from language.tab, copyright.tab, filetypes.tab,
thesaurus.tab, and filecategories.tab.

=cut

# ----------------------------------------------------------------------- BEGIN

BEGIN {	BEGIN {
# Variable initialization	# Variable initialization
$thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";	$thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
Line 151 BEGIN {	Line 117 BEGIN {
while (<$fh>) {	while (<$fh>) {
next if /^\#/;	next if /^\#/;
chomp;	chomp;
my ($key,$two,$country,$three,$enc,$val)=(split(/\t/,$_));	my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));
$language{$key}=$val.' - '.$enc;	$language{$key}=$val.' - '.$enc;
	if ($sup) {
	$supported_language{$key}=$sup;
	}
}	}
}	}
}	}
Line 228 BEGIN {	Line 197 BEGIN {
} # end of unless($readit)	} # end of unless($readit)

}	}
# ============================================================= END BEGIN BLOCK
###############################################################	###############################################################
## HTML and Javascript Helper Functions ##	## HTML and Javascript Helper Functions ##
###############################################################	###############################################################

=pod	=pod

=item browser_and_searcher_javascript	=head1 General Subroutines

	=over 4

	=head1 HTML and Javascript Functions

	=over 4

	=item * browser_and_searcher_javascript ()

Returns scalar containing javascript to open a browser window	X<browsing, javascript>X<searching, javascript>Returns a string
or a searcher window. Also creates	containing javascript with two functions, C<openbrowser> and
	C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
	tags.

=over 4	=over 4

=item openbrowser(formname,elementname,only,omit) [javascript]	=item * openbrowser(formname,elementname,only,omit) [javascript]

inputs: formname, elementname, only, omit	inputs: formname, elementname, only, omit

Line 255 with the given extension. Can be a comm	Line 234 with the given extension. Can be a comm
Specifying 'omit' will restrict the browser to NOT displaying files	Specifying 'omit' will restrict the browser to NOT displaying files
with the given extension. Can be a comma seperated list.	with the given extension. Can be a comma seperated list.

=item opensearcher(formname, elementname) [javascript]	=item * opensearcher(formname, elementname) [javascript]

Inputs: formname, elementname	Inputs: formname, elementname

Line 266 of the element the selection from the se	Line 245 of the element the selection from the se

=cut	=cut

###############################################################
sub browser_and_searcher_javascript {	sub browser_and_searcher_javascript {
return <<END;	return <<END;
var editbrowser = null;	var editbrowser = null;
function openbrowser(formname,elementname,only,omit) {	function openbrowser(formname,elementname,only,omit,titleelement) {
var url = '/res/?';	var url = '/res/?';
if (editbrowser == null) {	if (editbrowser == null) {
url += 'launch=1&';	url += 'launch=1&';
Line 284 sub browser_and_searcher_javascript {	Line 262 sub browser_and_searcher_javascript {
if (omit != null) {	if (omit != null) {
url += 'omit=' + omit + '&';	url += 'omit=' + omit + '&';
}	}
	if (titleelement != null) {
	url += 'titleelement=' + titleelement + '&';
	}
url += 'element=' + elementname + '';	url += 'element=' + elementname + '';
var title = 'Browser';	var title = 'Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
Line 292 sub browser_and_searcher_javascript {	Line 273 sub browser_and_searcher_javascript {
editbrowser.focus();	editbrowser.focus();
}	}
var editsearcher;	var editsearcher;
function opensearcher(formname,elementname) {	function opensearcher(formname,elementname,titleelement) {
var url = '/adm/searchcat?';	var url = '/adm/searchcat?';
if (editsearcher == null) {	if (editsearcher == null) {
url += 'launch=1&';	url += 'launch=1&';
Line 300 sub browser_and_searcher_javascript {	Line 281 sub browser_and_searcher_javascript {
url += 'catalogmode=interactive&';	url += 'catalogmode=interactive&';
url += 'mode=edit&';	url += 'mode=edit&';
url += 'form=' + formname + '&';	url += 'form=' + formname + '&';
	if (titleelement != null) {
	url += 'titleelement=' + titleelement + '&';
	}
url += 'element=' + elementname + '';	url += 'element=' + elementname + '';
var title = 'Search';	var title = 'Search';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
Line 311 END	Line 295 END
}	}

sub studentbrowser_javascript {	sub studentbrowser_javascript {
unless ($ENV{'request.course.id'}) { return ''; }	unless (
unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {	(($ENV{'request.course.id'}) &&
return '';	(&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})))
}	\|\| ($ENV{'request.role'}=~/^(au\|dc\|su)/)
	) { return ''; }
return (<<'ENDSTDBRW');	return (<<'ENDSTDBRW');
<script type="text/javascript" language="Javascript" >	<script type="text/javascript" language="Javascript" >
var stdeditbrowser;	var stdeditbrowser;
function openstdbrowser(formname,uname,udom) {	function openstdbrowser(formname,uname,udom,roleflag) {
var url = '/adm/pickstudent?';	var url = '/adm/pickstudent?';
var filter;	var filter;
eval('filter=document.'+formname+'.'+uname+'.value;');	eval('filter=document.'+formname+'.'+uname+'.value;');
Line 329 sub studentbrowser_javascript {	Line 314 sub studentbrowser_javascript {
}	}
url += 'form=' + formname + '&unameelement='+uname+	url += 'form=' + formname + '&unameelement='+uname+
'&udomelement='+udom;	'&udomelement='+udom;
	if (roleflag) { url+="&roles=1"; }
var title = 'Student_Browser';	var title = 'Student_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';	options += ',width=700,height=600';
Line 340 ENDSTDBRW	Line 326 ENDSTDBRW
}	}

sub selectstudent_link {	sub selectstudent_link {
my ($form,$unameele,$udomele)=@_;	my ($form,$unameele,$udomele)=@_;
unless ($ENV{'request.course.id'}) { return ''; }	if ($ENV{'request.course.id'}) {
unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {	unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
return '';	return '';
	}
	return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
	'","'.$udomele.'");'."'>".&mt('Select User')."</a>";
	}
	if ($ENV{'request.role'}=~/^(au\|dc\|su)/) {
	return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
	'","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
}	}
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.	return '';
'","'.$udomele.'");'."'>Select User</a>";
}	}

sub coursebrowser_javascript {	sub coursebrowser_javascript {
return (<<'ENDSTDBRW');	my ($domainfilter)=@_;
	return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >	<script type="text/javascript" language="Javascript" >
var stdeditbrowser;	var stdeditbrowser;
function opencrsbrowser(formname,uname,udom) {	function opencrsbrowser(formname,uname,udom) {
Line 361 sub coursebrowser_javascript {	Line 354 sub coursebrowser_javascript {
url += 'filter='+filter+'&';	url += 'filter='+filter+'&';
}	}
}	}
	var domainfilter='$domainfilter';
	if (domainfilter != null) {
	if (domainfilter != '') {
	url += 'domainfilter='+domainfilter+'&';
	}
	}
url += 'form=' + formname + '&cnumelement='+uname+	url += 'form=' + formname + '&cnumelement='+uname+
'&cdomelement='+udom;	'&cdomelement='+udom;
var title = 'Course_Browser';	var title = 'Course_Browser';
Line 376 ENDSTDBRW	Line 375 ENDSTDBRW
sub selectcourse_link {	sub selectcourse_link {
my ($form,$unameele,$udomele)=@_;	my ($form,$unameele,$udomele)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.	return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
'","'.$udomele.'");'."'>Select Course</a>";	'","'.$udomele.'");'."'>".&mt('Select Course')."</a>";
}	}

###############################################################

=pod	=pod

=item linked_select_forms(...)	=item * linked_select_forms(...)

linked_select_forms returns a string containing a <script></script> block	linked_select_forms returns a string containing a <script></script> block
and html for two <select> menus. The select menus will be linked in that	and html for two <select> menus. The select menus will be linked in that
Line 395 linked_select_forms takes the following	Line 392 linked_select_forms takes the following

=over 4	=over 4

=item $formname, the name of the <form> tag	=item * $formname, the name of the <form> tag

=item $middletext, the text which appears between the <select> tags	=item * $middletext, the text which appears between the <select> tags

=item $firstdefault, the default value for the first menu	=item * $firstdefault, the default value for the first menu

=item $firstselectname, the name of the first <select> tag	=item * $firstselectname, the name of the first <select> tag

=item $secondselectname, the name of the second <select> tag	=item * $secondselectname, the name of the second <select> tag

=item $hashref, a reference to a hash containing the data for the menus.	=item * $hashref, a reference to a hash containing the data for the menus.

=back	=back

Line 416 first menu value is given in $menu{$choi	Line 413 first menu value is given in $menu{$choi
and text for the second menu are given in the hash pointed to by	and text for the second menu are given in the hash pointed to by
$menu{$choice1}->{'select2'}.	$menu{$choice1}->{'select2'}.

my %menu = ( A1 => { text =>"Choice A1" ,	my %menu = ( A1 => { text =>"Choice A1" ,
default => "B3",	default => "B3",
select2 => {	select2 => {
B1 => "Choice B1",	B1 => "Choice B1",
B2 => "Choice B2",	B2 => "Choice B2",
B3 => "Choice B3",	B3 => "Choice B3",
B4 => "Choice B4"	B4 => "Choice B4"
}	}
},	},
A2 => { text =>"Choice A2" ,	A2 => { text =>"Choice A2" ,
default => "C2",	default => "C2",
select2 => {	select2 => {
C1 => "Choice C1",	C1 => "Choice C1",
C2 => "Choice C2",	C2 => "Choice C2",
C3 => "Choice C3"	C3 => "Choice C3"
}	}
},	},
A3 => { text =>"Choice A3" ,	A3 => { text =>"Choice A3" ,
default => "D6",	default => "D6",
select2 => {	select2 => {
D1 => "Choice D1",	D1 => "Choice D1",
D2 => "Choice D2",	D2 => "Choice D2",
D3 => "Choice D3",	D3 => "Choice D3",
D4 => "Choice D4",	D4 => "Choice D4",
D5 => "Choice D5",	D5 => "Choice D5",
D6 => "Choice D6",	D6 => "Choice D6",
D7 => "Choice D7"	D7 => "Choice D7"
}	}
}	}
);	);

=cut	=cut

# ------------------------------------------------

sub linked_select_forms {	sub linked_select_forms {
my ($formname,	my ($formname,
$middletext,	$middletext,
Line 499 function select1_changed() {	Line 494 function select1_changed() {
// in with the nuclear	// in with the nuclear
for (i=0;i<values.length; i++) {	for (i=0;i<values.length; i++) {
$second.options[i] = new Option(values[i]);	$second.options[i] = new Option(values[i]);
	$second.options[i].value = values[i];
$second.options[i].text = texts[i];	$second.options[i].text = texts[i];
if (values[i] == select2def) {	if (values[i] == select2def) {
$second.options[i].selected = true;	$second.options[i].selected = true;
Line 512 END	Line 508 END
foreach my $value (sort(keys(%$hashref))) {	foreach my $value (sort(keys(%$hashref))) {
$result.=" <option value=\"$value\" ";	$result.=" <option value=\"$value\" ";
$result.=" selected=\"true\" " if ($value eq $firstdefault);	$result.=" selected=\"true\" " if ($value eq $firstdefault);
$result.=">$hashref->{$value}->{'text'}</option>\n";	$result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
}	}
$result .= "</select>\n";	$result .= "</select>\n";
my %select2 = %{$hashref->{$firstdefault}->{'select2'}};	my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
Line 522 END	Line 518 END
foreach my $value (sort(keys(%select2))) {	foreach my $value (sort(keys(%select2))) {
$result.=" <option value=\"$value\" ";	$result.=" <option value=\"$value\" ";
$result.=" selected=\"true\" " if ($value eq $seconddefault);	$result.=" selected=\"true\" " if ($value eq $seconddefault);
$result.=">$select2{$value}</option>\n";	$result.=">".&mt($select2{$value})."</option>\n";
}	}
$result .= "</select>\n";	$result .= "</select>\n";
# return $debug;	# return $debug;
return $result;	return $result;
} # end of sub linked_select_forms {	} # end of sub linked_select_forms {

###############################################################

=pod	=pod

=item help_open_topic($topic, $text, $stayOnPage, $width, $height)	=item * help_open_topic($topic, $text, $stayOnPage, $width, $height)

Returns a string corresponding to an HTML link to the given help $topic, where $topic corresponds to the name of a .tex file in /home/httpd/html/adm/help/tex, with underscores replaced by spaces.	Returns a string corresponding to an HTML link to the given help
	$topic, where $topic corresponds to the name of a .tex file in
$text will optionally be linked to the same topic, allowing you to link text in addition to the graphic. If you do not want to link text, but wish to specify one of the later parameters, pass an empty string.	/home/httpd/html/adm/help/tex, with underscores replaced by
	spaces.
$stayOnPage is a value that will be interpreted as a boolean. If true, the link will not open a new window. If false, the link will open a new window using Javascript. (Default is false.)
	$text will optionally be linked to the same topic, allowing you to
$width and $height are optional numerical parameters that will override the width and height of the popped up window, which may be useful for certain help topics with big pictures included.	link text in addition to the graphic. If you do not want to link
	text, but wish to specify one of the later parameters, pass an
	empty string.

	$stayOnPage is a value that will be interpreted as a boolean. If true,
	the link will not open a new window. If false, the link will open
	a new window using Javascript. (Default is false.)

	$width and $height are optional numerical parameters that will
	override the width and height of the popped up window, which may
	be useful for certain help topics with big pictures included.

=cut	=cut

Line 549 sub help_open_topic {	Line 553 sub help_open_topic {
my ($topic, $text, $stayOnPage, $width, $height) = @_;	my ($topic, $text, $stayOnPage, $width, $height) = @_;
$text = "" if (not defined $text);	$text = "" if (not defined $text);
$stayOnPage = 0 if (not defined $stayOnPage);	$stayOnPage = 0 if (not defined $stayOnPage);
if ($ENV{'browser.interface'} eq 'textual') {	if ($ENV{'browser.interface'} eq 'textual' \|\|
	$ENV{'environment.remote'} eq 'off' ) {
$stayOnPage=1;	$stayOnPage=1;
}	}
$width = 350 if (not defined $width);	$width = 350 if (not defined $width);
Line 608 sub helpLatexCheatsheet {	Line 613 sub helpLatexCheatsheet {

=pod	=pod

=item csv_translate($text)	=item * csv_translate($text)

Translate $text to allow it to be output as a 'comma seperated values'	Translate $text to allow it to be output as a 'comma seperated values'
format.	format.
Line 622 sub csv_translate {	Line 627 sub csv_translate {
return $text;	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 ##	## Home server <option> list generating code ##
###############################################################	###############################################################
#-------------------------------------------

=pod	=pod

=item get_domains()	=head1 Home Server option list generating code

	=over 4

	=item * get_domains()

Returns an array containing each of the domains listed in the hosts.tab	Returns an array containing each of the domains listed in the hosts.tab
file.	file.
Line 651 sub get_domains {	Line 744 sub get_domains {

=pod	=pod

=item select_form($defdom,$name,%hash)	=item * select_form($defdom,$name,%hash)

Returns a string containing a <select name='$name' size='1'> form to	Returns a string containing a <select name='$name' size='1'> form to
allow a user to select options from a hash option_name => displayed text.	allow a user to select options from a hash option_name => displayed text.
Line 663 See lonrights.pm for an example invocati	Line 756 See lonrights.pm for an example invocati
sub select_form {	sub select_form {
my ($def,$name,%hash) = @_;	my ($def,$name,%hash) = @_;
my $selectform = "<select name=\"$name\" size=\"1\">\n";	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=\"$_\" ".	$selectform.="<option value=\"$_\" ".
($_ eq $def ? 'selected' : '').	($_ eq $def ? 'selected' : '').
">".$hash{$_}."</option>\n";	">".&mt($hash{$_})."</option>\n";
}	}
$selectform.="</select>";	$selectform.="</select>";
return $selectform;	return $selectform;
Line 677 sub select_form {	Line 776 sub select_form {

=pod	=pod

=item select_dom_form($defdom,$name,$includeempty)	=item * select_dom_form($defdom,$name,$includeempty)

Returns a string containing a <select name='$name' size='1'> form to	Returns a string containing a <select name='$name' size='1'> form to
allow a user to select the domain to preform an operation in.	allow a user to select the domain to preform an operation in.
Line 707 sub select_dom_form {	Line 806 sub select_dom_form {

=pod	=pod

=item get_library_servers($domain)	=item * get_library_servers($domain)

Returns a hash which contains keys like '103l3' and values like	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	'kirk.lite.msu.edu'. All of the keys will be for machines in the
Line 731 sub get_library_servers {	Line 830 sub get_library_servers {

=pod	=pod

=item home_server_option_list($domain)	=item * home_server_option_list($domain)

returns a string which contains an <option> list to be used in a	returns a string which contains an <option> list to be used in a
<select> form input. See loncreateuser.pm for an example.	<select> form input. See loncreateuser.pm for an example.
Line 749 sub home_server_option_list {	Line 848 sub home_server_option_list {
}	}
return $result;	return $result;
}	}
###############################################################
## End of home server <option> list generating code ##	=pod
###############################################################
	=back

	=cut

###############################################################	###############################################################
	## Decoding User Agent ##
###############################################################	###############################################################

=pod	=pod

=item &decode_user_agent()	=head1 Decoding the User Agent

	=over 4

	=item * &decode_user_agent()

Inputs: $r	Inputs: $r

Line 766 Outputs:	Line 873 Outputs:

=over 4	=over 4

=item $httpbrowser	=item * $httpbrowser

=item $clientbrowser	=item * $clientbrowser

=item $clientversion	=item * $clientversion

=item $clientmathml	=item * $clientmathml

=item $clientunicode	=item * $clientunicode

=item $clientos	=item * $clientos

=back	=back

Line 818 sub decode_user_agent {	Line 925 sub decode_user_agent {
$clientunicode,$clientos,);	$clientunicode,$clientos,);
}	}

###############################################################	=pod
###############################################################

	=back

	=cut

###############################################################	###############################################################
## Authentication changing form generation subroutines ##	## Authentication changing form generation subroutines ##
Line 834 sub decode_user_agent {	Line 943 sub decode_user_agent {

=pod	=pod

=item authform_xxxxxx	=head1 Authentication Routines

	=over 4

	=item * authform_xxxxxx

The authform_xxxxxx subroutines provide javascript and html forms which	The authform_xxxxxx subroutines provide javascript and html forms which
handle some of the conveniences required for authentication forms.	handle some of the conveniences required for authentication forms.
Line 844 See loncreateuser.pm for invocation and	Line 957 See loncreateuser.pm for invocation and

=over 4	=over 4

=item authform_header	=item * authform_header

=item authform_authorwarning	=item * authform_authorwarning

=item authform_nochange	=item * authform_nochange

=item authform_kerberos	=item * authform_kerberos

=item authform_internal	=item * authform_internal

=item authform_filesystem	=item * authform_filesystem

=back	=back

Line 948 END	Line 1061 END

sub authform_authorwarning{	sub authform_authorwarning{
my $result='';	my $result='';
$result=<<"END";	$result='<i>'.
<i>As a general rule, only authors or co-authors should be filesystem	&mt('As a general rule, only authors or co-authors should be '.
authenticated (which allows access to the server filesystem).</i>	'filesystem authenticated '.
END	'(which allows access to the server filesystem).')."</i>\n";
return $result;	return $result;
}	}

Line 961 sub authform_nochange{	Line 1074 sub authform_nochange{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my $result='';	my $result = &mt('[_1] Do not change login data',
$result.=<<"END";	'<input type="radio" name="login" value="nochange" '.
<input type="radio" name="login" value="nochange" checked="checked"	'checked="checked" onclick="'.
onclick="javascript:changed_radio('nochange',$in{'formname'});" />	"javascript:changed_radio('nochange',$in{'formname'});".'" />');
Do not change login data
END
return $result;	return $result;
}	}

Line 977 sub authform_kerberos{	Line 1088 sub authform_kerberos{
kerb_def_auth => 'krb4',	kerb_def_auth => 'krb4',
@_,	@_,
);	);
my $result='';	my ($check4,$check5);
my $check4;
my $check5;
if ($in{'kerb_def_auth'} eq 'krb5') {	if ($in{'kerb_def_auth'} eq 'krb5') {
$check5 = " checked=\"on\"";	$check5 = " checked=\"on\"";
} else {	} else {
$check4 = " checked=\"on\"";	$check4 = " checked=\"on\"";
}	}
$result.=<<"END";	my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
<input type="radio" name="login" value="krb"	my $result .= &mt
onclick="javascript:changed_radio('krb',$in{'formname'});"	('[_1] Kerberos authenticated with domain [_2] '.
onchange="javascript:changed_radio('krb',$in{'formname'});" />	'[_3] Version 4 [_4] Version 5',
Kerberos authenticated with domain	'<input type="radio" name="login" value="krb" '.
<input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}"	'onclick="'.$jscall.'" onchange="'.$jscall.'" />',
onchange="javascript:changed_text('krb',$in{'formname'});" />	'<input type="text" size="10" name="krbarg" '.
<input type="radio" name="krbver" value="4" $check4 />Version 4	'value="'.$in{'kerb_def_dom'}.'" '.
<input type="radio" name="krbver" value="5" $check5 />Version 5	'onchange="'.$jscall.'" />',
END	'<input type="radio" name="krbver" value="4" '.$check4.' />',
	'<input type="radio" name="krbver" value="5" '.$check5.' />');
return $result;	return $result;
}	}

Line 1004 sub authform_internal{	Line 1114 sub authform_internal{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my $result='';	my $jscall = "javascript:changed_radio('int',$args{'formname'});";
$result.=<<"END";	my $result.=&mt
<input type="radio" name="login" value="int"	('[_1] Internally authenticated (with initial password [_2])',
onchange="javascript:changed_radio('int',$args{'formname'});"	'<input type="radio" name="login" value="int" '.
onclick="javascript:changed_radio('int',$args{'formname'});" />	'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
Internally authenticated (with initial password	'<input type="text" size="10" name="intarg" value="" '.
<input type="text" size="10" name="intarg" value=""	'onchange="'.$jscall.'" />');
onchange="javascript:changed_text('int',$args{'formname'});" />)
END
return $result;	return $result;
}	}

Line 1022 sub authform_local{	Line 1130 sub authform_local{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my $result='';	my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
$result.=<<"END";	my $result.=&mt('[_1] Local Authentication with arguement [_2]',
<input type="radio" name="login" value="loc"	'<input type="radio" name="login" value="loc" '.
onchange="javascript:changed_radio('loc',$in{'formname'});"	'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
onclick="javascript:changed_radio('loc',$in{'formname'});" />	'<input type="text" size="10" name="locarg" value="" '.
Local Authentication with argument	'onchange="'.$jscall.'" />');
<input type="text" size="10" name="locarg" value=""
onchange="javascript:changed_text('loc',$in{'formname'});" />
END
return $result;	return $result;
}	}

Line 1040 sub authform_filesystem{	Line 1145 sub authform_filesystem{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my $result='';	my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
$result.=<<"END";	my $result.= &mt
<input type="radio" name="login" value="fsys"	('[_1] Filesystem Authenticated (with initial password [_2])',
onchange="javascript:changed_radio('fsys',$in{'formname'});"	'<input type="radio" name="login" value="fsys" '.
onclick="javascript:changed_radio('fsys',$in{'formname'});" />	'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
Filesystem authenticated (with initial password	'<input type="text" size="10" name="fsysarg" value="" '.
<input type="text" size="10" name="fsysarg" value=""	'onchange="'.$jscall.'" />');
onchange="javascript:changed_text('fsys',$in{'formname'});">)
END
return $result;	return $result;
}	}

###############################################################	=pod
## End Authentication changing form generation functions ##
###############################################################	=back

	=cut

###############################################################	###############################################################
## Get Authentication Defaults for Domain ##	## Get Authentication Defaults for Domain ##
###############################################################	###############################################################
##
## Returns default authentication type and an associated argument
## as listed in file domain.tab
##
#-------------------------------------------

=pod	=pod

=item get_auth_defaults	=head1 Domains and Authentication

	Returns default authentication type and an associated argument as
	listed in file 'domain.tab'.

	=over 4

	=item * get_auth_defaults

get_auth_defaults($target_domain) returns the default authentication	get_auth_defaults($target_domain) returns the default authentication
type and an associated argument (initial password or a kerberos domain).	type and an associated argument (initial password or a kerberos domain).
Line 1077 These values are stored in lonTabs/domai	Line 1184 These values are stored in lonTabs/domai

If target_domain is not found in domain.tab, returns nothing ('').	If target_domain is not found in domain.tab, returns nothing ('').

=over 4

=item get_auth_defaults

=back

=cut	=cut

#-------------------------------------------	#-------------------------------------------
Line 1106 sub get_auth_defaults {	Line 1207 sub get_auth_defaults {

=pod	=pod

=item get_kerberos_defaults	=item * get_kerberos_defaults

get_kerberos_defaults($target_domain) returns the default kerberos	get_kerberos_defaults($target_domain) returns the default kerberos
version and domain. If not found in domain.tabs, it defaults to	version and domain. If not found in domain.tabs, it defaults to
Line 1114 version 4 and the domain of the server.	Line 1215 version 4 and the domain of the server.

($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);	($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);

=over 4

=item get_kerberos_defaults

=back

=cut	=cut

#-------------------------------------------	#-------------------------------------------
Line 1135 sub get_kerberos_defaults {	Line 1230 sub get_kerberos_defaults {
}	}
return ($krbdef,$krbdefdom);	return ($krbdef,$krbdefdom);
}	}
###############################################################
## End Get Kerberos Defaults for Domain ##	=pod
###############################################################
	=back

	=cut

###############################################################	###############################################################
## Thesaurus Functions ##	## Thesaurus Functions ##
Line 1145 sub get_kerberos_defaults {	Line 1243 sub get_kerberos_defaults {

=pod	=pod

=item initialize_keywords	=head1 Thesaurus Functions

	=over 4

	=item * initialize_keywords

Initializes the package variable %Keywords if it is empty. Uses the	Initializes the package variable %Keywords if it is empty. Uses the
package variable $thesaurus_db_file.	package variable $thesaurus_db_file.
Line 1190 sub initialize_keywords {	Line 1292 sub initialize_keywords {

=pod	=pod

=item keyword($word)	=item * keyword($word)

Returns true if $word is a keyword. A keyword is a word that appears more	Returns true if $word is a keyword. A keyword is a word that appears more
than the average number of times in the thesaurus database. Calls	than the average number of times in the thesaurus database. Calls
Line 1211 sub keyword {	Line 1313 sub keyword {

=pod	=pod

=item get_related_words	=item * get_related_words

Look up a word in the thesaurus. Takes a scalar arguement and returns	Look up a word in the thesaurus. Takes a scalar arguement and returns
an array of words. If the keyword is not in the thesaurus, an empty array	an array of words. If the keyword is not in the thesaurus, an empty array
Line 1248 sub get_related_words {	Line 1350 sub get_related_words {
return @Words;	return @Words;
}	}

###############################################################	=pod
## End Thesaurus Functions ##
###############################################################	=back

	=cut

# -------------------------------------------------------------- Plaintext name	# -------------------------------------------------------------- Plaintext name
=pod	=pod

=item plainname($uname,$udom)	=head1 User Name Functions

Gets a users name and returns it as a string in	=over 4
"first middle last generation"
form	=item * plainname($uname,$udom)

	Takes a users logon name and returns it as a string in
	"first middle last generation" form

=cut	=cut

Line 1279 sub plainname {	Line 1386 sub plainname {
# -------------------------------------------------------------------- Nickname	# -------------------------------------------------------------------- Nickname
=pod	=pod

=item nickname($uname,$udom)	=item * nickname($uname,$udom)

Gets a users name and returns it as a string as	Gets a users name and returns it as a string as

Line 1314 sub nickname {	Line 1421 sub nickname {

=pod	=pod

=item screenname($uname,$udom)	=item * screenname($uname,$udom)

Gets a users screenname and returns it as a string	Gets a users screenname and returns it as a string

Line 1352 sub aboutmewrapper {	Line 1459 sub aboutmewrapper {


sub syllabuswrapper {	sub syllabuswrapper {
my ($link,$un,$do,$tf)=@_;	my ($linktext,$coursedir,$domain,$fontcolor)=@_;
if ($tf) { $link='<font color="'.$tf.'">'.$link.'</font>'; }	if ($fontcolor) {
return "<a href='/public/$do/$un/syllabus'>$link</a>";	$linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';
	}
	return "<a href='/public/$domain/$coursedir/syllabus'>$linktext</a>";
}	}

# ---------------------------------------------------------------- Language IDs	=pod

	=back

	=head1 Access .tab File Data

	=over 4

	=item * languageids()

	returns list of all language ids

	=cut

sub languageids {	sub languageids {
return sort(keys(%language));	return sort(keys(%language));
}	}

# -------------------------------------------------------- Language Description	=pod

	=item * languagedescription()

	returns description of a specified language id

	=cut

sub languagedescription {	sub languagedescription {
return $language{shift(@_)};	my $code=shift;
	return ($supported_language{$code}?'* ':'').
	$language{$code}.
	($supported_language{$code}?' ('.&mt('interface available').')':'');
}	}

# ----------------------------------------------------------- Display Languages	sub plainlanguagedescription {
# returns a hash with all desired display languages	my $code=shift;
#	return $language{$code};
	}

sub display_languages {	sub supportedlanguagecode {
my %languages=();	my $code=shift;
if ($ENV{'environment.languages'}) {	return $supported_language{$code};
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;
}
}
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
if ($ENV{'form.displaylanguage'}) {
foreach (split(/\s(\,\|\;\|\:)\s/,$ENV{'form.displaylanguage'})) {
$languages{$_}=1;
}
}
return %languages;
}	}

# --------------------------------------------------------------- Copyright IDs	=pod

	=item * copyrightids()

	returns list of all copyrights

	=cut

sub copyrightids {	sub copyrightids {
return sort(keys(%cprtag));	return sort(keys(%cprtag));
}	}

# ------------------------------------------------------- Copyright Description	=pod

	=item * copyrightdescription()

	returns description of a specified copyright id

	=cut

sub copyrightdescription {	sub copyrightdescription {
return $cprtag{shift(@_)};	return $cprtag{shift(@_)};
}	}

# ------------------------------------------------------------- File Categories	=pod

	=item * filecategories()

	returns list of all file categories

	=cut

sub filecategories {	sub filecategories {
return sort(keys(%category_extensions));	return sort(keys(%category_extensions));
}	}

# -------------------------------------- File Types within a specified category	=pod

	=item * filecategorytypes()

	returns list of file types belonging to a given file
	category

	=cut

sub filecategorytypes {	sub filecategorytypes {
return @{$category_extensions{lc($_[0])}};	return @{$category_extensions{lc($_[0])}};
}	}

# ------------------------------------------------------------------ File Types	=pod
sub fileextensions {
return sort(keys(%fe));	=item * fileembstyle()
}
	returns embedding style for a specified file type

	=cut

# ------------------------------------------------------------- Embedding Style
sub fileembstyle {	sub fileembstyle {
return $fe{lc(shift(@_))};	return $fe{lc(shift(@_))};
}	}

# ------------------------------------------------------------ Description Text	=pod

	=item * filedescription()

	returns description for a specified file type

	=cut

sub filedescription {	sub filedescription {
return $fd{lc(shift(@_))};	return $fd{lc(shift(@_))};
}	}

# ------------------------------------------------------------ Description Text	=pod

	=item * filedescriptionex()

	returns description for a specified file type with
	extra formatting

	=cut

sub filedescriptionex {	sub filedescriptionex {
my $ex=shift;	my $ex=shift;
return '.'.$ex.' '.$fd{lc($ex)};	return '.'.$ex.' '.$fd{lc($ex)};
}	}

# ---- Retrieve attempts by students	# End of .tab access
# input	=pod
# $symb - problem including path
# $username,$domain - that of the student	=back
# $course - course name
# $getattempt - leave blank if want all attempts, else put something.	=cut
# $regexp - regular expression. If string matches regexp send to
# $gradesub - routine that process the string if it matches regexp	# ------------------------------------------------------------------ File Types
#	sub fileextensions {
# output	return sort(keys(%fe));
# formatted as a table all the attempts, if any.	}

	# ----------------------------------------------------------- Display Languages
	# returns a hash with all desired display languages
#	#

	sub display_languages {
	my %languages=();
	foreach (&preferred_languages()) {
	$languages{$_}=1;
	}
	&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
	if ($ENV{'form.displaylanguage'}) {
	foreach (split(/\s(\,\|\;\|\:)\s/,$ENV{'form.displaylanguage'})) {
	$languages{$_}=1;
	}
	}
	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 ##
	###############################################################

	=pod

	=head1 Alternate Problem Views

	=over 4

	=item * get_previous_attempt($symb, $username, $domain, $course,
	$getattempt, $regexp, $gradesub)

	Return string with previous attempt on problem. Arguments:

	=over 4

	=item * $symb: Problem, including path

	=item * $username: username of the desired student

	=item * $domain: domain of the desired student

	=item * $course: Course ID

	=item * $getattempt: Leave blank for all attempts, otherwise put
	something

	=item * $regexp: if string matches this regexp, the string will be
	sent to $gradesub

	=item * $gradesub: routine that processes the string if it matches $regexp

	=back

	The output string is a table containing all desired attempts, if any.

	=cut

sub get_previous_attempt {	sub get_previous_attempt {
my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;	my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
my $prevattempts='';	my $prevattempts='';
Line 1487 sub get_previous_attempt {	Line 1745 sub get_previous_attempt {
} else {	} else {
$value=$returnhash{$version.':'.$_};	$value=$returnhash{$version.':'.$_};
}	}
$prevattempts.='<td>'.$value.' </td>';	$prevattempts.='<td>'.&Apache::lonnet::unescape($value).' </td>';
}	}
}	}
}	}
Line 1499 sub get_previous_attempt {	Line 1757 sub get_previous_attempt {
} else {	} else {
$value=$lasthash{$_};	$value=$lasthash{$_};
}	}
	$value=&Apache::lonnet::unescape($value);
if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}	if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
$prevattempts.='<td>'.$value.' </td>';	$prevattempts.='<td>'.$value.' </td>';
}	}
Line 1546 sub relative_to_absolute {	Line 1805 sub relative_to_absolute {
return $output;	return $output;
}	}

	=pod

	=item * get_student_view

	show a snapshot of what student was looking at

	=cut

sub get_student_view {	sub get_student_view {
my ($symb,$username,$domain,$courseid,$target) = @_;	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 (%old,%moreenv);
my @elements=('symb','courseid','domain','username');	my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {	foreach my $element (@elements) {
Line 1574 sub get_student_view {	Line 1841 sub get_student_view {
return $userview;	return $userview;
}	}

	=pod

	=item * get_student_answers()

	show a snapshot of how student was answering problem

	=cut

sub get_student_answers {	sub get_student_answers {
my ($symb,$username,$domain,$courseid,%form) = @_;	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 (%old,%moreenv);
my @elements=('symb','courseid','domain','username');	my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {	foreach my $element (@elements) {
Line 1593 sub get_student_answers {	Line 1868 sub get_student_answers {
return $userview;	return $userview;
}	}

	=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

###############################################	###############################################


Line 1657 sub findallcourses {	Line 1962 sub findallcourses {

=pod	=pod

=item &determinedomain()	=head1 Domain Template Functions

	=over 4

	=item * &determinedomain()

Inputs: $domain (usually will be undef)	Inputs: $domain (usually will be undef)

Line 1681 sub determinedomain {	Line 1990 sub determinedomain {
###############################################	###############################################
=pod	=pod

=item &domainlogo()	=item * &domainlogo()

Inputs: $domain (usually will be undef)	Inputs: $domain (usually will be undef)

Line 1689 Returns: A link to a domain logo, if the	Line 1998 Returns: A link to a domain logo, if the
If the domain logo does not exist, a description of the domain.	If the domain logo does not exist, a description of the domain.

=cut	=cut

###############################################	###############################################
sub domainlogo {	sub domainlogo {
my $domain = &determinedomain(shift);	my $domain = &determinedomain(shift);
Line 1697 sub domainlogo {	Line 2007 sub domainlogo {
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};	my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }	if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.	return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
'/adm/lonDomLogos/'.$domain.'.gif" />';	'/adm/lonDomLogos/'.$domain.'.gif" alt="'.$domain.'" />';
} elsif(exists($Apache::lonnet::domaindescription{$domain})) {	} elsif(exists($Apache::lonnet::domaindescription{$domain})) {
return $Apache::lonnet::domaindescription{$domain};	return $Apache::lonnet::domaindescription{$domain};
} else {	} else {
Line 1708 sub domainlogo {	Line 2018 sub domainlogo {

=pod	=pod

=item &designparm()	=item * &designparm()

Inputs: $which parameter; $domain (usually will be undef)	Inputs: $which parameter; $domain (usually will be undef)

Returns: value of designparamter $which	Returns: value of designparamter $which

=cut	=cut

##############################################	##############################################
sub designparm {	sub designparm {
my ($which,$domain)=@_;	my ($which,$domain)=@_;
	if ($ENV{'browser.blackwhite'} eq 'on') {
	if ($which=~/\.(font\|alink\|vlink\|link)$/) {
	return '#000000';
	}
	if ($which=~/\.(pgbg\|sidebg)$/) {
	return '#FFFFFF';
	}
	if ($which=~/\.tabbg$/) {
	return '#CCCCCC';
	}
	}
if ($ENV{'environment.color.'.$which}) {	if ($ENV{'environment.color.'.$which}) {
return $ENV{'environment.color.'.$which};	return $ENV{'environment.color.'.$which};
}	}
Line 1734 sub designparm {	Line 2056 sub designparm {

=pod	=pod

=item &bodytag()	=back

	=head1 HTTP Helpers

	=over 4

	=item * &bodytag()

Returns a uniform header for LON-CAPA web pages.	Returns a uniform header for LON-CAPA web pages.

Inputs:	Inputs:

$title, A title to be displayed on the page.	=over 4
$function, the current role (can be undef).
$addentries, extra parameters for the <body> tag.	=item * $title, A title to be displayed on the page.
$bodyonly, if defined, only return the <body> tag.
$domain, if defined, force a given domain.	=item * $function, the current role (can be undef).
$forcereg, if page should register as content page (relevant for
	=item * $addentries, extra parameters for the <body> tag.

	=item * $bodyonly, if defined, only return the <body> tag.

	=item * $domain, if defined, force a given domain.

	=item * $forcereg, if page should register as content page (relevant for
text interface only)	text interface only)

	=back

Returns: A uniform header for LON-CAPA web pages.	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 nonzero, a string containing a <body> tag will be returned.
If $bodyonly is undef or zero, an html string containing a <body> tag and	If $bodyonly is undef or zero, an html string containing a <body> tag and
Line 1755 other decorations will be returned.	Line 2092 other decorations will be returned.

=cut	=cut

###############################################


###############################################
sub bodytag {	sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;	my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;
	$title=&mt($title);
unless ($function) {	unless ($function) {
$function='student';	$function='student';
if ($ENV{'request.role'}=~/^(cc\|in\|ta\|ep)/) {	if ($ENV{'request.role'}=~/^(cc\|in\|ta\|ep)/) {
Line 1782 sub bodytag {	Line 2116 sub bodytag {
my $alink=&designparm($function.'.alink',$domain);	my $alink=&designparm($function.'.alink',$domain);
my $vlink=&designparm($function.'.vlink',$domain);	my $vlink=&designparm($function.'.vlink',$domain);
my $sidebg=&designparm($function.'.sidebg',$domain);	my $sidebg=&designparm($function.'.sidebg',$domain);
	# Accessibility font enhance
	unless ($addentries) { $addentries=''; }
	my $addstyle='';
	if ($ENV{'browser.fontenhance'} eq 'on') {
	$addstyle=' font-size: x-large;';
	}
# role and realm	# role and realm
my ($role,$realm)	my ($role,$realm)
=&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);	=&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
Line 1799 sub bodytag {	Line 2138 sub bodytag {
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }	if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
# construct main body tag	# construct main body tag
my $bodytag = <<END;	my $bodytag = <<END;
	<style>
	h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
	a:hover { color: black; background: yellow }
	a:focus { color: red; background: yellow }
	</style>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"	<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
$addentries>	style="margin-top: 0px;$addstyle" $addentries>
END	END
my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.	my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
$lonhttpdPort.$img.'" />';	$lonhttpdPort.$img.'" alt="'.$function.'" />';
if ($bodyonly) {	if ($bodyonly) {
return $bodytag;	return $bodytag;
} elsif ($ENV{'browser.interface'} eq 'textual') {	} elsif ($ENV{'browser.interface'} eq 'textual') {
Line 1815 END	Line 2159 END
# No Remote	# No Remote
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',	return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
$forcereg).	$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>';	'</b></font></td></tr></table>';
}	}

Line 1831 $upperleft</td>	Line 2175 $upperleft</td>
</tr>	</tr>
<tr>	<tr>
<td rowspan="3" bgcolor="$tabbg">	<td rowspan="3" bgcolor="$tabbg">
<font size="5"><b>$title</b></font>	<font size="5" face="Arial, Helvetica, sans-serif"><b>$title</b></font>
<td bgcolor="$tabbg" align="right">	<td bgcolor="$tabbg" align="right">
<font size="2">	<font size="2" face="Arial, Helvetica, sans-serif">
$ENV{'environment.firstname'}	$ENV{'environment.firstname'}
$ENV{'environment.middlename'}	$ENV{'environment.middlename'}
$ENV{'environment.lastname'}	$ENV{'environment.lastname'}
Line 1842 $upperleft</td>	Line 2186 $upperleft</td>
</td>	</td>
</tr>	</tr>
<tr><td bgcolor="$tabbg" align="right">	<tr><td bgcolor="$tabbg" align="right">
<font size="2">$role</font>	<font size="2" face="Arial, Helvetica, sans-serif">$role</font>
</td></tr>	</td></tr>
<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>	</table><br>
ENDBODY	ENDBODY
}	}
Line 1921 sub get_posted_cgi {	Line 2265 sub get_posted_cgi {
$r->headers_in->unset('Content-length');	$r->headers_in->unset('Content-length');
}	}

###############################################	=pod

	=item * get_unprocessed_cgi($query,$possible_names)

	Modify the %ENV hash to contain unprocessed CGI form parameters held in
	$query. The parameters listed in $possible_names (an array reference),
	will be set in $ENV{'form.name'} if they do not already exist.

	Typically called with $ENV{'QUERY_STRING'} as the first parameter.
	$possible_names is an ref to an array of form element names. As an example:
	get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
	will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.

	=cut

sub get_unprocessed_cgi {	sub get_unprocessed_cgi {
my ($query,$possible_names)= @_;	my ($query,$possible_names)= @_;
Line 1938 sub get_unprocessed_cgi {	Line 2295 sub get_unprocessed_cgi {
}	}
}	}

	=pod

	=item * cacheheader()

	returns cache-controlling header code

	=cut

sub cacheheader {	sub cacheheader {
unless ($ENV{'request.method'} eq 'GET') { return ''; }	unless ($ENV{'request.method'} eq 'GET') { return ''; }
my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);	my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
Line 1947 sub cacheheader {	Line 2312 sub cacheheader {
return $output;	return $output;
}	}

	=pod

	=item * no_cache($r)

	specifies header code to not have cache

	=cut

sub no_cache {	sub no_cache {
my ($r) = @_;	my ($r) = @_;
unless ($ENV{'request.method'} eq 'GET') { return ''; }	unless ($ENV{'request.method'} eq 'GET') { return ''; }
Line 1956 sub no_cache {	Line 2329 sub no_cache {
#$r->header_out("Expires" => $date);	#$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)

	adds $name to the %ENV hash with value
	$value, if $name already exists, the entry is converted to an array
	reference and $value is added to the array.

	=cut

sub add_to_env {	sub add_to_env {
my ($name,$value)=@_;	my ($name,$value)=@_;
if (defined($ENV{$name})) {	if (defined($ENV{$name})) {
Line 1975 sub add_to_env {	Line 2366 sub add_to_env {

=pod	=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	=back

=head2 CSV Upload/Handling functions	=head1 CSV Upload/Handling functions

=over 4	=over 4

=item upfile_store($r)	=item * upfile_store($r)

Store uploaded file, $r should be the HTTP Request object,	Store uploaded file, $r should be the HTTP Request object,
needs $ENV{'form.upfile'}	needs $ENV{'form.upfile'}
Line 2008 sub upfile_store {	Line 2425 sub upfile_store {

=pod	=pod

=item load_tmp_file($r)	=item * load_tmp_file($r)

Load uploaded file from tmp, $r should be the HTTP Request object,	Load uploaded file from tmp, $r should be the HTTP Request object,
needs $ENV{'form.datatoken'},	needs $ENV{'form.datatoken'},
Line 2031 sub load_tmp_file {	Line 2448 sub load_tmp_file {

=pod	=pod

=item upfile_record_sep()	=item * upfile_record_sep()

Separate uploaded file into records	Separate uploaded file into records
returns array of records,	returns array of records,
Line 2048 sub upfile_record_sep {	Line 2465 sub upfile_record_sep {

=pod	=pod

=item record_sep($record)	=item * record_sep($record)

Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}	Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}

Line 2098 sub record_sep {	Line 2515 sub record_sep {
return %components;	return %components;
}	}

	######################################################
	######################################################

=pod	=pod

=item upfile_select_html()	=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	=cut

	######################################################
	######################################################
sub upfile_select_html {	sub upfile_select_html {
return (<<'ENDUPFORM');	my %Types = (
<input type="file" name="upfile" size="50" />	csv => &mt('CSV (comma separated values, spreadsheet)'),
<br />Type: <select name="upfiletype">	space => &mt('Space separated'),
<option value="csv">CSV (comma separated values, spreadsheet)</option>	tab => &mt('Tabulator separated'),
<option value="space">Space separated</option>	# xml => &mt('HTML/XML'),
<option value="tab">Tabulator separated</option>	);
<option value="xml">HTML/XML</option>	my $Str = '<input type="file" name="upfile" size="50" />'.
</select>	'<br />Type: <select name="upfiletype">';
ENDUPFORM	foreach my $type (sort(keys(%Types))) {
	$Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
	}
	$Str .= "</select>\n";
	return $Str;
}	}

	######################################################
	######################################################

=pod	=pod

=item csv_print_samples($r,$records)	=item * csv_print_samples($r,$records)

Prints a table of sample values from each column uploaded $r is an	Prints a table of sample values from each column uploaded $r is an
Apache Request ref, $records is an arrayref from	Apache Request ref, $records is an arrayref from
Line 2128 Apache Request ref, $records is an array	Line 2558 Apache Request ref, $records is an array

=cut	=cut

	######################################################
	######################################################
sub csv_print_samples {	sub csv_print_samples {
my ($r,$records) = @_;	my ($r,$records) = @_;
my (%sone,%stwo,%sthree);	my (%sone,%stwo,%sthree);
%sone=&record_sep($$records[0]);	%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}	if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}	if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
	#
$r->print('Samples<br /><table border="2"><tr>');	$r->print(&mt('Samples').'<br /><table border="2"><tr>');
foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column '.($_+1).'</th>'); }	foreach (sort({$a <=> $b} keys(%sone))) {
	$r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); }
$r->print('</tr>');	$r->print('</tr>');
foreach my $hash (\%sone,\%stwo,\%sthree) {	foreach my $hash (\%sone,\%stwo,\%sthree) {
$r->print('<tr>');	$r->print('<tr>');
Line 2150 sub csv_print_samples {	Line 2583 sub csv_print_samples {
$r->print('</tr></table><br />'."\n");	$r->print('</tr></table><br />'."\n");
}	}

	######################################################
	######################################################

=pod	=pod

=item csv_print_select_table($r,$records,$d)	=item * csv_print_select_table($r,$records,$d)

Prints a table to create associations between values and table columns.	Prints a table to create associations between values and table columns.

$r is an Apache Request ref,	$r is an Apache Request ref,
$records is an arrayref from &Apache::loncommon::upfile_record_sep,	$records is an arrayref from &Apache::loncommon::upfile_record_sep,
$d is an array of 2 element arrays (internal name, displayed name)	$d is an array of 2 element arrays (internal name, displayed name)

=cut	=cut

	######################################################
	######################################################
sub csv_print_select_table {	sub csv_print_select_table {
my ($r,$records,$d) = @_;	my ($r,$records,$d) = @_;
my $i=0;my %sone;	my $i=0;my %sone;
%sone=&record_sep($$records[0]);	%sone=&record_sep($$records[0]);
$r->print('Associate columns with student attributes.'."\n".	$r->print(&mt('Associate columns with student attributes.')."\n".
'<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");	'<table border="2"><tr>'.
	'<th>'.&mt('Attribute').'</th>'.
	'<th>'.&mt('Column').'</th></tr>'."\n");
foreach (@$d) {	foreach (@$d) {
my ($value,$display)=@{ $_ };	my ($value,$display)=@{ $_ };
$r->print('<tr><td>'.$display.'</td>');	$r->print('<tr><td>'.$display.'</td>');
Line 2184 sub csv_print_select_table {	Line 2625 sub csv_print_select_table {
return $i;	return $i;
}	}

	######################################################
	######################################################

=pod	=pod

=item csv_samples_select_table($r,$records,$d)	=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.	Prints a table of sample values from the upload and can make associate samples to internal names.

Line 2196 $d is an array of 2 element arrays (inte	Line 2640 $d is an array of 2 element arrays (inte

=cut	=cut

	######################################################
	######################################################
sub csv_samples_select_table {	sub csv_samples_select_table {
my ($r,$records,$d) = @_;	my ($r,$records,$d) = @_;
my %sone; my %stwo; my %sthree;	my %sone; my %stwo; my %sthree;
my $i=0;	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]);	%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}	if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}	if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
	#
foreach (sort keys %sone) {	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.');">');	' onchange="javascript:flip(this.form,'.$i.');">');
foreach (@$d) {	foreach (@$d) {
my ($value,$display)=@{ $_ };	my ($value,$display)=@{ $_ };
$r->print('<option value='.$value.'>'.$display.'</option>');	$r->print('<option value="'.$value.'">'.$display.'</option>');
}	}
$r->print('</select></td><td>');	$r->print('</select></td><td>');
if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }	if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
Line 2224 sub csv_samples_select_table {	Line 2671 sub csv_samples_select_table {
return($i);	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	=pod

=item check_if_partid_hidden($id,$symb,$udom,$uname)	=item * check_if_partid_hidden($id,$symb,$udom,$uname)

Returns either 1 or undef	Returns either 1 or undef

Line 2243 $uname, optional the username of the use	Line 2712 $uname, optional the username of the use

sub check_if_partid_hidden {	sub check_if_partid_hidden {
my ($id,$symb,$udom,$uname) = @_;	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);	$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);	my @hiddenlist=split(/,/,$hiddenparts);
foreach my $checkid (@hiddenlist) {	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;
}	}


	############################################################
	############################################################

1;	=pod
__END__;
	=head1 cgi-bin script and graphing routines

	=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++)%100000;
	return (time.'_'.$uniq);
	}

	############################################################
	############################################################

=pod	=pod

=back	=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'.

=head2 Access .tab File Data	Inputs:

=over 4	=over 4

=item languageids()	=item $Title: string, the title of the plot

returns list of all language ids	=item $xlabel: string, text describing the X-axis of the plot

=item languagedescription()	=item $ylabel: string, text describing the Y-axis of the plot

returns description of a specified language id	=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 copyrightids()	=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.

returns list of all copyrights	=item @Values: An array of array references. Each array reference holds data
	to be plotted in a stacked bar chart.

=item copyrightdescription()	=back

returns description of a specified copyright id	Returns:

=item filecategories()	An <img> tag which references graph.png and the appropriate identifying
	information for the plot.

returns list of all file categories	=cut

=item filecategorytypes()	############################################################
	############################################################
	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" />';
	}

returns list of file types belonging to a given file	############################################################
category	############################################################

=item fileembstyle()	=pod

returns embedding style for a specified file type	=item DrawXYGraph

=item filedescription()	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.

returns description for a specified file type	Inputs:

=item filedescriptionex()	=over 4

returns description for a specified file type with	=item $Title: string, the title of the plot
extra formatting
	=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	=back

=head2 Alternate Problem Views	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	=over 4

=item get_previous_attempt()	=item $Title: string, the title of the plot

return string with previous attempt on problem	=item $xlabel: string, text describing the X-axis of the plot

=item get_student_view()	=item $ylabel: string, text describing the Y-axis of the plot

show a snapshot of what student was looking at	=item $colors: Array ref containing the hex color codes for the data to be
	plotted in. If undefined, default values will be used.

=item get_student_answers()	=item $Xlabels: Array ref containing the labels to be used for the X-axis.

show a snapshot of how student was answering problem	=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	=back

=head2 HTTP Helper	Returns:

=over 4	An <img> tag which references graph.png and the appropriate identifying
	information for the plot.

=item get_unprocessed_cgi($query,$possible_names)	=cut

Modify the %ENV hash to contain unprocessed CGI form parameters held in	############################################################
$query. The parameters listed in $possible_names (an array reference),	############################################################
will be set in $ENV{'form.name'} if they do not already exist.	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" />';
	}

Typically called with $ENV{'QUERY_STRING'} as the first parameter.	############################################################
$possible_names is an ref to an array of form element names. As an example:	############################################################
get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.

=item cacheheader()	=pod

returns cache-controlling header code	=head1 Statistics helper routines?

=item no_cache($r)	Bad place for them but what the hell.

specifies header code to not have cache	=item &chartlink

=item add_to_env($name,$value)	Returns a link to the chart for a specific student.

adds $name to the %ENV hash with value	Inputs:
$value, if $name already exists, the entry is converted to an array
reference and $value is added to the array.	=over 4

	=item $linktext: The text of the link

	=item $sname: The students username

	=item $sdomain: The students domain

	=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

=back	=back

=cut	=cut

	1;
	__END__;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.107
changed lines
	Added in v.1.152