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.636 and 1.692.4.2

version 1.636, 2008/01/21 00:35:58	version 1.692.4.2, 2009/05/21 05:27:10
Line 61 use POSIX qw(strftime mktime);	Line 61 use POSIX qw(strftime mktime);
use Apache::lonmenu();	use Apache::lonmenu();
use Apache::lonenc();	use Apache::lonenc();
use Apache::lonlocal;	use Apache::lonlocal;
	use Apache::lonnet();
use HTML::Entities;	use HTML::Entities;
use Apache::lonhtmlcommon();	use Apache::lonhtmlcommon();
use Apache::loncoursedata();	use Apache::loncoursedata();
use Apache::lontexconvert();	use Apache::lontexconvert();
use Apache::lonclonecourse();	use Apache::lonclonecourse();
use LONCAPA qw(:DEFAULT :match);	use LONCAPA qw(:DEFAULT :match);
	use DateTime::TimeZone;
	use DateTime::Locale::Catalog;

# ---------------------------------------------- Designs	# ---------------------------------------------- Designs
use vars qw(%defaultdesign);	use vars qw(%defaultdesign);
Line 78 my $readit;	Line 81 my $readit;
## Global Variables	## Global Variables
##	##


	# ----------------------------------------------- SSI with retries:
	#

	=pod

	=head1 Server Side include with retries:

	=over 4

	=item * &ssi_with_retries(resource,retries form)

	Performs an ssi with some number of retries. Retries continue either
	until the result is ok or until the retry count supplied by the
	caller is exhausted.

	Inputs:

	=over 4

	resource - Identifies the resource to insert.

	retries - Count of the number of retries allowed.

	form - Hash that identifies the rendering options.

	=back

	Returns:

	=over 4

	content - The content of the response. If retries were exhausted this is empty.

	response - The response from the last attempt (which may or may not have been successful.

	=back

	=back

	=cut

	sub ssi_with_retries {
	my ($resource, $retries, %form) = @_;


	my $ok = 0; # True if we got a good response.
	my $content;
	my $response;

	# Try to get the ssi done. within the retries count:

	do {
	($content, $response) = &Apache::lonnet::ssi($resource, %form);
	$ok = $response->is_success;
	if (!$ok) {
	&Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
	}
	$retries--;
	} while (!$ok && ($retries > 0));

	if (!$ok) {
	$content = ''; # On error return an empty content.
	}
	return ($content, $response);

	}



# ----------------------------------------------- Filetypes/Languages/Copyright	# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;	my %language;
my %supported_language;	my %supported_language;
Line 214 BEGIN {	Line 287 BEGIN {

=over 4	=over 4

=item * browser_and_searcher_javascript ()	=item * &browser_and_searcher_javascript()

X<browsing, javascript>X<searching, javascript>Returns a string	X<browsing, javascript>X<searching, javascript>Returns a string
containing javascript with two functions, C<openbrowser> and	containing javascript with two functions, C<openbrowser> and
C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>	C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
tags.	tags.

=item * openbrowser(formname,elementname,only,omit) [javascript]	=item * &openbrowser(formname,elementname,only,omit) [javascript]

inputs: formname, elementname, only, omit	inputs: formname, elementname, only, omit

Line 234 with the given extension. Can be a comm	Line 307 with the given extension. Can be a comm
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 separated list.	with the given extension. Can be a comma separated list.

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

Inputs: formname, elementname	Inputs: formname, elementname

Line 319 sub storeresurl {	Line 392 sub storeresurl {
unless ($resurl=~/^\/res/) { return 0; }	unless ($resurl=~/^\/res/) { return 0; }
$resurl=~s/\/$//;	$resurl=~s/\/$//;
&Apache::lonnet::put('environment',{'lastresurl' => $resurl});	&Apache::lonnet::put('environment',{'lastresurl' => $resurl});
&Apache::lonnet::appenv('environment.lastresurl' => $resurl);	&Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
return 1;	return 1;
}	}

Line 333 sub studentbrowser_javascript {	Line 406 sub studentbrowser_javascript {
\|\| ($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">
var stdeditbrowser;	var stdeditbrowser;
function openstdbrowser(formname,uname,udom,roleflag,ignorefilter) {	function openstdbrowser(formname,uname,udom,roleflag,ignorefilter,courseadvonly) {
var url = '/adm/pickstudent?';	var url = '/adm/pickstudent?';
var filter;	var filter;
if (!ignorefilter) {	if (!ignorefilter) {
Line 349 sub studentbrowser_javascript {	Line 422 sub studentbrowser_javascript {
url += 'form=' + formname + '&unameelement='+uname+	url += 'form=' + formname + '&unameelement='+uname+
'&udomelement='+udom;	'&udomelement='+udom;
if (roleflag) { url+="&roles=1"; }	if (roleflag) { url+="&roles=1"; }
	if (courseadvonly) { url+="&courseadvonly=1"; }
var title = 'Student_Browser';	var title = 'Student_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 360 ENDSTDBRW	Line 434 ENDSTDBRW
}	}

sub selectstudent_link {	sub selectstudent_link {
my ($form,$unameele,$udomele)=@_;	my ($form,$unameele,$udomele,$courseadvonly)=@_;
	my $callargs = "'".$form."','".$unameele."','".$udomele."'";
if ($env{'request.course.id'}) {	if ($env{'request.course.id'}) {
if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})	if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
&& !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.	&& !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
'/'.$env{'request.course.sec'})) {	'/'.$env{'request.course.sec'})) {
return '';	return '';
}	}
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.	if ($courseadvonly) {
'","'.$udomele.'");'."'>".&mt('Select User')."</a>";	$callargs .= ",'',1,1";
	}
	return '<span class="LC_nobreak">'.
	'<a href="javascript:openstdbrowser('.$callargs.');">'.
	&mt('Select User').'</a></span>';
}	}
if ($env{'request.role'}=~/^(au\|dc\|su)/) {	if ($env{'request.role'}=~/^(au\|dc\|su)/) {
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.	$callargs .= ",1";
'","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";	return '<span class="LC_nobreak">'.
	'<a href="javascript:openstdbrowser('.$callargs.');">'.
	&mt('Select User').'</a></span>';
}	}
return '';	return '';
}	}

	sub authorbrowser_javascript {
	return <<"ENDAUTHORBRW";
	<script type="text/javascript">
	var stdeditbrowser;

	function openauthorbrowser(formname,udom) {
	var url = '/adm/pickauthor?';
	url += 'form='+formname+'&roledom='+udom;
	var title = 'Author_Browser';
	var options = 'scrollbars=1,resizable=1,menubar=0';
	options += ',width=700,height=600';
	stdeditbrowser = open(url,title,options,'1');
	stdeditbrowser.focus();
	}

	</script>
	ENDAUTHORBRW
	}

sub coursebrowser_javascript {	sub coursebrowser_javascript {
my ($domainfilter,$sec_element,$formname)=@_;	my ($domainfilter,$sec_element,$formname)=@_;
my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role');	my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role');
my $output = '	my $output = '
<script type="text/javascript">	<script type="text/javascript" language="JavaScript">
var stdeditbrowser;'."\n";	var stdeditbrowser;'."\n";
$output .= <<"ENDSTDBRW";	$output .= <<"ENDSTDBRW";
function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {	function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {
Line 510 function setSect(sectionlist) {	Line 610 function setSect(sectionlist) {

sub selectcourse_link {	sub selectcourse_link {
my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;	my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.	return '<span class="LC_nobreak">'
'","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>";	."<a href='"
	.'javascript:opencrsbrowser("'.$form.'","'.$unameele
	.'","'.$udomele.'","'.$desc.'","'.$extra_element
	.'","'.$multflag.'","'.$selecttype.'");'
	."'>".&mt('Select Course').'</a>'
	.'</span>';
	}

	sub selectauthor_link {
	my ($form,$udom)=@_;
	return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
	&mt('Select Author').'</a>';
}	}

sub check_uncheck_jscript {	sub check_uncheck_jscript {
Line 539 ENDSCRT	Line 650 ENDSCRT
return $jscript;	return $jscript;
}	}

	sub select_timezone {
	my ($name,$selected,$onchange,$includeempty)=@_;
	my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
	if ($includeempty) {
	$output .= '<option value=""';
	if (($selected eq '') \|\| ($selected eq 'local')) {
	$output .= ' selected="selected" ';
	}
	$output .= '> </option>';
	}
	my @timezones = DateTime::TimeZone->all_names;
	foreach my $tzone (@timezones) {
	$output.= '<option value="'.$tzone.'"';
	if ($tzone eq $selected) {
	$output.=' selected="selected"';
	}
	$output.=">$tzone</option>\n";
	}
	$output.="</select>";
	return $output;
	}

	sub select_datelocale {
	my ($name,$selected,$onchange,$includeempty)=@_;
	my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
	if ($includeempty) {
	$output .= '<option value=""';
	if ($selected eq '') {
	$output .= ' selected="selected" ';
	}
	$output .= '> </option>';
	}
	my (@possibles,%locale_names);
	my @locales = DateTime::Locale::Catalog::Locales;
	foreach my $locale (@locales) {
	if (ref($locale) eq 'HASH') {
	my $id = $locale->{'id'};
	if ($id ne '') {
	my $en_terr = $locale->{'en_territory'};
	my $native_terr = $locale->{'native_territory'};
	my @languages = &Apache::lonlocal::preferred_languages();
	if (grep(/^en$/,@languages) \|\| !@languages) {
	if ($en_terr ne '') {
	$locale_names{$id} = '('.$en_terr.')';
	} elsif ($native_terr ne '') {
	$locale_names{$id} = $native_terr;
	}
	} else {
	if ($native_terr ne '') {
	$locale_names{$id} = $native_terr.' ';
	} elsif ($en_terr ne '') {
	$locale_names{$id} = '('.$en_terr.')';
	}
	}
	push (@possibles,$id);
	}
	}
	}
	foreach my $item (sort(@possibles)) {
	$output.= '<option value="'.$item.'"';
	if ($item eq $selected) {
	$output.=' selected="selected"';
	}
	$output.=">$item";
	if ($locale_names{$item} ne '') {
	$output.=" $locale_names{$item}</option>\n";
	}
	$output.="</option>\n";
	}
	$output.="</select>";
	return $output;
	}

	sub select_language {
	my ($name,$selected,$includeempty) = @_;
	my %langchoices;
	if ($includeempty) {
	%langchoices = ('' => 'No language preference');
	}
	foreach my $id (&languageids()) {
	my $code = &supportedlanguagecode($id);
	if ($code) {
	$langchoices{$code} = &plainlanguagedescription($id);
	}
	}
	return &select_form($selected,$name,%langchoices);
	}

=pod	=pod

=item * linked_select_forms(...)	=item * &linked_select_forms(...)

linked_select_forms returns a string containing a <script></script> block	linked_select_forms returns a string containing a <script></script> block
and html for two <select> menus. The select menus will be linked in that	and html for two <select> menus. The select menus will be linked in that
Line 626 sub linked_select_forms {	Line 824 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 type=\"text/javascript\">\n";	$result.='<script type="text/javascript" language="JavaScript">'."\n";
$result.="var select2data = new Object();\n";	$result.="var select2data = new Object();\n";
$" = '","';	$" = '","';
my $debug = '';	my $debug = '';
Line 707 END	Line 905 END

=pod	=pod

=item * help_open_topic($topic, $text, $stayOnPage, $width, $height)	=item * &help_open_topic($topic,$text,$stayOnPage,$width,$height)

Returns a string corresponding to an HTML link to the given help	Returns a string corresponding to an HTML link to the given help
$topic, where $topic corresponds to the name of a .tex file in	$topic, where $topic corresponds to the name of a .tex file in
Line 756 sub help_open_topic {	Line 954 sub help_open_topic {
if ($text ne "") {	if ($text ne "") {
$template .=	$template .=
"<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".	"<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
"<td bgcolor='#5555FF'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";	"<td bgcolor='#5555FF'><span class=\"LC_nobreak\"><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
}	}

# Add the graphic	# Add the graphic
my $title = &mt('Online Help');	my $title = &mt('Online Help');
my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");	my $helpicon=&lonhttpdurl("/adm/help/help.png");
$template .= <<"ENDTEMPLATE";	$template .= '<a target="_top" href="'.$link.'" title="'.$title.'">'.
<a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>	'<img src="'.$helpicon.'" border="0" alt="'.&mt('Help: [_1]',$topic).
ENDTEMPLATE	'" title="'.$title.'" /></a>';
if ($text ne '') { $template.='</td></tr></table>' };	if ($text ne '') {
	$template.='</span></td></tr></table>';
	}
return $template;	return $template;

}	}
Line 773 ENDTEMPLATE	Line 973 ENDTEMPLATE
# This is a quicky function for Latex cheatsheet editing, since it	# This is a quicky function for Latex cheatsheet editing, since it
# appears in at least four places	# appears in at least four places
sub helpLatexCheatsheet {	sub helpLatexCheatsheet {
my $other = shift;	my ($topic,$text,$not_author) = @_;
	my $out;
my $addOther = '';	my $addOther = '';
if ($other) {	if ($other) {
$addOther = Apache::loncommon::help_open_topic($other, shift,	$addOther = &Apache::loncommon::help_open_topic($topic,$text,
undef, undef, 600) .	undef, undef, 600) .
'</td><td>';	'</td><td>';
}	}
return '<table><tr><td>'.	$out = '<table><tr><td>'.
$addOther .	$addOther .
&Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),	&Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),
undef,undef,600)	undef,undef,600).
.'</td><td>'.	'</td><td>'.
&Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),	&Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),
undef,undef,600)	undef,undef,600).
.'</td></tr></table>';	'</td>';
	unless ($not_author) {
	$out .= '<td>'.
	&Apache::loncommon::help_open_topic("Authoring_Output_Tags",&mt('Output Tags'),
	undef,undef,600).
	'</td>';
	}
	$out .= '</tr></table>';
	return $out;
}	}

sub general_help {	sub general_help {
Line 796 sub general_help {	Line 1005 sub general_help {
$helptopic='Authoring_Intro';	$helptopic='Authoring_Intro';
} elsif ($env{'request.role'}=~/^cc/) {	} elsif ($env{'request.role'}=~/^cc/) {
$helptopic='Course_Coordination_Intro';	$helptopic='Course_Coordination_Intro';
	} elsif ($env{'request.role'}=~/^dc/) {
	$helptopic='Domain_Coordination_Intro';
}	}
return $helptopic;	return $helptopic;
}	}
Line 1017 ENDTEMPLATE	Line 1228 ENDTEMPLATE

=pod	=pod

=item * change_content_javascript():	=item * &change_content_javascript():

This and the next function allow you to create small sections of an	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	otherwise static HTML page that you can update on the fly with
Line 1072 DOMBASED	Line 1283 DOMBASED

=pod	=pod

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

This provides a "changable area" that can be modified on the fly via	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 Javascript code provided in C<change_content_javascript>. $name is
Line 1096 sub changable_area {	Line 1307 sub changable_area {

=pod	=pod

=item * viewport_geometry_js {	=item * &viewport_geometry_js

Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.	Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.

Line 1143 GEOMETRY	Line 1354 GEOMETRY

=pod	=pod

=item * viewport_size_js {	=item * &viewport_size_js()

Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window.	Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window.

Line 1167 DIMS	Line 1378 DIMS

=pod	=pod

=item * resize_textarea_js	=item * &resize_textarea_js()

emits the needed javascript to resize a textarea to be as big as possible	emits the needed javascript to resize a textarea to be as big as possible

Line 1176 the id of the element to resize, second	Line 1387 the id of the element to resize, second
surrounds everything that comes after the textarea, this routine needs	surrounds everything that comes after the textarea, this routine needs
to be attached to the <body> for the onload and onresize events.	to be attached to the <body> for the onload and onresize events.

	=back

=cut	=cut

Line 1228 RESIZE	Line 1440 RESIZE

=pod	=pod

=back

=head1 Excel and CSV file utility routines	=head1 Excel and CSV file utility routines

=over 4	=over 4
Line 1241 RESIZE	Line 1451 RESIZE

=pod	=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'
format.	format.
Line 1262 sub csv_translate {	Line 1472 sub csv_translate {

=pod	=pod

=item * define_excel_formats	=item * &define_excel_formats()

Define some commonly used Excel cell formats.	Define some commonly used Excel cell formats.

Line 1318 sub define_excel_formats {	Line 1528 sub define_excel_formats {

=pod	=pod

=item * create_workbook	=item * &create_workbook()

Create an Excel worksheet. If it fails, output message on the	Create an Excel worksheet. If it fails, output message on the
request object and return undefs.	request object and return undefs.
Line 1361 sub create_workbook {	Line 1571 sub create_workbook {

=pod	=pod

=item * create_text_file	=item * &create_text_file()

Create a file to write to and eventually make available to the user.	Create a file to write to and eventually make available to the user.
If file creation fails, outputs an error message on the request object and	If file creation fails, outputs an error message on the request object and
Line 1386 sub create_text_file {	Line 1596 sub create_text_file {
$fh = Apache::File->new('>/home/httpd'.$filename);	$fh = Apache::File->new('>/home/httpd'.$filename);
if (! defined($fh)) {	if (! defined($fh)) {
$r->log_error("Couldn't open $filename for output $!");	$r->log_error("Couldn't open $filename for output $!");
$r->print("Problems occured in creating the output file. ".	$r->print(&mt('Problems occurred in creating the output file. '
"This error has been logged. ".	.'This error has been logged. '
"Please alert your LON-CAPA administrator.");	.'Please alert your LON-CAPA administrator.'));
}	}
return ($fh,$filename)	return ($fh,$filename)
}	}
Line 1429 sub domain_select {	Line 1639 sub domain_select {

=over 4	=over 4

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

Returns a string containing a <select> element int multiple mode	Returns a string containing a <select> element int multiple mode

Line 1455 sub multiple_select_form {	Line 1665 sub multiple_select_form {
$size = scalar(keys(%$hash));	$size = scalar(keys(%$hash));
}	}
}	}
$output.="\n<select name='$name' size='$size' multiple='1'>";	$output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
my @order;	my @order;
if (ref($order) eq 'ARRAY') {	if (ref($order) eq 'ARRAY') {
@order = @{$order};	@order = @{$order};
Line 1479 sub multiple_select_form {	Line 1689 sub multiple_select_form {

=pod	=pod

=item * select_form($defdom,$name,%hash)	=item * &select_form($defdom,$name,%hash)

Returns a string containing a <select name='$name' size='1'> form to	Returns a string containing a <select name='$name' size='1'> form to
allow a user to select options from a hash option_name => displayed text.	allow a user to select options from a hash option_name => displayed text.
Line 1512 sub select_form {	Line 1722 sub select_form {
sub display_filter {	sub display_filter {
if (!$env{'form.show'}) { $env{'form.show'}=10; }	if (!$env{'form.show'}) { $env{'form.show'}=10; }
if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }	if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
return '<nobr><label>'.&mt('Records [_1]',	return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
&Apache::lonmeta::selectbox('show',$env{'form.show'},undef,	&Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
(&mt('all'),10,20,50,100,1000,10000))).	(&mt('all'),10,20,50,100,1000,10000))).
'</label></nobr> <nobr>'.	'</label></span> <span class="LC_nobreak">'.
&mt('Filter [_1]',	&mt('Filter [_1]',
&select_form($env{'form.displayfilter'},	&select_form($env{'form.displayfilter'},
'displayfilter',	'displayfilter',
('currentfolder' => 'Current folder/page',	('currentfolder' => 'Current folder/page',
'containing' => 'Containing phrase',	'containing' => 'Containing phrase',
'none' => 'None'))).	'none' => 'None'))).
'<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></nobr>';	'<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
}	}

sub gradeleveldescription {	sub gradeleveldescription {
Line 1566 sub select_level_form {	Line 1776 sub select_level_form {

=pod	=pod

=item * select_dom_form($defdom,$name,$includeempty,$showdomdesc)	=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$autosubmit)

Returns a string containing a <select name='$name' size='1'> form to	Returns a string containing a <select name='$name' size='1'> form to
allow a user to select the domain to preform an operation in.	allow a user to select the domain to preform an operation in.
Line 1575 See loncreateuser.pm for an example invo	Line 1785 See loncreateuser.pm for an example invo
If the $includeempty flag is set, it also includes an empty choice ("no domain	If the $includeempty flag is set, it also includes an empty choice ("no domain
selected");	selected");

If the $showdomdesc flag is set, the domain name is followed by the domain description.	If the $showdomdesc flag is set, the domain name is followed by the domain description.

	If the $autosubmit flag is set, the form containing the domain selector will be auto-submitted by an onchange action.

=cut	=cut

#-------------------------------------------	#-------------------------------------------
sub select_dom_form {	sub select_dom_form {
my ($defdom,$name,$includeempty,$showdomdesc) = @_;	my ($defdom,$name,$includeempty,$showdomdesc,$autosubmit) = @_;
	my $onchange;
	if ($autosubmit) {
	$onchange = ' onchange="this.form.submit()"';
	}
my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());	my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
if ($includeempty) { @domains=('',@domains); }	if ($includeempty) { @domains=('',@domains); }
my $selectdomain = "<select name=\"$name\" size=\"1\">\n";	my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
foreach my $dom (@domains) {	foreach my $dom (@domains) {
$selectdomain.="<option value=\"$dom\" ".	$selectdomain.="<option value=\"$dom\" ".
($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;	($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
Line 1606 sub select_dom_form {	Line 1822 sub select_dom_form {

=pod	=pod

=item * home_server_form_item($domain,$name,$defaultflag)	=item * &home_server_form_item($domain,$name,$defaultflag)

input: 4 arguments (two required, two optional) -	input: 4 arguments (two required, two optional) -
$domain - domain of new user	$domain - domain of new user
Line 1640 sub home_server_form_item {	Line 1856 sub home_server_form_item {
if ($numlib > 1) {	if ($numlib > 1) {
$result .= '<select name="'.$name.'" />'."\n";	$result .= '<select name="'.$name.'" />'."\n";
if ($default) {	if ($default) {
$result .= '<option value="default" selected>'.&mt('default').	$result .= '<option value="default" selected="selected">'.&mt('default').
'</option>'."\n";	'</option>'."\n";
}	}
foreach my $hostid (sort(keys(%servers))) {	foreach my $hostid (sort(keys(%servers))) {
Line 1766 sub decode_user_agent {	Line 1982 sub decode_user_agent {

=over 4	=over 4

=item * authform_xxxxxx	=item * &authform_xxxxxx()

The authform_xxxxxx subroutines provide javascript and html forms which	The authform_xxxxxx subroutines provide javascript and html forms which
handle some of the conveniences required for authentication forms.	handle some of the conveniences required for authentication forms.
This is not an optimal method, but it works.	This is not an optimal method, but it works.

See loncreateuser.pm for invocation and use examples.

=over 4	=over 4

=item * authform_header	=item * authform_header
Line 1790 See loncreateuser.pm for invocation and	Line 2004 See loncreateuser.pm for invocation and

=back	=back

=back	See loncreateuser.pm for invocation and use examples.

=cut	=cut

Line 1937 sub authform_kerberos {	Line 2151 sub authform_kerberos {
$autharg,$jscall);	$autharg,$jscall);
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
if ($in{'kerb_def_auth'} eq 'krb5') {	if ($in{'kerb_def_auth'} eq 'krb5') {
$check5 = ' checked="on"';	$check5 = ' checked="checked"';
} else {	} else {
$check4 = ' checked="on"';	$check4 = ' checked="checked"';
}	}
$krbarg = $in{'kerb_def_dom'};	$krbarg = $in{'kerb_def_dom'};
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'krb') {	if ($in{'curr_authtype'} eq 'krb') {
$krbcheck = ' checked="on"';	$krbcheck = ' checked="checked"';
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifyuser') {	if ($in{'mode'} eq 'modifyuser') {
$krbcheck = '';	$krbcheck = '';
Line 1952 sub authform_kerberos {	Line 2166 sub authform_kerberos {
}	}
if (defined($in{'curr_kerb_ver'})) {	if (defined($in{'curr_kerb_ver'})) {
if ($in{'curr_krb_ver'} eq '5') {	if ($in{'curr_krb_ver'} eq '5') {
$check5 = ' checked="on"';	$check5 = ' checked="checked"';
$check4 = '';	$check4 = '';
} else {	} else {
$check4 = ' checked="on"';	$check4 = ' checked="checked"';
$check5 = '';	$check5 = '';
}	}
}	}
Line 1976 sub authform_kerberos {	Line 2190 sub authform_kerberos {
}	}
} else {	} else {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="hidden" name="login" value="krb">';	$authtype = '<input type="hidden" name="login" value="krb" />';
}	}
}	}
if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {	if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
Line 1985 sub authform_kerberos {	Line 2199 sub authform_kerberos {
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="hidden" name="login" value="krb">';	$authtype = '<input type="hidden" name="login" value="krb" />';
}	}
}	}
}	}
Line 2046 sub authform_internal{	Line 2260 sub authform_internal{
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'int') {	if ($in{'curr_authtype'} eq 'int') {
if ($can_assign{'int'}) {	if ($can_assign{'int'}) {
$intcheck = 'checked="on" ';	$intcheck = 'checked="checked" ';
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifyuser') {	if ($in{'mode'} eq 'modifyuser') {
$intcheck = '';	$intcheck = '';
Line 2062 sub authform_internal{	Line 2276 sub authform_internal{
}	}
} else {	} else {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="hidden" name="login" value="int">';	$authtype = '<input type="hidden" name="login" value="int" />';
}	}
}	}
if (!$can_assign{'int'}) {	if (!$can_assign{'int'}) {
Line 2071 sub authform_internal{	Line 2285 sub authform_internal{
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="hidden" name="login" value="int">';	$authtype = '<input type="hidden" name="login" value="int" />';
}	}
}	}
}	}
Line 2101 sub authform_local{	Line 2315 sub authform_local{
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'loc') {	if ($in{'curr_authtype'} eq 'loc') {
if ($can_assign{'loc'}) {	if ($can_assign{'loc'}) {
$loccheck = 'checked="on" ';	$loccheck = 'checked="checked" ';
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifyuser') {	if ($in{'mode'} eq 'modifyuser') {
$loccheck = '';	$loccheck = '';
Line 2117 sub authform_local{	Line 2331 sub authform_local{
}	}
} else {	} else {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="hidden" name="login" value="loc">';	$authtype = '<input type="hidden" name="login" value="loc" />';
}	}
}	}
if (!$can_assign{'loc'}) {	if (!$can_assign{'loc'}) {
Line 2126 sub authform_local{	Line 2340 sub authform_local{
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="hidden" name="login" value="loc">';	$authtype = '<input type="hidden" name="login" value="loc" />';
}	}
}	}
}	}
Line 2155 sub authform_filesystem{	Line 2369 sub authform_filesystem{
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'fsys') {	if ($in{'curr_authtype'} eq 'fsys') {
if ($can_assign{'fsys'}) {	if ($can_assign{'fsys'}) {
$fsyscheck = 'checked="on" ';	$fsyscheck = 'checked="checked" ';
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifyuser') {	if ($in{'mode'} eq 'modifyuser') {
$fsyscheck = '';	$fsyscheck = '';
Line 2168 sub authform_filesystem{	Line 2382 sub authform_filesystem{
}	}
} else {	} else {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="hidden" name="login" value="fsys">';	$authtype = '<input type="hidden" name="login" value="fsys" />';
}	}
}	}
if (!$can_assign{'fsys'}) {	if (!$can_assign{'fsys'}) {
Line 2177 sub authform_filesystem{	Line 2391 sub authform_filesystem{
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="hidden" name="login" value="fsys">';	$authtype = '<input type="hidden" name="login" value="fsys" />';
}	}
}	}
}	}
Line 2242 sub get_assignable_auth {	Line 2456 sub get_assignable_auth {
}	}

###############################################################	###############################################################
## Get Authentication Defaults for Domain ##
###############################################################

=pod

=head1 Domains and Authentication

Returns default authentication type and an associated argument as
listed in file 'domain.tab'.

=over 4

=item * get_auth_defaults

get_auth_defaults($target_domain) returns the default authentication
type and an associated argument (initial password or a kerberos domain).
These values are stored in lonTabs/domain.tab

($def_auth, $def_arg) = &get_auth_defaults($target_domain);

If target_domain is not found in domain.tab, returns nothing ('').

=cut

#-------------------------------------------
sub get_auth_defaults {
my $domain=shift;
return (&Apache::lonnet::domain($domain,'auth_def'),
&Apache::lonnet::domain($domain,'auth_arg_def'));

}
###############################################################
## End Get Authentication Defaults for Domain ##
###############################################################

###############################################################
## Get Kerberos Defaults for Domain ##	## Get Kerberos Defaults for Domain ##
###############################################################	###############################################################
##	##
Line 2289 sub get_auth_defaults {	Line 2467 sub get_auth_defaults {

=pod	=pod

=item * get_kerberos_defaults	=item * &get_kerberos_defaults()

get_kerberos_defaults($target_domain) returns the default kerberos	get_kerberos_defaults($target_domain) returns the default kerberos
version and domain. If not found in domain.tabs, it defaults to	version and domain. If not found, it defaults to version 4 and the
version 4 and the domain of the server.	domain of the server.

	=over 4

($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);	($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);

	=back

	=back

=cut	=cut

#-------------------------------------------	#-------------------------------------------
sub get_kerberos_defaults {	sub get_kerberos_defaults {
my $domain=shift;	my $domain=shift;
my ($krbdef,$krbdefdom) =	my ($krbdef,$krbdefdom);
&Apache::loncommon::get_auth_defaults($domain);	my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
unless ($krbdef =~/^krb/ && $krbdefdom) {	if (($domdefaults{'auth_def'} =~/^krb(4\|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
	$krbdef = $domdefaults{'auth_def'};
	$krbdefdom = $domdefaults{'auth_arg_def'};
	} else {
$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;	$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
my $krbdefdom=$1;	my $krbdefdom=$1;
$krbdefdom=~tr/a-z/A-Z/;	$krbdefdom=~tr/a-z/A-Z/;
Line 2313 sub get_kerberos_defaults {	Line 2500 sub get_kerberos_defaults {
return ($krbdef,$krbdefdom);	return ($krbdef,$krbdefdom);
}	}

=pod

=back

=cut

###############################################################	###############################################################
## Thesaurus Functions ##	## Thesaurus Functions ##
Line 2329 sub get_kerberos_defaults {	Line 2511 sub get_kerberos_defaults {

=over 4	=over 4

=item * initialize_keywords	=item * &initialize_keywords()

Initializes the package variable %Keywords if it is empty. Uses the	Initializes the package variable %Keywords if it is empty. Uses the
package variable $thesaurus_db_file.	package variable $thesaurus_db_file.
Line 2374 sub initialize_keywords {	Line 2556 sub initialize_keywords {

=pod	=pod

=item * keyword($word)	=item * &keyword($word)

Returns true if $word is a keyword. A keyword is a word that appears more	Returns true if $word is a keyword. A keyword is a word that appears more
than the average number of times in the thesaurus database. Calls	than the average number of times in the thesaurus database. Calls
Line 2395 sub keyword {	Line 2577 sub keyword {

=pod	=pod

=item * get_related_words	=item * &get_related_words()

Look up a word in the thesaurus. Takes a scalar argument and returns	Look up a word in the thesaurus. Takes a scalar argument and returns
an array of words. If the keyword is not in the thesaurus, an empty array	an array of words. If the keyword is not in the thesaurus, an empty array
Line 2453 sub get_related_words {	Line 2635 sub get_related_words {

=over 4	=over 4

=item * plainname($uname,$udom,$first)	=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
Line 2482 sub plainname {	Line 2664 sub plainname {
# -------------------------------------------------------------------- Nickname	# -------------------------------------------------------------------- Nickname
=pod	=pod

=item * nickname($uname,$udom)	=item * &nickname($uname,$udom)

Gets a users name and returns it as a string as	Gets a users name and returns it as a string as

Line 2532 sub getnames {	Line 2714 sub getnames {
}	}

# -------------------------------------------------------------------- getemails	# -------------------------------------------------------------------- getemails

=pod	=pod

=item * getemails($uname,$udom)	=item * &getemails($uname,$udom)

Gets a user's email information and returns it as a hash with keys:	Gets a user's email information and returns it as a hash with keys:
notification, critnotification, permanentemail	notification, critnotification, permanentemail

For notification and critnotification, values are comma-separated lists	For notification and critnotification, values are comma-separated lists
of e-mail address(es); for permanentemail, value is a single e-mail address.	of e-mail addresses; for permanentemail, value is a single e-mail address.


=cut	=cut


sub getemails {	sub getemails {
my ($uname,$udom)=@_;	my ($uname,$udom)=@_;
if ($udom eq 'public' && $uname eq 'public') {	if ($udom eq 'public' && $uname eq 'public') {
Line 2574 sub flush_email_cache {	Line 2759 sub flush_email_cache {
&Apache::lonnet::devalidate_cache_new('emailscache',$id);	&Apache::lonnet::devalidate_cache_new('emailscache',$id);
}	}

	# -------------------------------------------------------------------- getlangs

	=pod

	=item * &getlangs($uname,$udom)

	Gets a user's language preference and returns it as a hash with key:
	language.

	=cut


	sub getlangs {
	my ($uname,$udom) = @_;
	if (!$udom) { $udom =$env{'user.domain'}; }
	if (!$uname) { $uname=$env{'user.name'}; }
	my $id=$uname.':'.$udom;
	my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
	if ($cached) {
	return %{$langs};
	} else {
	my %loadlangs=&Apache::lonnet::get('environment',['languages'],
	$udom,$uname);
	&Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
	return %loadlangs;
	}
	}

	sub flush_langs_cache {
	my ($uname,$udom)=@_;
	if (!$udom) { $udom =$env{'user.domain'}; }
	if (!$uname) { $uname=$env{'user.name'}; }
	return if ($udom eq 'public' && $uname eq 'public');
	my $id=$uname.':'.$udom;
	&Apache::lonnet::devalidate_cache_new('userlangs',$id);
	}

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

=pod	=pod

=item * screenname($uname,$udom)	=item * &screenname($uname,$udom)

Gets a users screenname and returns it as a string	Gets a users screenname and returns it as a string

Line 2592 sub screenname {	Line 2814 sub screenname {
return $names{'screenname'};	return $names{'screenname'};
}	}

	# ------------------------------------------------------------- Confirm Wrapper
	=pod

	=item confirmwrapper

	Wrap messages about completion of operation in box

	=cut

	sub confirmwrapper {
	my ($message)=@_;
	if ($message) {
	return "\n".'<div class="LC_confirm_box">'."\n"
	.$message."\n"
	.'</div>'."\n";
	} else {
	return $message;
	}
	}

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

Line 2618 sub aboutmewrapper {	Line 2859 sub aboutmewrapper {
return;	return;
}	}
return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.	return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
($target?' target="$target"':'').' title="'.&mt("View this user's personal page").'">'.$link.'</a>';	($target?' target="$target"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
}	}

# ------------------------------------------------------------ Syllabus Wrapper	# ------------------------------------------------------------ Syllabus Wrapper
Line 2653 sub track_student_link {	Line 2894 sub track_student_link {
&help_open_topic('View_recent_activity');	&help_open_topic('View_recent_activity');
}	}

	sub slot_reservations_link {
	my ($linktext,$sname,$sdom,$target) = @_;
	my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
	my $title = 'View slot reservation history';
	if (defined($sname) && $sname !~ /^\s*$/ &&
	defined($sdom) && $sdom !~ /^\s*$/) {
	$link .= "&uname=$sname&udom=$sdom";
	$title .= ' of this student';
	}
	if (defined($target) && $target !~ /^\s*$/) {
	$target = qq{target="$target"};
	} else {
	$target = '';
	}
	$title = &mt($title);
	$linktext = &mt($linktext);
	return qq{<a href="$link" title="$title" $target>$linktext</a>};
	# FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');

	}

# ===================================================== Display a student photo	# ===================================================== Display a student photo


Line 2674 sub student_image_tag {	Line 2936 sub student_image_tag {

=over 4	=over 4

=item * languageids()	=item * &languageids()

returns list of all language ids	returns list of all language ids

Line 2686 sub languageids {	Line 2948 sub languageids {

=pod	=pod

=item * languagedescription()	=item * &languagedescription()

returns description of a specified language id	returns description of a specified language id

Line 2711 sub supportedlanguagecode {	Line 2973 sub supportedlanguagecode {

=pod	=pod

=item * copyrightids()	=item * &copyrightids()

returns list of all copyrights	returns list of all copyrights

Line 2723 sub copyrightids {	Line 2985 sub copyrightids {

=pod	=pod

=item * copyrightdescription()	=item * &copyrightdescription()

returns description of a specified copyright id	returns description of a specified copyright id

Line 2735 sub copyrightdescription {	Line 2997 sub copyrightdescription {

=pod	=pod

=item * source_copyrightids()	=item * &source_copyrightids()

returns list of all source copyrights	returns list of all source copyrights

Line 2747 sub source_copyrightids {	Line 3009 sub source_copyrightids {

=pod	=pod

=item * source_copyrightdescription()	=item * &source_copyrightdescription()

returns description of a specified source copyright id	returns description of a specified source copyright id

Line 2759 sub source_copyrightdescription {	Line 3021 sub source_copyrightdescription {

=pod	=pod

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

returns list of all file categories	returns list of all file categories

Line 2771 sub filecategories {	Line 3033 sub filecategories {

=pod	=pod

=item * filecategorytypes()	=item * &filecategorytypes()

returns list of file types belonging to a given file	returns list of file types belonging to a given file
category	category
Line 2785 sub filecategorytypes {	Line 3047 sub filecategorytypes {

=pod	=pod

=item * fileembstyle()	=item * &fileembstyle()

returns embedding style for a specified file type	returns embedding style for a specified file type

Line 2809 sub filecategoryselect {	Line 3071 sub filecategoryselect {

=pod	=pod

=item * filedescription()	=item * &filedescription()

returns description for a specified file type	returns description for a specified file type

Line 2823 sub filedescription {	Line 3085 sub filedescription {

=pod	=pod

=item * filedescriptionex()	=item * &filedescriptionex()

returns description for a specified file type with	returns description for a specified file type with
extra formatting	extra formatting
Line 2855 sub fileextensions {	Line 3117 sub fileextensions {

sub display_languages {	sub display_languages {
my %languages=();	my %languages=();
foreach my $lang (&preferred_languages()) {	foreach my $lang (&Apache::lonlocal::preferred_languages()) {
$languages{$lang}=1;	$languages{$lang}=1;
}	}
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);	&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
Line 2867 sub display_languages {	Line 3129 sub display_languages {
return %languages;	return %languages;
}	}

sub preferred_languages {
my @languages=();
if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
@languages=(@languages,split(/\s(\,\|\;\|\:)\s/,
$env{'course.'.$env{'request.course.id'}.'.languages'}));
}
if ($env{'environment.languages'}) {
@languages=(@languages,
split(/\s(\,\|\;\|\:)\s/,$env{'environment.languages'}));
}
my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'};
if ($browser) {
my @browser =
map { (split(/\s;\s/,$_))[0] } (split(/\s,\s/,$browser));
push(@languages,@browser);
}
if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) {
@languages=(@languages,
&Apache::lonnet::domain($env{'user.domain'},
'lang_def'));
}
if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) {
@languages=(@languages,
&Apache::lonnet::domain($env{'request.role.domain'},
'lang_def'));
}
if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
'lang_def')) {
@languages=(@languages,
&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
'lang_def'));
}
# turn "en-ca" into "en-ca,en"
my @genlanguages;
foreach my $lang (@languages) {
unless ($lang=~/\w/) { next; }
push(@genlanguages,$lang);
if ($lang=~/(\-\|\_)/) {
push(@genlanguages,(split(/(\-\|\_)/,$lang))[0]);
}
}
#uniqueify the languages list
my %count;
@genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages;
return @genlanguages;
}

sub languages {	sub languages {
my ($possible_langs) = @_;	my ($possible_langs) = @_;
my @preferred_langs = &preferred_languages();	my @preferred_langs = &Apache::lonlocal::preferred_languages();
if (!ref($possible_langs)) {	if (!ref($possible_langs)) {
if( wantarray ) {	if( wantarray ) {
return @preferred_langs;	return @preferred_langs;
Line 2937 sub languages {	Line 3152 sub languages {
return $preferred_possibilities[0];	return $preferred_possibilities[0];
}	}

	sub user_lang {
	my ($touname,$toudom,$fromcid) = @_;
	my @userlangs;
	if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
	@userlangs=(@userlangs,split(/\s(\,\|\;\|\:)\s/,
	$env{'course.'.$fromcid.'.languages'}));
	} else {
	my %langhash = &getlangs($touname,$toudom);
	if ($langhash{'languages'} ne '') {
	@userlangs = split(/\s(\,\|\;\|\:)\s/,$langhash{'languages'});
	} else {
	my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
	if ($domdefs{'lang_def'} ne '') {
	@userlangs = ($domdefs{'lang_def'});
	}
	}
	}
	my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
	my $user_lh = Apache::localize->get_handle(@languages);
	return $user_lh;
	}

###############################################################	###############################################################
## Student Answer Attempts ##	## Student Answer Attempts ##
###############################################################	###############################################################
Line 2947 sub languages {	Line 3184 sub languages {

=over 4	=over 4

=item * get_previous_attempt($symb, $username, $domain, $course,	=item * &get_previous_attempt($symb, $username, $domain, $course,
$getattempt, $regexp, $gradesub)	$getattempt, $regexp, $gradesub)

Return string with previous attempt on problem. Arguments:	Return string with previous attempt on problem. Arguments:
Line 3075 sub relative_to_absolute {	Line 3312 sub relative_to_absolute {
}	}
$thisdir=~s-/[^/]*$--;	$thisdir=~s-/[^/]*$--;
foreach my $link (@rlinks) {	foreach my $link (@rlinks) {
unless (($link=~/^http:\/\//i) \|\|	unless (($link=~/^https?\:\/\//i) \|\|
($link=~/^\//) \|\|	($link=~/^\//) \|\|
($link=~/^javascript:/i) \|\|	($link=~/^javascript:/i) \|\|
($link=~/^mailto:/i) \|\|	($link=~/^mailto:/i) \|\|
Line 3091 sub relative_to_absolute {	Line 3328 sub relative_to_absolute {

=pod	=pod

=item * get_student_view	=item * &get_student_view()

show a snapshot of what student was looking at	show a snapshot of what student was looking at

Line 3110 sub get_student_view {	Line 3347 sub get_student_view {
}	}
if (defined($target)) { $form{'grade_target'} = $target; }	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,$response)=&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 3119 sub get_student_view {	Line 3356 sub get_student_view {
$userview=~s/\<\/head\>//gi;	$userview=~s/\<\/head\>//gi;
$userview=~s/action\s*\=/would_be_action\=/gi;	$userview=~s/action\s*\=/would_be_action\=/gi;
$userview=&relative_to_absolute($feedurl,$userview);	$userview=&relative_to_absolute($feedurl,$userview);
return $userview;	if (wantarray) {
	return ($userview,$response);
	} else {
	return $userview;
	}
	}

	sub get_student_view_with_retries {
	my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;

	my $ok = 0; # True if we got a good response.
	my $content;
	my $response;

	# Try to get the student_view done. within the retries count:

	do {
	($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
	$ok = $response->is_success;
	if (!$ok) {
	&Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
	}
	$retries--;
	} while (!$ok && ($retries > 0));

	if (!$ok) {
	$content = ''; # On error return an empty content.
	}
	if (wantarray) {
	return ($content, $response);
	} else {
	return $content;
	}
}	}

=pod	=pod

=item * get_student_answers()	=item * &get_student_answers()

show a snapshot of how student was answering problem	show a snapshot of how student was answering problem

Line 3228 sub pprmlink {	Line 3497 sub pprmlink {


sub timehash {	sub timehash {
my @ltime=localtime(shift);	my ($thistime) = @_;
return ( 'seconds' => $ltime[0],	my $timezone = &Apache::lonlocal::gettimezone();
'minutes' => $ltime[1],	my $dt = DateTime->from_epoch(epoch => $thistime)
'hours' => $ltime[2],	->set_time_zone($timezone);
'day' => $ltime[3],	my $wday = $dt->day_of_week();
'month' => $ltime[4]+1,	if ($wday == 7) { $wday = 0; }
'year' => $ltime[5]+1900,	return ( 'second' => $dt->second(),
'weekday' => $ltime[6],	'minute' => $dt->minute(),
'dayyear' => $ltime[7]+1,	'hour' => $dt->hour(),
'dlsav' => $ltime[8] );	'day' => $dt->day_of_month(),
	'month' => $dt->month(),
	'year' => $dt->year(),
	'weekday' => $wday,
	'dayyear' => $dt->day_of_year(),
	'dlsav' => $dt->is_dst() );
}	}

sub utc_string {	sub utc_string {
Line 3247 sub utc_string {	Line 3521 sub utc_string {

sub maketime {	sub maketime {
my %th=@_;	my %th=@_;
	my ($epoch_time,$timezone,$dt);
	$timezone = &Apache::lonlocal::gettimezone();
	eval {
	$dt = DateTime->new( year => $th{'year'},
	month => $th{'month'},
	day => $th{'day'},
	hour => $th{'hour'},
	minute => $th{'minute'},
	second => $th{'second'},
	time_zone => $timezone,
	);
	};
	if (!$@) {
	$epoch_time = $dt->epoch;
	if ($epoch_time) {
	return $epoch_time;
	}
	}
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,-1));	$th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
Line 3597 sub blocking_status {	Line 3889 sub blocking_status {
&Apache::lonnet::coursedescription($course);	&Apache::lonnet::coursedescription($course);
$coursedesc = $courseinfo{'description'};	$coursedesc = $courseinfo{'description'};
}	}
$category = "Group files in the course '$coursedesc'";	$category = "Group portfolio files in the course '$coursedesc'";
} else {	} else {
$category = 'Portfolio files belonging to ';	$category = 'Portfolio files belonging to ';
if ($env{'user.name'} eq 'public' &&	if ($env{'user.name'} eq 'public' &&
Line 3627 sub blocking_status {	Line 3919 sub blocking_status {

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

	sub check_ip_acc {
	my ($acc)=@_;
	&Apache::lonxml::debug("acc is $acc");
	if (!defined($acc) \|\| $acc =~ /^\s$/ \|\| $acc =~/^\sno\s*$/i) {
	return 1;
	}
	my $allowed=0;
	my $ip=$env{'request.host'} \|\| $ENV{'REMOTE_ADDR'};

	my $name;
	foreach my $pattern (split(',',$acc)) {
	$pattern =~ s/^\s*//;
	$pattern =~ s/\s*$//;
	if ($pattern =~ /\*$/) {
	#35.8.*
	$pattern=~s/\*//;
	if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
	} elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
	#35.8.3.[34-56]
	my $low=$2;
	my $high=$3;
	$pattern=$1;
	if ($ip =~ /^\Q$pattern\E/) {
	my $last=(split(/\./,$ip))[3];
	if ($last <=$high && $last >=$low) { $allowed=1; }
	}
	} elsif ($pattern =~ /^\*/) {
	#*.msu.edu
	$pattern=~s/\*//;
	if (!defined($name)) {
	use Socket;
	my $netaddr=inet_aton($ip);
	($name)=gethostbyaddr($netaddr,AF_INET);
	}
	if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
	} elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
	#127.0.0.1
	if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
	} else {
	#some.name.com
	if (!defined($name)) {
	use Socket;
	my $netaddr=inet_aton($ip);
	($name)=gethostbyaddr($netaddr,AF_INET);
	}
	if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
	}
	if ($allowed) { last; }
	}
	return $allowed;
	}

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

=pod	=pod

=head1 Domain Template Functions	=head1 Domain Template Functions
Line 3675 sub get_domainconf {	Line 4021 sub get_domainconf {
if (ref($domconfig{'login'}) eq 'HASH') {	if (ref($domconfig{'login'}) eq 'HASH') {
if (keys(%{$domconfig{'login'}})) {	if (keys(%{$domconfig{'login'}})) {
foreach my $key (keys(%{$domconfig{'login'}})) {	foreach my $key (keys(%{$domconfig{'login'}})) {
$designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};	if (ref($domconfig{'login'}{$key}) eq 'HASH') {
	foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
	$designhash{$udom.'.login.'.$key.'_'.$img} =
	$domconfig{'login'}{$key}{$img};
	}
	} else {
	$designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
	}
}	}
} else {	} else {
$legacy{'login'} = 1;	$legacy{'login'} = 1;
Line 3897 sub bodytag {	Line 4250 sub bodytag {
my $font = &designparm($function.'.font',$domain);	my $font = &designparm($function.'.font',$domain);
my $pgbg = $bgcolor \|\| &designparm($function.'.pgbg',$domain);	my $pgbg = $bgcolor \|\| &designparm($function.'.pgbg',$domain);

my %design = ( 'style' => 'margin-top: 0px',	my %design = ( 'style' => 'margin-top: 0',
'bgcolor' => $pgbg,	'bgcolor' => $pgbg,
'text' => $font,	'text' => $font,
'alink' => &designparm($function.'.alink',$domain),	'alink' => &designparm($function.'.alink',$domain),
Line 3981 ENDROLE	Line 4334 ENDROLE
$dc_info = '('.$dc_info.')';	$dc_info = '('.$dc_info.')';
}	}

if ($env{'environment.remote'} eq 'off') {	if (($env{'environment.remote'} eq 'off') \|\| ($args->{'suppress_header_logos'})) {
# No Remote	# No Remote
if ($env{'request.state'} eq 'construct') {	if ($env{'request.state'} eq 'construct') {
$forcereg=1;	$forcereg=1;
Line 4004 ENDROLE	Line 4357 ENDROLE
$lastitem = $thisdisfn;	$lastitem = $thisdisfn;
}	}
$titleinfo =	$titleinfo =
&Apache::loncommon::help_open_menu('','',3,'Authoring').	&Apache::loncommon::help_open_menu('','',3,'Authoring')
'<b>Construction Space</b>: '.	.'<b>'.&mt('Construction Space').'</b>: '
'<form name="dirs" method="post" action="'.$formaction	.'<form name="dirs" method="post" action="'.$formaction
.'" target="_top"><tt><b>'	.'" target="_top"><tt><b>'
.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"	.&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()')	.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
Line 4201 sub standard_css {	Line 4554 sub standard_css {
my $feedback_link_bg = '#BBBBBB';	my $feedback_link_bg = '#BBBBBB';

my $border = ($env{'browser.type'} eq 'explorer' \|\|	my $border = ($env{'browser.type'} eq 'explorer' \|\|
$env{'browser.type'} eq 'safari' ) ? '0px 2px 0px 2px'	$env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
: '0px 3px 0px 4px';	: '0 3px 0 4px';


return <<END;	return <<END;
Line 4237 form, .inline { display: inline; }	Line 4590 form, .inline { display: inline; }
.LC_diff_added {	.LC_diff_added {
color: green;	color: green;
}	}
.LC_unknown {
color: yellow;	div.LC_confirm_box {
	background-color: #FAFAFA;
	border: 1px solid $lg_border_color;
	margin-right: 0;
	padding: 5px;
	}

	div.LC_confirm_box .LC_error img,
	div.LC_confirm_box .LC_success img {
	vertical-align: middle;
}	}

.LC_icon {	.LC_icon {
border: 0px;	border: none;
}	}
.LC_indexer_icon {	.LC_indexer_icon {
border: 0px;	border: 0;
height: 22px;	height: 22px;
}	}
.LC_docs_spacer {	.LC_docs_spacer {
width: 25px;	width: 25px;
height: 1px;	height: 1px;
border: 0px;	border: none;
}	}

.LC_internal_info {	.LC_internal_info {
color: #999;	color: #999999;
}	}

table.LC_pastsubmission {	table.LC_pastsubmission {
Line 4268 table#LC_top_nav, table#LC_menubuttons,t	Line 4630 table#LC_top_nav, table#LC_menubuttons,t
background: $pgbg;	background: $pgbg;
border: 2px;	border: 2px;
border-collapse: separate;	border-collapse: separate;
padding: 0px;	padding: 0;
}	}

table#LC_title_bar, table.LC_breadcrumbs,	table#LC_title_bar, table.LC_breadcrumbs,
Line 4281 table#LC_title_bar.LC_with_remote {	Line 4643 table#LC_title_bar.LC_with_remote {
background: $pgbg;	background: $pgbg;
font-family: $sans;	font-family: $sans;
border-collapse: collapse;	border-collapse: collapse;
padding: 0px;	padding: 0;
}	}

table.LC_docs_path {	table.LC_docs_path {
Line 4290 table.LC_docs_path {	Line 4652 table.LC_docs_path {
background: $pgbg;	background: $pgbg;
font-family: $sans;	font-family: $sans;
border-collapse: collapse;	border-collapse: collapse;
padding: 0px;	padding: 0;
}	}

table#LC_title_bar td {	table#LC_title_bar td {
Line 4311 span.LC_title_bar_title {	Line 4673 span.LC_title_bar_title {
table#LC_title_bar td.LC_title_bar_domain_logo {	table#LC_title_bar td.LC_title_bar_domain_logo {
background: $sidebg;	background: $sidebg;
text-align: right;	text-align: right;
padding: 0px;	padding: 0;
}	}
table#LC_title_bar td.LC_title_bar_role_logo {	table#LC_title_bar td.LC_title_bar_role_logo {
background: $sidebg;	background: $sidebg;
padding: 0px;	padding: 0;
}	}

table#LC_menubuttons_mainmenu {	table#LC_menubuttons_mainmenu {
width: 100%;	width: 100%;
border: 0px;	border: 0;
border-spacing: 1px;	border-spacing: 1px;
padding: 0px 1px;	padding: 0 1px;
margin: 0px;	margin: 0;
border-collapse: separate;	border-collapse: separate;
}	}
table#LC_menubuttons img, table#LC_menubuttons_mainmenu img {	table#LC_menubuttons img, table#LC_menubuttons_mainmenu img {
border: 0px;	border: none;
}	}
table#LC_top_nav td {	table#LC_top_nav td {
background: $tabbg;	background: $tabbg;
border: 0px;	border: none;
font-size: small;	font-size: small;
}	}
table#LC_top_nav td a, div#LC_top_nav a {	table#LC_top_nav td a, div#LC_top_nav a {
Line 4345 table#LC_top_nav td.LC_top_nav_logo {	Line 4707 table#LC_top_nav td.LC_top_nav_logo {
width: 31px;	width: 31px;
}	}
table#LC_top_nav td.LC_top_nav_logo img {	table#LC_top_nav td.LC_top_nav_logo img {
border: 0px;	border: none;
vertical-align: bottom;	vertical-align: bottom;
}	}
table#LC_top_nav td.LC_top_nav_exit,	table#LC_top_nav td.LC_top_nav_exit,
Line 4373 table.LC_docs_path td.LC_docs_path_compo	Line 4735 table.LC_docs_path td.LC_docs_path_compo
td.LC_table_cell_checkbox {	td.LC_table_cell_checkbox {
text-align: center;	text-align: center;
}	}

table#LC_mainmenu td.LC_mainmenu_column {	table#LC_mainmenu td.LC_mainmenu_column {
vertical-align: top;	vertical-align: top;
}	}
Line 4387 table#LC_mainmenu td.LC_mainmenu_column	Line 4748 table#LC_mainmenu td.LC_mainmenu_column
.LC_menubuttons_link {	.LC_menubuttons_link {
text-decoration: none;	text-decoration: none;
}	}
	/2008--9-5: new menu style sheet.Changed category/
.LC_menubuttons_category {	.LC_menubuttons_category {
color: $font;	color: $font;
background: $pgbg;	background: $pgbg;
Line 4415 td.LC_menubuttons_img {	Line 4776 td.LC_menubuttons_img {
font-weight: bold;	font-weight: bold;
}	}

.LC_rolesmenu_is {
font-family: $sans;
}

.LC_rolesmenu_selected {
font-family: $sans;
}

.LC_rolesmenu_future {
font-family: $sans;
}


.LC_rolesmenu_will {
font-family: $sans;
}

.LC_rolesmenu_will_not {
font-family: $sans;
}

.LC_rolesmenu_expired {
font-family: $sans;
}

.LC_rolesinfo {
font-family: $sans;
}

.LC_dropadd_labeltext {	.LC_dropadd_labeltext {
font-family: $sans;	font-family: $sans;
text-align: right;	text-align: right;
Line 4454 td.LC_menubuttons_img {	Line 4786 td.LC_menubuttons_img {
text-align: right;	text-align: right;
}	}

	.LC_roleslog_note {
	font-size: smaller;
	}

	.LC_mail_functions {
	font-weight: bold;
	}

table.LC_aboutme_port {	table.LC_aboutme_port {
border: 0px;	border: none;
border-collapse: collapse;	border-collapse: collapse;
border-spacing: 0px;	border-spacing: 0;
}	}
table.LC_data_table, table.LC_mail_list {	table.LC_data_table, table.LC_mail_list {
border: 1px solid #000000;	border: 1px solid #000000;
Line 4471 table.LC_data_table, table.LC_mail_list	Line 4811 table.LC_data_table, table.LC_mail_list
table.LC_nested_outer {	table.LC_nested_outer {
border: 1px solid #000000;	border: 1px solid #000000;
border-collapse: collapse;	border-collapse: collapse;
border-spacing: 0px;	border-spacing: 0;
width: 100%;	width: 100%;
}	}
table.LC_nested {	table.LC_nested {
border: 0px;	border: none;
border-collapse: collapse;	border-collapse: collapse;
border-spacing: 0px;	border-spacing: 0;
width: 100%;	width: 100%;
}	}
table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,	table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
Line 4486 table.LC_prior_tries tr th {	Line 4826 table.LC_prior_tries tr th {
background-color: $data_table_head;	background-color: $data_table_head;
font-size: smaller;	font-size: smaller;
}	}
	table.LC_data_table tr.LC_info_row > td {
	background-color: #CCCCCC;
	font-weight: bold;
	text-align: left;
	}
table.LC_data_table tr.LC_odd_row > td,	table.LC_data_table tr.LC_odd_row > td,
	table.LC_pick_box tr > td.LC_odd_row,
table.LC_aboutme_port tr td {	table.LC_aboutme_port tr td {
background-color: $data_table_light;	background-color: $data_table_light;
padding: 2px;	padding: 2px;
}	}
table.LC_data_table tr.LC_even_row > td,	table.LC_data_table tr.LC_even_row > td,
	table.LC_pick_box tr > td.LC_even_row,
table.LC_aboutme_port tr.LC_even_row td {	table.LC_aboutme_port tr.LC_even_row td {
background-color: $data_table_dark;	background-color: $data_table_dark;
	padding: 2px;
}	}
table.LC_data_table tr.LC_data_table_highlight td {	table.LC_data_table tr.LC_data_table_highlight td {
background-color: $data_table_darker;	background-color: $data_table_darker;
}	}
	table.LC_data_table tr td.LC_leftcol_header {
	background-color: $data_table_head;
	font-weight: bold;
	}
table.LC_data_table tr.LC_empty_row td,	table.LC_data_table tr.LC_empty_row td,
table.LC_nested tr.LC_empty_row td {	table.LC_nested tr.LC_empty_row td {
background-color: #FFFFFF;	background-color: #FFFFFF;
Line 4523 table.LC_nested_outer tr td.LC_subheader	Line 4875 table.LC_nested_outer tr td.LC_subheader
text-align: right;	text-align: right;
}	}
table.LC_nested tr.LC_info_row td {	table.LC_nested tr.LC_info_row td {
background-color: #CCC;	background-color: #CCCCCC;
font-weight: bold;	font-weight: bold;
font-size: small;	font-size: small;
text-align: center;	text-align: center;
Line 4533 table.LC_nested_outer tr th.LC_left_item	Line 4885 table.LC_nested_outer tr th.LC_left_item
text-align: left;	text-align: left;
}	}
table.LC_nested td {	table.LC_nested td {
background-color: #FFF;	background-color: #FFFFFF;
font-size: small;	font-size: small;
}	}
table.LC_nested_outer tr th.LC_right_item,	table.LC_nested_outer tr th.LC_right_item,
Line 4544 table.LC_nested tr td.LC_right_item {	Line 4896 table.LC_nested tr td.LC_right_item {
}	}

table.LC_nested tr.LC_odd_row td {	table.LC_nested tr.LC_odd_row td {
background-color: #EEE;	background-color: #EEEEEE;
}	}

table.LC_createuser {	table.LC_createuser {
Line 4555 table.LC_createuser tr.LC_section_row td	Line 4907 table.LC_createuser tr.LC_section_row td
}	}

table.LC_createuser tr.LC_info_row td {	table.LC_createuser tr.LC_info_row td {
background-color: #CCC;	background-color: #CCCCCC;
font-weight: bold;	font-weight: bold;
text-align: center;	text-align: center;
}	}
Line 4611 table.LC_mail_list tr.LC_mail_odd {	Line 4963 table.LC_mail_list tr.LC_mail_odd {
table#LC_portfolio_actions {	table#LC_portfolio_actions {
width: auto;	width: auto;
background: $pgbg;	background: $pgbg;
border: 0px;	border: none;
border-spacing: 2px 2px;	border-spacing: 2px 2px;
padding: 0px;	padding: 0;
margin: 0px;	margin: 0;
border-collapse: separate;	border-collapse: separate;
}	}
table#LC_portfolio_actions td.LC_label {	table#LC_portfolio_actions td.LC_label {
Line 4670 table#LC_browser tr.LC_browser_file_meta	Line 5022 table#LC_browser tr.LC_browser_file_meta
table#LC_browser tr.LC_browser_folder {	table#LC_browser tr.LC_browser_folder {
background: #CCCCFF;	background: #CCCCFF;
}	}

	table.LC_data_table tr > td.LC_roles_is {
	/* background: #77FF77; */
	}
	table.LC_data_table tr > td.LC_roles_future {
	background: #FFFF77;
	}
	table.LC_data_table tr > td.LC_roles_will {
	background: #FFAA77;
	}
	table.LC_data_table tr > td.LC_roles_expired {
	background: #FF7777;
	}
	table.LC_data_table tr > td.LC_roles_will_not {
	background: #AAFF77;
	}
	table.LC_data_table tr > td.LC_roles_selected {
	background: #11CC55;
	}

span.LC_current_location {	span.LC_current_location {
font-size: x-large;	font-size: x-large;
background: $pgbg;	background: $pgbg;
Line 4715 table.LC_parm_overview_restrictions th {	Line 5087 table.LC_parm_overview_restrictions th {
border-color: $pgbg;	border-color: $pgbg;
}	}
table#LC_helpmenu {	table#LC_helpmenu {
border: 0px;	border: none;
height: 55px;	height: 55px;
border-spacing: 0px;	border-spacing: 0;
}	}

table#LC_helpmenu fieldset legend {	table#LC_helpmenu fieldset legend {
Line 4728 table#LC_helpmenu_links {	Line 5100 table#LC_helpmenu_links {
width: 100%;	width: 100%;
border: 1px solid black;	border: 1px solid black;
background: $pgbg;	background: $pgbg;
padding: 0px;	padding: 0;
border-spacing: 1px;	border-spacing: 1px;
}	}
table#LC_helpmenu_links tr td {	table#LC_helpmenu_links tr td {
Line 4770 table.LC_pick_box td.LC_pick_box_title {	Line 5142 table.LC_pick_box td.LC_pick_box_title {
background: $tabbg;	background: $tabbg;
font-weight: bold;	font-weight: bold;
text-align: right;	text-align: right;
	vertical-align: top;
width: 184px;	width: 184px;
padding: 8px;	padding: 8px;
}	}
	table.LC_pick_box td.LC_selfenroll_pick_box_title {
	background: $tabbg;
	font-weight: bold;
	text-align: right;
	width: 350px;
	padding: 8px;
	}

table.LC_pick_box td.LC_pick_box_value {	table.LC_pick_box td.LC_pick_box_value {
text-align: left;	text-align: left;
padding: 8px;	padding: 8px;
Line 4782 table.LC_pick_box td.LC_pick_box_select	Line 5163 table.LC_pick_box td.LC_pick_box_select
padding: 8px;	padding: 8px;
}	}
table.LC_pick_box td.LC_pick_box_separator {	table.LC_pick_box td.LC_pick_box_separator {
padding: 0px;	padding: 0;
height: 1px;	height: 1px;
background: black;	background: black;
}	}
Line 4824 table.LC_helpform_receipt td.LC_oddrow_v	Line 5205 table.LC_helpform_receipt td.LC_oddrow_v
background-color: $data_table_light;	background-color: $data_table_light;
}	}
table.LC_helpform_receipt td.LC_pick_box_separator {	table.LC_helpform_receipt td.LC_pick_box_separator {
padding: 0px;	padding: 0;
height: 1px;	height: 1px;
background: black;	background: black;
}	}
Line 4857 table.LC_group_priv_box td.LC_groups_fun	Line 5238 table.LC_group_priv_box td.LC_groups_fun
}	}
table.LC_group_priv td {	table.LC_group_priv td {
text-align: left;	text-align: left;
padding: 0px;	padding: 0;
}	}

table.LC_notify_front_page {	table.LC_notify_front_page {
Line 4878 table.LC_notify_front_page td {	Line 5259 table.LC_notify_front_page td {
background: $tabbg;	background: $tabbg;
vertical-align: middle;	vertical-align: middle;
margin: 2ex 0ex 2ex 0ex;	margin: 2ex 0ex 2ex 0ex;
	padding: 3px;
}	}
.LC_topic_bar span {	.LC_topic_bar span {
vertical-align: middle;	vertical-align: middle;
Line 4994 span.LC_cusr_subheading {	Line 5376 span.LC_cusr_subheading {

table.LC_docs_documents {	table.LC_docs_documents {
background: #BBBBBB;	background: #BBBBBB;
border-width: 0px;	border-width: 0;
border-collapse: collapse;	border-collapse: collapse;
}	}

Line 5011 table.LC_docs_documents td.LC_docs_docum	Line 5393 table.LC_docs_documents td.LC_docs_docum
}	}

.LC_docs_entry_move {	.LC_docs_entry_move {
border: 0px;	border: none;
border-collapse: collapse;	border-collapse: collapse;
}	}

Line 5067 table.LC_sty_end {	Line 5449 table.LC_sty_end {
}	}

table.LC_double_column {	table.LC_double_column {
border-width: 0px;	border-width: 0;
border-collapse: collapse;	border-collapse: collapse;
width: 100%;	width: 100%;
padding: 2px;	padding: 2px;
Line 5206 table.LC_edit_problem_header_title {	Line 5588 table.LC_edit_problem_header_title {

background: $tabbg;	background: $tabbg;
border-collapse: collapse;	border-collapse: collapse;
padding: 0px	padding: 0;
}	}

div.LC_edit_problem_discards {	div.LC_edit_problem_discards {
Line 5222 hr.LC_edit_problem_divide {	Line 5604 hr.LC_edit_problem_divide {
color: $tabbg;	color: $tabbg;
background-color: $tabbg;	background-color: $tabbg;
height: 3px;	height: 3px;
border: 0px;	border: none;
	}
	img.stift{
	border-width:0;
	vertical-align:middle;
	}

	table#LC_mainmenu{
	margin-top:10px;
	width:80%;

	}

	table#LC_mainmenu td.LC_mainmenu_col_fieldset{
	vertical-align: top;
	width: 45%;
	}
	.LC_mainmenu_fieldset_category {
	color: $font;
	background: $pgbg;
	font-family: $sans;
	font-size: small;
	font-weight: bold;
}	}
	fieldset#LC_mainmenu_fieldset {
	margin:0 10px 10px 0;

	}

	div.LC_createcourse {
	margin: 10px 10px 10px 10px;
	}

END	END
}	}

Line 5317 Inputs: none	Line 5730 Inputs: none

sub font_settings {	sub font_settings {
my $headerstring='';	my $headerstring='';
if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) {	if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
$headerstring.=
'<meta Content-Type="text/html; charset=x-mac-roman" />';
} elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
$headerstring.=	$headerstring.=
'<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';	'<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
}	}
Line 5379 sub endheadtag {	Line 5789 sub endheadtag {

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

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

	$title - optional title for the page

	$head_extra - optional extra HTML to put inside the <head>

	=back

=cut	=cut

Line 5395 sub head {	Line 5812 sub head {

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

Inputs: $title - optional title for the page	Inputs:
$head_extra - optional extra HTML to incude inside the <head>
$args - additional optional args supported are:	=over 4
only_body -> is true will set &bodytag() onlybodytag
	$title - optional title for the page

	$head_extra - optional extra HTML to incude inside the <head>

	$args - additional optional args supported are:

	=over 8

	only_body -> is true will set &bodytag() onlybodytag
arg on	arg on
no_nav_bar -> is true will set &bodytag() notopbar arg on	no_nav_bar -> is true will set &bodytag() notopbar arg on
add_entries -> additional attributes to add to the <body>	add_entries -> additional attributes to add to the <body>
domain -> force to color decorate a page for a	domain -> force to color decorate a page for a
specific domain	specific domain
function -> force usage of a specific rolish color	function -> force usage of a specific rolish color
scheme	scheme
redirect -> see &headtag()	redirect -> see &headtag()
bgcolor -> override the default page bg color	bgcolor -> override the default page bg color
js_ready -> return a string ready for being used in	js_ready -> return a string ready for being used in
a javascript writeln	a javascript writeln
html_encode -> return a string ready for being used in	html_encode -> return a string ready for being used in
a html attribute	a html attribute
force_register -> if is true will turn on the &bodytag()	force_register -> if is true will turn on the &bodytag()
$forcereg arg	$forcereg arg
body_title -> alternate text to use instead of $title	body_title -> alternate text to use instead of $title
in the title box that appears, this text	in the title box that appears, this text
is not auto translated like the $title is	is not auto translated like the $title is
frameset -> if true will start with a <frameset>	frameset -> if true will start with a <frameset>
rather than <body>	rather than <body>
no_title -> if true the title bar won't be shown	no_title -> if true the title bar won't be shown
skip_phases -> hash ref of	skip_phases -> hash ref of
head -> skip the <html><head> generation	head -> skip the <html><head> generation
body -> skip all <body> generation	body -> skip all <body> generation
	no_inline_link -> if true and in remote mode, don't show the
no_inline_link -> if true and in remote mode, don't show the
'Switch To Inline Menu' link	'Switch To Inline Menu' link
	no_auto_mt_title -> prevent &mt()ing the title arg
no_auto_mt_title -> prevent &mt()ing the title arg	inherit_jsmath -> when creating popup window in a page,

inherit_jsmath -> when creating popup window in a page,
should it have jsmath forced on by the	should it have jsmath forced on by the
current page	current page

	=back

	=back

=cut	=cut

sub start_page {	sub start_page {
Line 5478 sub start_page {	Line 5905 sub start_page {
if ($args->{'html_encode'}) {	if ($args->{'html_encode'}) {
$result = &html_encode($result);	$result = &html_encode($result);
}	}
return $result;	#Breadcrumbs
}	if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
	&Apache::lonhtmlcommon::clear_breadcrumbs();
	#if any br links exists, add them to the breadcrumbs
	if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
	foreach my $crumb (@{$args->{'bread_crumbs'}}){
	&Apache::lonhtmlcommon::add_breadcrumb($crumb);
	}
	}

	#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
	if (exists($args->{'bread_crumbs_component'})){
	$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
	} else {
	$result .= &Apache::lonhtmlcommon::breadcrumbs();
	}
	}
	return $result;

=pod	=pod

Line 5723 sub get_users_function {	Line 6165 sub get_users_function {

=pod	=pod

	=item * &show_course()

	Used by lonmenu.pm and lonroles.pm to determine whether to use the word
	'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
	Inputs:
	None

	Outputs:
	Scalar: 1 if 'Course' to be used, 0 otherwise.

	=cut

	###############################################
	sub show_course {
	my $course = !$env{'user.adv'};
	if (!$env{'user.adv'}) {
	foreach my $env (keys(%env)) {
	next if ($env !~ m/^user\.priv\./);
	if ($env !~ m/^user\.priv\.(?:st\|cm)/) {
	$course = 0;
	last;
	}
	}
	}
	return $course;
	}

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

	=pod

=item * &check_user_status()	=item * &check_user_status()

Determines current status of supplied role for a	Determines current status of supplied role for a
Line 6238 sub default_quota {	Line 6711 sub default_quota {
['quotas'],$udom);	['quotas'],$udom);
if (ref($quotahash{'quotas'}) eq 'HASH') {	if (ref($quotahash{'quotas'}) eq 'HASH') {
if ($inststatus ne '') {	if ($inststatus ne '') {
my @statuses = split(/:/,$inststatus);	my @statuses = map { &unescape($_); } split(/:/,$inststatus);
foreach my $item (@statuses) {	foreach my $item (@statuses) {
if ($quotahash{'quotas'}{$item} ne '') {	if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
if ($defquota eq '') {	if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
$defquota = $quotahash{'quotas'}{$item};	if ($defquota eq '') {
$settingstatus = $item;	$defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
} elsif ($quotahash{'quotas'}{$item} > $defquota) {	$settingstatus = $item;
$defquota = $quotahash{'quotas'}{$item};	} elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
$settingstatus = $item;	$defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
	$settingstatus = $item;
	}
	}
	} else {
	if ($quotahash{'quotas'}{$item} ne '') {
	if ($defquota eq '') {
	$defquota = $quotahash{'quotas'}{$item};
	$settingstatus = $item;
	} elsif ($quotahash{'quotas'}{$item} > $defquota) {
	$defquota = $quotahash{'quotas'}{$item};
	$settingstatus = $item;
	}
}	}
}	}
}	}
}	}
if ($defquota eq '') {	if ($defquota eq '') {
$defquota = $quotahash{'quotas'}{'default'};	if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
	$defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
	} else {
	$defquota = $quotahash{'quotas'}{'default'};
	}
$settingstatus = 'default';	$settingstatus = 'default';
}	}
} else {	} else {
Line 6401 sub user_picker {	Line 6890 sub user_picker {
if ($cancreate) {	if ($cancreate) {
$new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>';	$new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>';
} else {	} else {
my $helplink = ' href="javascript:helpMenu('."'display'".')"';	my $helplink = 'javascript:helpMenu('."'display'".')';
my %usertypetext = (	my %usertypetext = (
official => 'institutional',	official => 'institutional',
unofficial => 'non-institutional',	unofficial => 'non-institutional',
);	);
$new_user_create = '<br /><span class="LC_warning">'.&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.").' '.&mt('Contact the <a[_1]>helpdesk</a> for assistance.',$helplink).'</span><br /><br />';	$new_user_create = '<p class="LC_warning">'.
	&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.").' '.
	&mt('Please contact the [_1]helpdesk[_2] for assistance.','<a href="'.$helplink.'">','</a>').'</p><br />';
}	}
}	}
}	}
Line 6658 sub instrule_disallow_msg {	Line 7149 sub instrule_disallow_msg {
$text{'action'} = 'IDs';	$text{'action'} = 'IDs';
}	}
}	}
$response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for <span class=\"LC_cusr_emph\">[_1]</span>, but the $text{'item'} $text{'do'} not exist in the institutional directory.",$domdesc).'<br />';	$response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for [_1], but the $text{'item'} $text{'do'} not exist in the institutional directory.",'<span class="LC_cusr_emph">'.$domdesc.'</span>').'<br />';
if ($mode eq 'upload') {	if ($mode eq 'upload') {
if ($checkitem eq 'username') {	if ($checkitem eq 'username') {
$response .= &mt("You will need to modify your upload file so it will include $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");	$response .= &mt("You will need to modify your upload file so it will include $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
} elsif ($checkitem eq 'id') {	} elsif ($checkitem eq 'id') {
$response .= &mt("Either upload a file which includes $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the ID/Student Number field.");	$response .= &mt("Either upload a file which includes $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the Student/Employee ID field.");
	}
	} elsif ($mode eq 'selfcreate') {
	if ($checkitem eq 'id') {
	$response .= &mt("You must either choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank.");
}	}
} else {	} else {
if ($checkitem eq 'username') {	if ($checkitem eq 'username') {
Line 6684 sub personal_data_fieldtitles {	Line 7179 sub personal_data_fieldtitles {
middlename => 'Middle Name',	middlename => 'Middle Name',
generation => 'Generation',	generation => 'Generation',
gen => 'Generation',	gen => 'Generation',
	inststatus => 'Affiliation',
);	);
return %fieldtitles;	return %fieldtitles;
}	}

	sub sorted_inst_types {
	my ($dom) = @_;
	my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
	my $othertitle = &mt('All users');
	if ($env{'request.course.id'}) {
	$othertitle = &mt('Any users');
	}
	my @types;
	if (ref($order) eq 'ARRAY') {
	@types = @{$order};
	}
	if (@types == 0) {
	if (ref($usertypes) eq 'HASH') {
	@types = sort(keys(%{$usertypes}));
	}
	}
	if (keys(%{$usertypes}) > 0) {
	$othertitle = &mt('Other users');
	}
	return ($othertitle,$usertypes,\@types);
	}

	sub get_institutional_codes {
	my ($settings,$allcourses,$LC_code) = @_;
	# Get complete list of course sections to update
	my @currsections = ();
	my @currxlists = ();
	my $coursecode = $$settings{'internal.coursecode'};

	if ($$settings{'internal.sectionnums'} ne '') {
	@currsections = split(/,/,$$settings{'internal.sectionnums'});
	}

	if ($$settings{'internal.crosslistings'} ne '') {
	@currxlists = split(/,/,$$settings{'internal.crosslistings'});
	}

	if (@currxlists > 0) {
	foreach (@currxlists) {
	if (m/^([^:]+):(\w*)$/) {
	unless (grep/^$1$/,@{$allcourses}) {
	push @{$allcourses},$1;
	$$LC_code{$1} = $2;
	}
	}
	}
	}

	if (@currsections > 0) {
	foreach (@currsections) {
	if (m/^(\w+):(\w*)$/) {
	my $sec = $coursecode.$1;
	my $lc_sec = $2;
	unless (grep/^$sec$/,@{$allcourses}) {
	push @{$allcourses},$sec;
	$$LC_code{$sec} = $lc_sec;
	}
	}
	}
	}
	return;
	}

	=pod

	=head1 Slot Helpers

	=over 4

	=item * sorted_slots()

	Sorts an array of slot names in order of slot start time (earliest first).

	Inputs:

	=over 4

	slotsarr - Reference to array of unsorted slot names.

	slots - Reference to hash of hash, where outer hash keys are slot names.

	=back

	Returns:

	=over 4

	sorted - An array of slot names sorted by the start time of the slot.

	=back

	=back

	=cut


	sub sorted_slots {
	my ($slotsarr,$slots) = @_;
	my @sorted;
	if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
	@sorted =
	sort {
	if (ref($slots->{$a}) && ref($slots->{$b})) {
	return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'}
	}
	if (ref($slots->{$a})) { return -1;}
	if (ref($slots->{$b})) { return 1;}
	return 0;
	} @{$slotsarr};
	}
	return @sorted;
	}

=pod	=pod

=back	=back
Line 6696 sub personal_data_fieldtitles {	Line 7305 sub personal_data_fieldtitles {

=over 4	=over 4

=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),
Line 6725 sub get_unprocessed_cgi {	Line 7334 sub get_unprocessed_cgi {

=pod	=pod

=item * cacheheader()	=item * &cacheheader()

returns cache-controlling header code	returns cache-controlling header code

Line 6742 sub cacheheader {	Line 7351 sub cacheheader {

=pod	=pod

=item * no_cache($r)	=item * &no_cache($r)

specifies header code to not have cache	specifies header code to not have cache

Line 6778 sub content_type {	Line 7387 sub content_type {

=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
Line 6805 sub add_to_env {	Line 7414 sub add_to_env {

=pod	=pod

=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.
Line 6828 sub get_env_multiple {	Line 7437 sub get_env_multiple {
return(@values);	return(@values);
}	}

	sub ask_for_embedded_content {
	my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
	my $upload_output = '
	<form name="upload_embedded" action="'.$actionurl.'"
	method="post" enctype="multipart/form-data">';
	$upload_output .= $state;
	$upload_output .= '<b>Upload embedded files</b>:<br />'.&start_data_table();

	my $num = 0;
	foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) {
	$upload_output .= &start_data_table_row().
	'<td>'.$embed_file.'</td><td>';
	if ($args->{'ignore_remote_references'}
	&& $embed_file =~ m{^\w+://}) {
	$upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
	} elsif ($args->{'error_on_invalid_names'}
	&& $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {

	$upload_output.='<span class="LC_warning">'.&mt("Invalid characters").'</span>';

	} else {
	$upload_output .='
	<input name="embedded_item_'.$num.'" type="file" value="" />
	<input name="embedded_orig_'.$num.'" type="hidden" value="'.&escape($embed_file).'" />';
	my $attrib = join(':',@{$$allfiles{$embed_file}});
	$upload_output .=
	"\n\t\t".
	'<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
	$attrib.'" />';
	if (exists($$codebase{$embed_file})) {
	$upload_output .=
	"\n\t\t".
	'<input name="codebase_'.$num.'" type="hidden" value="'.
	&escape($$codebase{$embed_file}).'" />';
	}
	}
	$upload_output .= '</td>'.&Apache::loncommon::end_data_table_row();
	$num++;
	}
	$upload_output .= &Apache::loncommon::end_data_table().'<br />
	<input type ="hidden" name="number_embedded_items" value="'.$num.'" />
	<input type ="submit" value="'.&mt('Upload Listed Files').'" />
	'.&mt('(only files for which a location has been provided will be uploaded)').'
	</form>';
	return $upload_output;
	}

	sub upload_embedded {
	my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
	$current_disk_usage) = @_;
	my $output;
	for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
	next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
	my $orig_uploaded_filename =
	$env{'form.embedded_item_'.$i.'.filename'};

	$env{'form.embedded_orig_'.$i} =
	&unescape($env{'form.embedded_orig_'.$i});
	my ($path,$fname) =
	($env{'form.embedded_orig_'.$i} =~ m{(./)([^/])});
	# no path, whole string is fname
	if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };

	$path = $env{'form.currentpath'}.$path;
	$fname = &Apache::lonnet::clean_filename($fname);
	# See if there is anything left
	next if ($fname eq '');

	# Check if file already exists as a file or directory.
	my ($state,$msg);
	if ($context eq 'portfolio') {
	my $port_path = $dirpath;
	if ($group ne '') {
	$port_path = "groups/$group/$port_path";
	}
	($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i,
	$dir_root,$port_path,$disk_quota,
	$current_disk_usage,$uname,$udom);
	if ($state eq 'will_exceed_quota'
	\|\| $state eq 'file_locked'
	\|\| $state eq 'file_exists' ) {
	$output .= $msg;
	next;
	}
	} elsif (($context eq 'author') \|\| ($context eq 'testbank')) {
	($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
	if ($state eq 'exists') {
	$output .= $msg;
	next;
	}
	}
	# Check if extension is valid
	if (($fname =~ /\.(\w+)$/) &&
	(&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
	$output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1);
	next;
	} elsif (($fname =~ /\.(\w+)$/) &&
	(!defined(&Apache::loncommon::fileembstyle($1)))) {
	$output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
	next;
	} elsif ($fname=~/\.(\d+)\.(\w+)$/) {
	$output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
	next;
	}

	$env{'form.embedded_item_'.$i.'.filename'}=$fname;
	if ($context eq 'portfolio') {
	my $result=
	&Apache::lonnet::userfileupload('embedded_item_'.$i,'',
	$dirpath.$path);
	if ($result !~ m\|^/uploaded/\|) {
	$output .= '<span class="LC_error">'
	.&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
	,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
	.'</span><br />';
	next;
	} else {
	$output .= '<p>'.&mt('Uploaded [_1]','<span class="LC_filename">'.
	$path.$fname.'</span>').'</p>';
	}
	} else {
	# Save the file
	my $target = $env{'form.embedded_item_'.$i};
	my $fullpath = $dir_root.$dirpath.'/'.$path;
	my $dest = $fullpath.$fname;
	my $url = $url_root.$dirpath.'/'.$path.$fname;
	my @parts=split(/\//,$fullpath);
	my $count;
	my $filepath = $dir_root;
	for ($count=4;$count<=$#parts;$count++) {
	$filepath .= "/$parts[$count]";
	if ((-e $filepath)!=1) {
	mkdir($filepath,0770);
	}
	}
	my $fh;
	if (!open($fh,'>'.$dest)) {
	&Apache::lonnet::logthis('Failed to create '.$dest);
	$output .= '<span class="LC_error">'.
	&mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
	'</span><br />';
	} else {
	if (!print $fh $env{'form.embedded_item_'.$i}) {
	&Apache::lonnet::logthis('Failed to write to '.$dest);
	$output .= '<span class="LC_error">'.
	&mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
	'</span><br />';
	} else {
	if ($context eq 'testbank') {
	$output .= &mt('Embedded file uploaded successfully:').
	' <a href="'.$url.'">'.
	$orig_uploaded_filename.'</a><br />';
	} else {
	$output .= '<font size="+2">'.
	&mt('View embedded file: [_1]','<a href="'.$url.'">'.
	$orig_uploaded_filename.'</a>').'</font><br />';
	}
	}
	close($fh);
	}
	}
	}
	return $output;
	}

	sub check_for_existing {
	my ($path,$fname,$element) = @_;
	my ($state,$msg);
	if (-d $path.'/'.$fname) {
	$state = 'exists';
	$msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
	} elsif (-e $path.'/'.$fname) {
	$state = 'exists';
	$msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
	}
	if ($state eq 'exists') {
	$msg = '<span class="LC_error">'.$msg.'</span><br />';
	}
	return ($state,$msg);
	}

	sub check_for_upload {
	my ($path,$fname,$group,$element,$portfolio_root,$port_path,
	$disk_quota,$current_disk_usage,$uname,$udom) = @_;
	my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
	my $getpropath = 1;
	my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,
	$getpropath);
	my $found_file = 0;
	my $locked_file = 0;
	foreach my $line (@dir_list) {
	my ($file_name)=split(/\&/,$line,2);
	if ($file_name eq $fname){
	$file_name = $path.$file_name;
	if ($group ne '') {
	$file_name = $group.$file_name;
	}
	$found_file = 1;
	if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
	$locked_file = 1;
	}
	}
	}
	if (($current_disk_usage + $filesize) > $disk_quota){
	my $msg = '<span class="LC_error">'.
	&mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
	'<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
	return ('will_exceed_quota',$msg);
	} elsif ($found_file) {
	if ($locked_file) {
	my $msg = '<span class="LC_error">';
	$msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>');
	$msg .= '</span><br />';
	$msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
	return ('file_locked',$msg);
	} else {
	my $msg = '<span class="LC_error">';
	$msg .= &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
	$msg .= '</span>';
	$msg .= '<br />';
	$msg .= &mt('To upload, rename or delete existing [_1] in [_2].','<span class="LC_filename">'.$fname.'</span>', $port_path.$env{'form.currentpath'});
	return ('file_exists',$msg);
	}
	}
	}


=pod	=pod

Line 6837 sub get_env_multiple {	Line 7672 sub get_env_multiple {

=over 4	=over 4

=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'}
Line 6867 sub upfile_store {	Line 7702 sub upfile_store {

=pod	=pod

=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'},
Line 6891 sub load_tmp_file {	Line 7726 sub load_tmp_file {

=pod	=pod

=item * upfile_record_sep()	=item * &upfile_record_sep()

Separate uploaded file into records	Separate uploaded file into records
returns array of records,	returns array of records,
Line 6913 sub upfile_record_sep {	Line 7748 sub upfile_record_sep {

=pod	=pod

=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'}

Line 6998 sub record_sep {	Line 7833 sub record_sep {

=pod	=pod

=item * upfile_select_html()	=item * &upfile_select_html()

Return HTML code to select a file from the users machine and specify	Return HTML code to select a file from the users machine and specify
the file type.	the file type.
Line 7016 sub upfile_select_html {	Line 7851 sub upfile_select_html {
# xml => &mt('HTML/XML'),	# xml => &mt('HTML/XML'),
);	);
my $Str = '<input type="file" name="upfile" size="50" />'.	my $Str = '<input type="file" name="upfile" size="50" />'.
'<br />Type: <select name="upfiletype">';	'<br />'.&mt('Type').': <select name="upfiletype">';
foreach my $type (sort(keys(%Types))) {	foreach my $type (sort(keys(%Types))) {
$Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";	$Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
}	}
Line 7045 sub get_samples {	Line 7880 sub get_samples {

=pod	=pod

=item * csv_print_samples($r,$records)	=item * &csv_print_samples($r,$records)

Prints a table of sample values from each column uploaded $r is an	Prints a table of sample values from each column uploaded $r is an
Apache Request ref, $records is an arrayref from	Apache Request ref, $records is an arrayref from
Line 7057 Apache Request ref, $records is an array	Line 7892 Apache Request ref, $records is an array
######################################################	######################################################
sub csv_print_samples {	sub csv_print_samples {
my ($r,$records) = @_;	my ($r,$records) = @_;
my $samples = &get_samples($records,3);	my $samples = &get_samples($records,5);

$r->print(&mt('Samples').'<br />'.&start_data_table().	$r->print(&mt('Samples').'<br />'.&start_data_table().
&start_data_table_header_row());	&start_data_table_header_row());
Line 7081 sub csv_print_samples {	Line 7916 sub csv_print_samples {

=pod	=pod

=item * csv_print_select_table($r,$records,$d)	=item * &csv_print_select_table($r,$records,$d)

Prints a table to create associations between values and table columns.	Prints a table to create associations between values and table columns.

Line 7104 sub csv_print_select_table {	Line 7939 sub csv_print_select_table {
&end_data_table_header_row()."\n");	&end_data_table_header_row()."\n");
foreach my $array_ref (@$d) {	foreach my $array_ref (@$d) {
my ($value,$display,$defaultcol)=@{ $array_ref };	my ($value,$display,$defaultcol)=@{ $array_ref };
$r->print(&start_data_table_row().'<tr><td>'.$display.'</td>');	$r->print(&start_data_table_row().'<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.');">');
Line 7112 sub csv_print_select_table {	Line 7947 sub csv_print_select_table {
foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<option value="'.$sample.'"'.	$r->print('<option value="'.$sample.'"'.
($sample eq $defaultcol ? ' selected="selected" ' : '').	($sample eq $defaultcol ? ' selected="selected" ' : '').
'>Column '.($sample+1).'</option>');	'>'.&mt('Column [_1]',($sample+1)).'</option>');
}	}
$r->print('</select></td>'.&end_data_table_row()."\n");	$r->print('</select></td>'.&end_data_table_row()."\n");
$i++;	$i++;
Line 7127 sub csv_print_select_table {	Line 7962 sub csv_print_select_table {

=pod	=pod

=item * csv_samples_select_table($r,$records,$d)	=item * &csv_samples_select_table($r,$records,$d)

Prints a table of sample values from the upload and can make associate samples to internal names.	Prints a table of sample values from the upload and can make associate samples to internal names.

Line 7143 sub csv_samples_select_table {	Line 7978 sub csv_samples_select_table {
my ($r,$records,$d) = @_;	my ($r,$records,$d) = @_;
my $i=0;	my $i=0;
#	#
my $samples = &get_samples($records,3);	my $max_samples = 5;
	my $samples = &get_samples($records,$max_samples);
$r->print(&start_data_table().	$r->print(&start_data_table().
&start_data_table_header_row().'<th>'.	&start_data_table_header_row().'<th>'.
&mt('Field').'</th><th>'.&mt('Samples').'</th>'.	&mt('Field').'</th><th>'.&mt('Samples').'</th>'.
Line 7159 sub csv_samples_select_table {	Line 7995 sub csv_samples_select_table {
$display.'</option>');	$display.'</option>');
}	}
$r->print('</select></td><td>');	$r->print('</select></td><td>');
foreach my $line (0..2) {	foreach my $line (0..($max_samples-1)) {
if (defined($samples->[$line]{$key})) {	if (defined($samples->[$line]{$key})) {
$r->print($samples->[$line]{$key}."<br />\n");	$r->print($samples->[$line]{$key}."<br />\n");
}	}
Line 7177 sub csv_samples_select_table {	Line 8013 sub csv_samples_select_table {

=pod	=pod

=item clean_excel_name($name)	=item * &clean_excel_name($name)

Returns a replacement for $name which does not contain any illegal characters.	Returns a replacement for $name which does not contain any illegal characters.

Line 7196 sub clean_excel_name {	Line 8032 sub clean_excel_name {

=pod	=pod

=item * check_if_partid_hidden($id,$symb,$udom,$uname)	=item * &check_if_partid_hidden($id,$symb,$udom,$uname)

Returns either 1 or undef	Returns either 1 or undef

Line 7237 sub check_if_partid_hidden {	Line 8073 sub check_if_partid_hidden {

=over 4	=over 4

=item get_cgi_id	=item * &get_cgi_id()

Inputs: none	Inputs: none

Line 7261 sub get_cgi_id {	Line 8097 sub get_cgi_id {

=pod	=pod

=item DrawBarGraph	=item * &DrawBarGraph()

Facilitates the plotting of data in a (stacked) bar graph.	Facilitates the plotting of data in a (stacked) bar graph.
Puts plot definition data into the users environment in order for	Puts plot definition data into the users environment in order for
Line 7396 sub DrawBarGraph {	Line 8232 sub DrawBarGraph {
$ValuesHash{$id.'.'.$key} = $value;	$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 7405 sub DrawBarGraph {	Line 8241 sub DrawBarGraph {

=pod	=pod

=item DrawXYGraph	=item * &DrawXYGraph()

Facilitates the plotting of data in an XY graph.	Facilitates the plotting of data in an XY graph.
Puts plot definition data into the users environment in order for	Puts plot definition data into the users environment in order for
Line 7486 sub DrawXYGraph {	Line 8322 sub DrawXYGraph {
$ValuesHash{$id.'.'.$key} = $value;	$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 7495 sub DrawXYGraph {	Line 8331 sub DrawXYGraph {

=pod	=pod

=item DrawXYYGraph	=item * &DrawXYYGraph()

Facilitates the plotting of data in an XY graph with two Y axes.	Facilitates the plotting of data in an XY graph with two Y axes.
Puts plot definition data into the users environment in order for	Puts plot definition data into the users environment in order for
Line 7588 sub DrawXYYGraph {	Line 8424 sub DrawXYYGraph {
$ValuesHash{$id.'.'.$key} = $value;	$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 7605 Bad place for them but what the hell.	Line 8441 Bad place for them but what the hell.

=over 4	=over 4

=item &chartlink	=item * &chartlink()

Returns a link to the chart for a specific student.	Returns a link to the chart for a specific student.

Line 7644 sub chartlink {	Line 8480 sub chartlink {

=over 4	=over 4

=item &restore_course_settings	=item * &restore_course_settings()

=item &store_course_settings	=item * &store_course_settings()

Restores/Store indicated form parameters from the course environment.	Restores/Store indicated form parameters from the course environment.
Will not overwrite existing values of the form parameters.	Will not overwrite existing values of the form parameters.
Line 7720 sub store_settings {	Line 8556 sub store_settings {
'got error:'.$put_result);	'got error:'.$put_result);
}	}
# Make sure these settings stick around in this session, too	# Make sure these settings stick around in this session, too
&Apache::lonnet::appenv(%AppHash);	&Apache::lonnet::appenv(\%AppHash);
return;	return;
}	}

Line 7757 sub restore_settings {	Line 8593 sub restore_settings {

=over 4	=over 4

=item &build_recipient_list	=item * &build_recipient_list()

Build recipient lists for three types of e-mail:	Build recipient lists for four types of e-mail:
(a) Error Reports, (b) Package Updates, (c) Help requests, generated by	(a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
lonerrorhandler.pm, CHECKRPMS and lonsupportreq.pm respectively.	(d) Help requests, generated by
	lonerrorhandler.pm, CHECKRPMS, loncron, and lonsupportreq.pm respectively.

Inputs:	Inputs:
defmail (scalar - email address of default recipient),	defmail (scalar - email address of default recipient),
Line 7770 defdom (domain for which to retrieve con	Line 8607 defdom (domain for which to retrieve con
origmail (scalar - email address of recipient from loncapa.conf,	origmail (scalar - email address of recipient from loncapa.conf,
i.e., predates configuration by DC via domainprefs.pm	i.e., predates configuration by DC via domainprefs.pm

Returns: comma separated list of addresses to which to send e-mail.	Returns: comma separated list of addresses to which to send e-mail.

	=back

=cut	=cut

Line 7783 sub build_recipient_list {	Line 8622 sub build_recipient_list {
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['contacts'],$defdom);	&Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
if (ref($domconfig{'contacts'}) eq 'HASH') {	if (ref($domconfig{'contacts'}) eq 'HASH') {
if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {	if (exists($domconfig{'contacts'}{$mailing})) {
my @contacts = ('adminemail','supportemail');	if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
foreach my $item (@contacts) {	my @contacts = ('adminemail','supportemail');
if ($domconfig{'contacts'}{$mailing}{$item}) {	foreach my $item (@contacts) {
my $addr = $domconfig{'contacts'}{$item};	if ($domconfig{'contacts'}{$mailing}{$item}) {
if (!grep(/^\Q$addr\E$/,@recipients)) {	my $addr = $domconfig{'contacts'}{$item};
push(@recipients,$addr);	if (!grep(/^\Q$addr\E$/,@recipients)) {
	push(@recipients,$addr);
	}
}	}
	$otheremails = $domconfig{'contacts'}{$mailing}{'others'};
}	}
$otheremails = $domconfig{'contacts'}{$mailing}{'others'};
}	}
	} elsif ($origmail ne '') {
	push(@recipients,$origmail);
}	}
} elsif ($origmail ne '') {	} elsif ($origmail ne '') {
push(@recipients,$origmail);	push(@recipients,$origmail);
}	}
if ($defmail ne '') {	if (defined($defmail)) {
push(@recipients,$defmail);	if ($defmail ne '') {
	push(@recipients,$defmail);
	}
}	}
if ($otheremails) {	if ($otheremails) {
my @others;	my @others;
Line 7821 sub build_recipient_list {	Line 8666 sub build_recipient_list {
############################################################	############################################################
############################################################	############################################################

	=pod

	=head1 Course Catalog Routines

	=over 4

	=item * &gather_categories()

	Converts category definitions - keys of categories hash stored in
	coursecategories in configuration.db on the primary library server in a
	domain - to an array. Also generates javascript and idx hash used to
	generate Domain Coordinator interface for editing Course Categories.

	Inputs:

	categories (reference to hash of category definitions).

	cats (reference to array of arrays/hashes which encapsulates hierarchy of
	categories and subcategories).

	idx (reference to hash of counters used in Domain Coordinator interface for
	editing Course Categories).

	jsarray (reference to array of categories used to create Javascript arrays for
	Domain Coordinator interface for editing Course Categories).

	Returns: nothing

	Side effects: populates cats, idx and jsarray.

	=cut

	sub gather_categories {
	my ($categories,$cats,$idx,$jsarray) = @_;
	my %counters;
	my $num = 0;
	foreach my $item (keys(%{$categories})) {
	my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
	if ($container eq '' && $depth == 0) {
	$cats->[$depth][$categories->{$item}] = $cat;
	} else {
	$cats->[$depth]{$container}[$categories->{$item}] = $cat;
	}
	my ($escitem,$tail) = split(/:/,$item,2);
	if ($counters{$tail} eq '') {
	$counters{$tail} = $num;
	$num ++;
	}
	if (ref($idx) eq 'HASH') {
	$idx->{$item} = $counters{$tail};
	}
	if (ref($jsarray) eq 'ARRAY') {
	push(@{$jsarray->[$counters{$tail}]},$item);
	}
	}
	return;
	}

	=pod

	=item * &extract_categories()

	Used to generate breadcrumb trails for course categories.

	Inputs:

	categories (reference to hash of category definitions).

	cats (reference to array of arrays/hashes which encapsulates hierarchy of
	categories and subcategories).

	trails (reference to array of breacrumb trails for each category).

	allitems (reference to hash - key is category key
	(format: escaped(name):escaped(parent category):depth in hierarchy).

	idx (reference to hash of counters used in Domain Coordinator interface for
	editing Course Categories).

	jsarray (reference to array of categories used to create Javascript arrays for
	Domain Coordinator interface for editing Course Categories).

	subcats (reference to hash of arrays containing all subcategories within each
	category, -recursive)

	Returns: nothing

	Side effects: populates trails and allitems hash references.

	=cut

	sub extract_categories {
	my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
	if (ref($categories) eq 'HASH') {
	&gather_categories($categories,$cats,$idx,$jsarray);
	if (ref($cats->[0]) eq 'ARRAY') {
	for (my $i=0; $i<@{$cats->[0]}; $i++) {
	my $name = $cats->[0][$i];
	my $item = &escape($name).'::0';
	my $trailstr;
	if ($name eq 'instcode') {
	$trailstr = &mt('Official courses (with institutional codes)');
	} else {
	$trailstr = $name;
	}
	if ($allitems->{$item} eq '') {
	push(@{$trails},$trailstr);
	$allitems->{$item} = scalar(@{$trails})-1;
	}
	my @parents = ($name);
	if (ref($cats->[1]{$name}) eq 'ARRAY') {
	for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
	my $category = $cats->[1]{$name}[$j];
	if (ref($subcats) eq 'HASH') {
	push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
	}
	&recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
	}
	} else {
	if (ref($subcats) eq 'HASH') {
	$subcats->{$item} = [];
	}
	}
	}
	}
	}
	return;
	}

	=pod

	=item *&recurse_categories()

	Recursively used to generate breadcrumb trails for course categories.

	Inputs:

	cats (reference to array of arrays/hashes which encapsulates hierarchy of
	categories and subcategories).

	depth (current depth in hierarchy of categories and sub-categories - 0 indexed).

	category (current course category, for which breadcrumb trail is being generated).

	trails (reference to array of breadcrumb trails for each category).

	allitems (reference to hash - key is category key
	(format: escaped(name):escaped(parent category):depth in hierarchy).

	parents (array containing containers directories for current category,
	back to top level).

	Returns: nothing

	Side effects: populates trails and allitems hash references

	=cut

	sub recurse_categories {
	my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
	my $shallower = $depth - 1;
	if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
	for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
	my $name = $cats->[$depth]{$category}[$k];
	my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
	my $trailstr = join(' -> ',(@{$parents},$category));
	if ($allitems->{$item} eq '') {
	push(@{$trails},$trailstr);
	$allitems->{$item} = scalar(@{$trails})-1;
	}
	my $deeper = $depth+1;
	push(@{$parents},$category);
	if (ref($subcats) eq 'HASH') {
	my $subcat = &escape($name).':'.$category.':'.$depth;
	for (my $j=@{$parents}; $j>=0; $j--) {
	my $higher;
	if ($j > 0) {
	$higher = &escape($parents->[$j]).':'.
	&escape($parents->[$j-1]).':'.$j;
	} else {
	$higher = &escape($parents->[$j]).'::'.$j;
	}
	push(@{$subcats->{$higher}},$subcat);
	}
	}
	&recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
	$subcats);
	pop(@{$parents});
	}
	} else {
	my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
	my $trailstr = join(' -> ',(@{$parents},$category));
	if ($allitems->{$item} eq '') {
	push(@{$trails},$trailstr);
	$allitems->{$item} = scalar(@{$trails})-1;
	}
	}
	return;
	}

	=pod

	=item *&assign_categories_table()

	Create a datatable for display of hierarchical categories in a domain,
	with checkboxes to allow a course to be categorized.

	Inputs:

	cathash - reference to hash of categories defined for the domain (from
	configuration.db)

	currcat - scalar with an & separated list of categories assigned to a course.

	Returns: $output (markup to be displayed)

	=cut

	sub assign_categories_table {
	my ($cathash,$currcat) = @_;
	my $output;
	if (ref($cathash) eq 'HASH') {
	my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
	&extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
	$maxdepth = scalar(@cats);
	if (@cats > 0) {
	my $itemcount = 0;
	if (ref($cats[0]) eq 'ARRAY') {
	$output = &Apache::loncommon::start_data_table();
	my @currcategories;
	if ($currcat ne '') {
	@currcategories = split('&',$currcat);
	}
	for (my $i=0; $i<@{$cats[0]}; $i++) {
	my $parent = $cats[0][$i];
	my $css_class = $itemcount%2?' class="LC_odd_row"':'';
	next if ($parent eq 'instcode');
	my $item = &escape($parent).'::0';
	my $checked = '';
	if (@currcategories > 0) {
	if (grep(/^\Q$item\E$/,@currcategories)) {
	$checked = ' checked="checked" ';
	}
	}
	$output .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
	'<input type="checkbox" name="usecategory" value="'.
	$item.'"'.$checked.' />'.$parent.'</span>'.
	'<input type="hidden" name="catname" value="'.$parent.'" /></td>';
	my $depth = 1;
	push(@path,$parent);
	$output .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
	pop(@path);
	$output .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
	$itemcount ++;
	}
	$output .= &Apache::loncommon::end_data_table();
	}
	}
	}
	return $output;
	}

	=pod

	=item *&assign_category_rows()

	Create a datatable row for display of nested categories in a domain,
	with checkboxes to allow a course to be categorized,called recursively.

	Inputs:

	itemcount - track row number for alternating colors

	cats - reference to array of arrays/hashes which encapsulates hierarchy of
	categories and subcategories.

	depth - current depth in hierarchy of categories and sub-categories - 0 indexed.

	parent - parent of current category item

	path - Array containing all categories back up through the hierarchy from the
	current category to the top level.

	currcategories - reference to array of current categories assigned to the course

	Returns: $output (markup to be displayed).

	=cut

	sub assign_category_rows {
	my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
	my ($text,$name,$item,$chgstr);
	if (ref($cats) eq 'ARRAY') {
	my $maxdepth = scalar(@{$cats});
	if (ref($cats->[$depth]) eq 'HASH') {
	if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
	my $numchildren = @{$cats->[$depth]{$parent}};
	my $css_class = $itemcount%2?' class="LC_odd_row"':'';
	$text .= '<td><table class="LC_datatable">';
	for (my $j=0; $j<$numchildren; $j++) {
	$name = $cats->[$depth]{$parent}[$j];
	$item = &escape($name).':'.&escape($parent).':'.$depth;
	my $deeper = $depth+1;
	my $checked = '';
	if (ref($currcategories) eq 'ARRAY') {
	if (@{$currcategories} > 0) {
	if (grep(/^\Q$item\E$/,@{$currcategories})) {
	$checked = ' checked="checked" ';
	}
	}
	}
	$text .= '<tr><td><span class="LC_nobreak"><label>'.
	'<input type="checkbox" name="usecategory" value="'.
	$item.'"'.$checked.' />'.$name.'</label></span>'.
	'<input type="hidden" name="catname" value="'.$name.'" />'.
	'</td><td>';
	if (ref($path) eq 'ARRAY') {
	push(@{$path},$name);
	$text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
	pop(@{$path});
	}
	$text .= '</td></tr>';
	}
	$text .= '</table></td>';
	}
	}
	}
	return $text;
	}

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


sub commit_customrole {	sub commit_customrole {
my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;	my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.	my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
($start?', '.&mt('starting').' '.localtime($start):'').	($start?', '.&mt('starting').' '.localtime($start):'').
($end?', ending '.localtime($end):'').': <b>'.	($end?', ending '.localtime($end):'').': <b>'.
&Apache::lonnet::assigncustomrole(	&Apache::lonnet::assigncustomrole(
$udom,$uname,$url,$three,$four,$five,$end,$start).	$udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
'</b><br />';	'</b><br />';
return $output;	return $output;
}	}
Line 7862 sub commit_standardrole {	Line 9041 sub commit_standardrole {
$output = &mt('Assigning').' '.$three.' in '.$url.	$output = &mt('Assigning').' '.$three.' in '.$url.
($start?', '.&mt('starting').' '.localtime($start):'').	($start?', '.&mt('starting').' '.localtime($start):'').
($end?', '.&mt('ending').' '.localtime($end):'').': ';	($end?', '.&mt('ending').' '.localtime($end):'').': ';
my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start);	my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
if ($context eq 'auto') {	if ($context eq 'auto') {
$output .= $result.$linefeed;	$output .= $result.$linefeed;
} else {	} else {
Line 7897 sub commit_studentrole {	Line 9076 sub commit_studentrole {
}	}
$oldsecurl = $uurl;	$oldsecurl = $uurl;
$expire_role_result =	$expire_role_result =
&Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now);	&Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
if ($env{'request.course.sec'} ne '') {	if ($env{'request.course.sec'} ne '') {
if ($expire_role_result eq 'refused') {	if ($expire_role_result eq 'refused') {
my @roles = ('st');	my @roles = ('st');
Line 7920 sub commit_studentrole {	Line 9099 sub commit_studentrole {
}	}
}	}
if (($expire_role_result eq 'ok') \|\| ($secchange == 0)) {	if (($expire_role_result eq 'ok') \|\| ($secchange == 0)) {
$modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid);	$modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
if ($modify_section_result =~ /^ok/) {	if ($modify_section_result =~ /^ok/) {
if ($secchange == 1) {	if ($secchange == 1) {
if ($sec eq '') {	if ($sec eq '') {
Line 8083 sub construct_course {	Line 9262 sub construct_course {
$outcome .= $clonemsg.$linefeed;	$outcome .= $clonemsg.$linefeed;
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
# Copy all files	# Copy all files
&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid);	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
# Restore URL	# Restore URL
$cenv{'url'}=$oldcenv{'url'};	$cenv{'url'}=$oldcenv{'url'};
# Restore title	# Restore title
$cenv{'description'}=$oldcenv{'description'};	$cenv{'description'}=$oldcenv{'description'};
# restore grading mode
if (defined($oldcenv{'grading'})) {
$cenv{'grading'}=$oldcenv{'grading'};
}
# Mark as cloned	# Mark as cloned
$cenv{'clonedfrom'}=$cloneid;	$cenv{'clonedfrom'}=$cloneid;
delete($cenv{'default_enrollment_start_date'});	# Need to clone grading mode
delete($cenv{'default_enrollment_end_date'});	my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
	$cenv{'grading'}=$newenv{'grading'};
	# Do not clone these environment entries
	&Apache::lonnet::del('environment',
	['default_enrollment_start_date',
	'default_enrollment_end_date',
	'question.email',
	'policy.email',
	'comment.email',
	'pch.users.denied',
	'plc.users.denied',
	'hidefromcat',
	'categories'],
	$$crsudom,$$crsunum);
}	}

#	#
Line 8123 sub construct_course {	Line 9311 sub construct_course {
} else {	} else {
$cenv{'internal.courseowner'} = $args->{'curruser'};	$cenv{'internal.courseowner'} = $args->{'curruser'};
}	}

my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.	my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
if ($args->{'crssections'}) {	if ($args->{'crssections'}) {
$cenv{'internal.sectionnums'} = '';	$cenv{'internal.sectionnums'} = '';
Line 8323 sub construct_course {	Line 9510 sub construct_course {
$outcome .= ($fatal?$errtext:'read ok').' - ';	$outcome .= ($fatal?$errtext:'read ok').' - ';
my $title; my $url;	my $title; my $url;
if ($args->{'firstres'} eq 'syl') {	if ($args->{'firstres'} eq 'syl') {
$title='Syllabus';	$title=&mt('Syllabus');
$url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';	$url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
} else {	} else {
$title='Navigate Contents';	$title=&mt('Navigate Contents');
$url='/adm/navmaps';	$url='/adm/navmaps';
}	}

Line 8380 sub icon {	Line 9567 sub icon {
return &lonhttpdurl($iconname);	return &lonhttpdurl($iconname);
}	}

sub lonhttpd_port {
my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
# IE doesn't like a secure page getting images from a non-secure
# port (when logging we haven't parsed the browser type so default
# back to secure
if ((!exists($env{'browser.type'}) \|\| $env{'browser.type'} eq 'explorer')
&& $ENV{'SERVER_PORT'} == 443) {
return 443;
}
return $lonhttpd_port;

}

sub lonhttpdurl {	sub lonhttpdurl {
	#
	# Had been used for "small fry" static images on separate port 8080.
	# Modify here if lightweight http functionality desired again.
	# Currently eliminated due to increasing firewall issues.
	#
my ($url)=@_;	my ($url)=@_;
	return $url;
my $lonhttpd_port = &lonhttpd_port();
if ($lonhttpd_port == 443) {
return 'https://'.$ENV{'SERVER_NAME'}.$url;
}
return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
}	}

sub connection_aborted {	sub connection_aborted {
Line 8437 sub escape_url {	Line 9610 sub escape_url {
return join('/',@urlslices).'/'.$lastitem;	return join('/',@urlslices).'/'.$lastitem;
}	}

	sub compare_arrays {
	my ($arrayref1,$arrayref2) = @_;
	my (@difference,%count);
	@difference = ();
	%count = ();
	if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
	foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
	foreach my $element (keys(%count)) {
	if ($count{$element} == 1) {
	push(@difference,$element);
	}
	}
	}
	return @difference;
	}

# -------------------------------------------------------- Initliaze user login	# -------------------------------------------------------- Initliaze user login
sub init_user_environment {	sub init_user_environment {
my ($r, $username, $domain, $authhost, $form, $args) = @_;	my ($r, $username, $domain, $authhost, $form, $args) = @_;
Line 8479 sub init_user_environment {	Line 9668 sub init_user_environment {
}	}
# Give them a new cookie	# Give them a new cookie
my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
: $now);	: $now.$$.int(rand(10000)));
$cookie="$username\_$id\_$domain\_$authhost";	$cookie="$username\_$id\_$domain\_$authhost";

# Initialize roles	# Initialize roles
Line 8567 sub init_user_environment {	Line 9756 sub init_user_environment {
}	}
}	}

	foreach my $tool ('aboutme','blog','portfolio') {
	$userenv{'availabletools.'.$tool} =
	&Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
	}

	foreach my $crstype ('official','unofficial') {
	$userenv{'canrequest.'.$crstype} =
	&Apache::lonnet::usertools_access($username,$domain,$crstype,
	'reload','requestcourses');
	}

$env{'user.environment'} = "$lonids/$cookie.id";	$env{'user.environment'} = "$lonids/$cookie.id";

if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
Line 8594 sub init_user_environment {	Line 9794 sub init_user_environment {

sub _add_to_env {	sub _add_to_env {
my ($idf,$env_data,$prefix) = @_;	my ($idf,$env_data,$prefix) = @_;
while (my ($key,$value) = each(%$env_data)) {	if (ref($env_data) eq 'HASH') {
$idf->{$prefix.$key} = $value;	while (my ($key,$value) = each(%$env_data)) {
$env{$prefix.$key} = $value;	$idf->{$prefix.$key} = $value;
	$env{$prefix.$key} = $value;
	}
	}
	}

	# --- Get the symbolic name of a problem and the url
	sub get_symb {
	my ($request,$silent) = @_;
	(my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}\|$ENV{'HTTP_HOST'})--;
	my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
	if ($symb eq '') {
	if (!$silent) {
	$request->print("Unable to handle ambiguous references:$url:.");
	return ();
	}
}	}
	&Apache::lonenc::check_decrypt(\$symb);
	return ($symb);
}	}

	# --------------------------------------------------------------Get annotation

	sub get_annotation {
	my ($symb,$enc) = @_;

	my $key = $symb;
	if (!$enc) {
	$key =
	&Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
	}
	my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
	return $annotation{$key};
	}

	sub clean_symb {
	my ($symb,$delete_enc) = @_;

	&Apache::lonenc::check_decrypt(\$symb);
	my $enc = $env{'request.enc'};
	if ($delete_enc) {
	delete($env{'request.enc'});
	}

	return ($symb,$enc);
	}

=pod	=pod

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

Removed from v.1.636
changed lines
	Added in v.1.692.4.2