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.246 and 1.335

version 1.246, 2005/01/14 21:15:09	version 1.335, 2006/04/13 21:02:25
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::lonmenu();	use Apache::lonmenu();
use Apache::lonlocal;	use Apache::lonlocal;
use HTML::Entities;	use HTML::Entities;
	use Apache::lonhtmlcommon();
	use Apache::loncoursedata();

my $readit;	my $readit;

Line 152 BEGIN {	Line 153 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 313 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 331 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)/)	\|\| &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
	'/'.$env{'request.course.sec'})
	))
	\|\| ($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 365 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'})) {	if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
	&& !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
	'/'.$env{'request.course.sec'})) {
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 386 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 409 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 423 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 547 END	Line 582 END
$result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";	$result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
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=\"selected\" " if ($value eq $firstdefault);
$result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";	$result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
}	}
$result .= "</select>\n";	$result .= "</select>\n";
Line 557 END	Line 592 END
my $seconddefault = $hashref->{$firstdefault}->{'default'};	my $seconddefault = $hashref->{$firstdefault}->{'default'};
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=\"selected\" " if ($value eq $seconddefault);
$result.=">".&mt($select2{$value})."</option>\n";	$result.=">".&mt($select2{$value})."</option>\n";
}	}
$result .= "</select>\n";	$result .= "</select>\n";
Line 593 sub help_open_topic {	Line 628 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 694 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 708 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 718 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 $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");	my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
	my $start_page =
	&Apache::loncommon::start_page('Help Menu', undef,
	{'frameset' => 1,
	'js_ready' => 1,
	'add_entries' => {
	'border' => '0',
	'rows' => "105,*",},});
	my $end_page =
	&Apache::loncommon::end_page({'frameset' => 1,
	'js_ready' => 1,});

$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<script type="text/javascript">	<script type="text/javascript">
//<!-- BEGIN LON-CAPA Internal	// <!-- BEGIN LON-CAPA Internal
	// <![CDATA[
function helpMenu(target) {	function helpMenu(target) {
var caller = this;	var caller = this;
if (target == 'open') {	if (target == 'open') {
var newWindow = null;	var newWindow = null;
try {	try {
newWindow = window.open("","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 710 function helpMenu(target) {	Line 757 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('$start_page<frame name="bannerframe" src="$banner_link" /><frame name="bodyframe" src="$details_link" /> $end_page')
caller.document.write("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
caller.document.write("</html>")
caller.document.close()	caller.document.close()
caller.focus()	caller.focus()
}	}
	// ]]>
// END LON-CAPA Internal -->	// END LON-CAPA Internal -->
</script>	</script>
<a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>	<a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>
Line 739 ENDTEMPLATE	Line 785 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 784 ENDTEMPLATE	Line 830 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 832 ENDTEMPLATE	Line 878 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 848 sub csv_translate {	Line 986 sub csv_translate {
return $text;	return $text;
}	}


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

Line 872 Currently supported formats:	Line 1009 Currently supported formats:

=item h3	=item h3

	=item h4

	=item i

=item date	=item date

=back	=back
Line 894 sub define_excel_formats {	Line 1035 sub define_excel_formats {
$format->{'h1'} = $workbook->add_format(bold=>1, size=>18);	$format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
$format->{'h2'} = $workbook->add_format(bold=>1, size=>16);	$format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
$format->{'h3'} = $workbook->add_format(bold=>1, size=>14);	$format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
	$format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
$format->{'i'} = $workbook->add_format(italic=>1);	$format->{'i'} = $workbook->add_format(italic=>1);
$format->{'date'} = $workbook->add_format(num_format=>	$format->{'date'} = $workbook->add_format(num_format=>
'mm/dd/yyyy hh:mm:ss');	'mm/dd/yyyy hh:mm:ss');
Line 905 sub define_excel_formats {	Line 1047 sub define_excel_formats {

=pod	=pod

=item * change_content_javascript():	=item * create_workbook

This and the next function allow you to create small sections of an	Create an Excel worksheet. If it fails, output message on the
otherwise static HTML page that you can update on the fly with	request object and return undefs.
Javascript, even in Netscape 4.

The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)	Inputs: Apache request object
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	Returns (undef) on failure,
to contain room for the original contents. You need to "make space"	Excel worksheet object, scalar with filename, and formats
for whatever changes you wish to make, and be B<sure> to check your	from &Apache::loncommon::define_excel_formats on success
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	=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_workbook {
$ENV{'browser.version'} =~ /^4\./) {	my ($r) = @_;
return (<<NETSCAPE4);	#
function change(name, content) {	# Create the excel spreadsheet
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).'.xls';
doc.close();	my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
}	if (! defined($workbook)) {
NETSCAPE4	$r->log_error("Error creating excel spreadsheet $filename: $!");
} else {	$r->print('<p>'.&mt("Unable to create new Excel 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	'</p>');
return (<<DOMBASED);	return (undef);
function change(name, content) {
element = document.getElementById(name);
element.innerHTML = content;
}
DOMBASED
}	}
	#
	$workbook->set_tempdir('/home/httpd/perl/tmp');
	#
	my $format = &Apache::loncommon::define_excel_formats($workbook);
	return ($workbook,$filename,$format);
}	}

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

=pod	=pod

=item * changable_area($name, $origContent):	=item * create_text_file

This provides a "changable area" that can be modified on the fly via	Create a file to write to and eventually make available to the usre.
the Javascript code provided in C<change_content_javascript>. $name is	If file creation fails, outputs an error message on the request object and
the name you will use to reference the area later; do not repeat the	return undefs.
same name on a given HTML page more then once. $origContent is what
the area will originally contain, which can be left blank.

=cut	Inputs: Apache request object, and file suffix

sub changable_area {	Returns (undef) on failure,
my ($name, $origContent) = @_;	Filehandle and filename on success.

if ($ENV{'browser.type'} eq 'netscape' &&	=cut
$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 {	sub create_text_file {
return "<span id='$name'>$origContent</span>";	my ($r,$suffix) = @_;
	if (! defined($suffix)) { $suffix = 'txt'; };
	my $fh;
	my $filename = '/prtspool/'.
	$env{'user.name'}.'_'.$env{'user.domain'}.'_'.
	time.'_'.rand(1000000000).'.'.$suffix;
	$fh = Apache::File->new('>/home/httpd'.$filename);
	if (! defined($fh)) {
	$r->log_error("Couldn't open $filename for output $!");
	$r->print("Problems occured in creating the output file. ".
	"This error has been logged. ".
	"Please alert your LON-CAPA administrator.");
}	}
	return ($fh,$filename)
}	}

=pod
	=pod

=back	=back

Line 1025 sub domain_select {	Line 1166 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 ' 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 1075 sub select_form {	Line 1238 sub select_form {
}	}
foreach (@keys) {	foreach (@keys) {
$selectform.="<option value=\"$_\" ".	$selectform.="<option value=\"$_\" ".
($_ eq $def ? 'selected' : '').	($_ eq $def ? 'selected="selected" ' : '').
">".&mt($hash{$_})."</option>\n";	">".&mt($hash{$_})."</option>\n";
}	}
$selectform.="</select>";	$selectform.="</select>";
Line 1112 sub select_level_form {	Line 1275 sub select_level_form {
my $selectform = "<select name=\"$name\" size=\"1\">\n";	my $selectform = "<select name=\"$name\" size=\"1\">\n";
for (my $i=0; $i<=18; $i++) {	for (my $i=0; $i<=18; $i++) {
$selectform.="<option value=\"$i\" ".	$selectform.="<option value=\"$i\" ".
($i==$deflevel ? 'selected' : '').	($i==$deflevel ? 'selected="selected" ' : '').
">".&gradeleveldescription($i)."</option>\n";	">".&gradeleveldescription($i)."</option>\n";
}	}
$selectform.="</select>";	$selectform.="</select>";
Line 1142 sub select_dom_form {	Line 1305 sub select_dom_form {
my $selectdomain = "<select name=\"$name\" size=\"1\">\n";	my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
foreach (@domains) {	foreach (@domains) {
$selectdomain.="<option value=\"$_\" ".	$selectdomain.="<option value=\"$_\" ".
($_ eq $defdom ? 'selected' : '').	($_ eq $defdom ? 'selected="selected" ' : '').
">$_</option>\n";	">$_</option>\n";
}	}
$selectdomain.="</select>";	$selectdomain.="</select>";
Line 1241 Outputs:	Line 1404 Outputs:
###############################################################	###############################################################
###############################################################	###############################################################
sub decode_user_agent {	sub decode_user_agent {
	my ($r)=@_;
my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});	my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});	my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
my $httpbrowser=$ENV{"HTTP_USER_AGENT"};	my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
	if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
my $clientbrowser='unknown';	my $clientbrowser='unknown';
my $clientversion='0';	my $clientversion='0';
my $clientmathml='';	my $clientmathml='';
Line 1439 sub authform_nochange{	Line 1604 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 1474 sub authform_kerberos{	Line 1640 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 1506 sub authform_internal{	Line 1673 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 1533 sub authform_local{	Line 1700 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 1549 sub authform_filesystem{	Line 1716 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 1767 if $first is set to 'lastname' then it r	Line 1934 if $first is set to 'lastname' then it r

=cut	=cut


###############################################################	###############################################################
sub plainname {	sub plainname {
my ($uname,$udom,$first)=@_;	my ($uname,$udom,$first)=@_;
my %names=&Apache::lonnet::get('environment',	my %names=&getnames($uname,$udom);
['firstname','middlename','lastname','generation'],
$udom,$uname);
my $name=&Apache::lonnet::format_name($names{'firstname'},	my $name=&Apache::lonnet::format_name($names{'firstname'},
$names{'middlename'},	$names{'middlename'},
$names{'lastname'},	$names{'lastname'},
Line 1803 if the user does not	Line 1969 if the user does not

sub nickname {	sub nickname {
my ($uname,$udom)=@_;	my ($uname,$udom)=@_;
my %names;	my %names=&getnames($uname,$udom);
if ($uname eq $ENV{'user.name'} &&
$udom eq $ENV{'user.domain'}) {
%names=('nickname' => $ENV{'environment.nickname'} ,
'firstname' => $ENV{'environment.firstname'} ,
'middlename' => $ENV{'environment.middlename'},
'lastname' => $ENV{'environment.lastname'} ,
'generation' => $ENV{'environment.generation'});
} else {
%names=&Apache::lonnet::get('environment',
['nickname','firstname','middlename',
'lastname','generation'],$udom,$uname);
}
my $name=$names{'nickname'};	my $name=$names{'nickname'};
if ($name) {	if ($name) {
$name='"'.$name.'"';	$name='"'.$name.'"';
Line 1828 sub nickname {	Line 1982 sub nickname {
return $name;	return $name;
}	}

	sub getnames {
	my ($uname,$udom)=@_;
	my $id=$uname.':'.$udom;
	my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
	if ($cached) {
	return %{$names};
	} else {
	my %loadnames=&Apache::lonnet::get('environment',
	['firstname','middlename','lastname','generation','nickname'],
	$udom,$uname);
	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
	return %loadnames;
	}
	}

# ------------------------------------------------------------------ Screenname	# ------------------------------------------------------------------ Screenname

Line 1841 Gets a users screenname and returns it a	Line 2009 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 1884 sub syllabuswrapper {	Line 2052 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 2090 sub display_languages {	Line 2257 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 2100 sub display_languages {	Line 2267 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 2350 sub submlink {	Line 2517 sub submlink {
&Apache::lonxml::whichuser($symb);	&Apache::lonxml::whichuser($symb);
if (!$symb) { $symb=$cursymb; }	if (!$symb) { $symb=$cursymb; }
}	}
if (!$symb) { $symb=&symbread(); }	if (!$symb) { $symb=&Apache::lonnet::symbread(); }
$symb=&Apache::lonnet::escape($symb);	$symb=&Apache::lonnet::escape($symb);
if ($target) { $target="target=\"$target\""; }	if ($target) { $target="target=\"$target\""; }
return '<a href="/adm/grades?&command=submission&'.	return '<a href="/adm/grades?&command=submission&'.
Line 2384 sub pgrdlink {	Line 2551 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 2396 sub pprmlink {	Line 2563 sub pprmlink {
&Apache::lonxml::whichuser($symb);	&Apache::lonxml::whichuser($symb);
if (!$symb) { $symb=$cursymb; }	if (!$symb) { $symb=$cursymb; }
}	}
if (!$symb) { $symb=&symbread(); }	if (!$symb) { $symb=&Apache::lonnet::symbread(); }
$symb=&Apache::lonnet::escape($symb);	$symb=&Apache::lonnet::escape($symb);
if ($target) { $target="target=\"$target\""; }	if ($target) { $target="target=\"$target\""; }
return '<a href="/adm/parmset?&command=set&'.	return '<a href="/adm/parmset?&command=set&'.
Line 2439 sub maketime {	Line 2606 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 2478 sub determinedomain {	Line 2645 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 2525 Returns: value of designparamter $which	Line 2692 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 2536 sub designparm {	Line 2703 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 2579 Inputs:	Line 2746 Inputs:
=item * $forcereg, if page should register as content page (relevant for	=item * $forcereg, if page should register as content page (relevant for
text interface only)	text interface only)

	=item * $customtitle, alternate text to use instead of $title
	in the title box that appears, this text
	is not auto translated like the $title is

	=item * $notopbar, if true, keep the 'what is this' info but remove the
	navigational links

	=item * $bgcolor, used to override the bg coor on a webpage to a specific value

=back	=back

Returns: A uniform header for LON-CAPA web pages.	Returns: A uniform header for LON-CAPA web pages.
Line 2589 other decorations will be returned.	Line 2765 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,$bgcolor)=@_;
$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);
my $pgbg=&designparm($function.'.pgbg',$domain);	my $pgbg= $bgcolor \|\| &designparm($function.'.pgbg',$domain);
my $tabbg=&designparm($function.'.tabbg',$domain);	my $tabbg=&designparm($function.'.tabbg',$domain);
my $font=&designparm($function.'.font',$domain);	my $font=&designparm($function.'.font',$domain);
my $link=&designparm($function.'.link',$domain);	my $link=&designparm($function.'.link',$domain);
Line 2601 sub bodytag {	Line 2778 sub bodytag {
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	# Accessibility font enhance
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 2620 sub bodytag {	Line 2796 sub bodytag {
# Port for miniserver	# Port for miniserver
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};	my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }	if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }

	my $extra_body_attr = &make_attr_string($forcereg,$addentries);

# construct main body tag	# construct main body tag
my $bodytag = <<END;	my $bodytag = <<END;
<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; }
	.filename {font-family: monospace;}
</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" $extra_body_attr>
END	END

	$bodytag .= &Apache::lontexconvert::init_math_support();

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
	\|\| ($env{'request.state'} eq 'construct'
	&& $env{'environment.remote'} ne 'off' )) {
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 2661 ENDROLE	Line 2850 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 2689 ENDROLE	Line 2878 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 2710 ENDROLE	Line 2907 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.')';
}	}
	# Explicit link to get inline menu
	my $menu='<br /><font size="2" face="Arial, Helvetica, sans-serif"> <a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a></font>';
#	#
return(<<ENDBODY);	return(<<ENDBODY);
$bodytag	$bodytag
Line 2727 $upperleft</td>	Line 2926 $upperleft</td>
</tr>	</tr>
<tr>	<tr>
<td rowspan="3" bgcolor="$tabbg">	<td rowspan="3" bgcolor="$tabbg">
$titleinfo $dc_info	$titleinfo $dc_info $menu
<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 2746 $titleinfo $dc_info	Line 2945 $titleinfo $dc_info
ENDBODY	ENDBODY
}	}

	sub make_attr_string {
	my ($register,$attr_ref) = @_;

	if ($attr_ref && !ref($attr_ref)) {
	die("addentries Must be a hash ref ".
	join(':',caller(1))." ".
	join(':',caller(0))." ");
	}

	if ($register) {
	$attr_ref->{'onload'} = &Apache::lonmenu::loadevents().
	$attr_ref->{'onload'};
	$attr_ref->{'onunload'} = &Apache::lonmenu::unloadevents().
	$attr_ref->{'onunload'};
	}
	my $attr_string;
	foreach my $attr (keys(%$attr_ref)) {
	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
	}
	return $attr_string;
	}


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

	=pod

	=back

	=head1 HTML Helpers

	=over 4

	=item * &endbodytag()

	Returns a uniform footer for LON-CAPA web pages.

	Inputs: none

	=back

	=cut

	sub endbodytag {
	my $endbodytag='</body>';
	$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
	if ( exists( $env{'internal.head.redirect'} ) ) {
	$endbodytag=
	"<br /><a href=\"$env{'internal.head.redirect'}\">".
	&mt('Continue').'</a>'.
	$endbodytag;
	}
	return $endbodytag;
	}

	=pod

	=over 4

	=item * &headtag()

	Returns a uniform footer for LON-CAPA web pages.

	Inputs: $title - optional title for the head
	$head_extra - optional extra HTML to put inside the <head>
	$args - optional arguments
	force_register - if is true call registerurl so the remote is
	informed

	redirect - array ref of seconds before redirect occurs
	url to redirect to
	(side effect of setting
	$env{'internal.head.redirect'} to the url
	redirected too)
	=back

	=cut

	sub headtag {
	my ($title,$head_extra,$args) = @_;

	my $result =
	'<head>'.
	&Apache::lonxml::fontsettings().
	&Apache::lonhtmlcommon::htmlareaheaders();

	if ($args->{'force_register'}) {
	$result .= &Apache::lonmenu::registerurl(1);
	}

	if (ref($args->{'redirect'})) {
	my ($time,$url) = @{$args->{'redirect'}};
	$url = &Apache::lonenc::check_encrypt($url);
	$env{'internal.head.redirect'} = $url;
	$result.=<<ADDMETA
	<meta http-equiv="pragma" content="no-cache" />
	<meta HTTP-EQUIV="Refresh" CONTENT="$time; url=$url" />
	ADDMETA
	}
	if (!defined($title)) {
	$title = 'The LearningOnline Network with CAPA';
	}

	$result .= '<title> LON-CAPA '.&mt($title).'</title>'.$head_extra;
	return $result;
	}

	=pod

	=over 4

	=item * &endheadtag()

	Returns a uniform </head> for LON-CAPA web pages.

	Inputs: none

	=back

	=cut

	sub endheadtag {
	return '</head>';
	}

	=pod

	=over 4

	=item * &head()

	Returns a uniform complete <head>..</head> section for LON-CAPA web pages.

	Inputs: $title - optional title for the page
	$head_extra - optional extra HTML to put inside the <head>
	=back

	=cut

	sub head {
	my ($title,$head_extra,$args) = @_;
	return &headtag($title,$head_extra,$args).&endheadtag();
	}

	=pod

	=over 4

	=item * &start_page()

	Returns a complete <html> .. <body> section for LON-CAPA web pages.

	Inputs: $title - optional title for the page
	$head_extra - optional extra HTML to incude inside the <head>
	$args - additional optional args supported are:
	only_body -> is true will set &bodytag() onlybodytag
	arg on
	no_nav_bar -> is true will set &bodytag() notopbar arg on
	add_entries -> additional attributes to add to the <body>
	domain -> force to color decorate a page for a
	specific domain
	function -> force usage of a specific rolish color
	scheme
	redirect -> see &headtag()
	bgcolor -> override the default page bg color
	js_ready -> return a string ready for being used in
	a javascript writeln
	html_encode -> return a string ready for being used in
	a html attribute
	force_register -> if is true will turn on the &bodytag()
	$forcereg arg
	body_title -> alternate text to use instead of $title
	in the title box that appears, this text
	is not auto translated like the $title is
	frameset -> if true will start with a <frameset>
	rather than <body>
	=back

	=cut

	sub start_page {
	my ($title,$head_extra,$args) = @_;
	#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
	my %head_args;
	foreach my $arg ('redirect','force_register') {
	if (defined($args->{$arg})) {
	$head_args{$arg} = $args->{$arg};
	}
	}

	$env{'internal.start_page'}++;
	my $result =
	&Apache::lonxml::xmlbegin().
	&headtag($title,$head_extra,\%head_args).&endheadtag();
	if ($args->{'frameset'}) {
	my $attr_string = &make_attr_string($args->{'force_register'},
	$args->{'add_entries'});
	$result .= "\n<frameset $attr_string>\n";
	} else {
	$result .=
	&bodytag($title,
	$args->{'function'}, $args->{'add_entries'},
	$args->{'only_body'}, $args->{'domain'},
	$args->{'force_register'}, $args->{'body_title'},
	$args->{'no_nav_bar'}, $args->{'bgcolor'});
	}
	if ($args->{'js_ready'}) {
	$result = &js_ready($result);
	}
	if ($args->{'html_encode'}) {
	$result = &html_encode($result);
	}
	return $result;
	}


	=pod

	=over 4

	=item * &head()

	Returns a complete </body></html> section for LON-CAPA web pages.

	Inputs: $args - additional optional args supported are:
	js_ready -> return a string ready for being used in
	a javascript writeln
	html_encode -> return a string ready for being used in
	a html attribute
	frameset -> if true will start with a <frameset>
	rather than <body>
	=back

	=cut

	sub end_page {
	my ($args) = @_;
	#&Apache::lonnet::logthis("end_page ".join(':',caller(0)));
	$env{'internal.end_page'}++;
	my $result;
	if ($args->{'discussion'}) {
	my ($target,$parser);
	if (ref($args->{'discussion'})) {
	($target,$parser) =($args->{'discussion'}{'target'},
	$args->{'discussion'}{'parser'});
	}
	$result .= &Apache::lonxml::xmlend($target,$parser);
	}

	if ($args->{'frameset'}) {
	$result .= '</frameset>';
	} else {
	$result .= &endbodytag();
	}
	$result .= "\n</html>";

	if ($args->{'js_ready'}) {
	$result = &js_ready($result);
	}

	if ($args->{'html_encode'}) {
	$result = &html_encode($result);
	}

	return $result;
	}

	sub html_encode {
	my ($result) = @_;

	$result = &HTML::Entities::encode($result,'<>&"');

	return $result;
	}
	sub js_ready {
	my ($result) = @_;

	$result =~ s/[\n\r]/ /xmsg;
	$result =~ s/\\/\\\\/xmsg;
	$result =~ s/'/\\'/xmsg;
	$result =~ s{</script>}{</scrip'+'t>}xmsg;

	return $result;
	}

	sub validate_page {
	if ( exists($env{'internal.start_page'})
	&& $env{'internal.start_page'} > 1) {
	&Apache::lonnet::logthis('start_page called multiple times '.
	$env{'internal.start_page'}.' '.
	$ENV{'request.filename'});
	}
	if ( exists($env{'internal.end_page'})
	&& $env{'internal.end_page'} > 1) {
	&Apache::lonnet::logthis('end_page called multiple times '.
	$env{'internal.end_page'}.' '.
	$env{'request.filename'});
	}
	if ( exists($env{'internal.start_page'})
	&& ! exists($env{'internal.end_page'})) {
	&Apache::lonnet::logthis('start_page called without end_page '.
	$env{'request.filename'});
	}
	if ( ! exists($env{'internal.start_page'})
	&& exists($env{'internal.end_page'})) {
	&Apache::lonnet::logthis('end_page called without start_page'.
	$env{'request.filename'});
	}
	}

	sub simple_error_page {
	my ($r,$title,$msg) = @_;
	my $page =
	&Apache::loncommon::start_page($title).
	&mt($msg).
	&Apache::loncommon::end_page();
	if (ref($r)) {
	$r->print($page);
	return;
	}
	return $page;
	}
###############################################	###############################################

=pod	=pod

	=over 4

=item get_users_function	=item get_users_function

Used by &bodytag to determine the current users primary role.	Used by &bodytag to determine the current users primary role.
Line 2760 Returns either 'student','coordinator','	Line 3284 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 2777 sub get_users_function {	Line 3301 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 2795 Returns number of sections.	Line 3373 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 2829 sub get_sections {	Line 3406 sub get_sections {
return $numsections;	return $numsections;
}	}

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

	=pod

	=item coursegroups

sub get_posted_cgi {	Retrieve information about groups in a course,
my $r=shift;

my $buffer;	Input:
	1. Reference to hash to populate with group information.
$r->read($buffer,$r->header_in('Content-length'),0);	2. Optional course domain
unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {	3. Optional course number
my @pairs=split(/&/,$buffer);	4. Optional group name
my $pair;
foreach $pair (@pairs) {	Course domain and number will be taken from user's
my ($name,$value) = split(/=/,$pair);	environment if not supplied. Optional group name will'
$value =~ tr/+/ /;	be passed to lonnet::get_coursegroups() as a regexp to
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;	use in the call to the dump function.
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;	Output
&add_to_env("form.$name",$value);	Returns number of groups in the course (subject to the
}	optional group name filter).
} else {
my $contentsep=$1;	Side effects:
my @lines = split (/\n/,$buffer);	Populates the referenced curr_groups hash, with key,
my $name='';	value pairs. Keys are group names, corresponding values
my $value='';	are scalars containing group information in XML. This
my $fname='';	can be sent to &get_group_settings() to be parsed.
my $fmime='';
my $i;	=cut
for ($i=0;$i<=$#lines;$i++) {
if ($lines[$i]=~/^$contentsep/) {	###############################################
if ($name) {
chomp($value);	sub coursegroups {
if ($fname) {	my ($curr_groups,$cdom,$cnum,$group) = @_;
$ENV{"form.$name.filename"}=$fname;	my $numgroups;
$ENV{"form.$name.mimetype"}=$fmime;	if (!defined($cdom) \|\| !defined($cnum)) {
} else {	my $cid = $env{'request.course.id'};
$value=~s/\s+$//s;	$cdom = $env{'course.'.$cid.'.domain'};
}	$cnum = $env{'course.'.$cid.'.num'};
&add_to_env("form.$name",$value);	}
	%{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
	my ($tmp) = keys(%{$curr_groups});
	if ($tmp=~/^error:/) {
	unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') {
	&logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.
	$cdom);
	}
	$numgroups = 0;
	} else {
	$numgroups = keys(%{$curr_groups});
	}
	return $numgroups;
	}

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

	=pod

	=item get_group_settings

	Uses TokeParser to extract group information from the
	XML used to describe course groups.

	Input:
	Scalar containing XML - as retrieved from &coursegroups().

	Output:
	Hash containing group information as key=values for (a), and
	hash of hashes for (b)

	Keys (in two categories):
	(a) groupname, creator, creation, modified, startdate,enddate.
	Corresponding values are name of the group, creator of the group
	(username:domain), UNIX time for date group was created, and
	settings were last modified, and default start and end access
	times for group members.

	(b) functions returned in hash of hashes.
	Outer hash key is functions.
	Inner hash keys are chat,discussion,email,files,homepage,roster.
	Corresponding values are either on or off, depending on
	whether this type of functionality is available for the group.

	=cut

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

	sub get_group_settings {
	my ($groupinfo)=@_;
	my $parser=HTML::TokeParser->new(\$groupinfo);
	my $token;
	my $tool = '';
	my $role = '';
	my %content=();
	while ($token=$parser->get_token) {
	if ($token->[0] eq 'S') {
	my $entry=$token->[1];
	if ($entry eq 'functions' \|\| $entry eq 'autosec') {
	%{$content{$entry}} = ();
	$tool = $entry;
	} elsif ($entry eq 'role') {
	if ($tool eq 'autosec') {
	$role = $token->[2]{id};
	}
	} else {
	my $value=$parser->get_text('/'.$entry);
	if ($entry eq 'name') {
	if ($tool eq 'functions') {
	my $function = $token->[2]{id};
	$content{$tool}{$function} = $value;
	}
	} elsif ($entry eq 'groupname') {
	$content{$entry}=&Apache::lonnet::unescape($value);
	} elsif (($entry eq 'roles') \|\| ($entry eq 'types') \|\|
	($entry eq 'sectionpick') \|\| ($entry eq 'defpriv')) {
	push(@{$content{$entry}},$value);
	} elsif ($entry eq 'section') {
	if ($tool eq 'autosec' && $role ne '') {
	push(@{$content{$tool}{$role}},$value);
	}
	} else {
	$content{$entry}=$value;
	}
	}
	} elsif ($token->[0] eq 'E') {
	if ($token->[1] eq 'functions' \|\| $token->[1] eq 'autosec') {
	$tool = '';
	} elsif ($token->[1] eq 'role') {
	$role = '';
	}

	}
	}
	return %content;
	}

	sub check_group_access {
	my ($group) = @_;
	my $access = 1;
	my $now = time;
	my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
	if (($end!=0) && ($end<$now)) { $access = 0; }
	if (($start!=0) && ($start>$now)) { $access=0; }
	return $access;
	}

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

	=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 ($i<$#lines) {	}
$i++;	if (defined($$types{'active'})) {
$lines[$i]=~	if ($$classlist{$student}[$idx{status}] eq 'Active') {
/Content\-Disposition\:\sform\-data\;\sname\=\"([^\"]+)\"/i;	push(@{$$users{st}{$student}},'active');
$name=$1;	$match = 1;
$value='';	}
if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {	}
$fname=$1;	if (defined($$types{'previous'})) {
if	if ($$classlist{$student}[$idx{end}] <= $now) {
($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {	push(@{$$users{st}{$student}},'previous');
$fmime=$1;	$match = 1;
$i++;	}
} else {	}
$fmime='';	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 '')) {
} else {	push(@{$$users{st}{$student}},'future');
$fname='';	$match = 1;
$fmime='';	}
	}
	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;
}	}
$i++;	}
}	if ($uname ne '' && $udom ne '') {
} else {	my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);
$value.=$lines[$i]."\n";	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);
	}
	}
	}
	}
}	}
$ENV{'request.method'}=$ENV{'REQUEST_METHOD'};	return;
$r->method_number(M_GET);	}
$r->method('GET');
$r->headers_in->unset('Content-length');	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{udom}] = $udom;
	return;
}	}

=pod	=pod

=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 2923 sub get_unprocessed_cgi {	Line 3710 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 2938 returns cache-controlling header code	Line 3724 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 2957 specifies header code to not have cache	Line 3743 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 2966 sub no_cache {	Line 3752 sub no_cache {

sub content_type {	sub content_type {
my ($r,$type,$charset) = @_;	my ($r,$type,$charset) = @_;
	if ($r) {
	# Note that printout.pl calls this with undef for $r.
	&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 2981 sub content_type {	Line 3772 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 2989 reference and $value is added to the arr	Line 3780 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 3008 sub add_to_env {	Line 3799 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 3018 returns an array of values	Line 3809 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 3041 sub get_env_multiple {	Line 3832 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 3071 sub upfile_store {	Line 3862 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 3081 sub load_tmp_file {	Line 3872 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 3096 sub load_tmp_file {	Line 3887 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 {
return split(/\n/,$ENV{'form.upfile'});	my @records;
	foreach my $line (split(/\n/,$env{'form.upfile'})) {
	if ($line=~/^\s*$/) { next; }
	push(@records,$line);
	}
	return @records;
}	}
}	}

Line 3111 sub upfile_record_sep {	Line 3907 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 3152 sub record_sep {	Line 3953 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 3189 sub upfile_select_html {	Line 3990 sub upfile_select_html {
return $Str;	return $Str;
}	}

	sub get_samples {
	my ($records,$toget) = @_;
	my @samples=({});
	my $got=0;
	foreach my $rec (@$records) {
	my %temp = &record_sep($rec);
	if (! grep(/\S/, values(%temp))) { next; }
	if (%temp) {
	$samples[$got]=\%temp;
	$got++;
	if ($got == $toget) { last; }
	}
	}
	return \@samples;
	}

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

Line 3206 Apache Request ref, $records is an array	Line 4023 Apache Request ref, $records is an array
######################################################	######################################################
sub csv_print_samples {	sub csv_print_samples {
my ($r,$records) = @_;	my ($r,$records) = @_;
my (%sone,%stwo,%sthree);	my $samples = &get_samples($records,3);
%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
#
$r->print(&mt('Samples').'<br /><table border="2"><tr>');	$r->print(&mt('Samples').'<br /><table border="2"><tr>');
foreach (sort({$a <=> $b} keys(%sone))) {	foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); }	$r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); }
$r->print('</tr>');	$r->print('</tr>');
foreach my $hash (\%sone,\%stwo,\%sthree) {	foreach my $hash (@$samples) {
$r->print('<tr>');	$r->print('<tr>');
foreach (sort({$a <=> $b} keys(%sone))) {	foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<td>');	$r->print('<td>');
if (defined($$hash{$_})) { $r->print($$hash{$_}); }	if (defined($$hash{$_})) { $r->print($$hash{$_}); }
$r->print('</td>');	$r->print('</td>');
Line 3246 $d is an array of 2 element arrays (inte	Line 4060 $d is an array of 2 element arrays (inte
######################################################	######################################################
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;
%sone=&record_sep($$records[0]);	my $samples = &get_samples($records,1);
$r->print(&mt('Associate columns with student attributes.')."\n".	$r->print(&mt('Associate columns with student attributes.')."\n".
'<table border="2"><tr>'.	'<table border="2"><tr>'.
'<th>'.&mt('Attribute').'</th>'.	'<th>'.&mt('Attribute').'</th>'.
Line 3259 sub csv_print_select_table {	Line 4073 sub csv_print_select_table {
$r->print('<td><select name=f'.$i.	$r->print('<td><select name=f'.$i.
' onchange="javascript:flip(this.form,'.$i.');">');	' onchange="javascript:flip(this.form,'.$i.');">');
$r->print('<option value="none"></option>');	$r->print('<option value="none"></option>');
foreach (sort({$a <=> $b} keys(%sone))) {	foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<option value="'.$_.'"'.	$r->print('<option value="'.$_.'"'.
($_ eq $defaultcol ? ' selected ' : '').	($_ eq $defaultcol ? ' selected="selected" ' : '').
'>Column '.($_+1).'</option>');	'>Column '.($_+1).'</option>');
}	}
$r->print('</select></td></tr>'."\n");	$r->print('</select></td></tr>'."\n");
Line 3290 $d is an array of 2 element arrays (inte	Line 4104 $d is an array of 2 element arrays (inte
######################################################	######################################################
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 $i=0;	my $i=0;
#	#
	my $samples = &get_samples($records,3);
$r->print('<table border=2><tr><th>'.	$r->print('<table border=2><tr><th>'.
&mt('Field').'</th><th>'.&mt('Samples').'</th></tr>');	&mt('Field').'</th><th>'.&mt('Samples').'</th></tr>');
%sone=&record_sep($$records[0]);
if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}	foreach my $key (sort(keys(%{ $samples->[0] }))) {
if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
#
foreach (sort keys %sone) {
$r->print('<tr><td><select name="f'.$i.'"'.	$r->print('<tr><td><select name="f'.$i.'"'.
' onchange="javascript:flip(this.form,'.$i.');">');	' onchange="javascript:flip(this.form,'.$i.');">');
foreach (@$d) {	foreach my $option (@$d) {
my ($value,$display,$defaultcol)=@{ $_ };	my ($value,$display,$defaultcol)=@{ $option };
$r->print('<option value="'.$value.'"'.	$r->print('<option value="'.$value.'"'.
($i eq $defaultcol ? ' selected ':'').'>'.	($i eq $defaultcol ? ' selected="selected" ':'').'>'.
$display.'</option>');	$display.'</option>');
}	}
$r->print('</select></td><td>');	$r->print('</select></td><td>');
if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }	foreach my $line (0..2) {
if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }	if (defined($samples->[$line]{$key})) {
if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }	$r->print($samples->[$line]{$key}."<br />\n");
	}
	}
$r->print('</td></tr>');	$r->print('</td></tr>');
$i++;	$i++;
}	}
Line 3400 the routine &Apache::lonnet::transfer_pr	Line 4213 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 3819 Returns: both routines return nothing	Line 4632 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 $udom = $env{'user.domain'};
	my $uname = $env{'user.name'};
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 = join('.','internal',$courseid,$prefix,$setting);
my $envname = 'course.'.$courseid.'.'.$basename;	my $envname = 'environment.'.$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 3854 sub store_course_settings {	Line 4668 sub store_course_settings {
}	}
}	}
my $put_result = &Apache::lonnet::put('environment',\%SaveHash,	my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
$coursedom,	$udom,$uname);
$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 3866 sub store_course_settings {	Line 4679 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 = 'environment.internal.'.$courseid.'.'.$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})
];	];
}	}
}	}
Line 3912 sub icon {	Line 4725 sub icon {
$curfext.".gif";	$curfext.".gif";
}	}
}	}
return $iconname;	return &lonhttpdurl($iconname);
}	}

sub lonhttpdurl {	sub lonhttpdurl {

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

Removed from v.1.246
changed lines
	Added in v.1.335