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.255 and 1.293

version 1.255, 2005/03/10 00:21:48	version 1.293, 2005/11/15 20:46:40
Line 55 redundancy from other modules and increa	Line 55 redundancy from other modules and increa
package Apache::loncommon;	package Apache::loncommon;

use strict;	use strict;
use Apache::lonnet();	use Apache::lonnet;
use GDBM_File;	use GDBM_File;
use POSIX qw(strftime mktime);	use POSIX qw(strftime mktime);
use Apache::Constants qw(:common :http :methods);	use Apache::Constants qw(:common :http :methods);
Line 152 BEGIN {	Line 152 BEGIN {
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
opendir(DIR,$designdir);	opendir(DIR,$designdir);
while ($filename=readdir(DIR)) {	while ($filename=readdir(DIR)) {
	if ($filename!~/\.tab$/) { next; }
my ($domain)=($filename=~/^(\w+)\./);	my ($domain)=($filename=~/^(\w+)\./);
{	{
my $designfile = $designdir.'/'.$filename;	my $designfile = $designdir.'/'.$filename;
if ( open (my $fh,"<$designfile") ) {	if ( open (my $fh,"<$designfile") ) {
while (<$fh>) {	while (<$fh>) {
next if /^\#/;	next if /^\#/;
chomp;	chomp;
my ($key,$val)=(split(/\=/,$_));	my ($key,$val)=(split(/\=/,$_));
if ($val) { $designhash{$domain.'.'.$key}=$val; }	if ($val) { $designhash{$domain.'.'.$key}=$val; }
}	}
close($fh);	close($fh);
}	}
}	}

}	}
closedir(DIR);	closedir(DIR);
Line 311 END	Line 312 END
}	}

