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.1075.2.127.2.3 and 1.1348

version 1.1075.2.127.2.3, 2017/11/01 02:54:35	version 1.1348, 2020/10/01 10:16:33
Line 71 use Apache::lonuserutils();	Line 71 use Apache::lonuserutils();
use Apache::lonuserstate();	use Apache::lonuserstate();
use Apache::courseclassifier();	use Apache::courseclassifier();
use LONCAPA qw(:DEFAULT :match);	use LONCAPA qw(:DEFAULT :match);
	use LONCAPA::LWPReq;
	use HTTP::Request;
use DateTime::TimeZone;	use DateTime::TimeZone;
use DateTime::Locale;	use DateTime::Locale;
use Encode();	use Encode();
	use Text::Aspell;
use Authen::Captcha;	use Authen::Captcha;
use Captcha::reCAPTCHA;	use Captcha::reCAPTCHA;
use JSON::DWIW;	use JSON::DWIW;
use LWP::UserAgent;
use Crypt::DES;	use Crypt::DES;
use DynaLoader; # for Crypt::DES version	use DynaLoader; # for Crypt::DES version
	use MIME::Lite;
	use MIME::Types;
use File::Copy();	use File::Copy();
use File::Path::Tiny();	use File::Path();
	use String::CRC32();
	use Short::URL();

