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.198 and 1.262

version 1.198, 2004/07/12 17:02:07	version 1.262, 2005/05/26 20:49:23
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);
use Apache::lonmsg();
use Apache::lonmenu();	use Apache::lonmenu();
use Apache::lonlocal;	use Apache::lonlocal;
use HTML::Entities;	use HTML::Entities;
Line 250 of the element the selection from the se	Line 249 of the element the selection from the se
=cut	=cut

sub browser_and_searcher_javascript {	sub browser_and_searcher_javascript {
	my ($mode)=@_;
	if (!defined($mode)) { $mode='edit'; }
my $resurl=&lastresurl();	my $resurl=&lastresurl();
return <<END;	return <<END;
	// <!-- BEGIN LON-CAPA Internal
var editbrowser = null;	var editbrowser = null;
function openbrowser(formname,elementname,only,omit,titleelement) {	function openbrowser(formname,elementname,only,omit,titleelement) {
var url = '$resurl/?';	var url = '$resurl/?';
Line 259 sub browser_and_searcher_javascript {	Line 261 sub browser_and_searcher_javascript {
url += 'launch=1&';	url += 'launch=1&';
}	}
url += 'catalogmode=interactive&';	url += 'catalogmode=interactive&';
url += 'mode=edit&';	url += 'mode=$mode&';
url += 'form=' + formname + '&';	url += 'form=' + formname + '&';
if (only != null) {	if (only != null) {
url += 'only=' + only + '&';	url += 'only=' + only + '&';
}	} else {
	url += 'only=&';
	}
if (omit != null) {	if (omit != null) {
url += 'omit=' + omit + '&';	url += 'omit=' + omit + '&';
}	} else {
	url += 'omit=&';
	}
if (titleelement != null) {	if (titleelement != null) {
url += 'titleelement=' + titleelement + '&';	url += 'titleelement=' + titleelement + '&';
}	} else {
	url += 'titleelement=&';
	}
url += 'element=' + elementname + '';	url += 'element=' + elementname + '';
var title = 'Browser';	var title = 'Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=1,location=1';
options += ',width=700,height=600';	options += ',width=700,height=600';
editbrowser = open(url,title,options,'1');	editbrowser = open(url,title,options,'1');
editbrowser.focus();	editbrowser.focus();
Line 284 sub browser_and_searcher_javascript {	Line 292 sub browser_and_searcher_javascript {
url += 'launch=1&';	url += 'launch=1&';
}	}
url += 'catalogmode=interactive&';	url += 'catalogmode=interactive&';
url += 'mode=edit&';	url += 'mode=$mode&';
url += 'form=' + formname + '&';	url += 'form=' + formname + '&';
if (titleelement != null) {	if (titleelement != null) {
url += 'titleelement=' + titleelement + '&';	url += 'titleelement=' + titleelement + '&';
}	} else {
	url += 'titleelement=&';
	}
url += 'element=' + elementname + '';	url += 'element=' + elementname + '';
var title = 'Search';	var title = 'Search';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
Line 296 sub browser_and_searcher_javascript {	Line 306 sub browser_and_searcher_javascript {
editsearcher = open(url,title,options,'1');	editsearcher = open(url,title,options,'1');
editsearcher.focus();	editsearcher.focus();
}	}
	// END LON-CAPA Internal -->
END	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 318 sub storeresurl {	Line 329 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 349 ENDSTDBRW	Line 360 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 368 sub coursebrowser_javascript {	Line 379 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) {	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 385 sub coursebrowser_javascript {	Line 396 sub coursebrowser_javascript {
url += 'form=' + formname + '&cnumelement='+uname+	url += 'form=' + formname + '&cnumelement='+uname+
'&cdomelement='+udom+	'&cdomelement='+udom+
'&cnameelement='+desc;	'&cnameelement='+desc;
	if (extra_element !=null && extra_element != '' && formname == 'rolechoice') {
	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';
options += ',width=700,height=600';	options += ',width=700,height=600';
Line 396 ENDSTDBRW	Line 413 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>";
}	}

=pod	=pod
Line 481 sub linked_select_forms {	Line 498 sub linked_select_forms {
my $first = "document.$formname.$firstselectname";	my $first = "document.$formname.$firstselectname";
# output the javascript to do the changing	# output the javascript to do the changing
my $result = '';	my $result = '';
$result.="<script>\n";	$result.="<script type=\"text/javascript\">\n";
$result.="var select2data = new Object();\n";	$result.="var select2data = new Object();\n";
$" = '","';	$" = '","';
my $debug = '';	my $debug = '';
Line 530 END	Line 547 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 540 END	Line 557 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 576 sub help_open_topic {	Line 593 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 609 sub help_open_topic {	Line 626 sub help_open_topic {

# Add the graphic	# Add the graphic
my $title = &mt('Online Help');	my $title = &mt('Online Help');
	my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<a href="$link" title="$title"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>	<a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>
ENDTEMPLATE	ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };	if ($text ne '') { $template.='</td></tr></table>' };
return $template;	return $template;
Line 641 sub help_open_menu {	Line 659 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);
$height = 600 if (not defined $height);	$height = 600 if (not defined $height);
my $link='';	my $link='';
my $title = &mt('Choose your help');	my $title = &mt('Get help');
my $origurl = $ENV{'REQUEST_URI'};	my $origurl = $ENV{'REQUEST_URI'};
	$origurl=~s\|^/~\|/priv/\|;
my $timestamp = time;	my $timestamp = time;
foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {	foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
$$_ = &Apache::lonnet::escape($$_);	$$_ = &Apache::lonnet::escape($$_);
Line 665 sub help_open_menu {	Line 684 sub help_open_menu {
my $template;	my $template;
if ($text ne "") {	if ($text ne "") {
$template .=	$template .=
"<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".	"<table bgcolor='#773311' cellspacing='1' cellpadding='1' border='0'><tr>".
"<td bgcolor='#448844'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";	"<td bgcolor='#886622'><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");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<script>	<script type="text/javascript">
function helpMenu(caller) {	// <!-- BEGIN LON-CAPA Internal
if (caller == 'open') {	// <![CDATA[
newWindow = window.open("","helpmenu","HEIGHT=$height,WIDTH=$width,resize=yes,scrollbars=yes" )	function helpMenu(target) {
caller = newWindow.document	var caller = this;
} else {	if (target == 'open') {
caller = this.document	var newWindow = null;
}	try {
caller.write("<html><head><title>LON-CAPA Help Menu</title><meta http-equiv='pragma' content='no-cache'></head>")	newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
caller.write("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")	}
caller.write("</html>")	catch(error) {
caller.close()	writeHelp(caller);
if (caller == newWindow.document) {	return;
caller.focus()	}
	if (newWindow) {
	caller = newWindow;
	}
}	}
	writeHelp(caller);
	return;
	}
	function writeHelp(caller) {
	caller.document.write('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>')
	caller.document.write("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
	caller.document.write("</html>")
	caller.document.close()
	caller.focus()
}	}
	// ]]>
	// END LON-CAPA Internal -->
</script>	</script>
<a href="$link" title="$title"><image src="/adm/lonMisc/smallFAQ.gif" border="0" alt="(Help Menu)" /></a>	<a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>
ENDTEMPLATE	ENDTEMPLATE
	if ($component_help) {
	if (!$text) {
	$template=&help_open_topic($component_help,undef,$stayOnPage,
	$width,$height).' '.$template;
	} else {
	my $help_text;
	$help_text=&Apache::lonnet::unescape($topic);
	$template='<table><tr><td>'.
	&help_open_topic($component_help,$help_text,$stayOnPage,
	$width,$height).'</td><td>'.$template.
	'</td></tr></table>';
	}
	}
if ($text ne '') { $template.='</td></tr></table>' };	if ($text ne '') { $template.='</td></tr></table>' };
return $template;	return $template;
}	}

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 728 sub help_open_bug {	Line 777 sub help_open_bug {

# Add the graphic	# Add the graphic
my $title = &mt('Report a Bug');	my $title = &mt('Report a Bug');
	my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<a href="$link" title="$title"><image src="/adm/lonMisc/smallBug.gif" border="0" alt="(Bug: $topic)" /></a>	<a href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
ENDTEMPLATE	ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };	if ($text ne '') { $template.='</td></tr></table>' };
return $template;	return $template;
Line 738 ENDTEMPLATE	Line 788 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 772 sub help_open_faq {	Line 822 sub help_open_faq {

# Add the graphic	# Add the graphic
my $title = &mt('View the FAQ');	my $title = &mt('View the FAQ');
	my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<a href="$link" title="$title"><image src="/adm/lonMisc/smallFAQ.gif" border="0" alt="(FAQ: $topic)" /></a>	<a href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
ENDTEMPLATE	ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };	if ($text ne '') { $template.='</td></tr></table>' };
return $template;	return $template;
Line 785 ENDTEMPLATE	Line 836 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 797 format.	Line 940 format.
sub csv_translate {	sub csv_translate {
my $text = shift;	my $text = shift;
$text =~ s/\"/\"\"/g;	$text =~ s/\"/\"\"/g;
$text =~ s/\n//g;	$text =~ s/\n/ /g;
return $text;	return $text;
}	}


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

Line 825 Currently supported formats:	Line 967 Currently supported formats:

=item h3	=item h3

	=item h4

	=item i

=item date	=item date

=back	=back
Line 847 sub define_excel_formats {	Line 993 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=>
'mmm d yyyy hh:mm AM/PM');	'mm/dd/yyyy hh:mm:ss');
return $format;	return $format;
}	}

Line 857 sub define_excel_formats {	Line 1005 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
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 996 sub multiple_select_form {	Line 1143 sub multiple_select_form {
$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";
Line 1027 sub select_form {	Line 1174 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 1064 sub select_level_form {	Line 1211 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 1094 sub select_dom_form {	Line 1241 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 1193 Outputs:	Line 1340 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 1710 sub get_related_words {	Line 1859 sub get_related_words {

=over 4	=over 4

=item * plainname($uname,$udom)	=item * plainname($uname,$udom,$first)

Takes a users logon name and returns it as a string in	Takes a users logon name and returns it as a string in
"first middle last generation" form	"first middle last generation" form
	if $first is set to 'lastname' then it returns it as
	'lastname generation, firstname middlename' if their is a lastname

=cut	=cut

###############################################################	###############################################################
sub plainname {	sub plainname {
my ($uname,$udom)=@_;	my ($uname,$udom,$first)=@_;
my %names=&Apache::lonnet::get('environment',	my %names=&Apache::lonnet::get('environment',
['firstname','middlename','lastname','generation'],	['firstname','middlename','lastname','generation'],
$udom,$uname);	$udom,$uname);
my $name=$names{'firstname'}.' '.$names{'middlename'}.' '.	my $name=&Apache::lonnet::format_name($names{'firstname'},
$names{'lastname'}.' '.$names{'generation'};	$names{'middlename'},
	$names{'lastname'},
	$names{'generation'},$first);
	$name=~s/^\s+//;
$name=~s/\s+$//;	$name=~s/\s+$//;
$name=~s/\s+/ /g;	$name=~s/\s+/ /g;
if ($name !~ /\S/) { $name=$uname.'@'.$udom; }	if ($name !~ /\S/) { $name=$uname.'@'.$udom; }
Line 1750 if the user does not	Line 1904 if the user does not

sub nickname {	sub nickname {
my ($uname,$udom)=@_;	my ($uname,$udom)=@_;
my %names=&Apache::lonnet::get('environment',	my %names;
['nickname','firstname','middlename','lastname','generation'],$udom,$uname);	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 1777 Gets a users screenname and returns it a	Line 1942 Gets a users screenname and returns it a

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


# ------------------------------------------------------------- Message Wrapper	# ------------------------------------------------------------- Message Wrapper

sub messagewrapper {	sub messagewrapper {
my ($link,$un,$do)=@_;	my ($link,$username,$domain)=@_;
return	return
"<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";	'<a href="/adm/email?compose=individual&'.
	'recname='.$username.'&recdom='.$domain.'" '.
	'title="'.&mt('Send message').'">'.$link.'</a>';
}	}
# --------------------------------------------------------------- Notes Wrapper	# --------------------------------------------------------------- Notes Wrapper

Line 1800 sub noteswrapper {	Line 1969 sub noteswrapper {

sub aboutmewrapper {	sub aboutmewrapper {
my ($link,$username,$domain,$target)=@_;	my ($link,$username,$domain,$target)=@_;
return "<a href='/adm/$domain/$username/aboutme'".	return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
($target?" target='$target'":'').">$link</a>";	($target?' target="$target"':'').' title="'.&mt('View this users personal page').'">'.$link.'</a>';
}	}

# ------------------------------------------------------------ Syllabus Wrapper	# ------------------------------------------------------------ Syllabus Wrapper
Line 1812 sub syllabuswrapper {	Line 1981 sub syllabuswrapper {
if ($fontcolor) {	if ($fontcolor) {
$linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';	$linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';
}	}
return "<a href='/public/$domain/$coursedir/syllabus'>$linktext</a>";	return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
}	}

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



=pod	=pod

=back	=back
Line 2003 sub display_languages {	Line 2191 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 2013 sub display_languages {	Line 2201 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 2209 sub get_student_view {	Line 2397 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 2249 sub get_student_answers {	Line 2437 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 2257 Returns: A link to grades.pm such as to	Line 2445 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)) {	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/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 andn resource

	=cut

	###############################################
	sub pprmlink {
	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/parmset?&command=set&'.
	'symb='.$symb.'&uname='.$uname.
	'&udom='.$udom.'" '.$target.'>'.$text.'</a>';
}	}
##############################################	##############################################

Line 2295 sub maketime {	Line 2532 sub maketime {
my %th=@_;	my %th=@_;
return POSIX::mktime(	return POSIX::mktime(
($th{'seconds'},$th{'minutes'},$th{'hours'},	($th{'seconds'},$th{'minutes'},$th{'hours'},
$th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));	$th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
}	}

#########################################	#########################################
Line 2303 sub maketime {	Line 2540 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 2342 sub determinedomain {	Line 2579 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 2366 sub domainlogo {	Line 2603 sub domainlogo {
my $domain = &determinedomain(shift);	my $domain = &determinedomain(shift);
# See if there is a logo	# See if there is a logo
if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {	if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};	my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }	return '<img src="'.$logo.'" alt="'.$domain.'" />';
return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
'/adm/lonDomLogos/'.$domain.'.gif" alt="'.$domain.'" />';
} elsif(exists($Apache::lonnet::domaindescription{$domain})) {	} elsif(exists($Apache::lonnet::domaindescription{$domain})) {
return $Apache::lonnet::domaindescription{$domain};	return $Apache::lonnet::domaindescription{$domain};
} else {	} else {
Line 2391 Returns: value of designparamter $which	Line 2626 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 2402 sub designparm {	Line 2637 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 2455 other decorations will be returned.	Line 2690 other decorations will be returned.
=cut	=cut

sub bodytag {	sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;	my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle)=@_;
$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 2469 sub bodytag {	Line 2704 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 2488 sub bodytag {	Line 2723 sub bodytag {
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }	if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
# construct main body tag	# construct main body tag
my $bodytag = <<END;	my $bodytag = <<END;
<style>	<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 }
</style>	</style>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"	<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
style="margin-top: 0px;$addstyle" $addentries>	style="margin-top: 0px;$addstyle" $addentries>
END	END
	if ($env{'environment.texengine'} eq 'jsMath') {
	$bodytag.='<script type="text/javascript">
	function NoFontMessage () {}
	</script>'."\n".
	'<script src="/adm/jsMath/jsMath.js"></script>'."\n";
	}

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

return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',	return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
$forcereg).	$forcereg).
'<h1>LON-CAPA: '.$title.'</h1>';	'<h1>LON-CAPA: '.$title.'</h1>';
} elsif ($ENV{'environment.remote'} eq 'off') {	} elsif ($env{'environment.remote'} eq 'off') {
# No Remote	# No Remote
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',	my $roleinfo=(<<ENDROLE);
$forcereg).	<td bgcolor="$tabbg" align="right">
'<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font face="Arial, Helvetica, sans-serif" size="+3" color="'.$font.'"><b>'.$title.	<font size="2" face="Arial, Helvetica, sans-serif">
'</b></font></td></tr></table>';	$env{'environment.firstname'}
	$env{'environment.middlename'}
	$env{'environment.lastname'}
	$env{'environment.generation'}
	</font>
	<br />
	<font size="2" face="Arial, Helvetica, sans-serif">$role</font>
	<br />
	<font size="2" face="Arial, Helvetica, sans-serif">$realm</font>
	</td>
	ENDROLE
	my $titleinfo = '<font face="Arial, Helvetica, sans-serif" size="+3" color="'.
	$font.'"><b>'.$title.'</b></font>';
	if ($customtitle) {
	$titleinfo = $customtitle;
	}

	if ($env{'request.state'} eq 'construct') {
	my ($uname,$thisdisfn)=
	($env{'request.filename'} =~ m\|^/home/([^/]+)/public_html/(.*)\|);
	my $formaction='/priv/'.$uname.'/'.$thisdisfn;
	$formaction=~s/\/+/\//g;
	unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm
	my $parentpath = '';
	my $lastitem = '';
	if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
	$parentpath = $1;
	$lastitem = $2;
	} else {
	$lastitem = $thisdisfn;
	}
	$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();

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

#	#
# Top frame rendering, Remote is up	# Top frame rendering, Remote is up
#	#
	my $titleinfo = ' <font size="5" face="Arial, Helvetica, sans-serif"><b>'.$title.'</b></font>';
	if ($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 2524 $upperleft</td>	Line 2835 $upperleft</td>
</tr>	</tr>
<tr>	<tr>
<td rowspan="3" bgcolor="$tabbg">	<td rowspan="3" bgcolor="$tabbg">
<font size="5" face="Arial, Helvetica, sans-serif"><b>$title</b></font>	$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 2539 $upperleft</td>	Line 2850 $upperleft</td>
</td></tr>	</td></tr>
<tr>	<tr>
<td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font> </td></tr>	<td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font> </td></tr>
</table><br>	</table><br />
ENDBODY	ENDBODY
}	}

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

	=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>';
	if ($env{'environment.texengine'} eq 'jsMath') {
	$endbodytag='<script type="text/javascript">jsMath.Process()</script>'.
	"\n".$endbodytag;
	}
	return $endbodytag;
	}

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

=pod	=pod

Line 2557 Returns either 'student','coordinator','	Line 2902 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 2572 sub get_users_function {	Line 2917 sub get_users_function {

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

	=pod

	=item get_sections

	Determines all the sections for a course including
	sections with students and sections containing other roles.
	Incoming parameters: domain, course number, reference to
	section hash (keys to be section/group IDs), reference to
	array containing roles for which sections should be gathered
	(optional). If the fourth argument is undefined, sections
	are gathered for any role.

	Returns number of sections.

	=cut

	###############################################
	sub get_sections {
	my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;
	if (!($cdom && $cnum)) { return 0; }
	my $cid = $cdom.'_'.$cnum;
	my $numsections = 0;

	if (!defined($possible_roles) \|\| (grep/^st$/,@$possible_roles)) {
	my ($classlist) = &Apache::loncoursedata::get_classlist($cid,$cdom,$cnum);
	my $sec_index = &Apache::loncoursedata::CL_SECTION();
	my $status_index = &Apache::loncoursedata::CL_STATUS();
	while (my ($student,$data) = each %$classlist) {
	my ($section,$status) = ($data->[$sec_index],
	$data->[$status_index]);
	unless ($section eq '-1' \|\| $section =~ /^\s*$/) {
	if (!defined($$sectioncount{$section})) { $numsections++; }
	$$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;
	}


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 2602 sub get_posted_cgi {	Line 3003 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 2635 sub get_posted_cgi {	Line 3036 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 2645 sub get_posted_cgi {	Line 3046 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 2666 sub get_unprocessed_cgi {	Line 3067 sub get_unprocessed_cgi {
$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:");	&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 2680 returns cache-controlling header code	Line 3081 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" />
<meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';	<meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
return $output;	return $output;
}	}

=pod	=pod
Line 2697 specifies header code to not have cache	Line 3098 specifies header code to not have cache
=cut	=cut

sub no_cache {	sub no_cache {
my ($r) = @_;	my ($r) = @_;
unless ($ENV{'request.method'} eq 'GET') { return ''; }	if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
#my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);	$env{'request.method'} ne 'GET') { return ''; }
$r->no_cache(1);	my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
$r->header_out("Pragma" => "no-cache");	$r->no_cache(1);
#$r->header_out("Expires" => $date);	$r->header_out("Expires" => $date);
	$r->header_out("Pragma" => "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 2722 sub content_type {	Line 3125 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 2730 reference and $value is added to the arr	Line 3133 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 2749 sub add_to_env {	Line 3152 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 2759 returns an array of values	Line 3162 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 2782 sub get_env_multiple {	Line 3185 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 2812 sub upfile_store {	Line 3215 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 2822 sub load_tmp_file {	Line 3225 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 2837 sub load_tmp_file {	Line 3240 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 2852 sub upfile_record_sep {	Line 3260 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 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=$_;
Line 2869 sub record_sep {	Line 3277 sub record_sep {
$components{$i}=$field;	$components{$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=$_;
Line 3002 sub csv_print_select_table {	Line 3410 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 3046 sub csv_samples_select_table {	Line 3454 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>');
Line 3177 they are plotted. If undefined, default	Line 3585 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 3197 sub DrawBarGraph {	Line 3608 sub DrawBarGraph {
'#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',	'#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
];	];
}	}
	my $extra_settings = {};
	if (ref($Values[-1]) eq 'HASH') {
	$extra_settings = pop(@Values);
	}
#	#
my $identifier = &get_cgi_id();	my $identifier = &get_cgi_id();
my $id = 'cgi.'.$identifier;	my $id = 'cgi.'.$identifier;
if (! @Values \|\| ref($Values[0]) ne 'ARRAY') {	if (! @Values \|\| ref($Values[0]) ne 'ARRAY') {
return '';	return '';
}	}
	#
	my @Labels;
	if (defined($labels)) {
	@Labels = @$labels;
	} else {
	for (my $i=0;$i<@{$Values[0]};$i++) {
	push (@Labels,$i+1);
	}
	}
	#
my $NumBars = scalar(@{$Values[0]});	my $NumBars = scalar(@{$Values[0]});
	if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
my %ValuesHash;	my %ValuesHash;
my $NumSets=1;	my $NumSets=1;
foreach my $array (@Values) {	foreach my $array (@Values) {
Line 3213 sub DrawBarGraph {	Line 3639 sub DrawBarGraph {
}	}
#	#
my ($height,$width,$xskip,$bar_width) = (200,120,1,15);	my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
if ($NumBars < 10) {	if ($NumBars < 3) {
	$width = 120+$NumBars*32;
	$xskip = 1;
	$bar_width = 30;
	} elsif ($NumBars < 5) {
	$width = 120+$NumBars*20;
	$xskip = 1;
	$bar_width = 20;
	} elsif ($NumBars < 10) {
$width = 120+$NumBars*15;	$width = 120+$NumBars*15;
$xskip = 1;	$xskip = 1;
$bar_width = 15;	$bar_width = 15;
Line 3231 sub DrawBarGraph {	Line 3665 sub DrawBarGraph {
$bar_width = 4;	$bar_width = 4;
}	}
#	#
my @Labels;
if (defined($labels)) {
@Labels = @$labels;
} else {
for (my $i=0;$i<@{$Values[0]};$i++) {
push (@Labels,$i+1);
}
}
#
$Max = 1 if ($Max < 1);	$Max = 1 if ($Max < 1);
if ( int($Max) < $Max ) {	if ( int($Max) < $Max ) {
$Max++;	$Max++;
Line 3262 sub DrawBarGraph {	Line 3687 sub DrawBarGraph {
$ValuesHash{$id.'.bar_width'} = $bar_width;	$ValuesHash{$id.'.bar_width'} = $bar_width;
$ValuesHash{$id.'.labels'} = join(',',@Labels);	$ValuesHash{$id.'.labels'} = join(',',@Labels);
#	#
	# Deal with other parameters
	while (my ($key,$value) = each(%$extra_settings)) {
	$ValuesHash{$id.'.'.$key} = $value;
	}
	#
&Apache::lonnet::appenv(%ValuesHash);	&Apache::lonnet::appenv(%ValuesHash);
return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';	return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
}	}
Line 3496 Inputs:	Line 3926 Inputs:
sub chartlink {	sub chartlink {
my ($linktext, $sname, $sdomain) = @_;	my ($linktext, $sname, $sdomain) = @_;
my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.	my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
'&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).	'&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).
'&chartoutputmode='.HTML::Entities::encode('html, with all links').	'&chartoutputmode='.HTML::Entities::encode('html, with all links').
'">'.$linktext.'</a>';	'">'.$linktext.'</a>';
}	}

Line 3538 Returns: both routines return nothing	Line 3968 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 3574 sub store_course_settings {	Line 4004 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 3585 sub store_course_settings {	Line 4015 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 3631 sub icon {	Line 4061 sub icon {
$curfext.".gif";	$curfext.".gif";
}	}
}	}
return $iconname;	return &lonhttpdurl($iconname);
}	}

	sub lonhttpdurl {
	my ($url)=@_;
	my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
	if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
	return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
	}

	sub connection_aborted {
	my ($r)=@_;
	$r->print(" ");$r->rflush();
	my $c = $r->connection;
	return $c->aborted();
	}

	# Escapes strings that may have embedded 's that will be put into
	# strings as 'strings'.
	sub escape_single {
	my ($input) = @_;
	$input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
	$input =~ s/\'/\\\'/g; # Esacpe the 's....
	return $input;
	}

	# Same as escape_single, but escape's "'s This
	# can be used for "strings"
	sub escape_double {
	my ($input) = @_;
	$input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
	$input =~ s/\"/\\\"/g; # Esacpe the "s....
	return $input;
	}

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

=back	=back

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

Removed from v.1.198
changed lines
	Added in v.1.262