sub lastresurl {	sub lastresurl {
if ($ENV{'environment.lastresurl'}) {	if ($env{'environment.lastresurl'}) {
return $ENV{'environment.lastresurl'}	return $env{'environment.lastresurl'}
} else {	} else {
return '/res';	return '/res';
}	}
Line 329 sub storeresurl {	Line 330 sub storeresurl {

sub studentbrowser_javascript {	sub studentbrowser_javascript {
unless (	unless (
(($ENV{'request.course.id'}) &&	(($env{'request.course.id'}) &&
(&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})))	(&Apache::lonnet::allowed('srm',$env{'request.course.id'})))
\|\| ($ENV{'request.role'}=~/^(au\|dc\|su)/)	\|\| ($env{'request.role'}=~/^(au\|dc\|su)/)
) { return ''; }	) { return ''; }
return (<<'ENDSTDBRW');	return (<<'ENDSTDBRW');
<script type="text/javascript" language="Javascript" >	<script type="text/javascript" language="Javascript" >
Line 360 ENDSTDBRW	Line 361 ENDSTDBRW

sub selectstudent_link {	sub selectstudent_link {
my ($form,$unameele,$udomele)=@_;	my ($form,$unameele,$udomele)=@_;
if ($ENV{'request.course.id'}) {	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.	return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
'","'.$udomele.'");'."'>".&mt('Select User')."</a>";	'","'.$udomele.'");'."'>".&mt('Select User')."</a>";
}	}
if ($ENV{'request.role'}=~/^(au\|dc\|su)/) {	if ($env{'request.role'}=~/^(au\|dc\|su)/) {
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.	return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
'","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";	'","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
}	}
Line 379 sub coursebrowser_javascript {	Line 380 sub coursebrowser_javascript {
return (<<ENDSTDBRW);	return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >	<script type="text/javascript" language="Javascript" >
var stdeditbrowser;	var stdeditbrowser;
function opencrsbrowser(formname,uname,udom,desc,extra_element) {	function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) {
var url = '/adm/pickcourse?';	var url = '/adm/pickcourse?';
var filter;	var filter;
if (filter != null) {	if (filter != null) {
Line 402 sub coursebrowser_javascript {	Line 403 sub coursebrowser_javascript {
url += '&domainfilter='+extra_element;	url += '&domainfilter='+extra_element;
}	}
}	}
	if (multflag !=null && multflag != '') {
	url += '&multiple='+multflag;
	}
var title = 'Course_Browser';	var title = 'Course_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 413 ENDSTDBRW	Line 417 ENDSTDBRW
}	}

sub selectcourse_link {	sub selectcourse_link {
my ($form,$unameele,$udomele,$desc,$extra_element)=@_;	my ($form,$unameele,$udomele,$desc,$extra_element,$multflag)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.	return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
'","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>";	'","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'");'."'>".&mt('Select Course')."</a>";
}	}

	sub check_uncheck_jscript {
	my $jscript = <<"ENDSCRT";
	function checkAll(field) {
	if (field.length > 0) {
	for (i = 0; i < field.length; i++) {
	field[i].checked = true ;
	}
	} else {
	field.checked = true
	}
	}

	function uncheckAll(field) {
	if (field.length > 0) {
	for (i = 0; i < field.length; i++) {
	field[i].checked = false ;
	} } else {
	field.checked = false ;
	}
	}
	ENDSCRT
	return $jscript;
	}


=pod	=pod

=item * linked_select_forms(...)	=item * linked_select_forms(...)
Line 593 sub help_open_topic {	Line 622 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' ) {	$env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;	$stayOnPage=1;
}	}
$width = 350 if (not defined $width);	$width = 350 if (not defined $width);
Line 659 sub help_open_menu {	Line 688 sub help_open_menu {
my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;	my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;
$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' ) {	$env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;	$stayOnPage=1;
}	}
$width = 620 if (not defined $width);	$width = 620 if (not defined $width);
Line 673 sub help_open_menu {	Line 702 sub help_open_menu {
foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {	foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
$$_ = &Apache::lonnet::escape($$_);	$$_ = &Apache::lonnet::escape($$_);
}	}

if (!$stayOnPage) {	if (!$stayOnPage) {
$link = "javascript:helpMenu('open')";	$link = "javascript:helpMenu('open')";
} else {	} else {
Line 684 sub help_open_menu {	Line 712 sub help_open_menu {
my $template;	my $template;
if ($text ne "") {	if ($text ne "") {
$template .=	$template .=
"<table bgcolor='#773311' cellspacing='1' cellpadding='1' border='0'><tr>".	"<table bgcolor='#CC3300' cellspacing='1' cellpadding='1' border='0'><tr>".
"<td bgcolor='#886622'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";	"<td bgcolor='#CC6600'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
}	}
	my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
my $html=&Apache::lonxml::xmlbegin();	my $html=&Apache::lonxml::xmlbegin();
my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");	my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
Line 698 function helpMenu(target) {	Line 727 function helpMenu(target) {
if (target == 'open') {	if (target == 'open') {
var newWindow = null;	var newWindow = null;
try {	try {
newWindow = window.open("/adm/rat/empty.html","helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )	newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
}	}
catch(error) {	catch(error) {
writeHelp(caller);	writeHelp(caller);
Line 712 function helpMenu(target) {	Line 741 function helpMenu(target) {
return;	return;
}	}
function writeHelp(caller) {	function writeHelp(caller) {
caller.document.write('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>')	caller.document.writeln('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>')
caller.document.write("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")	caller.document.writeln("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
caller.document.write("</html>")	caller.document.writeln("</html>")
caller.document.close()	caller.document.close()
caller.focus()	caller.focus()
}	}
Line 742 ENDTEMPLATE	Line 771 ENDTEMPLATE

sub help_open_bug {	sub help_open_bug {
my ($topic, $text, $stayOnPage, $width, $height) = @_;	my ($topic, $text, $stayOnPage, $width, $height) = @_;
unless ($ENV{'user.adv'}) { return ''; }	unless ($env{'user.adv'}) { return ''; }
unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }	unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
$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' ) {	$env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;	$stayOnPage=1;
}	}
$width = 600 if (not defined $width);	$width = 600 if (not defined $width);
Line 787 ENDTEMPLATE	Line 816 ENDTEMPLATE

sub help_open_faq {	sub help_open_faq {
my ($topic, $text, $stayOnPage, $width, $height) = @_;	my ($topic, $text, $stayOnPage, $width, $height) = @_;
unless ($ENV{'user.adv'}) { return ''; }	unless ($env{'user.adv'}) { return ''; }
unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }	unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
$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' ) {	$env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;	$stayOnPage=1;
}	}
$width = 350 if (not defined $width);	$width = 350 if (not defined $width);
Line 835 ENDTEMPLATE	Line 864 ENDTEMPLATE

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

	=head1 Excel and CSV file utility routines

	=over 4

	=cut

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

	=pod

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

Translate $text to allow it to be output as a 'comma separated values'	Translate $text to allow it to be output as a 'comma separated values'
Line 851 sub csv_translate {	Line 972 sub csv_translate {
return $text;	return $text;
}	}


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

Line 875 Currently supported formats:	Line 995 Currently supported formats:

=item h3	=item h3

	=item h4

	=item i

=item date	=item date

=back	=back
Line 909 sub define_excel_formats {	Line 1033 sub define_excel_formats {

=pod	=pod

=item &create_workbook	=item * create_workbook

Create an Excel worksheet. If it fails, output message on the	Create an Excel worksheet. If it fails, output message on the
request object and return undefs.	request object and return undefs.
Line 929 sub create_workbook {	Line 1053 sub create_workbook {
#	#
# Create the excel spreadsheet	# Create the excel spreadsheet
my $filename = '/prtspool/'.	my $filename = '/prtspool/'.
$ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.	$env{'user.name'}.'_'.$env{'user.domain'}.'_'.
time.'_'.rand(1000000000).'.xls';	time.'_'.rand(1000000000).'.xls';
my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);	my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
if (! defined($workbook)) {	if (! defined($workbook)) {
Line 952 sub create_workbook {	Line 1076 sub create_workbook {

=pod	=pod

=item * change_content_javascript():	=item * create_text_file

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)	Create a file to write to and eventually make available to the usre.
must be written to the HTML page once. It will prove the Javascript	If file creation fails, outputs an error message on the request object and
function "change(name, content)". Calling the change function with the	return undefs.
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	Inputs: Apache request object, and file suffix
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	Returns (undef) on failure,
user not using Netscape 4, this feature may be used freely with	Filehandle and filename on success.
pretty much any HTML.

=cut	=cut

sub change_content_javascript {	###############################################################
# If we're on Netscape 4, we need to use Layer-based code	###############################################################
if ($ENV{'browser.type'} eq 'netscape' &&	sub create_text_file {
$ENV{'browser.version'} =~ /^4\./) {	my ($r,$suffix) = @_;
return (<<NETSCAPE4);	if (! defined($suffix)) { $suffix = 'txt'; };
function change(name, content) {	my $fh;
doc = document.layers[name+"___escape"].layers[0].document;	my $filename = '/prtspool/'.
doc.open();	$env{'user.name'}.'_'.$env{'user.domain'}.'_'.
doc.write(content);	time.'_'.rand(1000000000).'.'.$suffix;
doc.close();	$fh = Apache::File->new('>/home/httpd'.$filename);
}	if (! defined($fh)) {
NETSCAPE4	$r->log_error("Couldn't open $filename for output $!");
} else {	$r->print("Problems occured in creating the output file. ".
# Otherwise, we need to use semi-standards-compliant code	"This error has been logged. ".
# (technically, "innerHTML" isn't standard but the equivalent	"Please alert your LON-CAPA administrator.");
# is really scary, and every useful browser supports it
return (<<DOMBASED);
function change(name, content) {
element = document.getElementById(name);
element.innerHTML = content;
}
DOMBASED
}	}
	return ($fh,$filename)
}	}

=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' &&	=pod
$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	=back

Line 1072 sub domain_select {	Line 1152 sub domain_select {
} &get_domains;	} &get_domains;
if ($multiple) {	if ($multiple) {
$domains{''}=&mt('Any domain');	$domains{''}=&mt('Any domain');
return &multiple_select_form($name,$value,4,%domains);	return &multiple_select_form($name,$value,4,\%domains);
} else {	} else {
return &select_form($name,$value,%domains);	return &select_form($name,$value,%domains);
}	}
}	}

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

	=pod

	=item * multiple_select_form($name,$value,$size,$hash,$order)

	Returns a string containing a <select> element int multiple mode


	Args:
	$name - name of the <select> element
	$value - sclara or array ref of values that should already be selected
	$size - number of rows long the select element is
	$hash - the elements should be 'option' => 'shown text'
	(shown text should already have been &mt())
	$order - (optional) array ref of the order to show the elments in

	=cut

	#-------------------------------------------
sub multiple_select_form {	sub multiple_select_form {
my ($name,$value,$size,%hash)=@_;	my ($name,$value,$size,$hash,$order)=@_;
my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);	my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
my $output='';	my $output='';
if (! defined($size)) {	if (! defined($size)) {
$size = 4;	$size = 4;
if (scalar(keys(%hash))<4) {	if (scalar(keys(%$hash))<4) {
$size = scalar(keys(%hash));	$size = scalar(keys(%$hash));
}	}
}	}
$output.="\n<select name='$name' size='$size' multiple='1'>";	$output.="\n<select name='$name' size='$size' multiple='1'>";
foreach (sort(keys(%hash))) {	my @order = ref($order) ? @$order
$output.='<option value="'.$_.'" ';	: sort(keys(%$hash));
$output.='selected="selected" ' if ($selected{$_});	foreach my $key (@order) {
$output.='>'.$hash{$_}."</option>\n";	$output.='<option value="'.$key.'" ';
	$output.='selected="selected" ' if ($selected{$key});
	$output.='>'.$hash->{$key}."</option>\n";
}	}
$output.="</select>\n";	$output.="</select>\n";
return $output;	return $output;
Line 1488 sub authform_nochange{	Line 1590 sub authform_nochange{
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my $result = &mt('[_1] Do not change login data',	my $result = '<label>'.&mt('[_1] Do not change login data',
'<input type="radio" name="login" value="nochange" '.	'<input type="radio" name="login" value="nochange" '.
'checked="checked" onclick="'.	'checked="checked" onclick="'.
"javascript:changed_radio('nochange',$in{'formname'});".'" />');	"javascript:changed_radio('nochange',$in{'formname'});".'" />').
	'</label>';
return $result;	return $result;
}	}

Line 1523 sub authform_kerberos{	Line 1626 sub authform_kerberos{
my $jscall = "javascript:changed_radio('krb',$in{'formname'});";	my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
my $result .= &mt	my $result .= &mt
('[_1] Kerberos authenticated with domain [_2] '.	('[_1] Kerberos authenticated with domain [_2] '.
'[_3] Version 4 [_4] Version 5',	'[_3] Version 4 [_4] Version 5 [_5]',
'<input type="radio" name="login" value="krb" '.	'<label><input type="radio" name="login" value="krb" '.
'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />',	'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />',
'<input type="text" size="10" name="krbarg" '.	'</label><input type="text" size="10" name="krbarg" '.
'value="'.$krbarg.'" '.	'value="'.$krbarg.'" '.
'onchange="'.$jscall.'" />',	'onchange="'.$jscall.'" />',
'<input type="radio" name="krbver" value="4" '.$check4.' />',	'<label><input type="radio" name="krbver" value="4" '.$check4.' />',
'<input type="radio" name="krbver" value="5" '.$check5.' />');	'</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
	'</label>');
return $result;	return $result;
}	}

Line 1555 sub authform_internal{	Line 1659 sub authform_internal{
my $jscall = "javascript:changed_radio('int',$args{'formname'});";	my $jscall = "javascript:changed_radio('int',$args{'formname'});";
my $result.=&mt	my $result.=&mt
('[_1] Internally authenticated (with initial password [_2])',	('[_1] Internally authenticated (with initial password [_2])',
'<input type="radio" name="login" value="int" '.$intcheck.	'<label><input type="radio" name="login" value="int" '.$intcheck.
' onchange="'.$jscall.'" onclick="'.$jscall.'" />',	' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
'<input type="text" size="10" name="intarg" '.$intarg.	'</label><input type="text" size="10" name="intarg" '.$intarg.
' onchange="'.$jscall.'" />');	' onchange="'.$jscall.'" />');
return $result;	return $result;
}	}
Line 1582 sub authform_local{	Line 1686 sub authform_local{

my $jscall = "javascript:changed_radio('loc',$in{'formname'});";	my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
my $result.=&mt('[_1] Local Authentication with argument [_2]',	my $result.=&mt('[_1] Local Authentication with argument [_2]',
'<input type="radio" name="login" value="loc" '.$loccheck.	'<label><input type="radio" name="login" value="loc" '.$loccheck.
' onchange="'.$jscall.'" onclick="'.$jscall.'" />',	' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
'<input type="text" size="10" name="locarg" '.$locarg.	'</label><input type="text" size="10" name="locarg" '.$locarg.
' onchange="'.$jscall.'" />');	' onchange="'.$jscall.'" />');
return $result;	return $result;
}	}
Line 1598 sub authform_filesystem{	Line 1702 sub authform_filesystem{
my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";	my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
my $result.= &mt	my $result.= &mt
('[_1] Filesystem Authenticated (with initial password [_2])',	('[_1] Filesystem Authenticated (with initial password [_2])',
'<input type="radio" name="login" value="fsys" '.	'<label><input type="radio" name="login" value="fsys" '.
'onchange="'.$jscall.'" onclick="'.$jscall.'" />',	'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
'<input type="text" size="10" name="fsysarg" value="" '.	'</label><input type="text" size="10" name="fsysarg" value="" '.
'onchange="'.$jscall.'" />');	'onchange="'.$jscall.'" />');
return $result;	return $result;
}	}
Line 1853 if the user does not	Line 1957 if the user does not
sub nickname {	sub nickname {
my ($uname,$udom)=@_;	my ($uname,$udom)=@_;
my %names;	my %names;
if ($uname eq $ENV{'user.name'} &&	if ($uname eq $env{'user.name'} &&
$udom eq $ENV{'user.domain'}) {	$udom eq $env{'user.domain'}) {
%names=('nickname' => $ENV{'environment.nickname'} ,	%names=('nickname' => $env{'environment.nickname'} ,
'firstname' => $ENV{'environment.firstname'} ,	'firstname' => $env{'environment.firstname'} ,
'middlename' => $ENV{'environment.middlename'},	'middlename' => $env{'environment.middlename'},
'lastname' => $ENV{'environment.lastname'} ,	'lastname' => $env{'environment.lastname'} ,
'generation' => $ENV{'environment.generation'});	'generation' => $env{'environment.generation'});
} else {	} else {
%names=&Apache::lonnet::get('environment',	%names=&Apache::lonnet::get('environment',
['nickname','firstname','middlename',	['nickname','firstname','middlename',
Line 1890 Gets a users screenname and returns it a	Line 1994 Gets a users screenname and returns it a

sub screenname {	sub screenname {
my ($uname,$udom)=@_;	my ($uname,$udom)=@_;
if ($uname eq $ENV{'user.name'} &&	if ($uname eq $env{'user.name'} &&
$udom eq $ENV{'user.domain'}) {return $ENV{'environment.screenname'};}	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);	my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
return $names{'screenname'};	return $names{'screenname'};
}	}
Line 1933 sub syllabuswrapper {	Line 2037 sub syllabuswrapper {
}	}

sub track_student_link {	sub track_student_link {
my ($linktext,$sname,$sdom,$target) = @_;	my ($linktext,$sname,$sdom,$target,$start) = @_;
my $link ="/adm/trackstudent";	my $link ="/adm/trackstudent?";
my $title = 'View recent activity';	my $title = 'View recent activity';
if (defined($sname) && $sname !~ /^\s*$/ &&	if (defined($sname) && $sname !~ /^\s*$/ &&
defined($sdom) && $sdom !~ /^\s*$/) {	defined($sdom) && $sdom !~ /^\s*$/) {
$link .= "?selected_student=$sname:$sdom";	$link .= "selected_student=$sname:$sdom";
$title .= ' of this student';	$title .= ' of this student';
}	}
if (defined($target) && $target !~ /^\s*$/) {	if (defined($target) && $target !~ /^\s*$/) {
$target = qq{target="$target"};	$target = qq{target="$target"};
} else {	} else {
$target = '';	$target = '';
}	}
	if ($start) { $link.='&start='.$start; }
return qq{<a href="$link" title="$title" $target>$linktext</a>};	return qq{<a href="$link" title="$title" $target>$linktext</a>};
}	}



=pod	=pod

=back	=back
Line 2139 sub display_languages {	Line 2242 sub display_languages {
$languages{$_}=1;	$languages{$_}=1;
}	}
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);	&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
if ($ENV{'form.displaylanguage'}) {	if ($env{'form.displaylanguage'}) {
foreach (split(/\s(\,\|\;\|\:)\s/,$ENV{'form.displaylanguage'})) {	foreach (split(/\s(\,\|\;\|\:)\s/,$env{'form.displaylanguage'})) {
$languages{$_}=1;	$languages{$_}=1;
}	}
}	}
Line 2149 sub display_languages {	Line 2252 sub display_languages {

sub preferred_languages {	sub preferred_languages {
my @languages=();	my @languages=();
if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {	if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,	@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,
$ENV{'course.'.$ENV{'request.course.id'}.'.languages'}));	$env{'course.'.$env{'request.course.id'}.'.languages'}));
}	}
if ($ENV{'environment.languages'}) {	if ($env{'environment.languages'}) {
@languages=split(/\s(\,\|\;\|\:)\s/,$ENV{'environment.languages'});	@languages=split(/\s(\,\|\;\|\:)\s/,$env{'environment.languages'});
}	}
my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];	my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];
if ($browser) {	if ($browser) {
@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,$browser));	@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,$browser));
}	}
if ($Apache::lonnet::domain_lang_def{$ENV{'user.domain'}}) {	if ($Apache::lonnet::domain_lang_def{$env{'user.domain'}}) {
@languages=(@languages,	@languages=(@languages,
$Apache::lonnet::domain_lang_def{$ENV{'user.domain'}});	$Apache::lonnet::domain_lang_def{$env{'user.domain'}});
}	}
if ($Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}}) {	if ($Apache::lonnet::domain_lang_def{$env{'request.role.domain'}}) {
@languages=(@languages,	@languages=(@languages,
$Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}});	$Apache::lonnet::domain_lang_def{$env{'request.role.domain'}});
}	}
if ($Apache::lonnet::domain_lang_def{	if ($Apache::lonnet::domain_lang_def{
$Apache::lonnet::perlvar{'lonDefDomain'}}) {	$Apache::lonnet::perlvar{'lonDefDomain'}}) {
Line 2433 sub pgrdlink {	Line 2536 sub pgrdlink {
Inputs: $text $uname $udom $symb $target	Inputs: $text $uname $udom $symb $target

Returns: A link to parmset.pm such as to see the PPRM view of a	Returns: A link to parmset.pm such as to see the PPRM view of a
student andn resource	student and a specific resource

=cut	=cut

Line 2488 sub maketime {	Line 2591 sub maketime {
sub findallcourses {	sub findallcourses {
my %courses=();	my %courses=();
my $now=time;	my $now=time;
foreach (keys %ENV) {	foreach (keys %env) {
if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {	if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {
my ($starttime,$endtime)=$ENV{$_};	my ($starttime,$endtime)=$env{$_};
my $active=1;	my $active=1;
if ($starttime) {	if ($starttime) {
if ($now<$starttime) { $active=0; }	if ($now<$starttime) { $active=0; }
Line 2527 sub determinedomain {	Line 2630 sub determinedomain {
if (! $domain) {	if (! $domain) {
# Determine domain if we have not been given one	# Determine domain if we have not been given one
$domain = $Apache::lonnet::perlvar{'lonDefDomain'};	$domain = $Apache::lonnet::perlvar{'lonDefDomain'};
if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; }	if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
if ($ENV{'request.role.domain'}) {	if ($env{'request.role.domain'}) {
$domain=$ENV{'request.role.domain'};	$domain=$env{'request.role.domain'};
}	}
}	}
return $domain;	return $domain;
Line 2574 Returns: value of designparamter $which	Line 2677 Returns: value of designparamter $which
##############################################	##############################################
sub designparm {	sub designparm {
my ($which,$domain)=@_;	my ($which,$domain)=@_;
if ($ENV{'browser.blackwhite'} eq 'on') {	if ($env{'browser.blackwhite'} eq 'on') {
if ($which=~/\.(font\|alink\|vlink\|link)$/) {	if ($which=~/\.(font\|alink\|vlink\|link)$/) {
return '#000000';	return '#000000';
}	}
Line 2585 sub designparm {	Line 2688 sub designparm {
return '#CCCCCC';	return '#CCCCCC';
}	}
}	}
if ($ENV{'environment.color.'.$which}) {	if ($env{'environment.color.'.$which}) {
return $ENV{'environment.color.'.$which};	return $env{'environment.color.'.$which};
}	}
$domain=&determinedomain($domain);	$domain=&determinedomain($domain);
if ($designhash{$domain.'.'.$which}) {	if ($designhash{$domain.'.'.$which}) {
Line 2638 other decorations will be returned.	Line 2741 other decorations will be returned.
=cut	=cut

sub bodytag {	sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle)=@_;	my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,$notopbar)=@_;
$title=&mt($title);	$title=&mt($title);
$function = &get_users_function() if (!$function);	$function = &get_users_function() if (!$function);
my $img=&designparm($function.'.img',$domain);	my $img=&designparm($function.'.img',$domain);
Line 2652 sub bodytag {	Line 2755 sub bodytag {
# Accessibility font enhance	# Accessibility font enhance
unless ($addentries) { $addentries=''; }	unless ($addentries) { $addentries=''; }
my $addstyle='';	my $addstyle='';
if ($ENV{'browser.fontenhance'} eq 'on') {	if ($env{'browser.fontenhance'} eq 'on') {
$addstyle=' font-size: x-large;';	$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]);
# realm	# realm
if ($ENV{'request.course.id'}) {	if ($env{'request.course.id'}) {
$realm=	$realm=
$ENV{'course.'.$ENV{'request.course.id'}.'.description'};	$env{'course.'.$env{'request.course.id'}.'.description'};
}	}
unless ($realm) { $realm=' '; }	unless ($realm) { $realm=' '; }
# Set messages	# Set messages
Line 2674 sub bodytag {	Line 2777 sub bodytag {
<style type="text/css">	<style type="text/css">
h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }	h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
a:focus { color: red; background: yellow }	a:focus { color: red; background: yellow }
	table.thinborder { border-collapse: collapse; }
	table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}
	form, .inline { display: inline; }
	.center { text-align: center; }
</style>	</style>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"	<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
style="margin-top: 0px;$addstyle" $addentries>	style="margin-top: 0px;$addstyle" $addentries>
END	END
if ($ENV{'environment.texengine'} eq 'jsMath') {	&Apache::lontexconvert::jsMath_reset();
$bodytag.='<script type="text/javascript">	if ($env{'environment.texengine'} eq 'jsMath') {
function NoFontMessage () {}	$bodytag.=&Apache::lontexconvert::jsMath_header();
</script>'."\n".
'<script src="/adm/jsMath/jsMath.js"></script>'."\n";
}	}

my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.	my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
$lonhttpdPort.$img.'" alt="'.$function.'" />';	$lonhttpdPort.$img.'" alt="'.$function.'" />';
if ($bodyonly) {	if ($bodyonly) {
return $bodytag;	return $bodytag;
} elsif ($ENV{'browser.interface'} eq 'textual') {	} elsif ($env{'browser.interface'} eq 'textual') {
# Accessibility	# Accessibility

return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',	return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
$forcereg).	$forcereg).
'<h1>LON-CAPA: '.$title.'</h1>';	'<h1>LON-CAPA: '.$title.'</h1>';
} elsif ($ENV{'environment.remote'} eq 'off') {	} elsif ($env{'environment.remote'} eq 'off') {
# No Remote	# No Remote
my $roleinfo=(<<ENDROLE);	my $roleinfo=(<<ENDROLE);
<td bgcolor="$tabbg" align="right">	<td bgcolor="$tabbg" align="right">
<font size="2" face="Arial, Helvetica, sans-serif">	<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'}
$ENV{'environment.generation'}	$env{'environment.generation'}
</font>	</font>
<br />	<br />
<font size="2" face="Arial, Helvetica, sans-serif">$role</font>	<font size="2" face="Arial, Helvetica, sans-serif">$role</font>
Line 2717 ENDROLE	Line 2822 ENDROLE
$titleinfo = $customtitle;	$titleinfo = $customtitle;
}	}

if ($ENV{'request.state'} eq 'construct') {	if ($env{'request.state'} eq 'construct') {
my ($uname,$thisdisfn)=	my ($uname,$thisdisfn)=
($ENV{'request.filename'} =~ m\|^/home/([^/]+)/public_html/(.*)\|);	($env{'request.filename'} =~ m\|^/home/([^/]+)/public_html/(.*)\|);
my $formaction='/priv/'.$uname.'/'.$thisdisfn;	my $formaction='/priv/'.$uname.'/'.$thisdisfn;
$formaction=~s/\/+/\//g;	$formaction=~s/\/+/\//g;
unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm	unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm
Line 2745 ENDROLE	Line 2850 ENDROLE
}	}
my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.	my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.
'cellspacing="3" cellpadding="3">'.	'cellspacing="3" cellpadding="3">'.
'<tr><td rowspan="3" bgcolor="'.$tabbg.'">'.	'<tr><td bgcolor="'.$tabbg.'">'.
$titleinfo.'</td>'.$roleinfo.'</tr></table>';	$titleinfo.'</td>'.$roleinfo.'</tr></table>';
if ($ENV{'request.state'} eq 'construct') {	if ($env{'request.state'} eq 'construct') {
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);	if ($notopbar) {
	$bodytag .= $titletable;
	} else {
	$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);
	}
} else {	} else {
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).	if ($notopbar) {
	$bodytag .= $titletable;
	} else {
	$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).
$titletable;	$titletable;
	}
}	}
return $bodytag;	return $bodytag;
}	}
Line 2766 ENDROLE	Line 2879 ENDROLE
#	#
# Extra info if you are the DC	# Extra info if you are the DC
my $dc_info = '';	my $dc_info = '';
if ($ENV{'user.adv'} && exists($ENV{'user.role.dc./'.	if ($env{'user.adv'} && exists($env{'user.role.dc./'.
$ENV{'course.'.$ENV{'request.course.id'}.	$env{'course.'.$env{'request.course.id'}.
'.domain'}.'/'})) {	'.domain'}.'/'})) {
my $cid = $ENV{'request.course.id'};	my $cid = $env{'request.course.id'};
$dc_info.= $cid.' '.$ENV{'course.'.$cid.'.internal.coursecode'};	$dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
$dc_info = '('.$dc_info.')';	$dc_info = '('.$dc_info.')';
}	}
#	#
return(<<ENDBODY);	return(<<ENDBODY);
$bodytag	$bodytag
<table width="100%" cellspacing="0" border="0" cellpadding="0">	<table class="thinborder" width="100%" cellspacing="0" border="0" cellpadding="0">
<tr><td bgcolor="$sidebg">	<tr><td bgcolor="$sidebg">
$upperleft</td>	$upperleft</td>
<td bgcolor="$sidebg" align="right">$messages </td>	<td bgcolor="$sidebg" align="right">$messages </td>
Line 2784 $upperleft</td>	Line 2897 $upperleft</td>
<tr>	<tr>
<td rowspan="3" bgcolor="$tabbg">	<td rowspan="3" bgcolor="$tabbg">
$titleinfo $dc_info	$titleinfo $dc_info
<td bgcolor="$tabbg" align="right">	</td><td bgcolor="$tabbg" align="right">
<font size="2" face="Arial, Helvetica, sans-serif">	<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'}
$ENV{'environment.generation'}	$env{'environment.generation'}
</font>	</font>
</td>	</td>
</tr>	</tr>
Line 2829 Returns: A uniform footer for LON-CAPA w	Line 2942 Returns: A uniform footer for LON-CAPA w

sub endbodytag {	sub endbodytag {
my $endbodytag='</body>';	my $endbodytag='</body>';
if ($ENV{'environment.texengine'} eq 'jsMath') {	$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
$endbodytag='<script type="text/javascript">jsMath.Process()</script>'.
"\n".$endbodytag;
}
return $endbodytag;	return $endbodytag;
}	}

Line 2850 Returns either 'student','coordinator','	Line 2960 Returns either 'student','coordinator','
###############################################	###############################################
sub get_users_function {	sub get_users_function {
my $function = 'student';	my $function = 'student';
if ($ENV{'request.role'}=~/^(cc\|in\|ta\|ep)/) {	if ($env{'request.role'}=~/^(cc\|in\|ta\|ep)/) {
$function='coordinator';	$function='coordinator';
}	}
if ($ENV{'request.role'}=~/^(su\|dc\|ad\|li)/) {	if ($env{'request.role'}=~/^(su\|dc\|ad\|li)/) {
$function='admin';	$function='admin';
}	}
if (($ENV{'request.role'}=~/^(au\|ca)/) \|\|	if (($env{'request.role'}=~/^(au\|ca)/) \|\|
($ENV{'REQUEST_URI'}=~/^(\/priv\|\~)/)) {	($ENV{'REQUEST_URI'}=~/^(\/priv\|\~)/)) {
$function='author';	$function='author';
}	}
Line 2867 sub get_users_function {	Line 2977 sub get_users_function {

=pod	=pod

	=item check_user_status

	Determines current status of supplied role for a
	specific user. Roles can be active, previous or future.

	Inputs:
	user's domain, user's username, course's domain,
	course's number, optional section/group.

	Outputs:
	role status: active, previous or future.

	=cut

	sub check_user_status {
	my ($udom,$uname,$cdom,$crs,$role,$secgrp) = @_;
	my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
	my @uroles = keys %userinfo;
	my $srchstr;
	my $active_chk = 'none';
	if (@uroles > 0) {
	if (($role eq 'cc') \|\| ($secgrp eq '') \|\| (!defined($secgrp))) {
	$srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
	} else {
	$srchstr = '/'.$cdom.'/'.$crs.'/'.$secgrp.'_'.$role; }
	if (grep/^$srchstr$/,@uroles) {
	my $role_end = 0;
	my $role_start = 0;
	$active_chk = 'active';
	if ($userinfo{$srchstr} =~ m/^($role)_(\d+)/) {
	$role_end = $2;
	if ($userinfo{$srchstr} =~ m/^($role)_($role_end)_(\d+)$/) {
	$role_start = $3;
	}
	}
	if ($role_start > 0) {
	if (time < $role_start) {
	$active_chk = 'future';
	}
	}
	if ($role_end > 0) {
	if (time > $role_end) {
	$active_chk = 'previous';
	}
	}
	}
	}
	return $active_chk;
	}

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

	=pod

=item get_sections	=item get_sections

Determines all the sections for a course including	Determines all the sections for a course including
Line 2885 Returns number of sections.	Line 3049 Returns number of sections.
sub get_sections {	sub get_sections {
my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;	my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;
if (!($cdom && $cnum)) { return 0; }	if (!($cdom && $cnum)) { return 0; }
my $cid = $cdom.'_'.$cnum;
my $numsections = 0;	my $numsections = 0;

if (!defined($possible_roles) \|\| (grep/^st$/,@$possible_roles)) {	if (!defined($possible_roles) \|\| (grep/^st$/,@$possible_roles)) {
my ($classlist) = &Apache::loncoursedata::get_classlist($cid,$cdom,$cnum);	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
my $sec_index = &Apache::loncoursedata::CL_SECTION();	my $sec_index = &Apache::loncoursedata::CL_SECTION();
my $status_index = &Apache::loncoursedata::CL_STATUS();	my $status_index = &Apache::loncoursedata::CL_STATUS();
while (my ($student,$data) = each %$classlist) {	while (my ($student,$data) = each %$classlist) {
Line 2919 sub get_sections {	Line 3082 sub get_sections {
return $numsections;	return $numsections;
}	}

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

	=pod

	=item get_course_users

	Retrieves usernames:domains for users in the specified course
	with specific role(s), and access status.

	Incoming parameters:
	1. course domain
	2. course number
	3. access status: users must have - either active,
	previous, future, or all.
	4. reference to array of permissible roles
	5. reference to array of section restrictions (optional)
	6. reference to results object (hash of hashes).
	7. reference to optional userdata hash
	Keys of top level hash are roles.
	Keys of inner hashes are username:domain, with
	values set to access type.
	Optional userdata hash returns an array with arguments in the
	same order as loncoursedata::get_classlist() for student data.

	Entries for end, start, section and status are blank because
	of the possibility of multiple values for non-student roles.

	=cut

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

	sub get_course_users {
	my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_;
	my %idx = ();

	$idx{udom} = &Apache::loncoursedata::CL_SDOM();
	$idx{uname} = &Apache::loncoursedata::CL_SNAME();
	$idx{end} = &Apache::loncoursedata::CL_END();
	$idx{start} = &Apache::loncoursedata::CL_START();
	$idx{id} = &Apache::loncoursedata::CL_ID();
	$idx{section} = &Apache::loncoursedata::CL_SECTION();
	$idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
	$idx{status} = &Apache::loncoursedata::CL_STATUS();

	if (grep(/^st$/,@{$roles})) {
	my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
	my $now = time;
	foreach my $student (keys(%{$classlist})) {
	my $match = 0;
	if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
	unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/,
	@{$sections})) {
	next;
	}
	}
	if (defined($$types{'active'})) {
	if ($$classlist{$student}[$idx{status}] eq 'Active') {
	push(@{$$users{st}{$student}},'active');
	$match = 1;
	}
	}
	if (defined($$types{'previous'})) {
	if ($$classlist{$student}[$idx{end}] <= $now) {
	push(@{$$users{st}{$student}},'previous');
	$match = 1;
	}
	}
	if (defined($$types{'future'})) {
	if (($$classlist{$student}[$idx{start}] > $now) && ($$classlist{$student}[$idx{end}] > $now) \|\| ($$classlist{$student}[$idx{end}] == 0) \|\| ($$classlist{$student}[$idx{end}] eq '')) {
	push(@{$$users{st}{$student}},'future');
	$match = 1;
	}
	}
	if ($match && defined($userdata)) {
	$$userdata{$student} = $$classlist{$student};
	}
	}
	}
	if ((@{$roles} > 0) && (@{$roles} ne "st")) {
	my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);
	foreach my $person (@coursepersonnel) {
	my $match = 0;
	my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);
	$user =~ s/:$//;
	if (($role) && (grep(/^\Q$role\E$/,@{$roles}))) {
	my ($uname,$udom,$usec) = split(/:/,$user);
	if ($usec ne '' && (ref($sections) eq 'ARRAY') &&
	@{$sections} > 0) {
	unless(grep(/^\Q$usec\E$/,@{$sections})) {
	next;
	}
	}
	if ($uname ne '' && $udom ne '') {
	my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);
	foreach my $type (keys(%{$types})) {
	if ($status eq $type) {
	@{$$users{$role}{$user}} = $type;
	$match = 1;
	}
	}
	if ($match && defined($userdata) &&
	!exists($$userdata{$uname.':'.$udom})) {
	&get_user_info($udom,$uname,\%idx,$userdata);
	}
	}
	}
	}
	if (grep(/^ow$/,@{$roles})) {
	if ((defined($cdom)) && (defined($cnum))) {
	my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
	if ( defined($csettings{'internal.courseowner'}) ) {
	my $owner = $csettings{'internal.courseowner'};
	@{$$users{'ow'}{$owner.':'.$cdom}} = 'any';
	if (defined($userdata) &&
	!exists($$userdata{$owner.':'.$cdom})) {
	&get_user_info($cdom,$owner,\%idx,$userdata);
	}
	}
	}
	}
	}
	return;
	}

	sub get_user_info {
	my ($udom,$uname,$idx,$userdata) = @_;
	$$userdata{$uname.':'.$udom}[$$idx{fullname}] =
	&plainname($uname,$udom,'lastname');
	$$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
	$$userdata{$uname.':'.$udom}[$$idx{uname}] = $udom;
	return;
	}

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

sub get_posted_cgi {	sub get_posted_cgi {
my $r=shift;	my $r=shift;

my $buffer;	my $buffer;
	if ($r->header_in('Content-length')) {
$r->read($buffer,$r->header_in('Content-length'),0);	$r->read($buffer,$r->header_in('Content-length'),0);
	}
unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {	unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
my @pairs=split(/&/,$buffer);	my @pairs=split(/&/,$buffer);
my $pair;	my $pair;
Line 2950 sub get_posted_cgi {	Line 3248 sub get_posted_cgi {
if ($name) {	if ($name) {
chomp($value);	chomp($value);
if ($fname) {	if ($fname) {
$ENV{"form.$name.filename"}=$fname;	$env{"form.$name.filename"}=$fname;
$ENV{"form.$name.mimetype"}=$fmime;	$env{"form.$name.mimetype"}=$fmime;
} else {	} else {
$value=~s/\s+$//s;	$value=~s/\s+$//s;
}	}
Line 2983 sub get_posted_cgi {	Line 3281 sub get_posted_cgi {
}	}
}	}
}	}
$ENV{'request.method'}=$ENV{'REQUEST_METHOD'};	$env{'request.method'}=$ENV{'REQUEST_METHOD'};
$r->method_number(M_GET);	$r->method_number(M_GET);
$r->method('GET');	$r->method('GET');
$r->headers_in->unset('Content-length');	$r->headers_in->unset('Content-length');
Line 2993 sub get_posted_cgi {	Line 3291 sub get_posted_cgi {

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

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

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

=cut	=cut

Line 3013 sub get_unprocessed_cgi {	Line 3311 sub get_unprocessed_cgi {
if (!defined($possible_names) \|\| (grep {$_ eq $name} @$possible_names)) {	if (!defined($possible_names) \|\| (grep {$_ eq $name} @$possible_names)) {
$value =~ tr/+/ /;	$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
&Apache::lonxml::debug("Seting :$name: to :$value:");	unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
}	}
}	}
}	}
Line 3028 returns cache-controlling header code	Line 3325 returns cache-controlling header code
=cut	=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);
my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />	my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
<meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />	<meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
Line 3047 specifies header code to not have cache	Line 3344 specifies header code to not have cache
sub no_cache {	sub no_cache {
my ($r) = @_;	my ($r) = @_;
if ($ENV{'REQUEST_METHOD'} ne 'GET' &&	if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
$ENV{'request.method'} ne 'GET') { return ''; }	$env{'request.method'} ne 'GET') { return ''; }
my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));	my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
$r->no_cache(1);	$r->no_cache(1);
$r->header_out("Expires" => $date);	$r->header_out("Expires" => $date);
Line 3056 sub no_cache {	Line 3353 sub no_cache {

sub content_type {	sub content_type {
my ($r,$type,$charset) = @_;	my ($r,$type,$charset) = @_;
if ($ENV{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }	&no_cache($r);
	if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
unless ($charset) {	unless ($charset) {
$charset=&Apache::lonlocal::current_encoding;	$charset=&Apache::lonlocal::current_encoding;
}	}
Line 3072 sub content_type {	Line 3370 sub content_type {

=item * add_to_env($name,$value)	=item * add_to_env($name,$value)

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

Line 3080 reference and $value is added to the arr	Line 3378 reference and $value is added to the arr

sub add_to_env {	sub add_to_env {
my ($name,$value)=@_;	my ($name,$value)=@_;
if (defined($ENV{$name})) {	if (defined($env{$name})) {
if (ref($ENV{$name})) {	if (ref($env{$name})) {
#already have multiple values	#already have multiple values
push(@{ $ENV{$name} },$value);	push(@{ $env{$name} },$value);
} else {	} else {
#first time seeing multiple values, convert hash entry to an arrayref	#first time seeing multiple values, convert hash entry to an arrayref
my $first=$ENV{$name};	my $first=$env{$name};
undef($ENV{$name});	undef($env{$name});
push(@{ $ENV{$name} },$first,$value);	push(@{ $env{$name} },$first,$value);
}	}
} else {	} else {
$ENV{$name}=$value;	$env{$name}=$value;
}	}
}	}

Line 3099 sub add_to_env {	Line 3397 sub add_to_env {

=item * get_env_multiple($name)	=item * get_env_multiple($name)

gets $name from the %ENV hash, it seemlessly handles the cases where multiple	gets $name from the %env hash, it seemlessly handles the cases where multiple
values may be defined and end up as an array ref.	values may be defined and end up as an array ref.

returns an array of values	returns an array of values
Line 3109 returns an array of values	Line 3407 returns an array of values
sub get_env_multiple {	sub get_env_multiple {
my ($name) = @_;	my ($name) = @_;
my @values;	my @values;
if (defined($ENV{$name})) {	if (defined($env{$name})) {
# exists is it an array	# exists is it an array
if (ref($ENV{$name})) {	if (ref($env{$name})) {
@values=@{ $ENV{$name} };	@values=@{ $env{$name} };
} else {	} else {
$values[0]=$ENV{$name};	$values[0]=$env{$name};
}	}
}	}
return(@values);	return(@values);
Line 3132 sub get_env_multiple {	Line 3430 sub get_env_multiple {
=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'}
returns $datatoken to be put into hidden field	returns $datatoken to be put into hidden field

=cut	=cut

sub upfile_store {	sub upfile_store {
my $r=shift;	my $r=shift;
$ENV{'form.upfile'}=~s/\r/\n/gs;	$env{'form.upfile'}=~s/\r/\n/gs;
$ENV{'form.upfile'}=~s/\f/\n/gs;	$env{'form.upfile'}=~s/\f/\n/gs;
$ENV{'form.upfile'}=~s/\n+/\n/gs;	$env{'form.upfile'}=~s/\n+/\n/gs;
$ENV{'form.upfile'}=~s/\n+$//gs;	$env{'form.upfile'}=~s/\n+$//gs;

my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.	my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
{	{
my $datafile = $r->dir_config('lonDaemons').	my $datafile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp';	'/tmp/'.$datatoken.'.tmp';
if ( open(my $fh,">$datafile") ) {	if ( open(my $fh,">$datafile") ) {
print $fh $ENV{'form.upfile'};	print $fh $env{'form.upfile'};
close($fh);	close($fh);
}	}
}	}
Line 3162 sub upfile_store {	Line 3460 sub upfile_store {
=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'},
sets $ENV{'form.upfile'} to the contents of the file	sets $env{'form.upfile'} to the contents of the file

=cut	=cut

Line 3172 sub load_tmp_file {	Line 3470 sub load_tmp_file {
my @studentdata=();	my @studentdata=();
{	{
my $studentfile = $r->dir_config('lonDaemons').	my $studentfile = $r->dir_config('lonDaemons').
'/tmp/'.$ENV{'form.datatoken'}.'.tmp';	'/tmp/'.$env{'form.datatoken'}.'.tmp';
if ( open(my $fh,"<$studentfile") ) {	if ( open(my $fh,"<$studentfile") ) {
@studentdata=<$fh>;	@studentdata=<$fh>;
close($fh);	close($fh);
}	}
}	}
$ENV{'form.upfile'}=join('',@studentdata);	$env{'form.upfile'}=join('',@studentdata);
}	}

=pod	=pod
Line 3187 sub load_tmp_file {	Line 3485 sub load_tmp_file {

Separate uploaded file into records	Separate uploaded file into records
returns array of records,	returns array of records,
needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}	needs $env{'form.upfile'} and $env{'form.upfiletype'}

=cut	=cut

sub upfile_record_sep {	sub upfile_record_sep {
if ($ENV{'form.upfiletype'} eq 'xml') {	if ($env{'form.upfiletype'} eq 'xml') {
} else {	} else {
my @records;	my @records;
foreach my $line (split(/\n/,$ENV{'form.upfile'})) {	foreach my $line (split(/\n/,$env{'form.upfile'})) {
if ($line=~/^\s*$/) { next; }	if ($line=~/^\s*$/) { next; }
push(@records,$line);	push(@records,$line);
}	}
Line 3207 sub upfile_record_sep {	Line 3505 sub upfile_record_sep {

=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'}

=cut	=cut

	sub takeleft {
	my $index=shift;
	return substr('0000'.$index,-4,4);
	}

sub record_sep {	sub record_sep {
my $record=shift;	my $record=shift;
my %components=();	my %components=();
if ($ENV{'form.upfiletype'} eq 'xml') {	if ($env{'form.upfiletype'} eq 'xml') {
} elsif ($ENV{'form.upfiletype'} eq 'space') {	} elsif ($env{'form.upfiletype'} eq 'space') {
my $i=0;	my $i=0;
foreach (split(/\s+/,$record)) {	foreach (split(/\s+/,$record)) {
my $field=$_;	my $field=$_;
$field=~s/^(\"\|\')//;	$field=~s/^(\"\|\')//;
$field=~s/(\"\|\')$//;	$field=~s/(\"\|\')$//;
$components{$i}=$field;	$components{&takeleft($i)}=$field;
$i++;	$i++;
}	}
} elsif ($ENV{'form.upfiletype'} eq 'tab') {	} elsif ($env{'form.upfiletype'} eq 'tab') {
my $i=0;	my $i=0;
foreach (split(/\t/,$record)) {	foreach (split(/\t/,$record)) {
my $field=$_;	my $field=$_;
$field=~s/^(\"\|\')//;	$field=~s/^(\"\|\')//;
$field=~s/(\"\|\')$//;	$field=~s/(\"\|\')$//;
$components{$i}=$field;	$components{&takeleft($i)}=$field;
$i++;	$i++;
}	}
} else {	} else {
Line 3248 sub record_sep {	Line 3551 sub record_sep {
$field=~s/^\s*$delimiter//;	$field=~s/^\s*$delimiter//;
$field=~s/$delimiter\s*$//;	$field=~s/$delimiter\s*$//;
}	}
$components{$i}=$field;	$components{&takeleft($i)}=$field;
$i++;	$i++;
}	}
}	}
Line 3405 sub csv_samples_select_table {	Line 3708 sub csv_samples_select_table {
$display.'</option>');	$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"); }
if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }	if (defined($stwo{$_})) { $r->print($stwo{$_}."<br />\n"); }
if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }	if (defined($sthree{$_})) { $r->print($sthree{$_}."<br />\n"); }
$r->print('</td></tr>');	$r->print('</td></tr>');
$i++;	$i++;
}	}
Line 3496 the routine &Apache::lonnet::transfer_pr	Line 3799 the routine &Apache::lonnet::transfer_pr
my $uniq=0;	my $uniq=0;
sub get_cgi_id {	sub get_cgi_id {
$uniq=($uniq+1)%100000;	$uniq=($uniq+1)%100000;
return (time.'_'.$uniq);	return (time.'_'.$$.'_'.$uniq);
}	}

############################################################	############################################################
Line 3915 Returns: both routines return nothing	Line 4218 Returns: both routines return nothing
sub store_course_settings {	sub store_course_settings {
# save to the environment	# save to the environment
# appenv the same items, just to be safe	# appenv the same items, just to be safe
my $courseid = $ENV{'request.course.id'};	my $courseid = $env{'request.course.id'};
my $coursedom = $ENV{'course.'.$courseid.'.domain'};	my $coursedom = $env{'course.'.$courseid.'.domain'};
my ($prefix,$Settings) = @_;	my ($prefix,$Settings) = @_;
my %SaveHash;	my %SaveHash;
my %AppHash;	my %AppHash;
while (my ($setting,$type) = each(%$Settings)) {	while (my ($setting,$type) = each(%$Settings)) {
my $basename = 'internal.'.$prefix.'.'.$setting;	my $basename = 'internal.'.$prefix.'.'.$setting;
my $envname = 'course.'.$courseid.'.'.$basename;	my $envname = 'course.'.$courseid.'.'.$basename;
if (exists($ENV{'form.'.$setting})) {	if (exists($env{'form.'.$setting})) {
# Save this value away	# Save this value away
if ($type eq 'scalar' &&	if ($type eq 'scalar' &&
(! exists($ENV{$envname}) \|\|	(! exists($env{$envname}) \|\|
$ENV{$envname} ne $ENV{'form.'.$setting})) {	$env{$envname} ne $env{'form.'.$setting})) {
$SaveHash{$basename} = $ENV{'form.'.$setting};	$SaveHash{$basename} = $env{'form.'.$setting};
$AppHash{$envname} = $ENV{'form.'.$setting};	$AppHash{$envname} = $env{'form.'.$setting};
} elsif ($type eq 'array') {	} elsif ($type eq 'array') {
my $stored_form;	my $stored_form;
if (ref($ENV{'form.'.$setting})) {	if (ref($env{'form.'.$setting})) {
$stored_form = join(',',	$stored_form = join(',',
map {	map {
&Apache::lonnet::escape($_);	&Apache::lonnet::escape($_);
} sort(@{$ENV{'form.'.$setting}}));	} sort(@{$env{'form.'.$setting}}));
} else {	} else {
$stored_form =	$stored_form =
&Apache::lonnet::escape($ENV{'form.'.$setting});	&Apache::lonnet::escape($env{'form.'.$setting});
}	}
# Determine if the array contents are the same.	# Determine if the array contents are the same.
if ($stored_form ne $ENV{$envname}) {	if ($stored_form ne $env{$envname}) {
$SaveHash{$basename} = $stored_form;	$SaveHash{$basename} = $stored_form;
$AppHash{$envname} = $stored_form;	$AppHash{$envname} = $stored_form;
}	}
Line 3951 sub store_course_settings {	Line 4254 sub store_course_settings {
}	}
my $put_result = &Apache::lonnet::put('environment',\%SaveHash,	my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
$coursedom,	$coursedom,
$ENV{'course.'.$courseid.'.num'});	$env{'course.'.$courseid.'.num'});
if ($put_result !~ /^(ok\|delayed)/) {	if ($put_result !~ /^(ok\|delayed)/) {
&Apache::lonnet::logthis('unable to save form parameters, '.	&Apache::lonnet::logthis('unable to save form parameters, '.
'got error:'.$put_result);	'got error:'.$put_result);
Line 3962 sub store_course_settings {	Line 4265 sub store_course_settings {
}	}

sub restore_course_settings {	sub restore_course_settings {
my $courseid = $ENV{'request.course.id'};	my $courseid = $env{'request.course.id'};
my ($prefix,$Settings) = @_;	my ($prefix,$Settings) = @_;
while (my ($setting,$type) = each(%$Settings)) {	while (my ($setting,$type) = each(%$Settings)) {
next if (exists($ENV{'form.'.$setting}));	next if (exists($env{'form.'.$setting}));
my $envname = 'course.'.$courseid.'.internal.'.$prefix.	my $envname = 'course.'.$courseid.'.internal.'.$prefix.
'.'.$setting;	'.'.$setting;
if (exists($ENV{$envname})) {	if (exists($env{$envname})) {
if ($type eq 'scalar') {	if ($type eq 'scalar') {
$ENV{'form.'.$setting} = $ENV{$envname};	$env{'form.'.$setting} = $env{$envname};
} elsif ($type eq 'array') {	} elsif ($type eq 'array') {
$ENV{'form.'.$setting} = [	$env{'form.'.$setting} = [
map {	map {
&Apache::lonnet::unescape($_);	&Apache::lonnet::unescape($_);
} split(',',$ENV{$envname})	} split(',',$env{$envname})
];	];
}	}
}	}

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

Removed from v.1.255
changed lines
	Added in v.1.293