# ---------------------------------------------- Designs	# ---------------------------------------------- Designs
use vars qw(%defaultdesign);	use vars qw(%defaultdesign);
Line 166 sub ssi_with_retries {	Line 172 sub ssi_with_retries {
# ----------------------------------------------- Filetypes/Languages/Copyright	# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;	my %language;
my %supported_language;	my %supported_language;
	my %supported_codes;
my %latex_language; # For choosing hyphenation in <transl..>	my %latex_language; # For choosing hyphenation in <transl..>
my %latex_language_bykey; # for choosing hyphenation from metadata	my %latex_language_bykey; # for choosing hyphenation from metadata
my %cprtag;	my %cprtag;
Line 196 BEGIN {	Line 203 BEGIN {
{	{
my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/language.tab';	'/language.tab';
if ( open(my $fh,"<$langtabfile") ) {	if ( open(my $fh,'<',$langtabfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line=~/^\#/);	next if ($line=~/^\#/);
chomp($line);	chomp($line);
my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));	my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
$language{$key}=$val.' - '.$enc;	$language{$key}=$val.' - '.$enc;
if ($sup) {	if ($sup) {
$supported_language{$key}=$sup;	$supported_language{$key}=$sup;
	$supported_codes{$key} = $code;
}	}
if ($latex) {	if ($latex) {
$latex_language_bykey{$key} = $latex;	$latex_language_bykey{$key} = $latex;
$latex_language{$two} = $latex;	$latex_language{$code} = $latex;
}	}
}	}
close($fh);	close($fh);
Line 217 BEGIN {	Line 225 BEGIN {
{	{
my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.	my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/copyright.tab';	'/copyright.tab';
if ( open (my $fh,"<$copyrightfile") ) {	if ( open (my $fh,'<',$copyrightfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line=~/^\#/);	next if ($line=~/^\#/);
chomp($line);	chomp($line);
Line 231 BEGIN {	Line 239 BEGIN {
{	{
my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.	my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/source_copyright.tab';	'/source_copyright.tab';
if ( open (my $fh,"<$sourcecopyrightfile") ) {	if ( open (my $fh,'<',$sourcecopyrightfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 245 BEGIN {	Line 253 BEGIN {
# -------------------------------------------------------------- default domain designs	# -------------------------------------------------------------- default domain designs
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
my $designfile = $designdir.'/default.tab';	my $designfile = $designdir.'/default.tab';
if ( open (my $fh,"<$designfile") ) {	if ( open (my $fh,'<',$designfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 259 BEGIN {	Line 267 BEGIN {
{	{
my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filecategories.tab';	'/filecategories.tab';
if ( open (my $fh,"<$categoryfile") ) {	if ( open (my $fh,'<',$categoryfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 274 BEGIN {	Line 282 BEGIN {
{	{
my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filetypes.tab';	'/filetypes.tab';
if ( open (my $fh,"<$typesfile") ) {	if ( open (my $fh,'<',$typesfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 427 sub studentbrowser_javascript {	Line 435 sub studentbrowser_javascript {
<script type="text/javascript" language="Javascript">	<script type="text/javascript" language="Javascript">
// <![CDATA[	// <![CDATA[
var stdeditbrowser;	var stdeditbrowser;
function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {	function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
var url = '/adm/pickstudent?';	var url = '/adm/pickstudent?';
var filter;	var filter;
if (!ignorefilter) {	if (!ignorefilter) {
Line 442 sub studentbrowser_javascript {	Line 450 sub studentbrowser_javascript {
'&udomelement='+udom+	'&udomelement='+udom+
'&clicker='+clicker;	'&clicker='+clicker;
if (roleflag) { url+="&roles=1"; }	if (roleflag) { url+="&roles=1"; }
if (courseadvonly) { url+="&courseadvonly=1"; }	if (courseadv == 'condition') {
	if (document.getElementById('courseadv')) {
	courseadv = document.getElementById('courseadv').value;
	}
	}
	if ((courseadv == 'only') \|\| (courseadv == 'none')) { url+="&courseadv="+courseadv; }
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 474 ENDRESBRW	Line 487 ENDRESBRW
}	}

sub selectstudent_link {	sub selectstudent_link {
my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;	my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".	my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
&Apache::lonhtmlcommon::entity_encode($unameele)."','".	&Apache::lonhtmlcommon::entity_encode($unameele)."','".
&Apache::lonhtmlcommon::entity_encode($udomele)."'";	&Apache::lonhtmlcommon::entity_encode($udomele)."'";
Line 485 sub selectstudent_link {	Line 498 sub selectstudent_link {
return '';	return '';
}	}
$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";	$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
if ($courseadvonly) {	if ($courseadv eq 'only') {
$callargs .= ",'',1,1";	$callargs .= ",'',1,'$courseadv'";
	} elsif ($courseadv eq 'none') {
	$callargs .= ",'','','$courseadv'";
	} elsif ($courseadv eq 'condition') {
	$callargs .= ",'','','$courseadv'";
}	}
return '<span class="LC_nobreak">'.	return '<span class="LC_nobreak">'.
'<a href="javascript:openstdbrowser('.$callargs.');">'.	'<a href="javascript:openstdbrowser('.$callargs.');">'.
Line 677 if (!Array.prototype.indexOf) {	Line 694 if (!Array.prototype.indexOf) {
var n = 0;	var n = 0;
if (arguments.length > 0) {	if (arguments.length > 0) {
n = Number(arguments[1]);	n = Number(arguments[1]);
if (n !== n) { // shortcut for verifying if it's NaN	if (n !== n) { // shortcut for verifying if it is NaN
n = 0;	n = 0;
} else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {	} else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
n = (n > 0 \|\| -1) * Math.floor(Math.abs(n));	n = (n > 0 \|\| -1) * Math.floor(Math.abs(n));
Line 878 sub selectcourse_link {	Line 895 sub selectcourse_link {
my $linktext = &mt('Select Course');	my $linktext = &mt('Select Course');
if ($selecttype eq 'Community') {	if ($selecttype eq 'Community') {
$linktext = &mt('Select Community');	$linktext = &mt('Select Community');
	} elsif ($selecttype eq 'Placement') {
	$linktext = &mt('Select Placement Test');
} elsif ($selecttype eq 'Course/Community') {	} elsif ($selecttype eq 'Course/Community') {
$linktext = &mt('Select Course/Community');	$linktext = &mt('Select Course/Community');
$type = '';	$type = '';
Line 913 sub check_uncheck_jscript {	Line 932 sub check_uncheck_jscript {
function checkAll(field) {	function checkAll(field) {
if (field.length > 0) {	if (field.length > 0) {
for (i = 0; i < field.length; i++) {	for (i = 0; i < field.length; i++) {
if (!field[i].disabled) {	if (!field[i].disabled) {
field[i].checked = true;	field[i].checked = true;
}	}
}	}
} else {	} else {
if (!field.disabled) {	if (!field.disabled) {
field.checked = true;	field.checked = true;
}	}
}	}
Line 994 sub select_datelocale {	Line 1013 sub select_datelocale {
}	}
$locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});	$locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
push(@possibles,$id);	push(@possibles,$id);
}	}
}	}
}	}
foreach my $item (sort(@possibles)) {	foreach my $item (sort(@possibles)) {
Line 1030 sub select_language {	Line 1049 sub select_language {

=pod	=pod


	=item * &list_languages()

	Returns an array reference that is suitable for use in language prompters.
	Each array element is itself a two element array. The first element
	is the language code. The second element a descsriptiuon of the
	language itself. This is suitable for use in e.g.
	&Apache::edit::select_arg (once dereferenced that is).

	=cut

	sub list_languages {
	my @lang_choices;

	foreach my $id (&languageids()) {
	my $code = &supportedlanguagecode($id);
	if ($code) {
	my $selector = $supported_codes{$id};
	my $description = &plainlanguagedescription($id);
	push(@lang_choices, [$selector, $description]);
	}
	}
	return \@lang_choices;
	}

	=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
Line 1062 linked_select_forms takes the following	Line 1108 linked_select_forms takes the following
=item * $onchangesecond, additional javascript call to execute for an onchange	=item * $onchangesecond, additional javascript call to execute for an onchange
event for the second <select> tag	event for the second <select> tag

	=item * $suffix, to differentiate separate uses of select2data javascript
	objects in a page.

=back	=back

Below is an example of such a hash. Only the 'text', 'default', and	Below is an example of such a hash. Only the 'text', 'default', and
Line 1116 sub linked_select_forms {	Line 1165 sub linked_select_forms {
$hashref,	$hashref,
$menuorder,	$menuorder,
$onchangefirst,	$onchangefirst,
$onchangesecond	$onchangesecond,
	$suffix
) = @_;	) = @_;
my $second = "document.$formname.$secondselectname";	my $second = "document.$formname.$secondselectname";
my $first = "document.$formname.$firstselectname";	my $first = "document.$formname.$firstselectname";
Line 1124 sub linked_select_forms {	Line 1174 sub linked_select_forms {
my $result = '';	my $result = '';
$result.='<script type="text/javascript" language="JavaScript">'."\n";	$result.='<script type="text/javascript" language="JavaScript">'."\n";
$result.="// <![CDATA[\n";	$result.="// <![CDATA[\n";
$result.="var select2data = new Object();\n";	$result.="var select2data${suffix} = new Object();\n";
$" = '","';	$" = '","';
my $debug = '';	my $debug = '';
foreach my $s1 (sort(keys(%$hashref))) {	foreach my $s1 (sort(keys(%$hashref))) {
$result.="select2data.d_$s1 = new Object();\n";	$result.="select2data${suffix}['d_$s1'] = new Object();\n";
$result.="select2data.d_$s1.def = new String('".	$result.="select2data${suffix}['d_$s1'].def = new String('".
$hashref->{$s1}->{'default'}."');\n";	$hashref->{$s1}->{'default'}."');\n";
$result.="select2data.d_$s1.values = new Array(";	$result.="select2data${suffix}['d_$s1'].values = new Array(";
my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));	my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {	if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
@s2values = @{$hashref->{$s1}->{'order'}};	@s2values = @{$hashref->{$s1}->{'order'}};
}	}
$result.="\"@s2values\");\n";	$result.="\"@s2values\");\n";
$result.="select2data.d_$s1.texts = new Array(";	$result.="select2data${suffix}['d_$s1'].texts = new Array(";
my @s2texts;	my @s2texts;
foreach my $value (@s2values) {	foreach my $value (@s2values) {
push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});	push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
Line 1147 sub linked_select_forms {	Line 1197 sub linked_select_forms {
$"=' ';	$"=' ';
$result.= <<"END";	$result.= <<"END";

function select1_changed() {	function select1${suffix}_changed() {
// Determine new choice	// Determine new choice
var newvalue = "d_" + $first.value;	var newvalue = "d_" + $first.options[$first.selectedIndex].value;
// update select2	// update select2
var values = select2data[newvalue].values;	var values = select2data${suffix}[newvalue].values;
var texts = select2data[newvalue].texts;	var texts = select2data${suffix}[newvalue].texts;
var select2def = select2data[newvalue].def;	var select2def = select2data${suffix}[newvalue].def;
var i;	var i;
// out with the old	// out with the old
for (i = 0; i < $second.options.length; i++) {	$second.options.length = 0;
$second.options[i] = null;	// in with the new
}
// in with the nuclear
for (i=0;i<values.length; i++) {	for (i=0;i<values.length; i++) {
$second.options[i] = new Option(values[i]);	$second.options[i] = new Option(values[i]);
$second.options[i].value = values[i];	$second.options[i].value = values[i];
Line 1173 function select1_changed() {	Line 1221 function select1_changed() {
</script>	</script>
END	END
# output the initial values for the selection lists	# output the initial values for the selection lists
$result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";	$result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
my @order = sort(keys(%{$hashref}));	my @order = sort(keys(%{$hashref}));
if (ref($menuorder) eq 'ARRAY') {	if (ref($menuorder) eq 'ARRAY') {
@order = @{$menuorder};	@order = @{$menuorder};
Line 1250 sub help_open_topic {	Line 1298 sub help_open_topic {
$topic=~s/\W/\_/g;	$topic=~s/\W/\_/g;

if (!$stayOnPage) {	if (!$stayOnPage) {
if ($env{'browser.mobile'}) {	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
} else {
$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
}
} elsif ($stayOnPage eq 'popup') {	} elsif ($stayOnPage eq 'popup') {
$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";	$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
} else {	} else {
Line 1262 sub help_open_topic {	Line 1306 sub help_open_topic {
}	}

# Add the text	# Add the text
	my $target = ' target="_top"';
	if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
	$target = '';
	}
if ($text ne "") {	if ($text ne "") {
$template.='<span class="LC_help_open_topic">'	$template.='<span class="LC_help_open_topic">'
.'<a target="_top" href="'.$link.'">'	.'<a'.$target.' href="'.$link.'">'
.$text.'</a>';	.$text.'</a>';
}	}

Line 1274 sub help_open_topic {	Line 1322 sub help_open_topic {
if ($imgid ne '') {	if ($imgid ne '') {
$imgid = ' id="'.$imgid.'"';	$imgid = ' id="'.$imgid.'"';
}	}
$template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'	$template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
.'<img src="'.$helpicon.'" border="0"'	.'<img src="'.$helpicon.'" border="0"'
.' alt="'.&mt('Help: [_1]',$topic).'"'	.' alt="'.&mt('Help: [_1]',$topic).'"'
.' title="'.$title.'" style="vertical-align:middle;"'.$imgid	.' title="'.$title.'" style="vertical-align:middle;"'.$imgid
Line 1303 sub helpLatexCheatsheet {	Line 1351 sub helpLatexCheatsheet {
.&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)	.&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
.'</span>';	.'</span>';
unless ($not_author) {	unless ($not_author) {
$out .= ' <span>'	$out .= '<span>'
.&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)	.&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
.'</span> <span>'	.'</span> <span>'
.&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)	.&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
.'</span>';	.'</span>';
}	}
$out .= '</span>'; # End cheatsheet	$out .= '</span>'; # End cheatsheet
return $out;	return $out;
Line 1370 sub help_open_menu {	Line 1418 sub help_open_menu {
sub top_nav_help {	sub top_nav_help {
my ($text) = @_;	my ($text) = @_;
$text = &mt($text);	$text = &mt($text);
my $stay_on_page;	my $stay_on_page = 1;
unless ($env{'environment.remote'} eq 'on') {
$stay_on_page = 1;
}
my ($link,$banner_link);	my ($link,$banner_link);
unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {	unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
$link = ($stay_on_page) ? "javascript:helpMenu('display')"	$link = ($stay_on_page) ? "javascript:helpMenu('display')"
Line 1403 sub help_menu_js {	Line 1449 sub help_menu_js {
&Apache::loncommon::start_page('Help Menu', undef,	&Apache::loncommon::start_page('Help Menu', undef,
{'frameset' => 1,	{'frameset' => 1,
'js_ready' => 1,	'js_ready' => 1,
'use_absolute' => $httphost,	'use_absolute' => $httphost,
'add_entries' => {	'add_entries' => {
'border' => '0',	'border' => '0',
'rows' => "110,*",},});	'rows' => "110,*",},});
my $end_page =	my $end_page =
&Apache::loncommon::end_page({'frameset' => 1,	&Apache::loncommon::end_page({'frameset' => 1,
Line 1469 sub help_open_bug {	Line 1515 sub help_open_bug {
{	{
$link = $url;	$link = $url;
}	}

	my $target = ' target="_top"';
	if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
	$target = '';
	}
# Add the text	# Add the text
if ($text ne "")	if ($text ne "")
{	{
$template .=	$template .=
"<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".	"<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
"<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";	"<td bgcolor='#FF5555'><a".$target." href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
}	}

# Add the graphic	# Add the graphic
my $title = &mt('Report a Bug');	my $title = &mt('Report a Bug');
my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");	my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>	<a$target href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
ENDTEMPLATE	ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };	if ($text ne '') { $template.='</td></tr></table>' };
return $template;	return $template;
Line 1747 RESIZE	Line 1798 RESIZE
}	}

sub colorfuleditor_js {	sub colorfuleditor_js {
	my $browse_or_search;
	my $respath;
	my ($cnum,$cdom) = &crsauthor_url();
	if ($cnum) {
	$respath = "/res/$cdom/$cnum/";
	my %js_lt = &Apache::lonlocal::texthash(
	sunm => 'Sub-directory name',
	save => 'Save page to make this permanent',
	);
	&js_escape(\%js_lt);
	$browse_or_search = <<"END";

	function toggleChooser(form,element,titleid,only,search) {
	var disp = 'none';
	if (document.getElementById('chooser_'+element)) {
	var curr = document.getElementById('chooser_'+element).style.display;
	if (curr == 'none') {
	disp='inline';
	if (form.elements['chooser_'+element].length) {
	for (var i=0; i<form.elements['chooser_'+element].length; i++) {
	form.elements['chooser_'+element][i].checked = false;
	}
	}
	toggleResImport(form,element);
	}
	document.getElementById('chooser_'+element).style.display = disp;
	}
	}

	function toggleCrsFile(form,element,numdirs) {
	if (document.getElementById('chooser_'+element+'_crsres')) {
	var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
	if (curr == 'none') {
	if (numdirs) {
	form.elements['coursepath_'+element].selectedIndex = 0;
	if (numdirs > 1) {
	window['select1'+element+'_changed']();
	}
	}
	}
	document.getElementById('chooser_'+element+'_crsres').style.display = 'block';

	}
	if (document.getElementById('chooser_'+element+'_upload')) {
	document.getElementById('chooser_'+element+'_upload').style.display = 'none';
	if (document.getElementById('uploadcrsres_'+element)) {
	document.getElementById('uploadcrsres_'+element).value = '';
	}
	}
	return;
	}

	function toggleCrsUpload(form,element,numcrsdirs) {
	if (document.getElementById('chooser_'+element+'_crsres')) {
	document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
	}
	if (document.getElementById('chooser_'+element+'_upload')) {
	var curr = document.getElementById('chooser_'+element+'_upload').style.display;
	if (curr == 'none') {
	if (numcrsdirs) {
	form.elements['crsauthorpath_'+element].selectedIndex = 0;
	form.elements['newsubdir_'+element][0].checked = true;
	toggleNewsubdir(form,element);
	}
	}
	document.getElementById('chooser_'+element+'_upload').style.display = 'block';
	}
	return;
	}

	function toggleResImport(form,element) {
	var choices = new Array('crsres','upload');
	for (var i=0; i<choices.length; i++) {
	if (document.getElementById('chooser_'+element+'_'+choices[i])) {
	document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
	}
	}
	}

	function toggleNewsubdir(form,element) {
	var newsub = form.elements['newsubdir_'+element];
	if (newsub) {
	if (newsub.length) {
	for (var j=0; j<newsub.length; j++) {
	if (newsub[j].checked) {
	if (document.getElementById('newsubdirname_'+element)) {
	if (newsub[j].value == '1') {
	document.getElementById('newsubdirname_'+element).type = "text";
	if (document.getElementById('newsubdir_'+element)) {
	document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
	}
	} else {
	document.getElementById('newsubdirname_'+element).type = "hidden";
	document.getElementById('newsubdirname_'+element).value = "";
	document.getElementById('newsubdir_'+element).innerHTML = "";
	}
	}
	break;
	}
	}
	}
	}
	}

	function updateCrsFile(form,element) {
	var directory = form.elements['coursepath_'+element];
	var filename = form.elements['coursefile_'+element];
	var path = directory.options[directory.selectedIndex].value;
	var file = filename.options[filename.selectedIndex].value;
	form.elements[element].value = '$respath';
	if (path == '/') {
	form.elements[element].value += file;
	} else {
	form.elements[element].value += path+'/'+file;
	}
	unClean();
	if (document.getElementById('previewimg_'+element)) {
	document.getElementById('previewimg_'+element).src = form.elements[element].value;
	var newsrc = document.getElementById('previewimg_'+element).src;
	}
	if (document.getElementById('showimg_'+element)) {
	document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
	}
	toggleChooser(form,element);
	return;
	}

	function uploadDone(suffix,name) {
	if (name) {
	document.forms["lonhomework"].elements[suffix].value = name;
	unClean();
	toggleChooser(document.forms["lonhomework"],suffix);
	}
	}

	\$(document).ready(function(){

	\$(document).delegate('form :submit', 'click', function( event ) {
	if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
	var buttonId = this.id;
	var suffix = buttonId.toString();
	suffix = suffix.replace(/^crsupload_/,'');
	event.preventDefault();
	document.lonhomework.target = 'crsupload_target_'+suffix;
	document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
	\$(this.form).submit();
	document.lonhomework.target = '';
	if (document.getElementById('crsuploadto_'+suffix)) {
	document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
	}
	return false;
	}
	});
	});
	END
	}
return <<"COLORFULEDIT"	return <<"COLORFULEDIT"
<script type="text/javascript">	<script type="text/javascript">
// <![CDATA[>	// <![CDATA[>
Line 1792 sub colorfuleditor_js {	Line 1999 sub colorfuleditor_js {
}	}

// only iterate whole storage if nothing to override	// only iterate whole storage if nothing to override
if(localStorage.getItem(key) == null){	if(localStorage.getItem(key) == null){

// prevent storage from growing large	// prevent storage from growing large
if(localStorage.length > 50){	if(localStorage.length > 50){
var regex_getTimestamp = /^(?:\d)+;/;	var regex_getTimestamp = /^(?:\d)+;/;
var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));	var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
var oldest_key;	var oldest_key;

for(var i = 1; i < localStorage.length; i++){	for(var i = 1; i < localStorage.length; i++){
if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {	if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
oldest_key = localStorage.key(i);	oldest_key = localStorage.key(i);
Line 1829 sub colorfuleditor_js {	Line 2036 sub colorfuleditor_js {
pairs = valueArr[i].split(',');	pairs = valueArr[i].split(',');
elements = document.getElementsByName(pairs[0]);	elements = document.getElementsByName(pairs[0]);

for (var j = 0; j < elements.length; j++){	for (var j = 0; j < elements.length; j++){
elements[j].style.display = pairs[1];	elements[j].style.display = pairs[1];
if (pairs[1] == "none"){	if (pairs[1] == "none"){
var regex_id = /([_\\d]+)\$/;	var regex_id = /([_\\d]+)\$/;
Line 1842 sub colorfuleditor_js {	Line 2049 sub colorfuleditor_js {
}	}

function getTagList () {	function getTagList () {

var stringToSearch = document.lonhomework.innerHTML;	var stringToSearch = document.lonhomework.innerHTML;

var ret = new Array();	var ret = new Array();
Line 1850 sub colorfuleditor_js {	Line 2057 sub colorfuleditor_js {
var tag_list = stringToSearch.match(regex_findBlock);	var tag_list = stringToSearch.match(regex_findBlock);

if(tag_list != null){	if(tag_list != null){
for(var i = 0; i < tag_list.length; i++){	for(var i = 0; i < tag_list.length; i++){
ret.push(tag_list[i].replace(/"/, ''));	ret.push(tag_list[i].replace(/"/, ''));
}	}
}	}
Line 1887 sub colorfuleditor_js {	Line 2094 sub colorfuleditor_js {

for(var i = 0; i < tag_list.length; i++){	for(var i = 0; i < tag_list.length; i++){
elem_list = document.getElementsByName(tag_list[i]);	elem_list = document.getElementsByName(tag_list[i]);

if(elem_list.length > 0){	if(elem_list.length > 0){
elem = elem_list[0];	elem = elem_list[0];
break;	break;
Line 1910 sub colorfuleditor_js {	Line 2117 sub colorfuleditor_js {
rect.right <= (window.innerWidth \|\| document.documentElement.clientWidth) /or $(window).width() /	rect.right <= (window.innerWidth \|\| document.documentElement.clientWidth) /or $(window).width() /
);	);
}	}

function autosize(depth){	function autosize(depth){
var cmInst = window['cm'+depth];	var cmInst = window['cm'+depth];
var fitsizeButton = document.getElementById('fitsize'+depth);	var fitsizeButton = document.getElementById('fitsize'+depth);
Line 1929 sub colorfuleditor_js {	Line 2136 sub colorfuleditor_js {
}	}
}	}

	$browse_or_search

// ]]>	// ]]>
</script>	</script>
Line 1977 sub insert_folding_button {	Line 2184 sub insert_folding_button {
my $curDepth = $Apache::lonxml::curdepth;	my $curDepth = $Apache::lonxml::curdepth;
my $lastresource = $env{'request.ambiguous'};	my $lastresource = $env{'request.ambiguous'};

return "<input type=\"button\" id=\"folding_btn_$curDepth\"	return "<input type=\"button\" id=\"folding_btn_$curDepth\"
value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";	value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
}	}

	sub crsauthor_url {
	my ($url) = @_;
	if ($url eq '') {
	$url = $ENV{'REQUEST_URI'};
	}
	my ($cnum,$cdom);
	if ($env{'request.course.id'}) {
	my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
	if ($audom ne '' && $auname ne '') {
	if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
	($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
	$cnum = $auname;
	$cdom = $audom;
	}
	}
	}
	return ($cnum,$cdom);
	}

	sub import_crsauthor_form {
	my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
	return (0) unless ($env{'request.course.id'});
	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
	return (0) unless (($cnum ne '') && ($cdom ne ''));
	my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
	my @ids=&Apache::lonnet::current_machine_ids();
	my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);

	if (grep(/^\Q$crshome\E$/,@ids)) {
	$is_home = 1;
	}
	$relpath = "/priv/$cdom/$cnum";
	&Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
	my %lt = &Apache::lonlocal::texthash (
	fnam => 'Filename',
	dire => 'Directory',
	);
	my $numdirs = scalar(keys(%files));
	my (%possexts,$singledir,@singledirfiles);
	if ($only) {
	map { $possexts{$_} = 1; } split(/\s,\s/,$only);
	}
	my (%nonemptydirs,$possdirs);
	if ($numdirs > 1) {
	my @order;
	foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
	if (ref($files{$key}) eq 'HASH') {
	my $shown = $key;
	if ($key eq '') {
	$shown = '/';
	}
	my @ordered = ();
	foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
	next if ($file =~ /\.rights$/);
	if ($only) {
	my ($ext) = ($file =~ /\.([^.]+)$/);
	unless ($possexts{lc($ext)}) {
	next;
	}
	}
	$selimport_menus{$key}->{'select2'}->{$file} = $file;
	push(@ordered,$file);
	}
	if (@ordered) {
	push(@order,$key);
	$nonemptydirs{$key} = 1;
	$selimport_menus{$key}->{'text'} = $shown;
	$selimport_menus{$key}->{'default'} = '';
	$selimport_menus{$key}->{'select2'}->{''} = '';
	$selimport_menus{$key}->{'order'} = \@ordered;
	}
	}
	}
	$possdirs = scalar(keys(%nonemptydirs));
	if ($possdirs > 1) {
	my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
	$output = $lt{'dire'}.
	&linked_select_forms($form,'<br />'.
	$lt{'fnam'},'',
	$firstselectname,$secondselectname,
	\%selimport_menus,\@order,
	$onchangefirst,'',$suffix).'<br />';
	} elsif ($possdirs == 1) {
	$singledir = (keys(%nonemptydirs))[0];
	if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
	@singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
	}
	delete($selimport_menus{$singledir});
	}
	} elsif ($numdirs == 1) {
	$singledir = (keys(%files))[0];
	foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
	if ($only) {
	my ($ext) = ($file =~ /\.([^.]+)$/);
	unless ($possexts{lc($ext)}) {
	next;
	}
	} else {
	next if ($file =~ /\.rights$/);
	}
	push(@singledirfiles,$file);
	}
	if (@singledirfiles) {
	$possdirs = 1;
	}
	}
	if (($possdirs == 1) && (@singledirfiles)) {
	my $showdir = $singledir;
	if ($singledir eq '') {
	$showdir = '/';
	}
	$output = $lt{'dire'}.
	'<select name="'.$firstselectname.'">'.
	'<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
	'</select><br />'.
	$lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
	'<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
	foreach my $file (@singledirfiles) {
	$output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
	}
	$output .= '</select><br />'."\n";
	}
	return ($possdirs,$output);
	}

=pod	=pod

Line 2169 sub create_text_file {	Line 2502 sub create_text_file {
# ------------------------------------------	# ------------------------------------------

sub domain_select {	sub domain_select {
my ($name,$value,$multiple)=@_;	my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
	my @possdoms;
	if (ref($incdoms) eq 'ARRAY') {
	@possdoms = @{$incdoms};
	} else {
	@possdoms = &Apache::lonnet::all_domains();
	}

my %domains=map {	my %domains=map {
$_ => $_.' '. &Apache::lonnet::domain($_,'description')	$_ => $_.' '. &Apache::lonnet::domain($_,'description')
} &Apache::lonnet::all_domains();	} @possdoms;

	if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
	foreach my $dom (@{$excdoms}) {
	delete($domains{$dom});
	}
	}

if ($multiple) {	if ($multiple) {
$domains{''}=&mt('Any domain');	$domains{''}=&mt('Any domain');
$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
Line 2249 option_name => displayed text. An option	Line 2596 option_name => displayed text. An option
a javascript onchange item, e.g., onchange="this.form.submit();".	a javascript onchange item, e.g., onchange="this.form.submit();".
An optional arg -- $readonly -- if true will cause the select form	An optional arg -- $readonly -- if true will cause the select form
to be disabled, e.g., for the case where an instructor has a section-	to be disabled, e.g., for the case where an instructor has a section-
specific role, and is viewing/modifying parameters.	specific role, and is viewing/modifying parameters.

See lonrights.pm for an example invocation and use.	See lonrights.pm for an example invocation and use.

Line 2262 sub select_form {	Line 2609 sub select_form {
if ($onchange) {	if ($onchange) {
$onchange = ' onchange="'.$onchange.'"';	$onchange = ' onchange="'.$onchange.'"';
}	}
my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";	my $disabled;
	if ($readonly) {
	$disabled = ' disabled="disabled"';
	}
	my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
my @keys;	my @keys;
if (exists($hashref->{'select_form_order'})) {	if (exists($hashref->{'select_form_order'})) {
@keys=@{$hashref->{'select_form_order'}};	@keys=@{$hashref->{'select_form_order'}};
Line 2448 The optional $incdoms is a reference to	Line 2799 The optional $incdoms is a reference to

The optional $excdoms is a reference to an array of domains which will be excluded from the available options.	The optional $excdoms is a reference to an array of domains which will be excluded from the available options.

The optional $disabled argument, if true, adds the disabled attribute to the select tag.	The optional $disabled argument, if true, adds the disabled attribute to the select tag.

=cut	=cut

Line 2469 sub select_dom_form {	Line 2820 sub select_dom_form {
}	}
if ($includeempty) { @domains=('',@domains); }	if ($includeempty) { @domains=('',@domains); }
if (ref($excdoms) eq 'ARRAY') {	if (ref($excdoms) eq 'ARRAY') {
map { $exclude{$_} = 1; } @{$excdoms};	map { $exclude{$_} = 1; } @{$excdoms};
}	}
my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";	my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
foreach my $dom (@domains) {	foreach my $dom (@domains) {
Line 2697 This is not an optimal method, but it wo	Line 3048 This is not an optimal method, but it wo

=item * authform_filesystem	=item * authform_filesystem

	=item * authform_lti

=back	=back

See loncreateuser.pm for invocation and use examples.	See loncreateuser.pm for invocation and use examples.
Line 2825 sub authform_nochange {	Line 3178 sub authform_nochange {
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
my $result;	my $result;
if (!$authnum) {	if (!$authnum) {
$result = &mt('Under your current role you are not permitted to change login settings for this user');	$result = &mt('Under your current role you are not permitted to change login settings for this user');
Line 3019 sub authform_local {	Line 3372 sub authform_local {
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
if ($in{'readonly'}) {	if ($in{'readonly'}) {
$disabled = ' disabled="disabled"';	$disabled = ' disabled="disabled"';
}	}
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'}) {
Line 3089 sub authform_filesystem {	Line 3442 sub authform_filesystem {
} else {	} else {
$result = &mt('Currently Filesystem Authenticated.');	$result = &mt('Currently Filesystem Authenticated.');
return $result;	return $result;
}	}
}	}
} else {	} else {
if ($authnum == 1) {	if ($authnum == 1) {
Line 3113 sub authform_filesystem {	Line 3466 sub authform_filesystem {
$fsyscheck.' onchange="'.$jscall.'" onclick="'.	$fsyscheck.' onchange="'.$jscall.'" onclick="'.
$jscall.'"'.$disabled.' />';	$jscall.'"'.$disabled.' />';
}	}
$autharg = '<input type="text" size="10" name="fsysarg" value=""'.	$autharg = '<input type="password" size="10" name="fsysarg" value=""'.
' onchange="'.$jscall.'"'.$disabled.' />';	' onchange="'.$jscall.'"'.$disabled.' />';
$result = &mt	$result = &mt
('[_1] Filesystem Authenticated (with initial password [_2])',	('[_1] Filesystem Authenticated (with initial password [_2])',
'<label><input type="radio" name="login" value="fsys" '.	'<label>'.$authtype,'</label>'.$autharg);
$fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',	return $result;
'</label><input type="password" size="10" name="fsysarg" value="" '.	}
'onchange="'.$jscall.'"'.$disabled.' />');
	sub authform_lti {
	my %in = (
	formname => 'document.cu',
	kerb_def_dom => 'MSU.EDU',
	@_,
	);
	my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
	if ($in{'readonly'}) {
	$disabled = ' disabled="disabled"';
	}
	if (defined($in{'curr_authtype'})) {
	if ($in{'curr_authtype'} eq 'lti') {
	if ($can_assign{'lti'}) {
	$lticheck = 'checked="checked" ';
	if (defined($in{'mode'})) {
	if ($in{'mode'} eq 'modifyuser') {
	$lticheck = '';
	}
	}
	} else {
	$result = &mt('Currently LTI Authenticated.');
	return $result;
	}
	}
	} else {
	if ($authnum == 1) {
	$authtype = '<input type="hidden" name="login" value="lti" />';
	}
	}
	if (!$can_assign{'lti'}) {
	return;
	} elsif ($authtype eq '') {
	if (defined($in{'mode'})) {
	if ($in{'mode'} eq 'modifycourse') {
	if ($authnum == 1) {
	$authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
	}
	}
	}
	}
	$jscall = "javascript:changed_radio('lti',$in{'formname'});";
	if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') \|\| ($in{'curr_authtype'} ne 'lti'))) {
	$authtype = '<input type="radio" name="login" value="lti" '.
	$lticheck.' onchange="'.$jscall.'" onclick="'.
	$jscall.'"'.$disabled.' />';
	}
	$autharg = '<input type="hidden" name="ltiarg" value="" />';
	if ($authtype) {
	$result = &mt('[_1] LTI Authenticated',
	'<label>'.$authtype.'</label>'.$autharg);
	} else {
	$result = '<b>'.&mt('LTI Authenticated').'</b>'.
	$autharg;
	}
return $result;	return $result;
}	}

Line 3134 sub get_assignable_auth {	Line 3542 sub get_assignable_auth {
krb5 => 1,	krb5 => 1,
int => 1,	int => 1,
loc => 1,	loc => 1,
	lti => 1,
);	);
my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);	my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
if (ref($domconfig{'usercreation'}) eq 'HASH') {	if (ref($domconfig{'usercreation'}) eq 'HASH') {
Line 3166 sub get_assignable_auth {	Line 3575 sub get_assignable_auth {
return ($authnum,%can_assign);	return ($authnum,%can_assign);
}	}

	sub check_passwd_rules {
	my ($domain,$plainpass) = @_;
	my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
	my ($min,$max,@chars,@brokerule,$warning);
	$min = $Apache::lonnet::passwdmin;
	if (ref($passwdconf{'chars'}) eq 'ARRAY') {
	if ($passwdconf{'min'} =~ /^\d+$/) {
	if ($passwdconf{'min'} > $min) {
	$min = $passwdconf{'min'};
	}
	}
	if ($passwdconf{'max'} =~ /^\d+$/) {
	$max = $passwdconf{'max'};
	}
	@chars = @{$passwdconf{'chars'}};
	}
	if (($min) && (length($plainpass) < $min)) {
	push(@brokerule,'min');
	}
	if (($max) && (length($plainpass) > $max)) {
	push(@brokerule,'max');
	}
	if (@chars) {
	my %rules;
	map { $rules{$_} = 1; } @chars;
	if ($rules{'uc'}) {
	unless ($plainpass =~ /[A-Z]/) {
	push(@brokerule,'uc');
	}
	}
	if ($rules{'lc'}) {
	unless ($plainpass =~ /[a-z]/) {
	push(@brokerule,'lc');
	}
	}
	if ($rules{'num'}) {
	unless ($plainpass =~ /\d/) {
	push(@brokerule,'num');
	}
	}
	if ($rules{'spec'}) {
	unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{\|}~]/) {
	push(@brokerule,'spec');
	}
	}
	}
	if (@brokerule) {
	my %rulenames = &Apache::lonlocal::texthash(
	uc => 'At least one upper case letter',
	lc => 'At least one lower case letter',
	num => 'At least one number',
	spec => 'At least one non-alphanumeric',
	);
	$rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
	$rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
	$rulenames{'num'} .= ': 0123456789';
	$rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{\|}~';
	$rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
	$rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
	$warning = &mt('Password did not satisfy the following:').'<ul>';
	foreach my $rule ('min','max','uc','lc','num','spec') {
	if (grep(/^$rule$/,@brokerule)) {
	$warning .= '<li>'.$rulenames{$rule}.'</li>';
	}
	}
	$warning .= '</ul>';
	}
	if (wantarray) {
	return @brokerule;
	}
	return $warning;
	}

###############################################################	###############################################################
## Get Kerberos Defaults for Domain ##	## Get Kerberos Defaults for Domain ##
###############################################################	###############################################################
Line 3333 sub get_related_words {	Line 3815 sub get_related_words {
untie %thesaurus_db;	untie %thesaurus_db;
return @Words;	return @Words;
}	}
	###############################################################
	#
	# Spell checking
	#

=pod	=pod

=back	=back

	=head1 Spell checking

	=over 4

	=item * &check_spelling($wordlist $language)

	Takes a string containing words and feeds it to an external
	spellcheck program via a pipeline. Returns a string containing
	them mis-spelled words.

	Parameters:

	=over 4

	=item - $wordlist

	String that will be fed into the spellcheck program.

	=item - $language

	Language string that specifies the language for which the spell
	check will be performed.

	=back

	=back

	Note: This sub assumes that aspell is installed.


=cut	=cut


	sub check_spelling {
	my ($wordlist, $language) = @_;
	my @misspellings;

	# Generate the speller and set the langauge.
	# if explicitly selected:

	my $speller = Text::Aspell->new;
	if ($language) {
	$speller->set_option('lang', $language);
	}

	# Turn the word list into an array of words by splittingon whitespace

	my @words = split(/\s+/, $wordlist);

	foreach my $word (@words) {
	if(! $speller->check($word)) {
	push(@misspellings, $word);
	}
	}
	return join(' ', @misspellings);

	}

# -------------------------------------------------------------- Plaintext name	# -------------------------------------------------------------- Plaintext name
=pod	=pod

Line 3803 category	Line 4345 category

sub filecategorytypes {	sub filecategorytypes {
my ($cat) = @_;	my ($cat) = @_;
return @{$category_extensions{lc($cat)}};	if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
	return @{$category_extensions{lc($cat)}};
	} else {
	return ();
	}
}	}

=pod	=pod
Line 3970 Return string with previous attempt on p	Line 4516 Return string with previous attempt on p

=item * $usec: section of the desired student	=item * $usec: section of the desired student

=item * $identifier: counter for student (multiple students one problem) or	=item * $identifier: counter for student (multiple students one problem) or
problem (one student; whole sequence).	problem (one student; whole sequence).

=back	=back
Line 4057 sub get_previous_attempt {	Line 4603 sub get_previous_attempt {
my (@hidden,@unsolved);	my (@hidden,@unsolved);
if (%typeparts) {	if (%typeparts) {
foreach my $id (keys(%typeparts)) {	foreach my $id (keys(%typeparts)) {
if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') \|\|	if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') \|\|
($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {	($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
push(@hidden,$id);	push(@hidden,$id);
} elsif ($identifier ne '') {	} elsif ($identifier ne '') {
Line 4118 sub get_previous_attempt {	Line 4664 sub get_previous_attempt {
if ($key =~ /\./) {	if ($key =~ /\./) {
my $value = $returnhash{$version.':'.$key};	my $value = $returnhash{$version.':'.$key};
if ($key =~ /\.rndseed$/) {	if ($key =~ /\.rndseed$/) {
my ($id) = ($key =~ /^(.+)\.rndseed$/);	my ($id) = ($key =~ /^(.+)\.[^.]+$/);
if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {	if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
$value = $returnhash{$version.':'.$id.'.rawrndseed'};	$value = $returnhash{$version.':'.$id.'.rawrndseed'};
}	}
Line 4135 sub get_previous_attempt {	Line 4681 sub get_previous_attempt {
next if ($key =~ /\.foilorder$/);	next if ($key =~ /\.foilorder$/);
my $value = $returnhash{$version.':'.$key};	my $value = $returnhash{$version.':'.$key};
if ($key =~ /\.rndseed$/) {	if ($key =~ /\.rndseed$/) {
my ($id) = ($key =~ /^(.+)\.rndseed$/);	my ($id) = ($key =~ /^(.+)\.[^.]+$/);
if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {	if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
$value = $returnhash{$version.':'.$id.'.rawrndseed'};	$value = $returnhash{$version.':'.$id.'.rawrndseed'};
}	}
Line 4166 sub get_previous_attempt {	Line 4712 sub get_previous_attempt {
if ($key =~/$regexp$/ && (defined &$gradesub)) {	if ($key =~/$regexp$/ && (defined &$gradesub)) {
$value = &$gradesub($value);	$value = &$gradesub($value);
}	}
$prevattempts.='<td>'.$value.' </td>';	$prevattempts.='<td>'. $value.' </td>';
} else {	} else {
$prevattempts.='<td> </td>';	$prevattempts.='<td> </td>';
}	}
Line 4182 sub get_previous_attempt {	Line 4728 sub get_previous_attempt {
if ($key =~/$regexp$/ && (defined &$gradesub)) {	if ($key =~/$regexp$/ && (defined &$gradesub)) {
$value = &$gradesub($value);	$value = &$gradesub($value);
}	}
$prevattempts.='<td>'.$value.' </td>';	$prevattempts.='<td>'.$value.' </td>';
}	}
}	}
$prevattempts.= &end_data_table_row().&end_data_table();	$prevattempts.= &end_data_table_row().&end_data_table();
} else {	} else {
	my $msg;
	if ($symb =~ /ext\.tool$/) {
	$msg = &mt('No grade passed back.');
	} else {
	$msg = &mt('Nothing submitted - no attempts.');
	}
$prevattempts=	$prevattempts=
&start_data_table().&start_data_table_row().	&start_data_table().&start_data_table_row().
'<td>'.&mt('Nothing submitted - no attempts.').'</td>'.	'<td>'.$msg.'</td>'.
&end_data_table_row().&end_data_table();	&end_data_table_row().&end_data_table();
}	}
} else {	} else {
Line 4203 sub get_previous_attempt {	Line 4755 sub get_previous_attempt {
sub format_previous_attempt_value {	sub format_previous_attempt_value {
my ($key,$value) = @_;	my ($key,$value) = @_;
if (($key =~ /timestamp/) \|\| ($key=~/duedate/)) {	if (($key =~ /timestamp/) \|\| ($key=~/duedate/)) {
$value = &Apache::lonlocal::locallocaltime($value);	$value = &Apache::lonlocal::locallocaltime($value);
} elsif (ref($value) eq 'ARRAY') {	} elsif (ref($value) eq 'ARRAY') {
$value = '('.join(', ', @{ $value }).')';	$value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
} elsif ($key =~ /answerstring$/) {	} elsif ($key =~ /answerstring$/) {
my %answers = &Apache::lonnet::str2hash($value);	my %answers = &Apache::lonnet::str2hash($value);
	my @answer = %answers;
	%answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
my @anskeys = sort(keys(%answers));	my @anskeys = sort(keys(%answers));
if (@anskeys == 1) {	if (@anskeys == 1) {
my $answer = $answers{$anskeys[0]};	my $answer = $answers{$anskeys[0]};
Line 4230 sub format_previous_attempt_value {	Line 4784 sub format_previous_attempt_value {
}	}
}	}
} else {	} else {
$value = &unescape($value);	$value = &HTML::Entities::encode(&unescape($value), '"<>&');
}	}
return $value;	return $value;
}	}
Line 4292 sub get_student_view {	Line 4846 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);
	if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
	$feedurl =~ s{^/adm/wrapper}{};
	}
my ($userview,$response)=&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;
Line 4591 sub findallcourses {	Line 5148 sub findallcourses {
###############################################	###############################################

sub blockcheck {	sub blockcheck {
my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;	my ($setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;

if (defined($udom) && defined($uname)) {	if (defined($udom) && defined($uname)) {
# If uname and udom are for a course, check for blocks in the course.	# If uname and udom are for a course, check for blocks in the course.
if (($is_course) \|\| (&Apache::lonnet::is_course($udom,$uname))) {	if (($is_course) \|\| (&Apache::lonnet::is_course($udom,$uname))) {
my ($startblock,$endblock,$triggerblock) =	my ($startblock,$endblock,$triggerblock) =
&get_blocks($setters,$activity,$udom,$uname,$url);	&get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
return ($startblock,$endblock,$triggerblock);	return ($startblock,$endblock,$triggerblock);
}	}
} else {	} else {
Line 4614 sub blockcheck {	Line 5171 sub blockcheck {
# boards, chat or groups, check for blocking in current course only.	# boards, chat or groups, check for blocking in current course only.

if (($activity eq 'boards' \|\| $activity eq 'chat' \|\|	if (($activity eq 'boards' \|\| $activity eq 'chat' \|\|
$activity eq 'groups' \|\| $activity eq 'printout') &&	$activity eq 'groups' \|\| $activity eq 'printout' \|\|
	$activity eq 'search' \|\| $activity eq 'reinit' \|\|
	$activity eq 'alert') &&
($env{'request.course.id'})) {	($env{'request.course.id'})) {
foreach my $key (keys(%live_courses)) {	foreach my $key (keys(%live_courses)) {
if ($key ne $env{'request.course.id'}) {	if ($key ne $env{'request.course.id'}) {
Line 4720 sub blockcheck {	Line 5279 sub blockcheck {
($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));	($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
next if ($no_userblock);	next if ($no_userblock);

# Retrieve blocking times and identity of locker for course	# Retrieve blocking times and identity of blocker for course
# of specified user, unless user has 'evb' privilege.	# of specified user, unless user has 'evb' privilege.

my ($start,$end,$trigger) =	my ($start,$end,$trigger) =
&get_blocks($setters,$activity,$cdom,$cnum,$url);	&get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
if (($start != 0) &&	if (($start != 0) &&
(($startblock == 0) \|\| ($startblock > $start))) {	(($startblock == 0) \|\| ($startblock > $start))) {
$startblock = $start;	$startblock = $start;
Line 4744 sub blockcheck {	Line 5303 sub blockcheck {
}	}

sub get_blocks {	sub get_blocks {
my ($setters,$activity,$cdom,$cnum,$url) = @_;	my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
my $startblock = 0;	my $startblock = 0;
my $endblock = 0;	my $endblock = 0;
my $triggerblock = '';	my $triggerblock = '';
Line 4757 sub get_blocks {	Line 5316 sub get_blocks {
my $now = time;	my $now = time;
my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);	my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
if ($activity eq 'docs') {	if ($activity eq 'docs') {
@blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);	my ($blocked,$nosymbcache,$noenccheck);
	if (($caller eq 'blockedaccess') \|\| ($caller eq 'blockingstatus')) {
	$blocked = 1;
	$nosymbcache = 1;
	$noenccheck = 1;
	}
	@blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
foreach my $block (@blockers) {	foreach my $block (@blockers) {
if ($block =~ /^firstaccess____(.+)$/) {	if ($block =~ /^firstaccess____(.+)$/) {
my $item = $1;	my $item = $1;
Line 4809 sub get_blocks {	Line 5374 sub get_blocks {
my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};	my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
if ($start && $end) {	if ($start && $end) {
if (($start <= time) && ($end >= time)) {	if (($start <= time) && ($end >= time)) {
unless (grep(/^\Q$block\E$/,@blockers)) {	if (ref($commblocks{$block}) eq 'HASH') {
push(@blockers,$block);	if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
$triggered{$block} = {	if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
start => $start,	unless(grep(/^\Q$block\E$/,@blockers)) {
end => $end,	push(@blockers,$block);
type => $type,	$triggered{$block} = {
};	start => $start,
	end => $end,
	type => $type,
	};
	}
	}
	}
}	}
}	}
}	}
Line 4879 sub parse_block_record {	Line 5450 sub parse_block_record {
}	}

sub blocking_status {	sub blocking_status {
my ($activity,$uname,$udom,$url,$is_course) = @_;	my ($activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
my %setters;	my %setters;

# check for active blocking	# check for active blocking
my ($startblock,$endblock,$triggerblock) =	my ($startblock,$endblock,$triggerblock) =
&blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);	&blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller);
my $blocked = 0;	my $blocked = 0;
if ($startblock && $endblock) {	if ($startblock && $endblock) {
$blocked = 1;	$blocked = 1;
Line 4897 sub blocking_status {	Line 5468 sub blocking_status {
my $querystring = "?activity=$activity";	my $querystring = "?activity=$activity";
# $uname and $udom decide whose portfolio the user is trying to look at	# $uname and $udom decide whose portfolio the user is trying to look at
if (($activity eq 'port') \|\| ($activity eq 'passwd')) {	if (($activity eq 'port') \|\| ($activity eq 'passwd')) {
$querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);	$querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
$querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);	$querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
} elsif ($activity eq 'docs') {	} elsif ($activity eq 'docs') {
$querystring .= '&url='.&HTML::Entities::encode($url,'&"');	my $showurl = &Apache::lonenc::check_encrypt($url);
	$querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
	if ($symb) {
	my $showsymb = &Apache::lonenc::check_encrypt($symb);
	$querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
	}
}	}

my $output .= <<'END_MYBLOCK';	my $output .= <<'END_MYBLOCK';
Line 4925 END_MYBLOCK	Line 5501 END_MYBLOCK
$text = &mt('Printing Blocked');	$text = &mt('Printing Blocked');
} elsif ($activity eq 'passwd') {	} elsif ($activity eq 'passwd') {
$text = &mt('Password Changing Blocked');	$text = &mt('Password Changing Blocked');
	} elsif ($activity eq 'grades') {
	$text = &mt('Gradebook Blocked');
	} elsif ($activity eq 'search') {
	$text = &mt('Search Blocked');
	} elsif ($activity eq 'alert') {
	$text = &mt('Checking Critical Messages Blocked');
	} elsif ($activity eq 'reinit') {
	$text = &mt('Checking Course Update Blocked');
}	}
$output .= <<"END_BLOCK";	$output .= <<"END_BLOCK";
<div class='$class'>	<div class='$class'>
Line 4948 sub check_ip_acc {	Line 5532 sub check_ip_acc {
if (!defined($acc) \|\| $acc =~ /^\s$/ \|\| $acc =~/^\sno\s*$/i) {	if (!defined($acc) \|\| $acc =~ /^\s$/ \|\| $acc =~/^\sno\s*$/i) {
return 1;	return 1;
}	}
my $allowed=0;	my ($ip,$allowed);
my $ip=$ENV{'REMOTE_ADDR'} \|\| $clientip \|\| $env{'request.host'};	if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') \|\|
	($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
my $name;	$ip = $env{'request.host'} \|\| $ENV{'REMOTE_ADDR'} \|\| $clientip;
foreach my $pattern (split(',',$acc)) {	} else {
$pattern =~ s/^\s*//;	$ip = $ENV{'REMOTE_ADDR'} \|\| $env{'request.host'} \|\| $clientip;
$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;
}

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

my $name;	my $name;
my %access = (	my %access = (
Line 5024 sub check_slotip_acc {	Line 5561 sub check_slotip_acc {
my $numallows = scalar(@allows);	my $numallows = scalar(@allows);
my $count = 0;	my $count = 0;
foreach my $pattern (@denies,@allows) {	foreach my $pattern (@denies,@allows) {
$count ++;	$count ++;
my $acctype = 'allowfrom';	my $acctype = 'allowfrom';
if ($count <= $numdenies) {	if ($count <= $numdenies) {
$acctype = 'denyfrom';	$acctype = 'denyfrom';
Line 5135 sub get_domainconf {	Line 5672 sub get_domainconf {
my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};	my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
$designhash{$udom.'.login.loginvia'} = $server;	$designhash{$udom.'.login.loginvia'} = $server;
if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {	if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {

$designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};	$designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
} else {	} else {
$designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};	$designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
Line 5215 sub get_legacy_domconf {	Line 5753 sub get_legacy_domconf {
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
my $designfile = $designdir.'/'.$udom.'.tab';	my $designfile = $designdir.'/'.$udom.'.tab';
if (-e $designfile) {	if (-e $designfile) {
if ( open (my $fh,"<$designfile") ) {	if ( open (my $fh,'<',$designfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 5404 sub CSTR_pageheader {	Line 5942 sub CSTR_pageheader {
$lastitem = $thisdisfn;	$lastitem = $thisdisfn;
}	}

	my ($crsauthor,$title);
	if (($env{'request.course.id'}) &&
	($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
	($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
	$crsauthor = 1;
	$title = &mt('Course Authoring Space');
	} else {
	$title = &mt('Authoring Space');
	}

	my ($target,$crumbtarget) = (' target="_top"','_top'); #FIXME lonpubdir: target="_parent"
	if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
	$target = '';
	$crumbtarget = '';
	}

my $output =	my $output =
'<div>'	'<div>'
.&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?	.&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
.'<b>'.&mt('Authoring Space:').'</b> '	.'<b>'.$title.'</b> '
.'<form name="dirs" method="post" action="'.$formaction	.'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
.'" target="_top">' #FIXME lonpubdir: target="_parent"	.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);

if ($lastitem) {	if ($lastitem) {
$output .=	$output .=
Line 5418 sub CSTR_pageheader {	Line 5971 sub CSTR_pageheader {
.$lastitem	.$lastitem
.'</span>';	.'</span>';
}	}
$output .=
'<br />'	if ($crsauthor) {
#FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"	$output .= '</form>'.&Apache::lonmenu::constspaceform();
.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')	} else {
.'</form>'	$output .=
.&Apache::lonmenu::constspaceform()	'<br />'
.'</div>';	#FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
	.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
	.'</form>'
	.&Apache::lonmenu::constspaceform();
	}
	$output .= '</div>';

return $output;	return $output;
}	}
Line 5466 Inputs:	Line 6024 Inputs:

=item * $bgcolor, used to override the bgcolor on a webpage to a specific value	=item * $bgcolor, used to override the bgcolor on a webpage to a specific value

=item * $no_inline_link, if true and in remote mode, don't show the
'Switch To Inline Menu' link

=item * $args, optional argument valid values are	=item * $args, optional argument valid values are
no_auto_mt_title -> prevents &mt()ing the title arg	no_auto_mt_title -> prevents &mt()ing the title arg
	use_absolute -> for external resource or syllabus, this will
	contain https://<hostname> if server uses
	https (as per hosts.tab), but request is for http
	hostname -> hostname, from $r->hostname().

=item * $advtoolsref, optional argument, ref to an array containing	=item * $advtoolsref, optional argument, ref to an array containing
inlineremote items to be added in "Functions" menu below	inlineremote items to be added in "Functions" menu below
breadcrumbs.	breadcrumbs.

	=item * $ltiscope, optional argument, will be one of: resource, map or
	course, if LON-CAPA is in LTI Provider context. Value is
	the scope of use, i.e., launch was for access to a single, a map
	or the entire course.

	=item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
	context, this will contain the URL for the landing item in
	the course, after launch from an LTI Consumer

	=item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
	context, this will contain a reference to hash of items
	to be included in the page header and/or inline menu.

=back	=back

Returns: A uniform header for LON-CAPA web pages.	Returns: A uniform header for LON-CAPA web pages.
Line 5487 other decorations will be returned.	Line 6059 other decorations will be returned.

sub bodytag {	sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,	my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
$no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;	$no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,$ltimenu)=@_;

my $public;	my $public;
if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))	if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
Line 5496 sub bodytag {	Line 6068 sub bodytag {
}	}
if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }	if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
my $httphost = $args->{'use_absolute'};	my $httphost = $args->{'use_absolute'};
	my $hostname = $args->{'hostname'};

$function = &get_users_function() if (!$function);	$function = &get_users_function() if (!$function);
my $img = &designparm($function.'.img',$domain);	my $img = &designparm($function.'.img',$domain);
Line 5530 sub bodytag {	Line 6103 sub bodytag {
$role = &mt('Helpdesk[_1]',' '.$2);	$role = &mt('Helpdesk[_1]',' '.$2);
}	}
} else {	} else {
$role = (split(/\//,$role,4))[-1];	$role = (split(/\//,$role,4))[-1];
}	}
if ($env{'request.course.sec'}) {	if ($env{'request.course.sec'}) {
$role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};	$role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
Line 5557 sub bodytag {	Line 6130 sub bodytag {
if ($public) {	if ($public) {
undef($role);	undef($role);
}	}

	if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
	if (ref($ltimenu) eq 'HASH') {
	unless ($ltimenu->{'role'}) {
	undef($role);
	}
	unless ($ltimenu->{'coursetitle'}) {
	$realm=' ';
	}
	}
	}

my $titleinfo = '<h1>'.$title.'</h1>';	my $titleinfo = '<h1>'.$title.'</h1>';
#	#
# Extra info if you are the DC	# Extra info if you are the DC
Line 5570 sub bodytag {	Line 6154 sub bodytag {
$dc_info =~ s/\s+$//;	$dc_info =~ s/\s+$//;
}	}

$role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});	my $crstype;
	if ($env{'request.course.id'}) {
if ($env{'request.state'} eq 'construct') { $forcereg=1; }	$crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
	} elsif ($args->{'crstype'}) {
	$crstype = $args->{'crstype'};
	}
my $funclist;	if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {	undef($role);
$bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
Apache::lonmenu::serverform();
my $forbodytag;
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
$forcereg,$args->{'group'},
$args->{'bread_crumbs'},
$advtoolsref,'',\$forbodytag);
unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
$funclist = $forbodytag;
}
} else {	} else {
	$role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
	}

	if ($env{'request.state'} eq 'construct') { $forcereg=1; }

# if ($env{'request.state'} eq 'construct') {	# if ($env{'request.state'} eq 'construct') {
# $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls	# $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
Line 5597 sub bodytag {	Line 6175 sub bodytag {
$bodytag .= Apache::lonhtmlcommon::scripttag(	$bodytag .= Apache::lonhtmlcommon::scripttag(
Apache::lonmenu::utilityfunctions($httphost), 'start');	Apache::lonmenu::utilityfunctions($httphost), 'start');

my ($left,$right) = Apache::lonmenu::primary_menu();	unless ($args->{'no_primary_menu'}) {
	my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu);

if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {	if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
if ($dc_info) {	if ($dc_info) {
$dc_info = qq\|<span class="LC_cusr_subheading">$dc_info</span>\|;	$dc_info = qq\|<span class="LC_cusr_subheading">$dc_info</span>\|;
	}
	$bodytag .= qq\|<div id="LC_nav_bar">$left $role<br />
	<em>$realm</em> $dc_info</div>\|;
	return $bodytag;
}	}
$bodytag .= qq\|<div id="LC_nav_bar">$left $role<br />
<em>$realm</em> $dc_info</div>\|;
return $bodytag;
}

unless ($env{'request.symb'} =~ m/\.page___\d+___/) {	unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
$bodytag .= qq\|<div id="LC_nav_bar">$left $role</div>\|;	$bodytag .= qq\|<div id="LC_nav_bar">$left $role</div>\|;
}	}

$bodytag .= $right;	$bodytag .= $right;

if ($dc_info) {	if ($dc_info) {
$dc_info = &dc_courseid_toggle($dc_info);	$dc_info = &dc_courseid_toggle($dc_info);
	}
	$bodytag .= qq\|<div id="LC_realm">$realm $dc_info</div>\|;
}	}
$bodytag .= qq\|<div id="LC_realm">$realm $dc_info</div>\|;

#if directed to not display the secondary menu, don't.	#if directed to not display the secondary menu, don't.
if ($args->{'no_secondary_menu'}) {	if ($args->{'no_secondary_menu'}) {
return $bodytag;	return $bodytag;
}	}
#don't show menus for public users	#don't show menus for public users
if (!$public){	if (!$public){
$bodytag .= Apache::lonmenu::secondary_menu($httphost);	unless ($args->{'no_inline_menu'}) {
	$bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
	$args->{'no_primary_menu'});
	}
$bodytag .= Apache::lonmenu::serverform();	$bodytag .= Apache::lonmenu::serverform();
$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');	$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
if ($env{'request.state'} eq 'construct') {	if ($env{'request.state'} eq 'construct') {
$bodytag .= &Apache::lonmenu::innerregister($forcereg,	$bodytag .= &Apache::lonmenu::innerregister($forcereg,
$args->{'bread_crumbs'});	$args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri);
} elsif ($forcereg) {	} elsif ($forcereg) {
$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,	$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
$args->{'group'},	$args->{'group'},
$args->{'hide_buttons'});	$args->{'hide_buttons'},
	$hostname,$ltiscope,$ltiuri);
} else {	} else {
my $forbodytag;	$bodytag .=
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'},	&Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
$forcereg,$args->{'group'},	$forcereg,$args->{'group'},
$args->{'bread_crumbs'},	$args->{'bread_crumbs'},
$advtoolsref,'',\$forbodytag);	$advtoolsref,'',$hostname);
unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
$bodytag .= $forbodytag;
}
}	}
}else{	}else{
# this is to seperate menu from content when there's no secondary	# this is to seperate menu from content when there's no secondary
Line 5653 sub bodytag {	Line 6234 sub bodytag {
}	}

return $bodytag;	return $bodytag;
}

#
# Top frame rendering, Remote is up
#

my $imgsrc = $img;
if ($img =~ /^\/adm/) {
$imgsrc = &lonhttpdurl($img);
}
my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';

my $help=($no_inline_link?''
:&Apache::loncommon::top_nav_help('Help'));

# Explicit link to get inline menu
my $menu= ($no_inline_link?''
:'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');

if ($dc_info) {
$dc_info = qq\|<span class="LC_cusr_subheading">($dc_info)</span>\|;
}

my $name = &plainname($env{'user.name'},$env{'user.domain'});
unless ($public) {
$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
undef,'LC_menubuttons_link');
}

unless ($env{'form.inhibitmenu'}) {
$bodytag .= qq\|<div id="LC_nav_bar">$name $role</div>
<ol class="LC_primary_menu LC_floatright LC_right">
<li>$help</li>
<li>$menu</li>
</ol><div id="LC_realm"> $realm $dc_info</div>\|;
}
if ($env{'request.state'} eq 'construct') {
if (!$public){
if ($env{'request.state'} eq 'construct') {
$funclist = &Apache::lonhtmlcommon::scripttag(
&Apache::lonmenu::utilityfunctions($httphost), 'start').
&Apache::lonhtmlcommon::scripttag('','end').
&Apache::lonmenu::innerregister($forcereg,
$args->{'bread_crumbs'});
}
}
}
return $bodytag."\n".$funclist;
}	}

sub dc_courseid_toggle {	sub dc_courseid_toggle {
Line 5732 sub make_attr_string {	Line 6265 sub make_attr_string {
delete($attr_ref->{$key});	delete($attr_ref->{$key});
}	}
}	}
if ($env{'environment.remote'} eq 'on') {	$attr_ref->{'onload'} = $on_load;
$attr_ref->{'onload'} =	$attr_ref->{'onunload'}= $on_unload;
&Apache::lonmenu::loadevents(). $on_load;
$attr_ref->{'onunload'}=
&Apache::lonmenu::unloadevents().$on_unload;
} else {
$attr_ref->{'onload'} = $on_load;
$attr_ref->{'onunload'}= $on_unload;
}
}	}

my $attr_string;	my $attr_string;
Line 6064 ul.LC_breadcrumb_tools_outerlist li {	Line 6590 ul.LC_breadcrumb_tools_outerlist li {
float: right;	float: right;
}	}

	.LC_placement_prog {
	padding-right: 20px;
	font-weight: bold;
	font-size: 90%;
	}

table#LC_title_bar td {	table#LC_title_bar td {
background: $tabbg;	background: $tabbg;
}	}
Line 6154 td.LC_menubuttons_text {	Line 6686 td.LC_menubuttons_text {
background: $tabbg;	background: $tabbg;
}	}

	td.LC_zero_height {
	line-height: 0;
	cellpadding: 0;
	}

table.LC_data_table {	table.LC_data_table {
border: 1px solid #000000;	border: 1px solid #000000;
border-collapse: separate;	border-collapse: separate;
Line 6475 td.LC_parm_overview_restrictions {	Line 7012 td.LC_parm_overview_restrictions {
border-collapse: collapse;	border-collapse: collapse;
}	}

	span.LC_parm_recursive,
	td.LC_parm_recursive {
	font-weight: bold;
	font-size: smaller;
	}

table.LC_parm_overview_restrictions td {	table.LC_parm_overview_restrictions td {
border-width: 1px 4px 1px 4px;	border-width: 1px 4px 1px 4px;
border-style: solid;	border-style: solid;
Line 6744 table.LC_prior_tries td {	Line 7287 table.LC_prior_tries td {
padding: 6px;	padding: 6px;
}	}

.LC_answer_unknown {	.LC_answer_unknown,
	.LC_answer_warning {
background: orange;	background: orange;
color: black;	color: black;
padding: 6px;	padding: 6px;
Line 6826 table.LC_data_table tr > td.LC_docs_entr	Line 7370 table.LC_data_table tr > td.LC_docs_entr
color: #990000;	color: #990000;
}	}

	.LC_docs_alias {
	color: #440055;
	}

	.LC_domprefs_email,
	.LC_docs_alias_name,
.LC_docs_reinit_warn,	.LC_docs_reinit_warn,
.LC_docs_ext_edit {	.LC_docs_ext_edit {
font-size: x-small;	font-size: x-small;
Line 7122 ol.LC_primary_menu li {	Line 7672 ol.LC_primary_menu li {
line-height: 1.5em;	line-height: 1.5em;
}	}

ol.LC_primary_menu li a,	ol.LC_primary_menu li a,
ol.LC_primary_menu li p {	ol.LC_primary_menu li p {
display: block;	display: block;
margin: 0;	margin: 0;
Line 7137 ol.LC_primary_menu li p span.LC_primary_	Line 7687 ol.LC_primary_menu li p span.LC_primary_
}	}

ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {	ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
display: inline-block;	display: inline-block;
width: 5%;	width: 5%;
float: right;	float: right;
text-align: right;	text-align: right;
Line 7172 ol.LC_primary_menu li:hover li, ol.LC_pr	Line 7722 ol.LC_primary_menu li:hover li, ol.LC_pr
float: none;	float: none;
border-left: 1px solid black;	border-left: 1px solid black;
border-right: 1px solid black;	border-right: 1px solid black;
/* A dark bottom border to visualize different menu options;	/* A dark bottom border to visualize different menu options;
overwritten in the create_submenu routine for the last border-bottom of the menu */	overwritten in the create_submenu routine for the last border-bottom of the menu */
border-bottom: 1px solid $data_table_dark;	border-bottom: 1px solid $data_table_dark;
}	}

ol.LC_primary_menu li li p:hover {	ol.LC_primary_menu li li p:hover {
Line 7734 ul.LC_funclist li {	Line 8284 ul.LC_funclist li {
cursor:pointer;	cursor:pointer;
}	}

	pre.LC_wordwrap {
	white-space: pre-wrap;
	white-space: -moz-pre-wrap;
	white-space: -pre-wrap;
	white-space: -o-pre-wrap;
	word-wrap: break-word;
	}

	/*
	styles used for response display
	*/
	div.LC_radiofoil, div.LC_rankfoil {
	margin: .5em 0em .5em 0em;
	}
	table.LC_itemgroup {
	margin-top: 1em;
	}

/*	/*
styles used by TTH when "Default set of options to pass to tth/m	styles used by TTH when "Default set of options to pass to tth/m
when converting TeX" in course settings has been set	when converting TeX" in course settings has been set
Line 7755 span.roman {font-family: serif; font-sty	Line 8323 span.roman {font-family: serif; font-sty
span.overacc2 {position: relative; left: .8em; top: -1.2ex;}	span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
span.overacc1 {position: relative; left: .6em; top: -1.2ex;}	span.overacc1 {position: relative; left: .6em; top: -1.2ex;}

	/*
	sections with roles, for content only
	*/
	section[class^="role-"] {
	padding-left: 10px;
	padding-right: 5px;
	margin-top: 8px;
	margin-bottom: 8px;
	border: 1px solid #2A4;
	border-radius: 5px;
	box-shadow: 0px 1px 1px #BBB;
	}
	section[class^="role-"]>h1 {
	position: relative;
	margin: 0px;
	padding-top: 10px;
	padding-left: 40px;
	}
	section[class^="role-"]>h1:before {
	position: absolute;
	left: -5px;
	top: 5px;
	}
	section.role-activity>h1:before {
	content:url('/adm/daxe/images/section_icons/activity.png');
	}
	section.role-advice>h1:before {
	content:url('/adm/daxe/images/section_icons/advice.png');
	}
	section.role-bibliography>h1:before {
	content:url('/adm/daxe/images/section_icons/bibliography.png');
	}
	section.role-citation>h1:before {
	content:url('/adm/daxe/images/section_icons/citation.png');
	}
	section.role-conclusion>h1:before {
	content:url('/adm/daxe/images/section_icons/conclusion.png');
	}
	section.role-definition>h1:before {
	content:url('/adm/daxe/images/section_icons/definition.png');
	}
	section.role-demonstration>h1:before {
	content:url('/adm/daxe/images/section_icons/demonstration.png');
	}
	section.role-example>h1:before {
	content:url('/adm/daxe/images/section_icons/example.png');
	}
	section.role-explanation>h1:before {
	content:url('/adm/daxe/images/section_icons/explanation.png');
	}
	section.role-introduction>h1:before {
	content:url('/adm/daxe/images/section_icons/introduction.png');
	}
	section.role-method>h1:before {
	content:url('/adm/daxe/images/section_icons/method.png');
	}
	section.role-more_information>h1:before {
	content:url('/adm/daxe/images/section_icons/more_information.png');
	}
	section.role-objectives>h1:before {
	content:url('/adm/daxe/images/section_icons/objectives.png');
	}
	section.role-prerequisites>h1:before {
	content:url('/adm/daxe/images/section_icons/prerequisites.png');
	}
	section.role-remark>h1:before {
	content:url('/adm/daxe/images/section_icons/remark.png');
	}
	section.role-reminder>h1:before {
	content:url('/adm/daxe/images/section_icons/reminder.png');
	}
	section.role-summary>h1:before {
	content:url('/adm/daxe/images/section_icons/summary.png');
	}
	section.role-syntax>h1:before {
	content:url('/adm/daxe/images/section_icons/syntax.png');
	}
	section.role-warning>h1:before {
	content:url('/adm/daxe/images/section_icons/warning.png');
	}

#LC_minitab_header {	#LC_minitab_header {
float:left;	float:left;
width:100%;	width:100%;
Line 7845 sub headtag {	Line 8494 sub headtag {
if (!$args->{'frameset'}) {	if (!$args->{'frameset'}) {
$result .= &Apache::lonhtmlcommon::htmlareaheaders();	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
}	}
if ($args->{'force_register'}) {	if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
$result .= &Apache::lonmenu::registerurl(1);	$result .= Apache::lonxml::display_title();
}	}
if (!$args->{'no_nav_bar'}	if (!$args->{'no_nav_bar'}
&& !$args->{'only_body'}	&& !$args->{'only_body'}
Line 7893 ADDMETA	Line 8542 ADDMETA
my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};	my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {	unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);	my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
	my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
	my $offload;
if (ref($domdefs{'offloadnow'}) eq 'HASH') {	if (ref($domdefs{'offloadnow'}) eq 'HASH') {
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
if ($domdefs{'offloadnow'}{$lonhost}) {	if ($domdefs{'offloadnow'}{$lonhost}) {
my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);	$offload = 1;
if (($newserver) && ($newserver ne $lonhost)) {	}
my $numsec = 5;	}
my $timeout = $numsec * 1000;	unless ($offload) {
my ($newurl,$locknum,%locks,$msg);	if (ref($domdefs{'offloadoth'}) eq 'HASH') {
if ($env{'request.role.adv'}) {	if ($domdefs{'offloadoth'}{$lonhost}) {
($locknum,%locks) = &Apache::lonnet::get_locks();	if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
}	(!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
my $disable_submit = 0;	unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
if ($requrl =~ /$LONCAPA::assess_re/) {	$offload = 1;
$disable_submit = 1;	$dom_in_use = $env{'user.domain'};
	}
}	}
if ($locknum) {	}
my @lockinfo = sort(values(%locks));	}
$msg = &mt('Once the following tasks are complete: ')."\\n".	}
join(", ",sort(values(%locks)))."\\n".	if ($offload) {
&mt('your session will be transferred to a different server, after you click "Roles".');	my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
	if (($newserver) && ($newserver ne $lonhost)) {
	my $numsec = 5;
	my $timeout = $numsec * 1000;
	my ($newurl,$locknum,%locks,$msg);
	if ($env{'request.role.adv'}) {
	($locknum,%locks) = &Apache::lonnet::get_locks();
	}
	my $disable_submit = 0;
	if ($requrl =~ /$LONCAPA::assess_re/) {
	$disable_submit = 1;
	}
	if ($locknum) {
	my @lockinfo = sort(values(%locks));
	$msg = &mt('Once the following tasks are complete: ')."\n".
	join(", ",sort(values(%locks)))."\n";
	if (&show_course()) {
	$msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
} else {	} else {
if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {	$msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
$msg = &mt('Your LON-CAPA submission has been recorded')."\\n";	}
}	} else {
$msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);	if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
$newurl = '/adm/switchserver?otherserver='.$newserver;	$msg = &mt('Your LON-CAPA submission has been recorded')."\n";
if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {	}
$newurl .= '&role='.$env{'request.role'};	$msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
	$newurl = '/adm/switchserver?otherserver='.$newserver;
	if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
	$newurl .= '&role='.$env{'request.role'};
	}
	if ($env{'request.symb'}) {
	my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
	if ($shownsymb =~ m{^/enc/}) {
	my $reqdmajor = 2;
	my $reqdminor = 11;
	my $reqdsubminor = 3;
	my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
	my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
	my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+\|)[\w.\-]+\'?$/);
	if (($major eq '' && $minor eq '') \|\|
	(($reqdmajor > $major) \|\| (($reqdmajor == $major) && ($reqdminor > $minor)) \|\|
	(($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') \|\|
	($reqdsubminor > $subminor))))) {
	undef($shownsymb);
	}
}	}
if ($env{'request.symb'}) {	if ($shownsymb) {
$newurl .= '&symb='.$env{'request.symb'};	&js_escape(\$shownsymb);
} else {	$newurl .= '&symb='.$shownsymb;
$newurl .= '&origurl='.$requrl;
}	}
	} else {
	my $shownurl = &Apache::lonenc::check_encrypt($requrl);
	&js_escape(\$shownurl);
	$newurl .= '&origurl='.$shownurl;
}	}
&js_escape(\$msg);	}
$result.=<<OFFLOAD	&js_escape(\$msg);
	$result.=<<OFFLOAD
<meta http-equiv="pragma" content="no-cache" />	<meta http-equiv="pragma" content="no-cache" />
<script type="text/javascript">	<script type="text/javascript">
// <![CDATA[	// <![CDATA[
Line 7950 function LC_Offload_Now() {	Line 8641 function LC_Offload_Now() {
// ]]>	// ]]>
</script>	</script>
OFFLOAD	OFFLOAD
}
}	}
}	}
}	}
Line 7966 OFFLOAD	Line 8656 OFFLOAD
if (!$args->{'frameset'}) {	if (!$args->{'frameset'}) {
$result .= ' /';	$result .= ' /';
}	}
$result .= '>'	$result .= '>'
.$inhibitprint	.$inhibitprint
.$head_extra;	.$head_extra;
my $clientmobile;	my $clientmobile;
Line 7999 sub font_settings {	Line 8689 sub font_settings {
my $headerstring='';	my $headerstring='';
if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) \|\|	if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) \|\|
((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {	((ref($args) eq 'HASH') && ($args->{'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"';
if (!$args->{'frameset'}) {	if (!$args->{'frameset'}) {
$headerstring.= ' /';	$headerstring.= ' /';
}	}
$headerstring .= '>'."\n";	$headerstring .= '>'."\n";
}	}
return $headerstring;	return $headerstring;
}	}
Line 8157 $args - additional optional args support	Line 8847 $args - additional optional args support
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
'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
bread_crumbs -> Array containing breadcrumbs	bread_crumbs -> Array containing breadcrumbs
bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs	bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
bread_crumbs_nomenu -> if true will pass false as the value of $menulink	bread_crumbs_nomenu -> if true will pass false as the value of $menulink
to lonhtmlcommon::breadcrumbs	to lonhtmlcommon::breadcrumbs
group -> includes the current group, if page is for a	group -> includes the current group, if page is for a
specific group	specific group
	use_absolute -> for request for external resource or syllabus, this
	will contain https://<hostname> if server uses
	https (as per hosts.tab), but request is for http
	hostname -> hostname, originally from $r->hostname(), (optional).

=back	=back

Line 8178 sub start_page {	Line 8870 sub start_page {
#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));	#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));

$env{'internal.start_page'}++;	$env{'internal.start_page'}++;
my ($result,@advtools);	my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu);

if (! exists($args->{'skip_phases'}{'head'}) ) {	if (! exists($args->{'skip_phases'}{'head'}) ) {
$result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);	$result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
}	}

	if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
	if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
	unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
	$args->{'no_primary_menu'} = 1;
	}
	unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
	$args->{'no_inline_menu'} = 1;
	}
	if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
	map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
	}
	} else {
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
	if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
	unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
	$args->{'no_primary_menu'} = 1;
	}
	unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
	$args->{'no_inline_menu'} = 1;
	}
	if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
	map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
	}
	}
	}
	($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
	$env{'course.'.$env{'request.course.id'}.'.domain'},
	$env{'course.'.$env{'request.course.id'}.'.num'});
	}

if (! exists($args->{'skip_phases'}{'body'}) ) {	if (! exists($args->{'skip_phases'}{'body'}) ) {
if ($args->{'frameset'}) {	if ($args->{'frameset'}) {
Line 8195 sub start_page {	Line 8918 sub start_page {
$args->{'function'}, $args->{'add_entries'},	$args->{'function'}, $args->{'add_entries'},
$args->{'only_body'}, $args->{'domain'},	$args->{'only_body'}, $args->{'domain'},
$args->{'force_register'}, $args->{'no_nav_bar'},	$args->{'force_register'}, $args->{'no_nav_bar'},
$args->{'bgcolor'}, $args->{'no_inline_link'},	$args->{'bgcolor'}, $args,
$args, \@advtools);	\@advtools,$ltiscope,$ltiuri,\%ltimenu);
}	}
}	}

Line 8231 sub start_page {	Line 8954 sub start_page {
}	}
my $menulink;	my $menulink;
# if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.	# if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
if (exists($args->{'bread_crumbs_nomenu'})) {	if ((exists($args->{'bread_crumbs_nomenu'})) \|\|
	($ltiscope eq 'map') \|\| ($ltiscope eq 'resource') \|\|
	((($args->{'crstype'} eq 'Placement') \|\| (($env{'request.course.id'}) &&
	($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
	(!$env{'request.role.adv'}))) {
$menulink = 0;	$menulink = 0;
} else {	} else {
undef($menulink);	undef($menulink);
Line 8239 sub start_page {	Line 8966 sub start_page {
#if bread_crumbs_component exists show it as headline else show only the breadcrumbs	#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
if(exists($args->{'bread_crumbs_component'})){	if(exists($args->{'bread_crumbs_component'})){
$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);	$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
}else{	} else {
$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);	$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
}	}
} elsif (($env{'environment.remote'} eq 'on') &&
($env{'form.inhibitmenu'} ne 'yes') &&
($env{'request.noversionuri'} =~ m{^/res/}) &&
($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
$result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
}	}
return $result;	return $result;
}	}
Line 8367 sub modal_link {	Line 9089 sub modal_link {
$target_attr = 'target="'.$target.'"';	$target_attr = 'target="'.$target.'"';
}	}
return <<"ENDLINK";	return <<"ENDLINK";
<a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">	<a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
$linktext</a>
ENDLINK	ENDLINK
}	}

Line 8394 sub modal_adhoc_inner {	Line 9115 sub modal_adhoc_inner {
my ($funcname,$width,$height,$content)=@_;	my ($funcname,$width,$height,$content)=@_;
my $innerwidth=$width-20;	my $innerwidth=$width-20;
$content=&js_ready(	$content=&js_ready(
&start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).	&start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
&start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).	&start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
$content.	$content.
&end_scrollbox().	&end_scrollbox().
Line 8471 sub end_togglebox {	Line 9192 sub end_togglebox {
}	}

sub LCprogressbar_script {	sub LCprogressbar_script {
my ($id)=@_;	my ($id,$number_to_do)=@_;
return(<<ENDPROGRESS);	if ($number_to_do) {
	return(<<ENDPROGRESS);
<script type="text/javascript">	<script type="text/javascript">
// <![CDATA[	// <![CDATA[
\$('#progressbar$id').progressbar({	\$('#progressbar$id').progressbar({
Line 8485 sub LCprogressbar_script {	Line 9207 sub LCprogressbar_script {
// ]]>	// ]]>
</script>	</script>
ENDPROGRESS	ENDPROGRESS
	} else {
	return(<<ENDPROGRESS);
	<script type="text/javascript">
	// <![CDATA[
	\$('#progressbar$id').progressbar({
	value: false,
	create: function(event, ui) {
	\$('.ui-widget-header', this).css({'background':'#F0F0F0'});
	\$('.ui-progressbar-overlay', this).css({'margin':'0'});
	}
	});
	// ]]>
	</script>
	ENDPROGRESS
	}
}	}

sub LCprogressbarUpdate_script {	sub LCprogressbarUpdate_script {
return(<<ENDPROGRESSUPDATE);	return(<<ENDPROGRESSUPDATE);
<style type="text/css">	<style type="text/css">
.ui-progressbar { position:relative; }	.ui-progressbar { position:relative; }
	.progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; }
.pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }	.pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
</style>	</style>
<script type="text/javascript">	<script type="text/javascript">
// <![CDATA[	// <![CDATA[
var LCprogressTxt='---';	var LCprogressTxt='---';

function LCupdateProgress(percent,progresstext,id) {	function LCupdateProgress(percent,progresstext,id,maxnum) {
LCprogressTxt=progresstext;	LCprogressTxt=progresstext;
\$('#progressbar'+id).progressbar('value',percent);	if ((maxnum == '') \|\| (maxnum == undefined) \|\| (maxnum == null)) {
	\$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
	} else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
	\$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
	} else {
	\$('#progressbar'+id).progressbar('value',percent);
	}
}	}
// ]]>	// ]]>
</script>	</script>
Line 8511 my $LCidcnt;	Line 9255 my $LCidcnt;
my $LCcurrentid;	my $LCcurrentid;

sub LCprogressbar {	sub LCprogressbar {
my ($r)=(@_);	my ($r,$number_to_do,$preamble)=@_;
$LClastpercent=0;	$LClastpercent=0;
$LCidcnt++;	$LCidcnt++;
$LCcurrentid=$$.'_'.$LCidcnt;	$LCcurrentid=$$.'_'.$LCidcnt;
my $starting=&mt('Starting');	my ($starting,$content);
my $content=(<<ENDPROGBAR);	if ($number_to_do) {
	$starting=&mt('Starting');
	$content=(<<ENDPROGBAR);
	$preamble
<div id="progressbar$LCcurrentid">	<div id="progressbar$LCcurrentid">
<span class="pblabel">$starting</span>	<span class="pblabel">$starting</span>
</div>	</div>
ENDPROGBAR	ENDPROGBAR
&r_print($r,$content.&LCprogressbar_script($LCcurrentid));	} else {
	$starting=&mt('Loading...');
	$LClastpercent='false';
	$content=(<<ENDPROGBAR);
	$preamble
	<div id="progressbar$LCcurrentid">
	<div class="progress-label">$starting</div>
	</div>
	ENDPROGBAR
	}
	&r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
}	}

sub LCprogressbarUpdate {	sub LCprogressbarUpdate {
my ($r,$val,$text)=@_;	my ($r,$val,$text,$number_to_do)=@_;
unless ($val) {	if ($number_to_do) {
if ($LClastpercent) {	unless ($val) {
$val=$LClastpercent;	if ($LClastpercent) {
} else {	$val=$LClastpercent;
$val=0;	} else {
}	$val=0;
	}
	}
	if ($val<0) { $val=0; }
	if ($val>100) { $val=0; }
	$LClastpercent=$val;
	unless ($text) { $text=$val.'%'; }
	} else {
	$val = 'false';
}	}
if ($val<0) { $val=0; }
if ($val>100) { $val=0; }
$LClastpercent=$val;
unless ($text) { $text=$val.'%'; }
$text=&js_ready($text);	$text=&js_ready($text);
&r_print($r,<<ENDUPDATE);	&r_print($r,<<ENDUPDATE);
<script type="text/javascript">	<script type="text/javascript">
// <![CDATA[	// <![CDATA[
LCupdateProgress($val,'$text','$LCcurrentid');	LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
// ]]>	// ]]>
</script>	</script>
ENDUPDATE	ENDUPDATE
Line 8726 function expand_div(caller) {	Line 9487 function expand_div(caller) {

sub simple_error_page {	sub simple_error_page {
my ($r,$title,$msg,$args) = @_;	my ($r,$title,$msg,$args) = @_;
	my %displayargs;
if (ref($args) eq 'HASH') {	if (ref($args) eq 'HASH') {
if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }	if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
	if ($args->{'only_body'}) {
	$displayargs{'only_body'} = 1;
	}
	if ($args->{'no_nav_bar'}) {
	$displayargs{'no_nav_bar'} = 1;
	}
} else {	} else {
$msg = &mt($msg);	$msg = &mt($msg);
}	}

my $page =	my $page =
&Apache::loncommon::start_page($title).	&Apache::loncommon::start_page($title,'',\%displayargs).
'<p class="LC_error">'.$msg.'</p>'.	'<p class="LC_error">'.$msg.'</p>'.
&Apache::loncommon::end_page();	&Apache::loncommon::end_page();
if (ref($r)) {	if (ref($r)) {
Line 9039 sub get_sections {	Line 9807 sub get_sections {
}	}
}	}

if ($check_students) {	if ($check_students) {
my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
my $sec_index = &Apache::loncoursedata::CL_SECTION();	my $sec_index = &Apache::loncoursedata::CL_SECTION();
my $status_index = &Apache::loncoursedata::CL_STATUS();	my $status_index = &Apache::loncoursedata::CL_STATUS();
Line 9361 Incoming parameters:	Line 10129 Incoming parameters:
2. user's domain	2. user's domain
3. quota name - portfolio, author, or course	3. quota name - portfolio, author, or course
(if no quota name provided, defaults to portfolio).	(if no quota name provided, defaults to portfolio).
4. crstype - official, unofficial, textbook or community, if quota name is	4. crstype - official, unofficial, textbook, placement or community,
course	if quota name is course

Returns:	Returns:
1. Disk quota (in MB) assigned to student.	1. Disk quota (in MB) assigned to student.
Line 9435 sub get_user_quota {	Line 10203 sub get_user_quota {
if ($quota eq '' \|\| wantarray) {	if ($quota eq '' \|\| wantarray) {
if ($quotaname eq 'course') {	if ($quotaname eq 'course') {
my %domdefs = &Apache::lonnet::get_domain_defaults($udom);	my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
if (($crstype eq 'official') \|\| ($crstype eq 'unofficial') \|\|	if (($crstype eq 'official') \|\| ($crstype eq 'unofficial') \|\|
($crstype eq 'community') \|\| ($crstype eq 'textbook')) {	($crstype eq 'community') \|\| ($crstype eq 'textbook') \|\|
	($crstype eq 'placement')) {
$defquota = $domdefs{$crstype.'quota'};	$defquota = $domdefs{$crstype.'quota'};
}	}
if ($defquota eq '') {	if ($defquota eq '') {
Line 9584 Inputs: 7	Line 10353 Inputs: 7
4. filename of file for which action is being requested	4. filename of file for which action is being requested
5. filesize (kB) of file	5. filesize (kB) of file
6. action being taken: copy or upload.	6. action being taken: copy or upload.
7. quotatype (in course context -- official, unofficial, community or textbook).	7. quotatype (in course context -- official, unofficial, textbook, placement or community).

Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,	Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
otherwise return null.	otherwise return null.
Line 9620 sub excess_filesize_warning {	Line 10389 sub excess_filesize_warning {
###############################################	###############################################




sub get_secgrprole_info {	sub get_secgrprole_info {
my ($cdom,$cnum,$needroles,$type) = @_;	my ($cdom,$cnum,$needroles,$type) = @_;
my %sections_count = &get_sections($cdom,$cnum);	my %sections_count = &get_sections($cdom,$cnum);
Line 9728 sub user_picker {	Line 10499 sub user_picker {
$allow_blank = 0;	$allow_blank = 0;
$domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);	$domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
} else {	} else {
$domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);	my $defdom = $env{'request.role.domain'};
	my ($trusted,$untrusted);
	if (($context eq 'requestcrs') \|\| ($context eq 'course')) {
	($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
	} elsif ($context eq 'author') {
	($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
	} elsif ($context eq 'domain') {
	($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
	}
	$domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
}	}
my $srchinsel = ' <select name="srchin">';	my $srchinsel = ' <select name="srchin">';

Line 9933 sub user_rule_check {	Line 10713 sub user_rule_check {
if (ref($usershash) eq 'HASH') {	if (ref($usershash) eq 'HASH') {
if (keys(%{$usershash}) > 1) {	if (keys(%{$usershash}) > 1) {
my (%by_username,%by_id,%userdoms);	my (%by_username,%by_id,%userdoms);
my $checkid;	my $checkid;
if (ref($checks) eq 'HASH') {	if (ref($checks) eq 'HASH') {
if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {	if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
$checkid = 1;	$checkid = 1;
Line 9944 sub user_rule_check {	Line 10724 sub user_rule_check {
if ($checkid) {	if ($checkid) {
if (ref($usershash->{$user}) eq 'HASH') {	if (ref($usershash->{$user}) eq 'HASH') {
if ($usershash->{$user}->{'id'} ne '') {	if ($usershash->{$user}->{'id'} ne '') {
$by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;	$by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
$userdoms{$udom} = 1;	$userdoms{$udom} = 1;
if (ref($inst_results) eq 'HASH') {	if (ref($inst_results) eq 'HASH') {
$inst_results->{$uname.':'.$udom} = {};	$inst_results->{$uname.':'.$udom} = {};
Line 10014 sub user_rule_check {	Line 10794 sub user_rule_check {
if (ref($usershash->{$user}) eq 'HASH') {	if (ref($usershash->{$user}) eq 'HASH') {
if (ref($checks) eq 'HASH') {	if (ref($checks) eq 'HASH') {
if (defined($checks->{'username'})) {	if (defined($checks->{'username'})) {
($inst_response{$user},%{$inst_results->{$user}}) =	($inst_response{$user},%{$inst_results->{$user}}) =
&Apache::lonnet::get_instuser($udom,$uname);	&Apache::lonnet::get_instuser($udom,$uname);
} elsif (defined($checks->{'id'})) {	} elsif (defined($checks->{'id'})) {
if ($usershash->{$user}->{'id'} ne '') {	if ($usershash->{$user}->{'id'} ne '') {
Line 10037 sub user_rule_check {	Line 10817 sub user_rule_check {
if (ref($domconfig{'usercreation'}) eq 'HASH') {	if (ref($domconfig{'usercreation'}) eq 'HASH') {
foreach my $item ('username','id') {	foreach my $item ('username','id') {
if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {	if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
$$curr_rules{$udom}{$item} =	$$curr_rules{$udom}{$item} =
$domconfig{'usercreation'}{$item.'_rule'};	$domconfig{'usercreation'}{$item.'_rule'};
}	}
}	}
Line 10060 sub user_rule_check {	Line 10840 sub user_rule_check {
$id = $inst_results->{$user}->{'id'};	$id = $inst_results->{$user}->{'id'};
}	}
}	}
if ($id eq '') {	if ($id eq '') {
if (ref($usershash->{$user})) {	if (ref($usershash->{$user})) {
$id = $usershash->{$user}->{'id'};	$id = $usershash->{$user}->{'id'};
}	}
Line 10362 future_reservable - ref to hash of stude	Line 11142 future_reservable - ref to hash of stude

Keys in inner hash are:	Keys in inner hash are:
(a) symb: either blank or symb to which slot use is restricted.	(a) symb: either blank or symb to which slot use is restricted.
(b) startreserve: start date of reservation period.	(b) startreserve: start date of reservation period.
(c) uniqueperiod: start,end dates when slot is to be uniquely	(c) uniqueperiod: start,end dates when slot is to be uniquely
selected.	selected.

Line 10372 future_reservable - ref to hash of stude	Line 11152 future_reservable - ref to hash of stude

sub get_future_slots {	sub get_future_slots {
my ($cnum,$cdom,$now,$symb) = @_;	my ($cnum,$cdom,$now,$symb) = @_;
	my $map;
	if ($symb) {
	($map) = &Apache::lonnet::decode_symb($symb);
	}
my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);	my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);	my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
foreach my $slot (keys(%slots)) {	foreach my $slot (keys(%slots)) {
next unless($slots{$slot}->{'type'} eq 'schedulable_student');	next unless($slots{$slot}->{'type'} eq 'schedulable_student');
if ($symb) {	if ($symb) {
next if (($slots{$slot}->{'symb'} ne '') &&	if ($slots{$slot}->{'symb'} ne '') {
($slots{$slot}->{'symb'} ne $symb));	my $canuse;
	my %oksymbs;
	my @slotsymbs = split(/\s,\s/,$slots{$slot}->{'symb'});
	map { $oksymbs{$_} = 1; } @slotsymbs;
	if ($oksymbs{$symb}) {
	$canuse = 1;
	} else {
	foreach my $item (@slotsymbs) {
	if ($item =~ /\.(page\|sequence)$/) {
	(undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
	if (($map ne '') && ($map eq $sloturl)) {
	$canuse = 1;
	last;
	}
	}
	}
	}
	next unless ($canuse);
	}
}	}
if (($slots{$slot}->{'starttime'} > $now) &&	if (($slots{$slot}->{'starttime'} > $now) &&
($slots{$slot}->{'endtime'} > $now)) {	($slots{$slot}->{'endtime'} > $now)) {
Line 10431 sub get_future_slots {	Line 11233 sub get_future_slots {
$reservable_now{$slot} = {	$reservable_now{$slot} = {
symb => $symb,	symb => $symb,
endreserve => $lastres,	endreserve => $lastres,
uniqueperiod => $uniqueperiod,	uniqueperiod => $uniqueperiod,
};	};
} elsif (($startreserve > $now) &&	} elsif (($startreserve > $now) &&
(!$endreserve \|\| $endreserve > $startreserve)) {	(!$endreserve \|\| $endreserve > $startreserve)) {
Line 10596 sub get_env_multiple {	Line 11398 sub get_env_multiple {
return(@values);	return(@values);
}	}

	# Looks at given dependencies, and returns something depending on the context.
	# For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
	# For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
	# For all other contexts, returns ($output, $counter, $numpathchg).
	# $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
	# $counter: integer with the number of existing dependencies when no HTML output is returned, and the number of missing dependencies when an HTML output is returned.
	# $numpathchg: integer with the number of cleaned up dependency paths.
	# \%existing: hash reference clean path -> 1 only for existing dependencies.
	# \%mapping: hash reference clean path -> original path for all dependencies.
	# @param {string} actionurl - The path to the handler, indicative of the context.
	# @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
	# @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
	# @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
	# @param {hash reference} args - More parameters ! Possible keys: error_on_invalid_names (boolean), ignore_remote_references (boolean), current_path (string), docs_url (string), docs_title (string), context (string)
	# @return {Array} - array depending on the context (not a reference)
sub ask_for_embedded_content {	sub ask_for_embedded_content {
	# NOTE: documentation was added afterwards, it could be wrong
my ($actionurl,$state,$allfiles,$codebase,$args)=@_;	my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,	my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
%currsubfile,%unused,$rem);	%currsubfile,%unused,$rem);
Line 10612 sub ask_for_embedded_content {	Line 11430 sub ask_for_embedded_content {
my $heading = &mt('Upload embedded files');	my $heading = &mt('Upload embedded files');
my $buttontext = &mt('Upload');	my $buttontext = &mt('Upload');

	# fills these variables based on the context:
	# $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
	# $path, $fileloc, $title, $rem, $filename
if ($env{'request.course.id'}) {	if ($env{'request.course.id'}) {
if ($actionurl eq '/adm/dependencies') {	if ($actionurl eq '/adm/dependencies') {
$navmap = Apache::lonnavmaps::navmap->new();	$navmap = Apache::lonnavmaps::navmap->new();
Line 10619 sub ask_for_embedded_content {	Line 11440 sub ask_for_embedded_content {
$cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};	$cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
$cnum = $env{'course.'.$env{'request.course.id'}.'.num'};	$cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
}	}
if (($actionurl eq '/adm/portfolio') \|\|	if (($actionurl eq '/adm/portfolio') \|\|
($actionurl eq '/adm/coursegrp_portfolio')) {	($actionurl eq '/adm/coursegrp_portfolio')) {
my $current_path='/';	my $current_path='/';
if ($env{'form.currentpath'}) {	if ($env{'form.currentpath'}) {
Line 10651 sub ask_for_embedded_content {	Line 11472 sub ask_for_embedded_content {
$toplevel = $url;	$toplevel = $url;
if ($args->{'context'} eq 'paste') {	if ($args->{'context'} eq 'paste') {
($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});	($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
($path) =	($path) =
($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs\|supplemental)/(?:default\|\d+)/\d+)/});	($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs\|supplemental)/(?:default\|\d+)/\d+)/});
$fileloc = &Apache::lonnet::filelocation('',$toplevel);	$fileloc = &Apache::lonnet::filelocation('',$toplevel);
$fileloc =~ s{^/}{};	$fileloc =~ s{^/}{};
}	}
}	}
} elsif ($actionurl eq '/adm/dependencies') {	} elsif ($actionurl eq '/adm/dependencies') {
if ($env{'request.course.id'} ne '') {	if ($env{'request.course.id'} ne '') {
if (ref($args) eq 'HASH') {	if (ref($args) eq 'HASH') {
$url = $args->{'docs_url'};	$url = $args->{'docs_url'};
$title = $args->{'docs_title'};	$title = $args->{'docs_title'};
$toplevel = $url;	$toplevel = $url;
unless ($toplevel =~ m{^/}) {	unless ($toplevel =~ m{^/}) {
$toplevel = "/$url";	$toplevel = "/$url";
}	}
Line 10696 sub ask_for_embedded_content {	Line 11517 sub ask_for_embedded_content {
$fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';	$fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
$fileloc =~ s{^/}{};	$fileloc =~ s{^/}{};
}	}

	# parses the dependency paths to get some info
	# fills $newfiles, $mapping, $subdependencies, $dependencies
	# $newfiles: hash URL -> 1 for new files or external URLs
	# (will be completed later)
	# $mapping:
	# for external URLs: external URL -> external URL
	# for relative paths: clean path -> original path
	# $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
	# $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
foreach my $file (keys(%{$allfiles})) {	foreach my $file (keys(%{$allfiles})) {
my $embed_file;	my $embed_file;
if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {	if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
Line 10738 sub ask_for_embedded_content {	Line 11569 sub ask_for_embedded_content {
}	}
}	}
}	}

	# looks for all existing files in dependency subdirectories (from $subdependencies filled above)
	# and lists
	# fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
	# $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
	# $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
	# the path had to be cleaned up
	# $existing: hash clean path -> 1 if the file exists
	# $numexisting: number of keys in $existing
	# $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
	# $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
	# dependency subdirectories that are
	# not listed as dependencies, with some exceptions using $rem
my $dirptr = 16384;	my $dirptr = 16384;
foreach my $path (keys(%subdependencies)) {	foreach my $path (keys(%subdependencies)) {
$currsubfile{$path} = {};	$currsubfile{$path} = {};
if (($actionurl eq '/adm/portfolio') \|\|	if (($actionurl eq '/adm/portfolio') \|\|
($actionurl eq '/adm/coursegrp_portfolio')) {	($actionurl eq '/adm/coursegrp_portfolio')) {
my ($sublistref,$listerror) =	my ($sublistref,$listerror) =
&Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);	&Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
if (ref($sublistref) eq 'ARRAY') {	if (ref($sublistref) eq 'ARRAY') {
Line 10813 sub ask_for_embedded_content {	Line 11657 sub ask_for_embedded_content {
}	}
}	}
}	}

	# fills $currfile, hash file name -> 1 or [$size,$mtime]
	# for files in $url or $fileloc (target directory) in some contexts
my %currfile;	my %currfile;
if (($actionurl eq '/adm/portfolio') \|\|	if (($actionurl eq '/adm/portfolio') \|\|
($actionurl eq '/adm/coursegrp_portfolio')) {	($actionurl eq '/adm/coursegrp_portfolio')) {
Line 10851 sub ask_for_embedded_content {	Line 11698 sub ask_for_embedded_content {
}	}
}	}
}	}
	# updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
	# are not in subdirectories, using $currfile
foreach my $file (keys(%dependencies)) {	foreach my $file (keys(%dependencies)) {
if (exists($currfile{$file})) {	if (exists($currfile{$file})) {
unless ($mapping{$file} eq $file) {	unless ($mapping{$file} eq $file) {
Line 10879 sub ask_for_embedded_content {	Line 11728 sub ask_for_embedded_content {
$unused{$file} = 1;	$unused{$file} = 1;
}	}
}	}

	# returns some results for coursedocs paste and syllabus rewrites ($output is undef)
if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&	if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
($args->{'context'} eq 'paste')) {	($args->{'context'} eq 'paste')) {
$counter = scalar(keys(%existing));	$counter = scalar(keys(%existing));
$numpathchg = scalar(keys(%pathchanges));	$numpathchg = scalar(keys(%pathchanges));
return ($output,$counter,$numpathchg,\%existing);	return ($output,$counter,$numpathchg,\%existing);
} elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&	} elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
(ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {	(ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
$counter = scalar(keys(%existing));	$counter = scalar(keys(%existing));
$numpathchg = scalar(keys(%pathchanges));	$numpathchg = scalar(keys(%pathchanges));
return ($output,$counter,$numpathchg,\%existing,\%mapping);	return ($output,$counter,$numpathchg,\%existing,\%mapping);
}	}

	# returns HTML otherwise, with dependency results and to ask for more uploads

	# $upload_output: missing dependencies (with upload form)
	# $modify_output: uploaded dependencies (in use)
	# $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {	foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
if ($actionurl eq '/adm/dependencies') {	if ($actionurl eq '/adm/dependencies') {
next if ($embed_file =~ m{^\w+://});	next if ($embed_file =~ m{^\w+://});
Line 11113 sub ask_for_embedded_content {	Line 11970 sub ask_for_embedded_content {

Performs clean-up of directories, subdirectories and filename in an	Performs clean-up of directories, subdirectories and filename in an
embedded object, referenced in an HTML file which is being uploaded	embedded object, referenced in an HTML file which is being uploaded
to a course or portfolio, where	to a course or portfolio, where
"Upload embedded images/multimedia files if HTML file" checkbox was	"Upload embedded images/multimedia files if HTML file" checkbox was
checked.	checked.

Line 11132 sub clean_path {	Line 11989 sub clean_path {
@contents = ($embed_file);	@contents = ($embed_file);
}	}
my $lastidx = scalar(@contents)-1;	my $lastidx = scalar(@contents)-1;
for (my $i=0; $i<=$lastidx; $i++) {	for (my $i=0; $i<=$lastidx; $i++) {
$contents[$i]=~s{\\}{/}g;	$contents[$i]=~s{\\}{/}g;
$contents[$i]=~s/\s+/\_/g;	$contents[$i]=~s/\s+/\_/g;
$contents[$i]=~s{[^/\w\.\-]}{}g;	$contents[$i]=~s{[^/\w\.\-]}{}g;
Line 11471 sub modify_html_refs {	Line 12328 sub modify_html_refs {
}	}
my (%allfiles,%codebase,$output,$content);	my (%allfiles,%codebase,$output,$content);
my @changes = &get_env_multiple('form.namechange');	my @changes = &get_env_multiple('form.namechange');
unless ((@changes > 0) \|\| ($context eq 'syllabus')) {	unless ((@changes > 0) \|\| ($context eq 'syllabus')) {
if (wantarray) {	if (wantarray) {
return ('',0,0);	return ('',0,0);
} else {	} else {
Line 11503 sub modify_html_refs {	Line 12360 sub modify_html_refs {
return;	return;
}	}
}	}
if (open(my $fh,"<$container")) {	if (open(my $fh,'<',$container)) {
$content = join('', <$fh>);	$content = join('', <$fh>);
close($fh);	close($fh);
} else {	} else {
Line 11568 sub modify_html_refs {	Line 12425 sub modify_html_refs {
}	}
}	}
} else {	} else {
if (open(my $fh,">$container")) {	if (open(my $fh,'>',$container)) {
print $fh $content;	print $fh $content;
close($fh);	close($fh);
$output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',	$output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
Line 11606 sub modify_html_refs {	Line 12463 sub modify_html_refs {
}	}
}	}
if ($rewrites) {	if ($rewrites) {
my $saveresult;	my $saveresult;
my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);	my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
if ($url eq $container) {	if ($url eq $container) {
my ($fname) = ($container =~ m{/([^/]+)$});	my ($fname) = ($container =~ m{/([^/]+)$});
Line 12132 sub process_decompression {	Line 12989 sub process_decompression {
}	}
my $numskip = scalar(@to_skip);	my $numskip = scalar(@to_skip);
my $numoverwrite = scalar(@to_overwrite);	my $numoverwrite = scalar(@to_overwrite);
if (($numskip) && (!$numoverwrite)) {	if (($numskip) && (!$numoverwrite)) {
$warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');	$warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
} elsif ($dir eq '') {	} elsif ($dir eq '') {
$error = &mt('Directory containing archive file unavailable.');	$error = &mt('Directory containing archive file unavailable.');
Line 12142 sub process_decompression {	Line 12999 sub process_decompression {
my $tempdir = time.'_'.$$.int(rand(10000));	my $tempdir = time.'_'.$$.int(rand(10000));
mkdir("$dir/$tempdir",0755);	mkdir("$dir/$tempdir",0755);
if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {	if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
($decompressed,$display) =	($decompressed,$display) =
&decompress_uploaded_file($file,"$dir/$tempdir");	&decompress_uploaded_file($file,"$dir/$tempdir");
foreach my $item (@to_skip) {	foreach my $item (@to_skip) {
if (($item ne '') && ($item !~ /\.\./)) {	if (($item ne '') && ($item !~ /\.\./)) {
if (-f "$dir/$tempdir/$item") {	if (-f "$dir/$tempdir/$item") {
unlink("$dir/$tempdir/$item");	unlink("$dir/$tempdir/$item");
} elsif (-d "$dir/$tempdir/$item") {	} elsif (-d "$dir/$tempdir/$item") {
&File::Path::Tiny::rm("$dir/$tempdir/$item");	&File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
}	}
}	}
}	}
Line 12159 sub process_decompression {	Line 13016 sub process_decompression {
if (-f "$dir/$item") {	if (-f "$dir/$item") {
unlink("$dir/$item");	unlink("$dir/$item");
} elsif (-d "$dir/$item") {	} elsif (-d "$dir/$item") {
&File::Path::Tiny::rm("$dir/$item");	&File::Path::remove_tree("$dir/$item",{ safe => 1 });
}	}
&File::Copy::move("$dir/$tempdir/$item","$dir/$item");	&File::Copy::move("$dir/$tempdir/$item","$dir/$item");
}	}
}	}
}	}
if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {	if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
&File::Path::Tiny::rm("$dir/$tempdir");	&File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
}	}
}	}
} else {	} else {
Line 12186 sub process_decompression {	Line 13043 sub process_decompression {
if (ref($newdirlistref) eq 'ARRAY') {	if (ref($newdirlistref) eq 'ARRAY') {
foreach my $dir_line (@{$newdirlistref}) {	foreach my $dir_line (@{$newdirlistref}) {
my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);	my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
unless (($item =~ /^\.+$/) \|\| ($item eq $file) \|\|	unless (($item =~ /^\.+$/) \|\| ($item eq $file)) {
((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
push(@newitems,$item);	push(@newitems,$item);
if ($dirptr&$testdir) {	if ($dirptr&$testdir) {
$is_dir{$item} = 1;	$is_dir{$item} = 1;
Line 12242 sub process_decompression {	Line 13098 sub process_decompression {
$env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};	$env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
$displayed{'folder'} = $i;	$displayed{'folder'} = $i;
} elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) \|\|	} elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) \|\|
(($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {	(($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
$env{'form.archive_'.$i} = 'display';	$env{'form.archive_'.$i} = 'display';
$env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};	$env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
$displayed{'web'} = $i;	$displayed{'web'} = $i;
Line 12694 sub process_extracted_files {	Line 13550 sub process_extracted_files {
$folders{'0'} = $items[-2];	$folders{'0'} = $items[-2];
if ($env{'form.folderpath'} =~ /\:1$/) {	if ($env{'form.folderpath'} =~ /\:1$/) {
$containers{'0'}='page';	$containers{'0'}='page';
} else {	} else {
$containers{'0'}='sequence';	$containers{'0'}='sequence';
}	}
}	}
Line 12811 sub process_extracted_files {	Line 13667 sub process_extracted_files {
'.'.$containers{$outer},1,1);	'.'.$containers{$outer},1,1);
unless ($errtext) {	unless ($errtext) {
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {	if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
$result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";	$result .= '<li>'.&mt('File: [_1] added to course',
	&HTML::Entities::encode($docstitle,'<>&"')).
	'</li>'."\n";
}	}
}	}
} else {	} else {
Line 12823 sub process_extracted_files {	Line 13681 sub process_extracted_files {
}	}
} else {	} else {
$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',	$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
&HTML::Entities::encode($path,'<>&"')).'<br />';	&HTML::Entities::encode($path,'<>&"')).'<br />';
}	}
}	}
for (my $i=1; $i<=$numitems; $i++) {	for (my $i=1; $i<=$numitems; $i++) {
Line 12845 sub process_extracted_files {	Line 13703 sub process_extracted_files {
}	}
if ($itemidx eq '') {	if ($itemidx eq '') {
$itemidx = 0;	$itemidx = 0;
}	}
if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {	if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
if ($mapinner{$referrer{$i}}) {	if ($mapinner{$referrer{$i}}) {
$fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";	$fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
Line 12884 sub process_extracted_files {	Line 13742 sub process_extracted_files {
}	}
if ($fullpath ne '') {	if ($fullpath ne '') {
if (-e "$prefix$path") {	if (-e "$prefix$path") {
system("mv $prefix$path $fullpath/$title");	unless (rename("$prefix$path","$fullpath/$title")) {
	$warning .= &mt('Failed to rename dependency').'<br />';
	}
}	}
if (-e "$fullpath/$title") {	if (-e "$fullpath/$title") {
my $showpath;	my $showpath;
Line 12892 sub process_extracted_files {	Line 13752 sub process_extracted_files {
$showpath = "$relpath/$title";	$showpath = "$relpath/$title";
} else {	} else {
$showpath = "/$title";	$showpath = "/$title";
}	}
$result .= '<li>'.&mt('[_1] included as a dependency',	$result .= '<li>'.&mt('[_1] included as a dependency',
&HTML::Entities::encode($showpath,'<>&"')).	&HTML::Entities::encode($showpath,'<>&"')).
'</li>'."\n";	'</li>'."\n";
}	unless ($ishome) {
unless ($ishome) {	my $fetch = "$fullpath/$title";
my $fetch = "$fullpath/$title";	$fetch =~ s/^\Q$prefix$dir\E//;
$fetch =~ s/^\Q$prefix$dir\E//;	$prompttofetch{$fetch} = 1;
$prompttofetch{$fetch} = 1;	}
}	}
}	}
}	}
Line 13186 sub upfile_store {	Line 14046 sub upfile_store {
$env{'form.upfile'}=~s/\n+/\n/gs;	$env{'form.upfile'}=~s/\n+/\n/gs;
$env{'form.upfile'}=~s/\n+$//gs;	$env{'form.upfile'}=~s/\n+$//gs;

my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.	my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;	'_enroll_'.$env{'request.course.id'}.'_'.
	time.'_'.$$);
	return if ($datatoken eq '');

{	{
my $datafile = $r->dir_config('lonDaemons').	my $datafile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp';	'/tmp/'.$datatoken.'.tmp';
if ( open(my $fh,">$datafile") ) {	if ( open(my $fh,'>',$datafile) ) {
print $fh $env{'form.upfile'};	print $fh $env{'form.upfile'};
close($fh);	close($fh);
}	}
Line 13216 sub load_tmp_file {	Line 14079 sub load_tmp_file {
{	{
my $studentfile = $r->dir_config('lonDaemons').	my $studentfile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp';	'/tmp/'.$datatoken.'.tmp';
if ( open(my $fh,"<$studentfile") ) {	if ( open(my $fh,'<',$studentfile) ) {
@studentdata=<$fh>;	@studentdata=<$fh>;
close($fh);	close($fh);
}	}
Line 13226 sub load_tmp_file {	Line 14089 sub load_tmp_file {

sub valid_datatoken {	sub valid_datatoken {
my ($datatoken) = @_;	my ($datatoken) = @_;
if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) {	if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(\|$match_domain\_$match_courseid)\_\d+_\d+$/) {
return $datatoken;	return $datatoken;
}	}
return;	return;
Line 14111 generated by lonerrorhandler.pm, CHECKRP	Line 14974 generated by lonerrorhandler.pm, CHECKRP
lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.	lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.

Inputs:	Inputs:
defmail (scalar - email address of default recipient),	defmail (scalar - email address of default recipient),
mailing type (scalar: errormail, packagesmail, helpdeskmail,	mailing type (scalar: errormail, packagesmail, helpdeskmail,
requestsmail, updatesmail, or idconflictsmail).	requestsmail, updatesmail, or idconflictsmail).

defdom (domain for which to retrieve configuration settings),	defdom (domain for which to retrieve configuration settings),

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

$requname username of requester (if mailing type is helpdeskmail)	$requname username of requester (if mailing type is helpdeskmail)
Line 14268 sub build_recipient_list {	Line 15131 sub build_recipient_list {
} elsif ($origmail ne '') {	} elsif ($origmail ne '') {
$lastresort = $origmail;	$lastresort = $origmail;
}	}

if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {	if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {	unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};	my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
Line 14371 sub build_recipient_list {	Line 15233 sub build_recipient_list {

=pod	=pod

	=over 4

	=item * &mime_email()

	Sends an email with a possible attachment

	Inputs:

	=over 4

	from - Sender's email address

	replyto - Reply-To email address

	to - Email address of recipient

	subject - Subject of email

	body - Body of email

	cc_string - Carbon copy email address

	bcc - Blind carbon copy email address

	attachment_path - Path of file to be attached

	file_name - Name of file to be attached

	attachment_text - The body of an attachment of type "TEXT"

	=back

	=back

	=cut

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

	sub mime_email {
	my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path,
	$file_name,$attachment_text) = @_;

	my $msg = MIME::Lite->new(
	From => $from,
	To => $to,
	Subject => $subject,
	Type =>'TEXT',
	Data => $body,
	);
	if ($replyto ne '') {
	$msg->add("Reply-To" => $replyto);
	}
	if ($cc_string ne '') {
	$msg->add("Cc" => $cc_string);
	}
	if ($bcc ne '') {
	$msg->add("Bcc" => $bcc);
	}
	$msg->attr("content-type" => "text/plain");
	$msg->attr("content-type.charset" => "UTF-8");
	# Attach file if given
	if ($attachment_path) {
	unless ($file_name) {
	if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
	}
	my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
	$msg->attach(Type => $type,
	Path => $attachment_path,
	Filename => $file_name
	);
	# Otherwise attach text if given
	} elsif ($attachment_text) {
	$msg->attach(Type => 'TEXT',
	Data => $attachment_text);
	}
	# Send it
	$msg->send('sendmail');
	}

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

	=pod

=head1 Course Catalog Routines	=head1 Course Catalog Routines

=over 4	=over 4
Line 14454 jsarray (reference to array of categorie	Line 15401 jsarray (reference to array of categorie
subcats (reference to hash of arrays containing all subcategories within each	subcats (reference to hash of arrays containing all subcategories within each
category, -recursive)	category, -recursive)

	maxd (reference to hash used to hold max depth for all top-level categories).

Returns: nothing	Returns: nothing

Side effects: populates trails and allitems hash references.	Side effects: populates trails and allitems hash references.
Line 14461 Side effects: populates trails and allit	Line 15410 Side effects: populates trails and allit
=cut	=cut

sub extract_categories {	sub extract_categories {
my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;	my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
if (ref($categories) eq 'HASH') {	if (ref($categories) eq 'HASH') {
&gather_categories($categories,$cats,$idx,$jsarray);	&gather_categories($categories,$cats,$idx,$jsarray);
if (ref($cats->[0]) eq 'ARRAY') {	if (ref($cats->[0]) eq 'ARRAY') {
Line 14473 sub extract_categories {	Line 15422 sub extract_categories {
$trailstr = &mt('Official courses (with institutional codes)');	$trailstr = &mt('Official courses (with institutional codes)');
} elsif ($name eq 'communities') {	} elsif ($name eq 'communities') {
$trailstr = &mt('Communities');	$trailstr = &mt('Communities');
	} elsif ($name eq 'placement') {
	$trailstr = &mt('Placement Tests');
} else {	} else {
$trailstr = $name;	$trailstr = $name;
}	}
Line 14487 sub extract_categories {	Line 15438 sub extract_categories {
if (ref($subcats) eq 'HASH') {	if (ref($subcats) eq 'HASH') {
push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');	push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
}	}
&recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);	&recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
}	}
} else {	} else {
if (ref($subcats) eq 'HASH') {	if (ref($subcats) eq 'HASH') {
$subcats->{$item} = [];	$subcats->{$item} = [];
}	}
	if (ref($maxd) eq 'HASH') {
	$maxd->{$name} = 1;
	}
}	}
}	}
}	}
Line 14530 Side effects: populates trails and allit	Line 15484 Side effects: populates trails and allit
=cut	=cut

sub recurse_categories {	sub recurse_categories {
my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;	my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
my $shallower = $depth - 1;	my $shallower = $depth - 1;
if (ref($cats->[$depth]{$category}) eq 'ARRAY') {	if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {	for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
my $name = $cats->[$depth]{$category}[$k];	my $name = $cats->[$depth]{$category}[$k];
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;	my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
my $trailstr = join(' -> ',(@{$parents},$category));	my $trailstr = join(' » ',(@{$parents},$category));
if ($allitems->{$item} eq '') {	if ($allitems->{$item} eq '') {
push(@{$trails},$trailstr);	push(@{$trails},$trailstr);
$allitems->{$item} = scalar(@{$trails})-1;	$allitems->{$item} = scalar(@{$trails})-1;
Line 14557 sub recurse_categories {	Line 15511 sub recurse_categories {
}	}
}	}
&recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,	&recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
$subcats);	$subcats,$maxd);
pop(@{$parents});	pop(@{$parents});
}	}
} else {	} else {
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;	my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
my $trailstr = join(' -> ',(@{$parents},$category));	my $trailstr = join(' » ',(@{$parents},$category));
if ($allitems->{$item} eq '') {	if ($allitems->{$item} eq '') {
push(@{$trails},$trailstr);	push(@{$trails},$trailstr);
$allitems->{$item} = scalar(@{$trails})-1;	$allitems->{$item} = scalar(@{$trails})-1;
}	}
	if (ref($maxd) eq 'HASH') {
	if ($depth > $maxd->{$parents->[0]}) {
	$maxd->{$parents->[0]} = $depth;
	}
	}
}	}
return;	return;
}	}
Line 14598 sub assign_categories_table {	Line 15557 sub assign_categories_table {
my ($cathash,$currcat,$type,$disabled) = @_;	my ($cathash,$currcat,$type,$disabled) = @_;
my $output;	my $output;
if (ref($cathash) eq 'HASH') {	if (ref($cathash) eq 'HASH') {
my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);	my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
&extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);	&extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
$maxdepth = scalar(@cats);	$maxdepth = scalar(@cats);
if (@cats > 0) {	if (@cats > 0) {
my $itemcount = 0;	my $itemcount = 0;
Line 14614 sub assign_categories_table {	Line 15573 sub assign_categories_table {
next if ($parent eq 'instcode');	next if ($parent eq 'instcode');
if ($type eq 'Community') {	if ($type eq 'Community') {
next unless ($parent eq 'communities');	next unless ($parent eq 'communities');
	} elsif ($type eq 'Placement') {
	next unless ($parent eq 'placement');
} else {	} else {
next if ($parent eq 'communities');	next if (($parent eq 'communities') \|\| ($parent eq 'placement'));
}	}
my $css_class = $itemcount%2?' class="LC_odd_row"':'';	my $css_class = $itemcount%2?' class="LC_odd_row"':'';
my $item = &escape($parent).'::0';	my $item = &escape($parent).'::0';
Line 14628 sub assign_categories_table {	Line 15589 sub assign_categories_table {
my $parent_title = $parent;	my $parent_title = $parent;
if ($parent eq 'communities') {	if ($parent eq 'communities') {
$parent_title = &mt('Communities');	$parent_title = &mt('Communities');
	} elsif ($parent eq 'placement') {
	$parent_title = &mt('Placement Tests');
}	}
$table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.	$table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
'<input type="checkbox" name="usecategory" value="'.	'<input type="checkbox" name="usecategory" value="'.
Line 14858 sub commit_studentrole {	Line 15821 sub commit_studentrole {
}	}
}	}
} else {	} else {
if ($secchange) {	if ($secchange) {
$$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;	$$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;
} else {	} else {
$$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;	$$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
Line 14921 sub check_clone {	Line 15884 sub check_clone {
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};	my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);	my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);	my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
my $clonemsg;	my $clonetitle;
	my @clonemsg;
my $can_clone = 0;	my $can_clone = 0;
my $lctype = lc($args->{'crstype'});	my $lctype = lc($args->{'crstype'});
if ($lctype ne 'community') {	if ($lctype ne 'community') {
Line 14929 sub check_clone {	Line 15893 sub check_clone {
}	}
if ($clonehome eq 'no_host') {	if ($clonehome eq 'no_host') {
if ($args->{'crstype'} eq 'Community') {	if ($args->{'crstype'} eq 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});	push(@clonemsg,({
	mt => 'No new community created.',
	args => [],
	},
	{
	mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
	args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
	}));
} else {	} else {
$clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});	push(@clonemsg,({
}	mt => 'No new course created.',
	args => [],
	},
	{
	mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
	args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
	}));
	}
} else {	} else {
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
	$clonetitle = $clonedesc{'description'};
if ($args->{'crstype'} eq 'Community') {	if ($args->{'crstype'} eq 'Community') {
if ($clonedesc{'type'} ne 'Community') {	if ($clonedesc{'type'} ne 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});	push(@clonemsg,({
return ($can_clone, $clonemsg, $cloneid, $clonehome);	mt => 'No new community created.',
	args => [],
	},
	{
	mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
	args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
	}));
	return ($can_clone,\@clonemsg,$cloneid,$clonehome);
}	}
}	}
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
Line 14955 sub check_clone {	Line 15941 sub check_clone {
if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {	if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
$can_clone = 1;	$can_clone = 1;
}	}
} elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&	} elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
($args->{'clonedomain'} eq $args->{'course_domain'})) {	($args->{'clonedomain'} eq $args->{'course_domain'})) {
if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},	if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
$clonehash{'internal.coursecode'},$args->{'crscode'})) {	$clonehash{'internal.coursecode'},$args->{'crscode'})) {
Line 14974 sub check_clone {	Line 15960 sub check_clone {
$can_clone = 1;	$can_clone = 1;
}	}
unless ($can_clone) {	unless ($can_clone) {
if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&	if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
($args->{'clonedomain'} eq $args->{'course_domain'})) {	($args->{'clonedomain'} eq $args->{'course_domain'})) {
my (%gotdomdefaults,%gotcodedefaults);	my (%gotdomdefaults,%gotcodedefaults);
foreach my $cloner (@cloners) {	foreach my $cloner (@cloners) {
Line 15013 sub check_clone {	Line 15999 sub check_clone {
if ($args->{'crstype'} eq 'Community') {	if ($args->{'crstype'} eq 'Community') {
$ccrole = 'co';	$ccrole = 'co';
}	}
my %roleshash =	my %roleshash =
&Apache::lonnet::get_my_roles($args->{'ccuname'},	&Apache::lonnet::get_my_roles($args->{'ccuname'},
$args->{'ccdomain'},	$args->{'ccdomain'},
'userroles',['active'],[$ccrole],	'userroles',['active'],[$ccrole],
[$args->{'clonedomain'}]);	[$args->{'clonedomain'}]);
if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {	if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
$can_clone = 1;	$can_clone = 1;
} elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},	} elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
$args->{'ccuname'},$args->{'ccdomain'})) {	$args->{'ccuname'},$args->{'ccdomain'})) {
Line 15027 sub check_clone {	Line 16013 sub check_clone {
}	}
unless ($can_clone) {	unless ($can_clone) {
if ($args->{'crstype'} eq 'Community') {	if ($args->{'crstype'} eq 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});	push(@clonemsg,({
	mt => 'No new community created.',
	args => [],
	},
	{
	mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',
	args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
	}));
} else {	} else {
$clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});	push(@clonemsg,({
}	mt => 'No new course created.',
	args => [],
	},
	{
	mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',
	args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
	}));
	}
}	}
}	}
}	}
return ($can_clone, $clonemsg, $cloneid, $clonehome);	return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
}	}

sub construct_course {	sub construct_course {
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,	my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
$cnum,$category,$coderef) = @_;	$cnum,$category,$coderef,$callercontext,$user_lh) = @_;
my $outcome;	my ($outcome,$msgref,$clonemsgref);
my $linefeed = '<br />'."\n";	my $linefeed = '<br />'."\n";
if ($context eq 'auto') {	if ($context eq 'auto') {
$linefeed = "\n";	$linefeed = "\n";
Line 15049 sub construct_course {	Line 16049 sub construct_course {
#	#
# Are we cloning?	# Are we cloning?
#	#
my ($can_clone, $clonemsg, $cloneid, $clonehome);	my ($can_clone,$cloneid,$clonehome,$clonetitle);
if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {	if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);	($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
if ($context ne 'auto') {
if ($clonemsg ne '') {
$clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
}
}
$outcome .= $clonemsg.$linefeed;

if (!$can_clone) {	if (!$can_clone) {
return (0,$outcome);	return (0,$outcome,$clonemsgref);
}	}
}	}

#	#
# Open course	# Open course
#	#
my $crstype = lc($args->{'crstype'});	my $showncrstype;
	if ($args->{'crstype'} eq 'Placement') {
	$showncrstype = 'placement test';
	} else {
	$showncrstype = lc($args->{'crstype'});
	}
my %cenv=();	my %cenv=();
$$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},	$$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
$args->{'cdescr'},	$args->{'cdescr'},
Line 15078 sub construct_course {	Line 16076 sub construct_course {
$args->{'ccuname'}.':'.	$args->{'ccuname'}.':'.
$args->{'ccdomain'},	$args->{'ccdomain'},
$args->{'crstype'},	$args->{'crstype'},
$cnum,$context,$category);	$cnum,$context,$category,
	$callercontext);

# Note: The testing routines depend on this being output; see	# Note: The testing routines depend on this being output; see
# Utils::Course. This needs to at least be output as a comment	# Utils::Course. This needs to at least be output as a comment
# if anyone ever decides to not show this, and Utils::Course::new	# if anyone ever decides to not show this, and Utils::Course::new
# will need to be suitably modified.	# will need to be suitably modified.
$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;	if (($callercontext eq 'auto') && ($user_lh ne '')) {
	$outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
	} else {
	$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
	}
if ($$courseid =~ /^error:/) {	if ($$courseid =~ /^error:/) {
return (0,$outcome);	return (0,$outcome,$clonemsgref);
}	}

#	#
Line 15095 sub construct_course {	Line 16098 sub construct_course {
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);	($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);	my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
if ($crsuhome eq 'no_host') {	if ($crsuhome eq 'no_host') {
$outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;	if (($callercontext eq 'auto') && ($user_lh ne '')) {
return (0,$outcome);	$outcome .= &mt_user($user_lh,
	'Course creation failed, unrecognized course home server.');
	} else {
	$outcome .= &mt('Course creation failed, unrecognized course home server.');
	}
	$outcome .= $linefeed;
	return (0,$outcome,$clonemsgref);
}	}
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed;	$outcome .= &mt('Created on').': '.$crsuhome.$linefeed;

#	#
# Do the cloning	# Do the cloning
#	#
	my @clonemsg;
if ($can_clone && $cloneid) {	if ($can_clone && $cloneid) {
$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);	push(@clonemsg,
if ($context ne 'auto') {	{
$clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';	mt => 'Created [_1] by cloning from [_2]',
}	args => [$showncrstype,$clonetitle],
$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,$args->{'datemode'},$args->{'dateshift'});	my @info =
	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
	$args->{'dateshift'},$args->{'crscode'},
	$args->{'ccuname'}.':'.$args->{'ccdomain'},
	$args->{'tinyurls'});
	if (@info) {
	push(@clonemsg,@info);
	}
# Restore URL	# Restore URL
$cenv{'url'}=$oldcenv{'url'};	$cenv{'url'}=$oldcenv{'url'};
# Restore title	# Restore title
Line 15272 sub construct_course {	Line 16289 sub construct_course {
$outcome .= $linefeed;	$outcome .= $linefeed;
} else {	} else {
$outcome .= "</ul><br /><br /></div>\n";	$outcome .= "</ul><br /><br /></div>\n";
}	}
}	}
if ($args->{'no_end_date'}) {	if ($args->{'no_end_date'}) {
$args->{'endaccess'} = 0;	$args->{'endaccess'} = 0;
Line 15341 sub construct_course {	Line 16358 sub construct_course {
if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {	if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
$crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;	$crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');	my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
}	}
if (ref($coderef)) {	if (ref($coderef)) {
$$coderef = $code;	$$coderef = $code;
}	}
Line 15378 sub construct_course {	Line 16395 sub construct_course {
# Open all assignments	# Open all assignments
#	#
if ($args->{'openall'}) {	if ($args->{'openall'}) {
	my $opendate = time;
	if ($args->{'openallfrom'} =~ /^\d+$/) {
	$opendate = $args->{'openallfrom'};
	}
my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';	my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
my %storecontent = ($storeunder => time,	my %storecontent = ($storeunder => $opendate,
$storeunder.'.type' => 'date_start');	$storeunder.'.type' => 'date_start');
	$outcome .= &mt('All assignments open starting [_1]',
$outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput	&Apache::lonlocal::locallocaltime($opendate)).': '.
('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;	&Apache::lonnet::cput
	('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
}	}
#	#
# Set first page	# Set first page
Line 15413 sub construct_course {	Line 16435 sub construct_course {
$outcome .= ($fatal?$errtext:'write ok').$linefeed;	$outcome .= ($fatal?$errtext:'write ok').$linefeed;
}	}

return (1,$outcome);	#
	# Set params for Placement Tests
	#
	if ($args->{'crstype'} eq 'Placement') {
	my %storecontent;
	my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
	my %defaults = (
	buttonshide => { value => 'yes',
	type => 'string_yesno',},
	type => { value => 'randomizetry',
	type => 'string_questiontype',},
	maxtries => { value => 1,
	type => 'int_pos',},
	problemstatus => { value => 'no',
	type => 'string_problemstatus',},
	);
	foreach my $key (keys(%defaults)) {
	$storecontent{$prefix.$key} = $defaults{$key}{'value'};
	$storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
	}
	&Apache::lonnet::cput
	('resourcedata',\%storecontent,$$crsudom,$$crsunum);
	}

	return (1,$outcome,\@clonemsg);
}	}

sub make_unique_code {	sub make_unique_code {
Line 15426 sub make_unique_code {	Line 16472 sub make_unique_code {
my $tries = 0;	my $tries = 0;
my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);	my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
my ($code,$error);	my ($code,$error);

while (($gotlock ne 'ok') && ($tries<3)) {	while (($gotlock ne 'ok') && ($tries<3)) {
$tries ++;	$tries ++;
sleep 1;	sleep 1;
Line 15473 sub generate_code {	Line 16519 sub generate_code {
############################################################	############################################################
############################################################	############################################################

#SD	# Community, Course and Placement Test
# only Community and Course, or anything else?
sub course_type {	sub course_type {
my ($cid) = @_;	my ($cid) = @_;
if (!defined($cid)) {	if (!defined($cid)) {
Line 15492 sub group_term {	Line 16537 sub group_term {
my %names = (	my %names = (
'Course' => 'group',	'Course' => 'group',
'Community' => 'group',	'Community' => 'group',
	'Placement' => 'group',
);	);
return $names{$crstype};	return $names{$crstype};
}	}

sub course_types {	sub course_types {
my @types = ('official','unofficial','community','textbook');	my @types = ('official','unofficial','community','textbook','placement','lti');
my %typename = (	my %typename = (
official => 'Official course',	official => 'Official course',
unofficial => 'Unofficial course',	unofficial => 'Unofficial course',
community => 'Community',	community => 'Community',
textbook => 'Textbook course',	textbook => 'Textbook course',
	placement => 'Placement test',
	lti => 'LTI provider',
);	);
return (\@types,\%typename);	return (\@types,\%typename);
}	}
Line 15582 sub compare_arrays {	Line 16630 sub compare_arrays {
return @difference;	return @difference;
}	}

	sub lon_status_items {
	my %defaults = (
	E => 100,
	W => 4,
	N => 1,
	U => 5,
	threshold => 200,
	sysmail => 2500,
	);
	my %names = (
	E => 'Errors',
	W => 'Warnings',
	N => 'Notices',
	U => 'Unsent',
	);
	return (\%defaults,\%names);
	}

# -------------------------------------------------------- Initialize user login	# -------------------------------------------------------- Initialize 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 15589 sub init_user_environment {	Line 16655 sub init_user_environment {

my $public=($username eq 'public' && $domain eq 'public');	my $public=($username eq 'public' && $domain eq 'public');

# See if old ID present, if so, remove

my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);	my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
my $now=time;	my $now=time;

Line 15612 sub init_user_environment {	Line 16676 sub init_user_environment {
}	}
if (!$cookie) { $cookie="publicuser_$oldest"; }	if (!$cookie) { $cookie="publicuser_$oldest"; }
} else {	} else {
# if this isn't a robot, kill any existing non-robot sessions	# See if old ID present, if so, remove if this isn't a robot,
	# killing any existing non-robot sessions
if (!$args->{'robot'}) {	if (!$args->{'robot'}) {
opendir(DIR,$lonids);	opendir(DIR,$lonids);
while ($filename=readdir(DIR)) {	while ($filename=readdir(DIR)) {
if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {	if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
unlink($lonids.'/'.$filename);	if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
	&GDBM_READER(),0640)) {
	my $linkedfile;
	if (exists($oldenv{'user.linkedenv'})) {
	$linkedfile = $oldenv{'user.linkedenv'};
	}
	untie(%oldenv);
	if (unlink("$lonids/$filename")) {
	if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
	if (-l "$lonids/$linkedfile.id") {
	unlink("$lonids/$linkedfile.id");
	}
	}
	}
	} else {
	unlink($lonids.'/'.$filename);
	}
}	}
}	}
closedir(DIR);	closedir(DIR);
Line 15652 sub init_user_environment {	Line 16733 sub init_user_environment {

my %userenv = &Apache::lonnet::dump('environment',$domain,$username);	my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
my ($tmp) = keys(%userenv);	my ($tmp) = keys(%userenv);
if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {	if ($tmp =~ /^(con_lost\|error\|no_such_host)/i) {
} else {
undef(%userenv);	undef(%userenv);
}	}
if (($userenv{'interface'}) && (!$form->{'interface'})) {	if (($userenv{'interface'}) && (!$form->{'interface'})) {
Line 15724 sub init_user_environment {	Line 16804 sub init_user_environment {
undef,\%userenv,\%domdef,\%is_adv);	undef,\%userenv,\%domdef,\%is_adv);
}	}

foreach my $crstype ('official','unofficial','community','textbook') {	foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
$userenv{'canrequest.'.$crstype} =	$userenv{'canrequest.'.$crstype} =
&Apache::lonnet::usertools_access($username,$domain,$crstype,	&Apache::lonnet::usertools_access($username,$domain,$crstype,
'reload','requestcourses',	'reload','requestcourses',
Line 15738 sub init_user_environment {	Line 16818 sub init_user_environment {
my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],	my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
$domain,$username);	$domain,$username);
my $reqstatus = $reqauthor{'author_status'};	my $reqstatus = $reqauthor{'author_status'};
if ($reqstatus eq 'approval' \|\| $reqstatus eq 'approved') {	if ($reqstatus eq 'approval' \|\| $reqstatus eq 'approved') {
if (ref($reqauthor{'author'}) eq 'HASH') {	if (ref($reqauthor{'author'}) eq 'HASH') {
$userenv{'requestauthorqueued'} = $reqstatus.':'.	$userenv{'requestauthorqueued'} = $reqstatus.':'.
$reqauthor{'author'}{'timestamp'};	$reqauthor{'author'}{'timestamp'};
}	}
}	}
	my ($types,$typename) = &course_types();
	if (ref($types) eq 'ARRAY') {
	my @options = ('approval','validate','autolimit');
	my $optregex = join('\|',@options);
	my (%willtrust,%trustchecked);
	foreach my $type (@{$types}) {
	my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
	if ($dom_str ne '') {
	my $updatedstr = '';
	my @possdomains = split(',',$dom_str);
	foreach my $entry (@possdomains) {
	my ($extdom,$extopt) = split(':',$entry);
	unless ($trustchecked{$extdom}) {
	$willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
	$trustchecked{$extdom} = 1;
	}
	if ($willtrust{$extdom}) {
	$updatedstr .= $entry.',';
	}
	}
	$updatedstr =~ s/,$//;
	if ($updatedstr) {
	$userenv{'reqcrsotherdom.'.$type} = $updatedstr;
	} else {
	delete($userenv{'reqcrsotherdom.'.$type});
	}
	}
	}
	}
}	}

$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 15849 and quotacheck.pl	Line 16957 and quotacheck.pl

Inputs:	Inputs:

filterlist - anonymous array of fields to include as potential filters	filterlist - anonymous array of fields to include as potential filters

crstype - course type	crstype - course type

roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used	roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
to pop-open a course selector (will contain "extra element").	to pop-open a course selector (will contain "extra element").

multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1	multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1

Line 15870 cloneruname - username of owner of new c	Line 16978 cloneruname - username of owner of new c

clonerudom - domain of owner of new course who wants to clone	clonerudom - domain of owner of new course who wants to clone

typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)	typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)

codetitlesref - reference to array of titles of components in institutional codes (official courses)	codetitlesref - reference to array of titles of components in institutional codes (official courses)

codedom - domain	codedom - domain

formname - value of form element named "form".	formname - value of form element named "form".

fixeddom - domain, if fixed.	fixeddom - domain, if fixed.

prevphase - value to assign to form element named "phase" when going back to the previous screen	prevphase - value to assign to form element named "phase" when going back to the previous screen

cnameelement - name of form element in form on opener page which will receive title of selected course	cnameelement - name of form element in form on opener page which will receive title of selected course

cnumelement - name of form element in form on opener page which will receive courseID of selected course	cnumelement - name of form element in form on opener page which will receive courseID of selected course

Line 15973 sub build_filters {	Line 17081 sub build_filters {
$createdfilterform = &timebased_select_form('createdfilter',$filter);	$createdfilterform = &timebased_select_form('createdfilter',$filter);
}	}

	my $prefix = $crstype;
	if ($crstype eq 'Placement') {
	$prefix = 'Placement Test'
	}
my %lt = &Apache::lonlocal::texthash(	my %lt = &Apache::lonlocal::texthash(
'cac' => "$crstype Activity",	'cac' => "$prefix Activity",
'ccr' => "$crstype Created",	'ccr' => "$prefix Created",
'cde' => "$crstype Title",	'cde' => "$prefix Title",
'cdo' => "$crstype Domain",	'cdo' => "$prefix Domain",
'ins' => 'Institutional Code',	'ins' => 'Institutional Code',
'inc' => 'Institutional Categorization',	'inc' => 'Institutional Categorization',
'cow' => "$crstype Owner/Co-owner",	'cow' => "$prefix Owner/Co-owner",
'cop' => "$crstype Personnel Includes",	'cop' => "$prefix Personnel Includes",
'cog' => 'Type',	'cog' => 'Type',
);	);

Line 15989 sub build_filters {	Line 17101 sub build_filters {
my $typeval = 'Course';	my $typeval = 'Course';
if ($crstype eq 'Community') {	if ($crstype eq 'Community') {
$typeval = 'Community';	$typeval = 'Community';
	} elsif ($crstype eq 'Placement') {
	$typeval = 'Placement';
}	}
$typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';	$typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
} else {	} else {
Line 15997 sub build_filters {	Line 17111 sub build_filters {
$typeselectform .= ' onchange="'.$onchange.'"';	$typeselectform .= ' onchange="'.$onchange.'"';
}	}
$typeselectform .= '>'."\n";	$typeselectform .= '>'."\n";
foreach my $posstype ('Course','Community') {	foreach my $posstype ('Course','Community','Placement') {
	my $shown;
	if ($posstype eq 'Placement') {
	$shown = &mt('Placement Test');
	} else {
	$shown = &mt($posstype);
	}
$typeselectform.='<option value="'.$posstype.'"'.	$typeselectform.='<option value="'.$posstype.'"'.
($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";	($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
}	}
$typeselectform.="</select>";	$typeselectform.="</select>";
}	}
Line 16024 sub build_filters {	Line 17144 sub build_filters {
if (exists($filter->{'instcodefilter'})) {	if (exists($filter->{'instcodefilter'})) {
# if (($fixeddom) \|\| ($formname eq 'requestcrs') \|\|	# if (($fixeddom) \|\| ($formname eq 'requestcrs') \|\|
# ($formname eq 'modifycourse') \|\| ($formname eq 'filterpicker')) {	# ($formname eq 'modifycourse') \|\| ($formname eq 'filterpicker')) {
if ($codedom) {	if ($codedom) {
$officialjs = 1;	$officialjs = 1;
($instcodeform,$jscript,$$numtitlesref) =	($instcodeform,$jscript,$$numtitlesref) =
&Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',	&Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
Line 16153 $typeelement	Line 17273 $typeelement
return $jscript.$clonewarning.$output;	return $jscript.$clonewarning.$output;
}	}

=pod	=pod

=item * &timebased_select_form()	=item * &timebased_select_form()

Line 16168 item - name of form element (sincefilter	Line 17288 item - name of form element (sincefilter
filter - anonymous hash of criteria and their values	filter - anonymous hash of criteria and their values

Returns: HTML for a select box contained a blank, then six time selections,	Returns: HTML for a select box contained a blank, then six time selections,
with value set in incoming form variables currently selected.	with value set in incoming form variables currently selected.

Side Effects: None	Side Effects: None

Line 16205 page load completion for page showing se	Line 17325 page load completion for page showing se

Inputs: None	Inputs: None

Returns: markup containing updateFilters() and hideSearching() javascript functions.	Returns: markup containing updateFilters() and hideSearching() javascript functions.

Side Effects: None	Side Effects: None

Line 16244 to retrieve a hash for which keys are co	Line 17364 to retrieve a hash for which keys are co

Inputs:	Inputs:

dom - domain being searched	dom - domain being searched

type - course type ('Course' or 'Community' or '.' if any).	type - course type ('Course' or 'Community' or '.' if any).

Line 16256 cloneruname - optional username of new c	Line 17376 cloneruname - optional username of new c

clonerudom - optional domain of new course owner	clonerudom - optional domain of new course owner

domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,	domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
(used when DC is using course creation form)	(used when DC is using course creation form)

codetitles - reference to array of titles of components in institutional codes (official courses).	codetitles - reference to array of titles of components in institutional codes (official courses).
Line 16266 cc_clone - escaped comma separated list	Line 17386 cc_clone - escaped comma separated list

reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone	reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone

reqinstcode - institutional code of new course, where search_courses is used to identify potential	reqinstcode - institutional code of new course, where search_courses is used to identify potential
courses to clone	courses to clone

Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.	Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.

Line 16393 $required - LON-CAPA version needed by c	Line 17513 $required - LON-CAPA version needed by c

Returns:	Returns:

$switchserver - query string tp append to /adm/switchserver call (if	$switchserver - query string tp append to /adm/switchserver call (if
current server's LON-CAPA version is too old.	current server's LON-CAPA version is too old.

$warning - Message is displayed if no suitable server could be found.	$warning - Message is displayed if no suitable server could be found.

Line 16507 Inputs:	Line 17627 Inputs:
$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)	$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)

$interval (optional) - Time which may elapse (in s) between last check for content	$interval (optional) - Time which may elapse (in s) between last check for content
change in current course. (default: 600 s).	change in current course. (default: 600 s).

Returns: an array; first element is:	Returns: an array; first element is:

Line 16515 Returns: an array; first element is:	Line 17635 Returns: an array; first element is:

'switch' - if content updates mean user's session	'switch' - if content updates mean user's session
needs to be switched to a server running a newer LON-CAPA version	needs to be switched to a server running a newer LON-CAPA version

'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)	'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
on current server hosting user's session	on current server hosting user's session

'' - if no action required.	'' - if no action required.

Line 16525 Returns: an array; first element is:	Line 17645 Returns: an array; first element is:

If first item element is 'switch':	If first item element is 'switch':

second item is $switchwarning - Warning message if no suitable server found to host session.	second item is $switchwarning - Warning message if no suitable server found to host session.

third item is $switchserver - query string to append to /adm/switchserver containing lonHostID	third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
and current role.	and current role.

otherwise: no other elements returned.	otherwise: no other elements returned.

Line 16546 sub needs_coursereinit {	Line 17666 sub needs_coursereinit {
$interval = 600;	$interval = 600;
}	}
if (($now-$env{'request.course.timechecked'})>$interval) {	if (($now-$env{'request.course.timechecked'})>$interval) {
my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
&Apache::lonnet::appenv({'request.course.timechecked'=>$now});	&Apache::lonnet::appenv({'request.course.timechecked'=>$now});
	my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
	if ($blocked) {
	return ();
	}
	my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
if ($lastchange > $env{'request.course.tied'}) {	if ($lastchange > $env{'request.course.tied'}) {
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');	my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
if ($curr_reqd_hash{'internal.releaserequired'} ne '') {	if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
Line 16570 sub needs_coursereinit {	Line 17694 sub needs_coursereinit {
}	}

sub update_content_constraints {	sub update_content_constraints {
my ($cdom,$cnum,$chome,$cid) = @_;	my ($cdom,$cnum,$chome,$cid,$keeporder) = @_;
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');	my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});	my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
my %checkresponsetypes;	my (%checkresponsetypes,%checkcrsrestypes);
foreach my $key (keys(%Apache::lonnet::needsrelease)) {	foreach my $key (keys(%Apache::lonnet::needsrelease)) {
my ($item,$name,$value) = split(/:/,$key);	my ($item,$name,$value) = split(/:/,$key);
if ($item eq 'resourcetag') {	if ($item eq 'resourcetag') {
if ($name eq 'responsetype') {	if ($name eq 'responsetype') {
$checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}	$checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
}	}
	} elsif ($item eq 'course') {
	if ($name eq 'courserestype') {
	$checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
	}
}	}
}	}
my $navmap = Apache::lonnavmaps::navmap->new();	my $navmap = Apache::lonnavmaps::navmap->new();
if (defined($navmap)) {	if (defined($navmap)) {
my %allresponses;	my (%allresponses,%allcrsrestypes);
foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {	foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() \|\| $_[0]->is_tool() },1,0)) {
	if ($res->is_tool()) {
	if ($allcrsrestypes{'exttool'}) {
	$allcrsrestypes{'exttool'} ++;
	} else {
	$allcrsrestypes{'exttool'} = 1;
	}
	next;
	}
my %responses = $res->responseTypes();	my %responses = $res->responseTypes();
foreach my $key (keys(%responses)) {	foreach my $key (keys(%responses)) {
next unless(exists($checkresponsetypes{$key}));	next unless(exists($checkresponsetypes{$key}));
Line 16598 sub update_content_constraints {	Line 17734 sub update_content_constraints {
($reqdmajor,$reqdminor) = ($major,$minor);	($reqdmajor,$reqdminor) = ($major,$minor);
}	}
}	}
	foreach my $key (keys(%allcrsrestypes)) {
	my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
	if (($major > $reqdmajor) \|\| ($major == $reqdmajor && $minor > $reqdminor)) {
	($reqdmajor,$reqdminor) = ($major,$minor);
	}
	}
undef($navmap);	undef($navmap);
}	}
	my (@resources,@order,@resparms,@zombies);
	if ($keeporder) {
	use LONCAPA::map;
	@resources = @LONCAPA::map::resources;
	@order = @LONCAPA::map::order;
	@resparms = @LONCAPA::map::resparms;
	@zombies = @LONCAPA::map::zombies;
	}
	my $suppmap = 'supplemental.sequence';
	my ($suppcount,$supptools,$errors) = (0,0,0);
	($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
	$suppcount,$supptools,$errors);
	if ($keeporder) {
	@LONCAPA::map::resources = @resources;
	@LONCAPA::map::order = @order;
	@LONCAPA::map::resparms = @resparms;
	@LONCAPA::map::zombies = @zombies;
	}
	if ($supptools) {
	my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
	if (($major > $reqdmajor) \|\| ($major == $reqdmajor && $minor > $reqdminor)) {
	($reqdmajor,$reqdminor) = ($major,$minor);
	}
	}
unless (($reqdmajor eq '') && ($reqdminor eq '')) {	unless (($reqdmajor eq '') && ($reqdminor eq '')) {
&Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);	&Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
}	}
Line 16620 sub allmaps_incourse {	Line 17786 sub allmaps_incourse {
if ($lastchange > $env{'request.course.tied'}) {	if ($lastchange > $env{'request.course.tied'}) {
my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");	my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
unless ($ferr) {	unless ($ferr) {
&update_content_constraints($cdom,$cnum,$chome,$cid);	&update_content_constraints($cdom,$cnum,$chome,$cid,1);
}	}
}	}
my $navmap = Apache::lonnavmaps::navmap->new();	my $navmap = Apache::lonnavmaps::navmap->new();
Line 16656 sub parse_supplemental_title {	Line 17822 sub parse_supplemental_title {
}	}

sub recurse_supplemental {	sub recurse_supplemental {
my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;	my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_;
if ($suppmap) {	if ($suppmap) {
my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);	my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
if ($fatal) {	if ($fatal) {
Line 16667 sub recurse_supplemental {	Line 17833 sub recurse_supplemental {
my ($title,$src,$ext,$type,$status)=split(/\:/,$res);	my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
if (($src ne '') && ($status eq 'res')) {	if (($src ne '') && ($status eq 'res')) {
if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {	if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);	($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1,
	$numfiles,$numexttools,$errors);
} else {	} else {
	if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
	$numexttools ++;
	}
$numfiles ++;	$numfiles ++;
}	}
}	}
Line 16676 sub recurse_supplemental {	Line 17846 sub recurse_supplemental {
}	}
}	}
}	}
return ($numfiles,$errors);	return ($numfiles,$numexttools,$errors);
}	}

sub symb_to_docspath {	sub symb_to_docspath {
Line 16750 sub symb_to_docspath {	Line 17920 sub symb_to_docspath {
}	}

sub captcha_display {	sub captcha_display {
my ($context,$lonhost) = @_;	my ($context,$lonhost,$defdom) = @_;
my ($output,$error);	my ($output,$error);
my ($captcha,$pubkey,$privkey,$version) =	my ($captcha,$pubkey,$privkey,$version) =
&get_captcha_config($context,$lonhost);	&get_captcha_config($context,$lonhost,$defdom);
if ($captcha eq 'original') {	if ($captcha eq 'original') {
$output = &create_captcha();	$output = &create_captcha();
unless ($output) {	unless ($output) {
Line 16769 sub captcha_display {	Line 17939 sub captcha_display {
}	}

sub captcha_response {	sub captcha_response {
my ($context,$lonhost) = @_;	my ($context,$lonhost,$defdom) = @_;
my ($captcha_chk,$captcha_error);	my ($captcha_chk,$captcha_error);
my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);	my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
if ($captcha eq 'original') {	if ($captcha eq 'original') {
($captcha_chk,$captcha_error) = &check_captcha();	($captcha_chk,$captcha_error) = &check_captcha();
} elsif ($captcha eq 'recaptcha') {	} elsif ($captcha eq 'recaptcha') {
Line 16783 sub captcha_response {	Line 17953 sub captcha_response {
}	}

sub get_captcha_config {	sub get_captcha_config {
my ($context,$lonhost) = @_;	my ($context,$lonhost,$dom_in_effect) = @_;
my ($captcha,$pubkey,$privkey,$version,$hashtocheck);	my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
my $hostname = &Apache::lonnet::hostname($lonhost);	my $hostname = &Apache::lonnet::hostname($lonhost);
my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);	my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
Line 16823 sub get_captcha_config {	Line 17993 sub get_captcha_config {
$captcha = 'recaptcha';	$captcha = 'recaptcha';
$version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};	$version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
if ($version ne '2') {	if ($version ne '2') {
$version = 1;	$version = 1;
}	}
} else {	} else {
$captcha = 'original';	$captcha = 'original';
Line 16831 sub get_captcha_config {	Line 18001 sub get_captcha_config {
} elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {	} elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
$captcha = 'original';	$captcha = 'original';
}	}
}	} elsif ($context eq 'passwords') {
	if ($dom_in_effect) {
	my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
	if ($passwdconf{'captcha'} eq 'recaptcha') {
	if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
	$pubkey = $passwdconf{'recaptchakeys'}{'public'};
	$privkey = $passwdconf{'recaptchakeys'}{'private'};
	}
	if ($privkey && $pubkey) {
	$captcha = 'recaptcha';
	$version = $passwdconf{'recaptchaversion'};
	if ($version ne '2') {
	$version = 1;
	}
	} else {
	$captcha = 'original';
	}
	} elsif ($passwdconf{'captcha'} ne 'notused') {
	$captcha = 'original';
	}
	}
	}
return ($captcha,$pubkey,$privkey,$version);	return ($captcha,$pubkey,$privkey,$version);
}	}

Line 16855 sub create_captcha {	Line 18046 sub create_captcha {
last;	last;
}	}
}	}
	if ($output eq '') {
	&Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
	}
return $output;	return $output;
}	}

Line 16905 sub create_recaptcha {	Line 18099 sub create_recaptcha {
&mt('If the text is hard to read, [_1] will replace them.',	&mt('If the text is hard to read, [_1] will replace them.',
'<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').	'<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
'<br /><br />';	'<br /><br />';
}	}
}	}

sub check_recaptcha {	sub check_recaptcha {
my ($privkey,$version) = @_;	my ($privkey,$version) = @_;
my $captcha_chk;	my $captcha_chk;
if ($version >= 2) {	if ($version >= 2) {
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
my %info = (	my %info = (
secret => $privkey,	secret => $privkey,
response => $env{'form.g-recaptcha-response'},	response => $env{'form.g-recaptcha-response'},
remoteip => $ENV{'REMOTE_ADDR'},	remoteip => $ENV{'REMOTE_ADDR'},
);	);
my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);	my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
	$request->content(join('&',map {
	my $name = escape($_);
	"$name=" . ( ref($info{$_}) eq 'ARRAY'
	? join("&$name=", map {escape($_) } @{$info{$_}})
	: &escape($info{$_}) );
	} keys(%info)));
	my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
if ($response->is_success) {	if ($response->is_success) {
my $data = JSON::DWIW->from_json($response->decoded_content);	my $data = JSON::DWIW->from_json($response->decoded_content);
if (ref($data) eq 'HASH') {	if (ref($data) eq 'HASH') {
Line 16982 sub cleanup_html {	Line 18181 sub cleanup_html {

# Checks for critical messages and returns a redirect url if one exists.	# Checks for critical messages and returns a redirect url if one exists.
# $interval indicates how often to check for messages.	# $interval indicates how often to check for messages.
	# $context is the calling context -- roles, grades, contents, menu or flip.
sub critical_redirect {	sub critical_redirect {
my ($interval) = @_;	my ($interval,$context) = @_;
if ((time-$env{'user.criticalcheck.time'})>$interval) {	if ((time-$env{'user.criticalcheck.time'})>$interval) {
my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},	if (($env{'request.course.id'}) && (($context eq 'flip') \|\| ($context eq 'contents'))) {
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
	if ($blocked) {
	my $checkrole = "cm./$cdom/$cnum";
	if ($env{'request.course.sec'} ne '') {
	$checkrole .= "/$env{'request.course.sec'}";
	}
	unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
	($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
	return;
	}
	}
	}
	my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
$env{'user.name'});	$env{'user.name'});
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time});	&Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
my $redirecturl;	my $redirecturl;
if ($what[0]) {	if ($what[0]) {
if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {	if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
$redirecturl='/adm/email?critical=display';	$redirecturl='/adm/email?critical=display';
my $url=&Apache::lonnet::absolute_url().$redirecturl;	my $url=&Apache::lonnet::absolute_url().$redirecturl;
return (1, $url);	return (1, $url);
}	}
}	}
}	}
return ();	return ();
}	}

Line 17050 sub des_decrypt {	Line 18265 sub des_decrypt {
return $plaintext;	return $plaintext;
}	}

	sub get_requested_shorturls {
	my ($cdom,$cnum,$navmap) = @_;
	return unless (ref($navmap));
	my ($numnew,$errors);
	my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
	if (@toshorten) {
	my (%maps,%resources,%titles);
	&Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
	'shorturls',$cdom,$cnum);
	if (keys(%resources)) {
	my %tocreate;
	foreach my $item (sort {$a <=> $b} (@toshorten)) {
	my $symb = $resources{$item};
	if ($symb) {
	$tocreate{$cnum.'&'.$symb} = 1;
	}
	}
	if (keys(%tocreate)) {
	($numnew,$errors) = &make_short_symbs($cdom,$cnum,
	\%tocreate);
	}
	}
	}
	return ($numnew,$errors);
	}

	sub make_short_symbs {
	my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
	my ($numnew,@errors);
	if (ref($tocreateref) eq 'HASH') {
	my %tocreate = %{$tocreateref};
	if (keys(%tocreate)) {
	my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
	my $su = Short::URL->new(no_vowels => 1);
	my $init = '';
	my (%newunique,%addcourse,%courseonly,%failed);
	# get lock on tiny db
	my $now = time;
	if ($lockuser eq '') {
	$lockuser = $env{'user.name'}.':'.$env{'user.domain'};
	}
	my $lockhash = {
	"lock\0$now" => $lockuser,
	};
	my $tries = 0;
	my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
	my ($code,$error);
	while (($gotlock ne 'ok') && ($tries<3)) {
	$tries ++;
	sleep 1;
	$gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
	}
	if ($gotlock eq 'ok') {
	$init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
	\%addcourse,\%courseonly,\%failed);
	if (keys(%failed)) {
	my $numfailed = scalar(keys(%failed));
	push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
	}
	if (keys(%newunique)) {
	my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
	if ($putres eq 'ok') {
	$numnew = scalar(keys(%newunique));
	my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
	unless ($newputres eq 'ok') {
	push(@errors,&mt('error: could not store course look-up of short URLs'));
	}
	} else {
	push(@errors,&mt('error: could not store unique six character URLs'));
	}
	}
	my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
	unless ($dellockres eq 'ok') {
	push(@errors,&mt('error: could not release lockfile'));
	}
	} else {
	push(@errors,&mt('error: could not obtain lockfile'));
	}
	if (keys(%courseonly)) {
	my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
	if ($result ne 'ok') {
	push(@errors,&mt('error: could not update course look-up of short URLs'));
	}
	}
	}
	}
	return ($numnew,\@errors);
	}

	sub shorten_symbs {
	my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
	return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
	(ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
	(ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
	my (%possibles,%collisions);
	foreach my $key (keys(%{$tocreate})) {
	my $num = String::CRC32::crc32($key);
	my $tiny = $su->encode($num,$init);
	if ($tiny) {
	$possibles{$tiny} = $key;
	}
	}
	if (!$init) {
	$init = 1;
	} else {
	$init ++;
	}
	if (keys(%possibles)) {
	my @posstiny = keys(%possibles);
	my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
	my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
	if (keys(%currtiny)) {
	foreach my $key (keys(%currtiny)) {
	next if ($currtiny{$key} eq '');
	if ($currtiny{$key} eq $possibles{$key}) {
	my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
	unless (($coursetiny->{$tsymb} eq $key) \|\| ($addcourse->{$tsymb} eq $key) \|\| ($courseonly->{$tsymb} eq $key)) {
	$courseonly->{$tsymb} = $key;
	}
	} else {
	$collisions{$possibles{$key}} = 1;
	}
	delete($possibles{$key});
	}
	}
	foreach my $key (keys(%possibles)) {
	$newunique->{$key} = $possibles{$key};
	my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
	unless (($coursetiny->{$tsymb} eq $key) \|\| ($addcourse->{$tsymb} eq $key) \|\| ($courseonly->{$tsymb} eq $key)) {
	$addcourse->{$tsymb} = $key;
	}
	}
	}
	if (keys(%collisions)) {
	if ($init <5) {
	if (!$init) {
	$init = 1;
	} else {
	$init ++;
	}
	$init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
	$newunique,$addcourse,$courseonly,$failed);
	} else {
	foreach my $key (keys(%collisions)) {
	$failed->{$key} = 1;
	}
	}
	}
	return $init;
	}

	sub is_nonframeable {
	my ($url,$absolute,$hostname,$ip,$nocache) = @_;
	my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
	return if (($remprotocol eq '') \|\| ($remhost eq ''));

	$remprotocol = lc($remprotocol);
	$remhost = lc($remhost);
	my $remport = 80;
	if ($remprotocol eq 'https') {
	$remport = 443;
	}
	my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
	if ($cached) {
	unless ($nocache) {
	if ($result) {
	return 1;
	} else {
	return 0;
	}
	}
	}
	my $uselink;
	my $request = new HTTP::Request('HEAD',$url);
	my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
	if ($response->is_success()) {
	my $secpolicy = lc($response->header('content-security-policy'));
	my $xframeop = lc($response->header('x-frame-options'));
	$secpolicy =~ s/^\s+\|\s+$//g;
	$xframeop =~ s/^\s+\|\s+$//g;
	if (($secpolicy ne '') \|\| ($xframeop ne '')) {
	my $remotehost = $remprotocol.'://'.$remhost;
	my ($origin,$protocol,$port);
	if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
	$port = $ENV{'SERVER_PORT'};
	} else {
	$port = 80;
	}
	if ($absolute eq '') {
	$protocol = 'http:';
	if ($port == 443) {
	$protocol = 'https:';
	}
	$origin = $protocol.'//'.lc($hostname);
	} else {
	$origin = lc($absolute);
	($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
	}
	if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;\|$)/)) {
	my $framepolicy = $1;
	$framepolicy =~ s/^\s+\|\s+$//g;
	my @policies = split(/\s+/,$framepolicy);
	if (@policies) {
	if (grep(/^\Q'none'\E$/,@policies)) {
	$uselink = 1;
	} else {
	$uselink = 1;
	if ((grep(/^\Q*\E$/,@policies)) \|\| (grep(/^\Q$protocol\E$/,@policies)) \|\|
	(($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) \|\|
	(($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
	undef($uselink);
	}
	if ($uselink) {
	if (grep(/^\Q'self'\E$/,@policies)) {
	if (($origin ne '') && ($remotehost eq $origin)) {
	undef($uselink);
	}
	}
	}
	if ($uselink) {
	my @possok;
	if ($ip ne '') {
	push(@possok,$ip);
	}
	my $hoststr = '';
	foreach my $part (reverse(split(/\./,$hostname))) {
	if ($hoststr eq '') {
	$hoststr = $part;
	} else {
	$hoststr = "$part.$hoststr";
	}
	if ($hoststr eq $hostname) {
	push(@possok,$hostname);
	} else {
	push(@possok,"*.$hoststr");
	}
	}
	if (@possok) {
	foreach my $poss (@possok) {
	last if (!$uselink);
	foreach my $policy (@policies) {
	if ($policy =~ m{^(\Q$protocol\E//\|)\Q$poss\E(\Q:$port\E\|)$}) {
	undef($uselink);
	last;
	}
	}
	}
	}
	}
	}
	}
	} elsif ($xframeop ne '') {
	$uselink = 1;
	my @policies = split(/\s,\s/,$xframeop);
	if (@policies) {
	unless (grep(/^deny$/,@policies)) {
	if ($origin ne '') {
	if (grep(/^sameorigin$/,@policies)) {
	if ($remotehost eq $origin) {
	undef($uselink);
	}
	}
	if ($uselink) {
	foreach my $policy (@policies) {
	if ($policy =~ /^allow-from\s*(.+)$/) {
	my $allowfrom = $1;
	if (($allowfrom ne '') && ($allowfrom eq $origin)) {
	undef($uselink);
	last;
	}
	}
	}
	}
	}
	}
	}
	}
	}
	}
	if ($nocache) {
	if ($cached) {
	my $devalidate;
	if ($uselink && !$result) {
	$devalidate = 1;
	} elsif (!$uselink && $result) {
	$devalidate = 1;
	}
	if ($devalidate) {
	&Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
	}
	}
	} else {
	if ($uselink) {
	$result = 1;
	} else {
	$result = 0;
	}
	&Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
	}
	return $uselink;
	}

1;	1;
__END__;	__END__;

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

Removed from v.1.1075.2.127.2.3
changed lines
	Added in v.1.1348