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.172 and 1.277

version 1.172, 2004/01/15 01:43:43	version 1.277, 2005/10/04 18:29:54
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 74 my $readit;	Line 73 my $readit;
my %language;	my %language;
my %supported_language;	my %supported_language;
my %cprtag;	my %cprtag;
	my %scprtag;
my %fe; my %fd;	my %fe; my %fd;
my %category_extensions;	my %category_extensions;

Line 131 BEGIN {	Line 131 BEGIN {
close($fh);	close($fh);
}	}
}	}
	# ------------------------------------------------------------------ source copyrights
# -------------------------------------------------------------- domain designs

my $filename;
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
opendir(DIR,$designdir);
while ($filename=readdir(DIR)) {
my ($domain)=($filename=~/^(\w+)\./);
{	{
my $designfile = $designdir.'/'.$filename;	my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
if ( open (my $fh,"<$designfile") ) {	'/source_copyright.tab';
	if ( open (my $fh,"<$sourcecopyrightfile") ) {
while (<$fh>) {	while (<$fh>) {
next if /^\#/;	next if /^\#/;
chomp;	chomp;
my ($key,$val)=(split(/\=/,$_));	my ($key,$val)=(split(/\s+/,$_,2));
if ($val) { $designhash{$domain.'.'.$key}=$val; }	$scprtag{$key}=$val;
}	}
close($fh);	close($fh);
}	}
}	}

	# -------------------------------------------------------------- domain designs

	my $filename;
	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
	opendir(DIR,$designdir);
	while ($filename=readdir(DIR)) {
	if ($filename!~/\.tab$/) { next; }
	my ($domain)=($filename=~/^(\w+)\./);
	{
	my $designfile = $designdir.'/'.$filename;
	if ( open (my $fh,"<$designfile") ) {
	while (<$fh>) {
	next if /^\#/;
	chomp;
	my ($key,$val)=(split(/\=/,$_));
	if ($val) { $designhash{$domain.'.'.$key}=$val; }
	}
	close($fh);
	}
	}

}	}
closedir(DIR);	closedir(DIR);

Line 220 formname and elementname indicate the na	Line 235 formname and elementname indicate the na
the element that the results of the browsing selection are to be placed in.	the element that the results of the browsing selection are to be placed in.

Specifying 'only' will restrict the browser to displaying only files	Specifying 'only' will restrict the browser to displaying only files
with the given extension. Can be a comma seperated list.	with the given extension. Can be a comma separated list.

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

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

