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.257

version 1.198, 2004/07/12 17:02:07	version 1.257, 2005/03/22 15:32:07
Line 59 use Apache::lonnet();	Line 59 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
}	}

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 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 648 sub help_open_menu {	Line 666 sub help_open_menu {
$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 $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("/adm/rat/empty.html","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;
}	}
Line 728 sub help_open_bug {	Line 776 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 772 sub help_open_faq {	Line 821 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 835 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 939 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 966 Currently supported formats:

=item h3	=item h3

	=item h4

	=item i

=item date	=item date

=back	=back
Line 847 sub define_excel_formats {	Line 992 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 1004 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 1142 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 1173 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 1210 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 1240 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 1339 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 1858 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 1903 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 1941 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 1968 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 1980 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 2209 sub get_student_view {	Line 2396 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 2436 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 2444 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 2295 sub maketime {	Line 2531 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 2366 sub domainlogo {	Line 2602 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 2455 other decorations will be returned.	Line 2689 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 2488 sub bodytag {	Line 2722 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 2834 $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'}
Line 2539 $upperleft</td>	Line 2849 $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 2572 sub get_users_function {	Line 2916 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;

Line 2680 returns cache-controlling header code	Line 3079 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 3096 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 2844 needs $ENV{'form.upfile'} and $ENV{'form	Line 3245 needs $ENV{'form.upfile'} and $ENV{'form
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 3002 sub csv_print_select_table {	Line 3408 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 3452 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 3583 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 3606 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 3637 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 3663 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 3685 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 3924 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 3631 sub icon {	Line 4059 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.257