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.233 and 1.283

version 1.233, 2004/11/21 04:24:49	version 1.283, 2005/11/08 03:08:15
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 375 sub selectstudent_link {	Line 376 sub selectstudent_link {
}	}

sub coursebrowser_javascript {	sub coursebrowser_javascript {
my ($domainfilter,$roleelement)=@_;	my ($domainfilter)=@_;
return (<<ENDSTDBRW);	return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >	<script type="text/javascript" language="Javascript" >
var extra_element = "$roleelement"
var stdeditbrowser;	var stdeditbrowser;
function opencrsbrowser(formname,uname,udom,desc) {	function opencrsbrowser(formname,uname,udom,desc,extra_element) {
var url = '/adm/pickcourse?';	var url = '/adm/pickcourse?';
var filter;	var filter;
if (filter != null) {	if (filter != null) {
Line 397 sub coursebrowser_javascript {	Line 397 sub coursebrowser_javascript {
url += 'form=' + formname + '&cnumelement='+uname+	url += 'form=' + formname + '&cnumelement='+uname+
'&cdomelement='+udom+	'&cdomelement='+udom+
'&cnameelement='+desc;	'&cnameelement='+desc;
if (extra_element != '') {	if (extra_element !=null && extra_element != '' && formname == 'rolechoice') {
url += '&roleelement=$roleelement';	url += '&roleelement='+extra_element;
	if (domainfilter == null \|\| domainfilter == '') {
	url += '&domainfilter='+extra_element;
	}
}	}
var title = 'Course_Browser';	var title = 'Course_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
Line 411 ENDSTDBRW	Line 414 ENDSTDBRW
}	}

sub selectcourse_link {	sub selectcourse_link {
my ($form,$unameele,$udomele,$desc)=@_;	my ($form,$unameele,$udomele,$desc,$extra_element)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.	return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
'","'.$udomele.'","'.$desc.'");'."'>".&mt('Select Course')."</a>";	'","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&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 545 END	Line 573 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 555 END	Line 583 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 591 sub help_open_topic {	Line 619 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 657 sub help_open_menu {	Line 685 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 671 sub help_open_menu {	Line 699 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 682 sub help_open_menu {	Line 709 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 $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");	my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<script type="text/javascript">	<script type="text/javascript">
//<!-- BEGIN LON-CAPA Internal	// <!-- BEGIN LON-CAPA Internal
function helpMenu(caller) {	// <![CDATA[
if (caller == 'open') {	function helpMenu(target) {
newWindow = window.open("","helpmenu","HEIGHT=$height,WIDTH=$width,resize=yes,scrollbars=yes" )	var caller = this;
caller = newWindow.document	if (target == 'open') {
} else {	var newWindow = null;
caller = this.document	try {
}	newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
caller.write("<html><head><title>LON-CAPA Help Menu</title><meta http-equiv='pragma' content='no-cache'></head>")	}
caller.write("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")	catch(error) {
caller.write("</html>")	writeHelp(caller);
caller.close()	return;
if (caller == newWindow.document) {	}
caller.focus()	if (newWindow) {
	caller = newWindow;
	}
}	}
	writeHelp(caller);
	return;
	}
	function writeHelp(caller) {
	caller.document.writeln('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>')
	caller.document.writeln("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
	caller.document.writeln("</html>")
	caller.document.close()
	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 727 ENDTEMPLATE	Line 768 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 772 ENDTEMPLATE	Line 813 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 820 ENDTEMPLATE	Line 861 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 836 sub csv_translate {	Line 969 sub csv_translate {
return $text;	return $text;
}	}


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

Line 860 Currently supported formats:	Line 992 Currently supported formats:

=item h3	=item h3

	=item h4

	=item i

=item date	=item date

=back	=back
Line 882 sub define_excel_formats {	Line 1018 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->{'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');
return $format;	return $format;
Line 892 sub define_excel_formats {	Line 1030 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
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 an Excel worksheet. If it fails, output message on the
must be written to the HTML page once. It will prove the Javascript	request object and return undefs.
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	Inputs: Apache request object
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	Excel worksheet object, scalar with filename, and formats
pretty much any HTML.	from &Apache::loncommon::define_excel_formats on success

=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 1018 sub domain_select {	Line 1155 sub domain_select {
}	}
}	}

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

	=pod

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

	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())

	=cut

	#-------------------------------------------
sub multiple_select_form {	sub multiple_select_form {
my ($name,$value,$size,%hash)=@_;	my ($name,$value,$size,$hash)=@_;
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))) {	foreach (sort(keys(%$hash))) {
$output.='<option value="'.$_.'" ';	$output.='<option value="'.$_.'" ';
$output.='selected ' if ($selected{$_});	$output.='selected="selected" ' if ($selected{$_});
$output.='>'.$hash{$_}."</option>\n";	$output.='>'.$hash->{$_}."</option>\n";
}	}
$output.="</select>\n";	$output.="</select>\n";
return $output;	return $output;
Line 1062 sub select_form {	Line 1218 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 1099 sub select_level_form {	Line 1255 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 1129 sub select_dom_form {	Line 1285 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 1228 Outputs:	Line 1384 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 1426 sub authform_nochange{	Line 1584 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 1461 sub authform_kerberos{	Line 1620 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 1493 sub authform_internal{	Line 1653 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 1520 sub authform_local{	Line 1680 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 1536 sub authform_filesystem{	Line 1696 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 1791 if the user does not	Line 1951 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 1828 Gets a users screenname and returns it a	Line 1988 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 1871 sub syllabuswrapper {	Line 2031 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 2077 sub display_languages {	Line 2236 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 2087 sub display_languages {	Line 2246 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 2283 sub get_student_view {	Line 2442 sub get_student_view {
if (defined($moreenv)) {	if (defined($moreenv)) {
%form=(%form,%{$moreenv});	%form=(%form,%{$moreenv});
}	}
if ($target eq 'tex') {$form{'grade_target'} = 'tex';}	if (defined($target)) { $form{'grade_target'} = $target; }
$feedurl=&Apache::lonnet::clutter($feedurl);	$feedurl=&Apache::lonnet::clutter($feedurl);
my $userview=&Apache::lonnet::ssi_body($feedurl,%form);	my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
$userview=~s/\<body[^\>]*\>//gi;	$userview=~s/\<body[^\>]*\>//gi;
Line 2323 sub get_student_answers {	Line 2482 sub get_student_answers {

=item * &submlink()	=item * &submlink()

Inputs: $text $uname $udom $symb	Inputs: $text $uname $udom $symb $target

Returns: A link to grades.pm such as to see the SUBM view of a student	Returns: A link to grades.pm such as to see the SUBM view of a student

Line 2331 Returns: A link to grades.pm such as to	Line 2490 Returns: A link to grades.pm such as to

###############################################	###############################################
sub submlink {	sub submlink {
my ($text,$uname,$udom,$symb)=@_;	my ($text,$uname,$udom,$symb,$target)=@_;
	if (!($uname && $udom)) {
	(my $cursymb, my $courseid,$udom,$uname)=
	&Apache::lonxml::whichuser($symb);
	if (!$symb) { $symb=$cursymb; }
	}
	if (!$symb) { $symb=&Apache::lonnet::symbread(); }
	$symb=&Apache::lonnet::escape($symb);
	if ($target) { $target="target=\"$target\""; }
	return '<a href="/adm/grades?&command=submission&'.
	'symb='.$symb.'&student='.$uname.
	'&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
	}
	##############################################

	=pod

	=item * &pgrdlink()

	Inputs: $text $uname $udom $symb $target

	Returns: A link to grades.pm such as to see the PGRD view of a student

	=cut

	###############################################
	sub pgrdlink {
	my $link=&submlink(@_);
	$link=~s/(&command=submission)/$1&showgrading=yes/;
	return $link;
	}
	##############################################

	=pod

	=item * &pprmlink()

	Inputs: $text $uname $udom $symb $target

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

	=cut

	###############################################
	sub pprmlink {
	my ($text,$uname,$udom,$symb,$target)=@_;
if (!($uname && $udom)) {	if (!($uname && $udom)) {
(my $cursymb, my $courseid,$udom,$uname)=	(my $cursymb, my $courseid,$udom,$uname)=
&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(); }
return '<a href="/adm/grades?symb='.$symb.'&student='.$uname.	$symb=&Apache::lonnet::escape($symb);
'&userdom='.$udom.'&command=submission">'.$text.'</a>';	if ($target) { $target="target=\"$target\""; }
	return '<a href="/adm/parmset?&command=set&'.
	'symb='.$symb.'&uname='.$uname.
	'&udom='.$udom.'" '.$target.'>'.$text.'</a>';
}	}
##############################################	##############################################

Line 2377 sub maketime {	Line 2585 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 2416 sub determinedomain {	Line 2624 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 2463 Returns: value of designparamter $which	Line 2671 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 2474 sub designparm {	Line 2682 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 2527 other decorations will be returned.	Line 2735 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 2541 sub bodytag {	Line 2749 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 2567 a:focus { color: red; background: yellow	Line 2775 a:focus { color: red; background: yellow
<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
	&Apache::lontexconvert::jsMath_reset();
	if ($env{'environment.texengine'} eq 'jsMath') {
	$bodytag.=&Apache::lontexconvert::jsMath_header();
	}

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 2597 ENDROLE	Line 2810 ENDROLE
$font.'"><b>'.$title.'</b></font>';	$font.'"><b>'.$title.'</b></font>';
if ($customtitle) {	if ($customtitle) {
$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;
$titleinfo = '<form name="dirs" method="post" action="'.$formaction	unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm
.'" target="_top">'	my $parentpath = '';
.&Apache::lonhtmlcommon::crumbs($uname.'/'.$thisdisfn,'_top','/priv','',-1,1)."<br />"	my $lastitem = '';
.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')	if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
.'</form>'	$parentpath = $1;
.&Apache::lonmenu::constspaceform();	$lastitem = $2;
	} else {
&Apache::lonhtmlcommon::store_recent('construct',$formaction,$formaction);	$lastitem = $thisdisfn;
if ($thisdisfn!~m\|/$\|) { $forcereg=1; }	}
}	$titleinfo = &Apache::loncommon::help_open_menu('','','','',3,'Authoring').
	'<font face="Arial, Helvetica, sans-serif"><b>Construction Space</b>:</font> '.
	'<form name="dirs" method="post" action="'.$formaction
	.'" target="_top"><tt><b>'
	.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
	.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
	.'</form>'
	.&Apache::lonmenu::constspaceform();

return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',	}
$forcereg).	$forcereg=1;
'<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td rowspan="3" bgcolor="'.$tabbg.'">'.$titleinfo.'</td>'.$roleinfo.'</tr></table>';	}
	my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.
	'cellspacing="3" cellpadding="3">'.
	'<tr><td bgcolor="'.$tabbg.'">'.
	$titleinfo.'</td>'.$roleinfo.'</tr></table>';
	if ($env{'request.state'} eq 'construct') {
	if ($notopbar) {
	$bodytag .= $titletable;
	} else {
	$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);
	}
	} else {
	if ($notopbar) {
	$bodytag .= $titletable;
	} else {
	$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).
	$titletable;
	}
	}
	return $bodytag;
}	}

#	#
Line 2626 ENDROLE	Line 2866 ENDROLE
if ($customtitle) {	if ($customtitle) {
$titleinfo = $customtitle;	$titleinfo = $customtitle;
}	}
	#
	# Extra info if you are the DC
	my $dc_info = '';
	if ($env{'user.adv'} && exists($env{'user.role.dc./'.
	$env{'course.'.$env{'request.course.id'}.
	'.domain'}.'/'})) {
	my $cid = $env{'request.course.id'};
	$dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
	$dc_info = '('.$dc_info.')';
	}
	#
return(<<ENDBODY);	return(<<ENDBODY);
$bodytag	$bodytag
<table width="100%" cellspacing="0" border="0" cellpadding="0">	<table width="100%" cellspacing="0" border="0" cellpadding="0">
Line 2635 $upperleft</td>	Line 2886 $upperleft</td>
</tr>	</tr>
<tr>	<tr>
<td rowspan="3" bgcolor="$tabbg">	<td rowspan="3" bgcolor="$tabbg">
$titleinfo	$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 2655 ENDBODY	Line 2906 ENDBODY
}	}

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

	=pod

	=back

	=head1 HTTP Helpers

	=over 4

	=item * &endbodytag()

	Returns a uniform footer for LON-CAPA web pages.

	Inputs:

	=over 4

	=back

	Returns: A uniform footer for LON-CAPA web pages.

	=cut

	sub endbodytag {
	my $endbodytag='</body>';
	$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
	return $endbodytag;
	}

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

=pod	=pod

Line 2668 Returns either 'student','coordinator','	Line 2950 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 2685 sub get_users_function {	Line 2967 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 2702 Returns number of sections.	Line 3038 Returns number of sections.
###############################################	###############################################
sub get_sections {	sub get_sections {
my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;	my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;
my $cid = $cdom.'_'.$cnum;	if (!($cdom && $cnum)) { return 0; }
my $numsections = 0;	my $numsections = 0;
if ($cdom && $cnum) {
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) {
my ($section,$status) = ($data->[$sec_index],	my ($section,$status) = ($data->[$sec_index],
$data->[$status_index]);	$data->[$status_index]);
unless ($section eq '' \|\| $section =~ /^\s*$/) {	unless ($section eq '-1' \|\| $section =~ /^\s*$/) {
if (!defined($$sectioncount{$section})) {	if (!defined($$sectioncount{$section})) { $numsections++; }
$$sectioncount{$section} = 1;	$$sectioncount{$section}++;
$numsections ++;	}
} else {	}
$$sectioncount{$section} ++;	}
}	my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
	foreach my $user (sort(keys(%courseroles))) {
	if ($user !~ /^(\w{2})/) { next; }
	my ($role) = ($user =~ /^(\w{2})/);
	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
	my $section;
	if ($role eq 'cr' &&
	$user =~ m-^$role/[^/]/[^/]/[^/]:[^:]:[^:]*:(\w+)-) {
	$section=$1;
	}
	if ($user =~ /^$role:[^:]:[^:]:(\w+)/) { $section=$1; }
	if (!defined($section) \|\| $section eq '-1') { next; }
	if (!defined($$sectioncount{$section})) { $numsections++; }
	$$sectioncount{$section}++;
	}
	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 results object (hash of hashes).
	Keys of top level hash are roles.
	Keys of inner hashes are username:domain, with
	values set to access type.

	=cut

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

	sub get_course_users {
	my ($cdom,$cnum,$types,$roles,$users) = @_;
	if (grep/^st$/,@{$roles}) {
	my $statusidx = &Apache::loncoursedata::CL_STATUS();
	my $startidx = &Apache::loncoursedata::CL_START();
	my $endidx = &Apache::loncoursedata::CL_END();
	my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
	my $now = time;
	foreach my $student (keys(%{$classlist})) {
	if (defined($$types{'active'})) {
	if ($$classlist{$student}[$statusidx] eq 'Active') {
	push(@{$$users{st}{$student}},'active');
	}
	}
	if (defined($$types{'previous'})) {
	if ($$classlist{$student}[$endidx] <= $now) {
	push(@{$$users{st}{$student}},'previous');
	}
	}
	if (defined($$types{'future'})) {
	if (($$classlist{$student}[$startidx] > $now) && ($$classlist{$student}[$endidx] > $now) \|\| ($$classlist{$student}[$endidx] == 0) \|\| ($$classlist{$student}[$endidx] eq '')) {
	push(@{$$users{st}{$student}},'future');
}	}
}	}
}	}
my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);	}
foreach my $user (sort keys %courseroles) {	if ((@{$roles} > 0) && (@{$roles} ne "st")) {
if ($user =~ /^(\w{2})/) {	my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);
my $role = $1;	foreach my $person (@coursepersonnel) {
if (!defined($possible_roles) \|\| (grep/^$role$/,@$possible_roles)) {	my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);
if ($role eq 'cr') {	$user =~ s/:$//;
if ($user =~ m-^$role/[^/]/[^/]/[^/]:[^:]:[^:]*:(\w+)-) {	if (($role) && (grep(/^$role$/,@{$roles}))) {
if (!defined($$sectioncount{$1})) {	my ($uname,$udom) = split(/:/,$user);
$$sectioncount{$1} = 1;	if ($uname ne '' && $udom ne '') {
$numsections ++;	my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);
} else {	foreach my $type (keys(%{$types})) {
$$sectioncount{$1} ++;	if ($status eq $type) {
}	$$users{$role}{$user} = $type;
}
}
if ($user =~ /^$role:[^:]:[^:]:(\w+)/) {
if (!defined($$sectioncount{$1})) {
$$sectioncount{$1} = 1;
$numsections ++;
} else {
$$sectioncount{$1} ++;
}	}
}	}
}	}
}	}
}	}
	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';
	}
	}
	}
}	}
return $numsections;	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 2783 sub get_posted_cgi {	Line 3187 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 2816 sub get_posted_cgi {	Line 3220 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 2826 sub get_posted_cgi {	Line 3230 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 2846 sub get_unprocessed_cgi {	Line 3250 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 2861 returns cache-controlling header code	Line 3264 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 2880 specifies header code to not have cache	Line 3283 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 2889 sub no_cache {	Line 3292 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'; }
unless ($charset) {	unless ($charset) {
$charset=&Apache::lonlocal::current_encoding;	$charset=&Apache::lonlocal::current_encoding;
}	}
Line 2904 sub content_type {	Line 3308 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 2912 reference and $value is added to the arr	Line 3316 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 2931 sub add_to_env {	Line 3335 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 2941 returns an array of values	Line 3345 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 2964 sub get_env_multiple {	Line 3368 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 2994 sub upfile_store {	Line 3398 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 3004 sub load_tmp_file {	Line 3408 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 3019 sub load_tmp_file {	Line 3423 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 3034 sub upfile_record_sep {	Line 3443 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 3075 sub record_sep {	Line 3489 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 3184 sub csv_print_select_table {	Line 3598 sub csv_print_select_table {
$r->print('<option value="none"></option>');	$r->print('<option value="none"></option>');
foreach (sort({$a <=> $b} keys(%sone))) {	foreach (sort({$a <=> $b} keys(%sone))) {
$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 3228 sub csv_samples_select_table {	Line 3642 sub csv_samples_select_table {
foreach (@$d) {	foreach (@$d) {
my ($value,$display,$defaultcol)=@{ $_ };	my ($value,$display,$defaultcol)=@{ $_ };
$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"); }	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 3323 the routine &Apache::lonnet::transfer_pr	Line 3737 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 3359 they are plotted. If undefined, default	Line 3773 they are plotted. If undefined, default
=item @Values: An array of array references. Each array reference holds data	=item @Values: An array of array references. Each array reference holds data
to be plotted in a stacked bar chart.	to be plotted in a stacked bar chart.

	=item If the final element of @Values is a hash reference the key/value
	pairs will be added to the graph definition.

=back	=back

Returns:	Returns:
Line 3739 Returns: both routines return nothing	Line 4156 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 3775 sub store_course_settings {	Line 4192 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 3786 sub store_course_settings {	Line 4203 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})
];	];
}	}
}	}
Line 3832 sub icon {	Line 4249 sub icon {
$curfext.".gif";	$curfext.".gif";
}	}
}	}
return $iconname;	return &lonhttpdurl($iconname);
}	}

sub lonhttpdurl {	sub lonhttpdurl {
Line 3870 sub escape_double {	Line 4287 sub escape_double {
# Escapes the last element of a full URL.	# Escapes the last element of a full URL.
sub escape_url {	sub escape_url {
my ($url) = @_;	my ($url) = @_;
my @urlslices = split(/\//, $url);	my @urlslices = split(/\//, $url,-1);
my $lastitem = &Apache::lonnet::escape(pop(@urlslices));	my $lastitem = &Apache::lonnet::escape(pop(@urlslices));
return join('/',@urlslices).'/'.$lastitem;	return join('/',@urlslices).'/'.$lastitem;
}	}

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

Removed from v.1.233
changed lines
	Added in v.1.283