Line 235 of the element the selection from the se	Line 250 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 244 sub browser_and_searcher_javascript {	Line 262 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 269 sub browser_and_searcher_javascript {	Line 293 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 281 sub browser_and_searcher_javascript {	Line 307 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 303 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 334 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 353 sub coursebrowser_javascript {	Line 380 sub coursebrowser_javascript {
return (<<ENDSTDBRW);	return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >	<script type="text/javascript" language="Javascript" >
var stdeditbrowser;	var stdeditbrowser;
function opencrsbrowser(formname,uname,udom) {	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 368 sub coursebrowser_javascript {	Line 395 sub coursebrowser_javascript {
}	}
}	}
url += 'form=' + formname + '&cnumelement='+uname+	url += 'form=' + formname + '&cnumelement='+uname+
'&cdomelement='+udom;	'&cdomelement='+udom+
	'&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 380 ENDSTDBRW	Line 414 ENDSTDBRW
}	}

sub selectcourse_link {	sub selectcourse_link {
my ($form,$unameele,$udomele)=@_;	my ($form,$unameele,$udomele,$desc,$extra_element)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.	return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
'","'.$udomele.'");'."'>".&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 465 sub linked_select_forms {	Line 524 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 514 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 524 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 560 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 592 sub help_open_topic {	Line 651 sub help_open_topic {
}	}

# Add the graphic	# Add the graphic
	my $title = &mt('Online Help');
	my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<a href="$link"><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 620 sub helpLatexCheatsheet {	Line 681 sub helpLatexCheatsheet {
.'</td></tr></table>';	.'</td></tr></table>';
}	}

	sub help_open_menu {
	my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;
	$text = "" if (not defined $text);
	$stayOnPage = 0 if (not defined $stayOnPage);
	if ($env{'browser.interface'} eq 'textual' \|\|
	$env{'environment.remote'} eq 'off' ) {
	$stayOnPage=1;
	}
	$width = 620 if (not defined $width);
	$height = 600 if (not defined $height);
	my $link='';
	my $title = &mt('Get help');
	my $origurl = $ENV{'REQUEST_URI'};
	$origurl=~s\|^/~\|/priv/\|;
	my $timestamp = time;
	foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
	$$_ = &Apache::lonnet::escape($$_);
	}
	if (!$stayOnPage) {
	$link = "javascript:helpMenu('open')";
	} else {
	$link = "javascript:helpMenu('display')";
	}
	my $banner_link = "/adm/helpmenu?page=banner&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
	my $details_link = "/adm/helpmenu?page=body&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp";
	my $template;
	if ($text ne "") {
	$template .=
	"<table bgcolor='#CC3300' cellspacing='1' cellpadding='1' border='0'><tr>".
	"<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");
	$template .= <<"ENDTEMPLATE";
	<script type="text/javascript">
	// <!-- BEGIN LON-CAPA Internal
	// <![CDATA[
	function helpMenu(target) {
	var caller = this;
	if (target == 'open') {
	var newWindow = null;
	try {
	newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
	}
	catch(error) {
	writeHelp(caller);
	return;
	}
	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 -->
	</script>
	<a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>
	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>' };
	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 = 350 if (not defined $width);	$width = 600 if (not defined $width);
$height = 400 if (not defined $height);	$height = 600 if (not defined $height);

$topic=~s/\W+/\+/g;	$topic=~s/\W+/\+/g;
my $link='';	my $link='';
Line 646 sub help_open_bug {	Line 792 sub help_open_bug {
{	{
$link = $url;	$link = $url;
}	}

# Add the text	# Add the text
if ($text ne "")	if ($text ne "")
{	{
Line 656 sub help_open_bug {	Line 801 sub help_open_bug {
}	}

# Add the graphic	# Add the graphic
	my $title = &mt('Report a Bug');
	my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<a href="$link"><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 666 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 694 sub help_open_faq {	Line 841 sub help_open_faq {
if ($text ne "")	if ($text ne "")
{	{
$template .=	$template .=
"<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".	"<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
"<td bgcolor='#FF5555'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";	"<td bgcolor='#448844'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
}	}

# Add the graphic	# Add the graphic
	my $title = &mt('View the FAQ');
	my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<a href="$link"><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;

}	}

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

Translate $text to allow it to be output as a 'comma seperated values'
format.

=cut

sub csv_translate {
my $text = shift;
$text =~ s/\"/\"\"/g;
$text =~ s/\n//g;
return $text;
}

=pod	=pod

Line 755 pretty much any HTML.	Line 891 pretty much any HTML.

sub change_content_javascript {	sub change_content_javascript {
# If we're on Netscape 4, we need to use Layer-based code	# If we're on Netscape 4, we need to use Layer-based code
if ($ENV{'browser.type'} eq 'netscape' &&	if ($env{'browser.type'} eq 'netscape' &&
$ENV{'browser.version'} =~ /^4\./) {	$env{'browser.version'} =~ /^4\./) {
return (<<NETSCAPE4);	return (<<NETSCAPE4);
function change(name, content) {	function change(name, content) {
doc = document.layers[name+"___escape"].layers[0].document;	doc = document.layers[name+"___escape"].layers[0].document;
Line 793 the area will originally contain, which	Line 929 the area will originally contain, which
sub changable_area {	sub changable_area {
my ($name, $origContent) = @_;	my ($name, $origContent) = @_;

if ($ENV{'browser.type'} eq 'netscape' &&	if ($env{'browser.type'} eq 'netscape' &&
$ENV{'browser.version'} =~ /^4\./) {	$env{'browser.version'} =~ /^4\./) {
# If this is netscape 4, we need to use the Layer tag	# 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>";	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
} else {	} else {
Line 806 sub changable_area {	Line 942 sub changable_area {

=back	=back

	=head1 Excel and CSV file utility routines

	=over 4

	=cut

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

	=pod

	=item * csv_translate($text)

	Translate $text to allow it to be output as a 'comma separated values'
	format.

	=cut

	###############################################################
	###############################################################
	sub csv_translate {
	my $text = shift;
	$text =~ s/\"/\"\"/g;
	$text =~ s/\n/ /g;
	return $text;
	}

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

	=pod

	=item * define_excel_formats

	Define some commonly used Excel cell formats.

	Currently supported formats:

	=over 4

	=item header

	=item bold

	=item h1

	=item h2

	=item h3

	=item h4

	=item i

	=item date

	=back

	Inputs: $workbook

	Returns: $format, a hash reference.

	=cut

	###############################################################
	###############################################################
	sub define_excel_formats {
	my ($workbook) = @_;
	my $format;
	$format->{'header'} = $workbook->add_format(bold => 1,
	bottom => 1,
	align => 'center');
	$format->{'bold'} = $workbook->add_format(bold=>1);
	$format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
	$format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
	$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=>
	'mm/dd/yyyy hh:mm:ss');
	return $format;
	}

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

	=pod

	=item * create_workbook

	Create an Excel worksheet. If it fails, output message on the
	request object and return undefs.

	Inputs: Apache request object

	Returns (undef) on failure,
	Excel worksheet object, scalar with filename, and formats
	from &Apache::loncommon::define_excel_formats on success

	=cut

	###############################################################
	###############################################################
	sub create_workbook {
	my ($r) = @_;
	#
	# Create the excel spreadsheet
	my $filename = '/prtspool/'.
	$env{'user.name'}.'_'.$env{'user.domain'}.'_'.
	time.'_'.rand(1000000000).'.xls';
	my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
	if (! defined($workbook)) {
	$r->log_error("Error creating excel spreadsheet $filename: $!");
	$r->print('<p>'.&mt("Unable to create new Excel file. ".
	"This error has been logged. ".
	"Please alert your LON-CAPA administrator").
	'</p>');
	return (undef);
	}
	#
	$workbook->set_tempdir('/home/httpd/perl/tmp');
	#
	my $format = &Apache::loncommon::define_excel_formats($workbook);
	return ($workbook,$filename,$format);
	}

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

	=pod

	=item * create_text_file

	Create a file to write to and eventually make available to the usre.
	If file creation fails, outputs an error message on the request object and
	return undefs.

	Inputs: Apache request object, and file suffix

	Returns (undef) on failure,
	Filehandle and filename on success.

	=cut

	###############################################################
	###############################################################
	sub create_text_file {
	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

	=back

=cut	=cut

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

sub multiple_select_form {	sub multiple_select_form {
my ($name,$value,%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='';
my $size =(scalar keys %hash<4?scalar keys %hash:4);	if (! defined($size)) {
	$size = 4;
	if (scalar(keys(%hash))<4) {
	$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 name='$_'".	$output.='<option value="'.$_.'" ';
($selected{$_}?' selected="1"' :'').">$hash{$_}</option>\n";	$output.='selected="selected" ' if ($selected{$_});
	$output.='>'.$hash{$_}."</option>\n";
}	}
$output.="</select>\n";	$output.="</select>\n";
return $output;	return $output;
Line 889 sub select_form {	Line 1199 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 926 sub select_level_form {	Line 1236 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 956 sub select_dom_form {	Line 1266 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 1055 Outputs:	Line 1365 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 1158 END	Line 1470 END
}	}

my $radioval = "'nochange'";	my $radioval = "'nochange'";
	if (exists($in{'curr_authtype'}) &&
	defined($in{'curr_authtype'}) &&
	$in{'curr_authtype'} ne '') {
	$radioval = "'$in{'curr_authtype'}arg'";
	}
my $argfield = 'null';	my $argfield = 'null';
if ( grep/^mode$/,(keys %in) ) {	if ( grep/^mode$/,(keys %in) ) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
Line 1567 sub get_related_words {	Line 1884 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; }
return $name;	return $name;
}	}

Line 1606 if the user does not	Line 1929 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 1633 Gets a users screenname and returns it a	Line 1967 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 1656 sub noteswrapper {	Line 1994 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 1668 sub syllabuswrapper {	Line 2006 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,$start) = @_;
	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 = '';
	}
	if ($start) { $link.='&start='.$start; }
	return qq{<a href="$link" title="$title" $target>$linktext</a>};
}	}

=pod	=pod
Line 1740 sub copyrightdescription {	Line 2096 sub copyrightdescription {

=pod	=pod

	=item * source_copyrightids()

	returns list of all source copyrights

	=cut

	sub source_copyrightids {
	return sort(keys(%scprtag));
	}

	=pod

	=item * source_copyrightdescription()

	returns description of a specified source copyright id

	=cut

	sub source_copyrightdescription {
	return &mt($scprtag{shift(@_)});
	}

	=pod

=item * filecategories()	=item * filecategories()

returns list of all file categories	returns list of all file categories
Line 1778 sub fileembstyle {	Line 2158 sub fileembstyle {

sub filecategoryselect {	sub filecategoryselect {
my ($name,$value)=@_;	my ($name,$value)=@_;
return &select_form($name,$value,	return &select_form($value,$name,
'' => &mt('Any category'),	'' => &mt('Any category'),
map { $_,$_ } sort(keys(%category_extensions)));	map { $_,$_ } sort(keys(%category_extensions)));
}	}
Line 1792 returns description for a specified file	Line 2172 returns description for a specified file
=cut	=cut

sub filedescription {	sub filedescription {
return &mt($fd{lc(shift(@_))});	my $file_description = $fd{lc(shift())};
	$file_description =~ s:([\[\]]):~$1:g;
	return &mt($file_description);
}	}

=pod	=pod
Line 1806 extra formatting	Line 2188 extra formatting

sub filedescriptionex {	sub filedescriptionex {
my $ex=shift;	my $ex=shift;
return '.'.$ex.' '.&mt($fd{lc($ex)});	my $file_description = $fd{lc($ex)};
	$file_description =~ s:([\[\]]):~$1:g;
	return '.'.$ex.' '.&mt($file_description);
}	}

# End of .tab access	# End of .tab access
Line 1831 sub display_languages {	Line 2215 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 1841 sub display_languages {	Line 2225 sub display_languages {

sub preferred_languages {	sub preferred_languages {
my @languages=();	my @languages=();
if ($ENV{'environment.languages'}) {	if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
@languages=split(/\s(\,\|\;\|\:)\s/,$ENV{'environment.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'}) {
	@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 2027 show a snapshot of what student was look	Line 2411 show a snapshot of what student was look
=cut	=cut

sub get_student_view {	sub get_student_view {
my ($symb,$username,$domain,$courseid,$target) = @_;	my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);	my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
my (%old,%moreenv);	my (%form);
my @elements=('symb','courseid','domain','username');	my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {	foreach my $element (@elements) {
$old{$element}=$ENV{'form.grade_'.$element};	$form{'grade_'.$element}=eval '$'.$element #'
$moreenv{'form.grade_'.$element}=eval '$'.$element #'
}	}
if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';}	if (defined($moreenv)) {
&Apache::lonnet::appenv(%moreenv);	%form=(%form,%{$moreenv});
$feedurl=&Apache::lonnet::clutter($feedurl);
my $userview=&Apache::lonnet::ssi_body($feedurl);
&Apache::lonnet::delenv('form.grade_');
foreach my $element (@elements) {
$ENV{'form.grade_'.$element}=$old{$element};
}	}
	if (defined($target)) { $form{'grade_target'} = $target; }
	$feedurl=&Apache::lonnet::clutter($feedurl);
	my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
$userview=~s/\<body[^\>]*\>//gi;	$userview=~s/\<body[^\>]*\>//gi;
$userview=~s/\<\/body\>//gi;	$userview=~s/\<\/body\>//gi;
$userview=~s/\<html\>//gi;	$userview=~s/\<html\>//gi;
Line 2065 show a snapshot of how student was answe	Line 2446 show a snapshot of how student was answe
sub get_student_answers {	sub get_student_answers {
my ($symb,$username,$domain,$courseid,%form) = @_;	my ($symb,$username,$domain,$courseid,%form) = @_;
my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);	my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
my (%old,%moreenv);	my (%moreenv);
my @elements=('symb','courseid','domain','username');	my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {	foreach my $element (@elements) {
$old{$element}=$ENV{'form.grade_'.$element};	$moreenv{'grade_'.$element}=eval '$'.$element #'
$moreenv{'form.grade_'.$element}=eval '$'.$element #'
}
$moreenv{'form.grade_target'}='answer';
&Apache::lonnet::appenv(%moreenv);
my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%form);
&Apache::lonnet::delenv('form.grade_');
foreach my $element (@elements) {
$ENV{'form.grade_'.$element}=$old{$element};
}	}
	$moreenv{'grade_target'}='answer';
	%moreenv=(%form,%moreenv);
	my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%moreenv);
return $userview;	return $userview;
}	}

Line 2085 sub get_student_answers {	Line 2461 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 2093 Returns: A link to grades.pm such as to	Line 2469 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 andn 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 2131 sub maketime {	Line 2556 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 2139 sub maketime {	Line 2564 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 2178 sub determinedomain {	Line 2603 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 2202 sub domainlogo {	Line 2627 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 2227 Returns: value of designparamter $which	Line 2650 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 2238 sub designparm {	Line 2661 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 2291 other decorations will be returned.	Line 2714 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,$notopbar)=@_;
$title=&mt($title);	$title=&mt($title);
unless ($function) {	$function = &get_users_function() if (!$function);
$function='student';
if ($ENV{'request.role'}=~/^(cc\|in\|ta\|ep)/) {
$function='coordinator';
}
if ($ENV{'request.role'}=~/^(su\|dc\|ad\|li)/) {
$function='admin';
}
if (($ENV{'request.role'}=~/^(au\|ca)/) \|\|
($ENV{'REQUEST_URI'}=~/^(\/priv\|\~)/)) {
$function='author';
}
}
my $img=&designparm($function.'.img',$domain);	my $img=&designparm($function.'.img',$domain);
my $pgbg=&designparm($function.'.pgbg',$domain);	my $pgbg=&designparm($function.'.pgbg',$domain);
my $tabbg=&designparm($function.'.tabbg',$domain);	my $tabbg=&designparm($function.'.tabbg',$domain);
Line 2317 sub bodytag {	Line 2728 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 2336 sub bodytag {	Line 2747 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
	&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
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 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;
}	}

#	#
# 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 2372 $upperleft</td>	Line 2865 $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 2387 $upperleft</td>	Line 2880 $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>';
	$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
	return $endbodytag;
	}

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

	=pod

	=item get_users_function

	Used by &bodytag to determine the current users primary role.
	Returns either 'student','coordinator','admin', or 'author'.

	=cut

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

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

	=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

	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 $numsections = 0;

	if (!defined($possible_roles) \|\| (grep/^st$/,@$possible_roles)) {
	my ($classlist) = &Apache::loncoursedata::get_classlist($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;
	}

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

	=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);
	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] <= time) {
	push(@{$$users{st}{$student}},'previous');
	}
	}
	if (defined($$types{'future'})) {
	if (($$classlist{$student}[$startidx] > 0) && ($$classlist{$student}[$endidx] > time) \|\| ($$classlist{$student}[$endidx] == 0) \|\| ($$classlist{$student}[$endidx] eq '')) {
	push(@{$$users{st}{$student}},'future');
	}
	}
	}
	}
	if ((@{$roles} > 0) && (@{$roles} ne "st")) {
	my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);
	foreach my $person (@coursepersonnel) {
	my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);
	$user =~ s/:$//;
	if (($role) && (grep(/^$role$/,@{$roles}))) {
	my ($uname,$udom) = split(/:/,$user);
	if ($uname ne '' && $udom ne '') {
	my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);
	foreach my $type (keys(%{$types})) {
	if ($status eq $type) {
	$$users{$role}{$user} = $type;
	}
	}
	}
	}
	}
	}
	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 2423 sub get_posted_cgi {	Line 3156 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 2456 sub get_posted_cgi {	Line 3189 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 2466 sub get_posted_cgi {	Line 3199 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 2486 sub get_unprocessed_cgi {	Line 3219 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 2501 returns cache-controlling header code	Line 3233 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 2518 specifies header code to not have cache	Line 3250 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) = @_;
unless ($charset) {	if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
$charset=&Apache::lonlocal::current_encoding;	unless ($charset) {
}	$charset=&Apache::lonlocal::current_encoding;
$r->content_type($type.($charset?'; charset='.$charset:''));	}
	if ($charset) { $type.='; charset='.$charset; }
	if ($r) {
	$r->content_type($type);
	} else {
	print("Content-type: $type\n\n");
	}
}	}

=pod	=pod

=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 2546 reference and $value is added to the arr	Line 3285 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 2565 sub add_to_env {	Line 3304 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 2575 returns an array of values	Line 3314 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 2598 sub get_env_multiple {	Line 3337 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 2628 sub upfile_store {	Line 3367 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 2638 sub load_tmp_file {	Line 3377 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 2653 sub load_tmp_file {	Line 3392 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 2668 sub upfile_record_sep {	Line 3412 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 2709 sub record_sep {	Line 3458 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 2795 Prints a table to create associations be	Line 3544 Prints a table to create associations be

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

=cut	=cut

Line 2810 sub csv_print_select_table {	Line 3559 sub csv_print_select_table {
'<th>'.&mt('Attribute').'</th>'.	'<th>'.&mt('Attribute').'</th>'.
'<th>'.&mt('Column').'</th></tr>'."\n");	'<th>'.&mt('Column').'</th></tr>'."\n");
foreach (@$d) {	foreach (@$d) {
my ($value,$display)=@{ $_ };	my ($value,$display,$defaultcol)=@{ $_ };
$r->print('<tr><td>'.$display.'</td>');	$r->print('<tr><td>'.$display.'</td>');

$r->print('<td><select name=f'.$i.	$r->print('<td><select name=f'.$i.
' onchange="javascript:flip(this.form,'.$i.');">');	' onchange="javascript:flip(this.form,'.$i.');">');
$r->print('<option value="none"></option>');	$r->print('<option value="none"></option>');
foreach (sort({$a <=> $b} keys(%sone))) {	foreach (sort({$a <=> $b} keys(%sone))) {
$r->print('<option value="'.$_.'">Column '.($_+1).'</option>');	$r->print('<option value="'.$_.'"'.
	($_ eq $defaultcol ? ' selected="selected" ' : '').
	'>Column '.($_+1).'</option>');
}	}
$r->print('</select></td></tr>'."\n");	$r->print('</select></td></tr>'."\n");
$i++;	$i++;
Line 2858 sub csv_samples_select_table {	Line 3609 sub csv_samples_select_table {
$r->print('<tr><td><select name="f'.$i.'"'.	$r->print('<tr><td><select name="f'.$i.'"'.
' onchange="javascript:flip(this.form,'.$i.');">');	' onchange="javascript:flip(this.form,'.$i.');">');
foreach (@$d) {	foreach (@$d) {
my ($value,$display)=@{ $_ };	my ($value,$display,$defaultcol)=@{ $_ };
$r->print('<option value="'.$value.'">'.$display.'</option>');	$r->print('<option value="'.$value.'"'.
	($i eq $defaultcol ? ' selected="selected" ':'').'>'.
	$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 2984 If $Max is < any data point, the graph w	Line 3737 If $Max is < any data point, the graph w
=item $colors: array ref holding the colors to be used for the data sets when	=item $colors: array ref holding the colors to be used for the data sets when
they are plotted. If undefined, default values will be used.	they are plotted. If undefined, default values will be used.

	=item $labels: array ref holding the labels to use on the x-axis for the bars.

=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 2999 information for the plot.	Line 3757 information for the plot.
############################################################	############################################################
############################################################	############################################################
sub DrawBarGraph {	sub DrawBarGraph {
my ($Title,$xlabel,$ylabel,$Max,$colors,@Values)=@_;	my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
#	#
if (! defined($colors)) {	if (! defined($colors)) {
$colors = ['#33ff00',	$colors = ['#33ff00',
Line 3007 sub DrawBarGraph {	Line 3765 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 3023 sub DrawBarGraph {	Line 3796 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 3041 sub DrawBarGraph {	Line 3822 sub DrawBarGraph {
$bar_width = 4;	$bar_width = 4;
}	}
#	#
my @Labels;
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 3068 sub DrawBarGraph {	Line 3844 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 3102 plotted in. If undefined, default value	Line 3883 plotted in. If undefined, default value
=item $Xlabels: Array ref containing the labels to be used for the X-axis.	=item $Xlabels: Array ref containing the labels to be used for the X-axis.

=item $Ydata: Array ref containing Array refs.	=item $Ydata: Array ref containing Array refs.
Each of the contained arrays will be plotted as a seperate curve.	Each of the contained arrays will be plotted as a separate curve.

=item %Values: hash indicating or overriding any default values which are	=item %Values: hash indicating or overriding any default values which are
passed to graph.png.	passed to graph.png.
Line 3302 Inputs:	Line 4083 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 3344 Returns: both routines return nothing	Line 4125 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 = 'env.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 3380 sub store_course_settings {	Line 4161 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 3391 sub store_course_settings {	Line 4172 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.'.env.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 3437 sub icon {	Line 4218 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.172
changed lines
	Added in v.1.277