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.1236 and 1.1328

version 1.1236, 2016/03/04 21:43:15	version 1.1328, 2019/05/02 02:12:18
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::Catalog;	use DateTime::Locale;
use Encode();	use Encode();
use Text::Aspell;	use Text::Aspell;
use Authen::Captcha;	use Authen::Captcha;
Line 83 use Crypt::DES;	Line 85 use Crypt::DES;
use DynaLoader; # for Crypt::DES version	use DynaLoader; # for Crypt::DES version
use MIME::Lite;	use MIME::Lite;
use MIME::Types;	use MIME::Types;
	use File::Copy();
	use File::Path();
	use String::CRC32();
	use Short::URL();

# ---------------------------------------------- Designs	# ---------------------------------------------- Designs
use vars qw(%defaultdesign);	use vars qw(%defaultdesign);
Line 198 BEGIN {	Line 204 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);
Line 220 BEGIN {	Line 226 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 234 BEGIN {	Line 240 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 248 BEGIN {	Line 254 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 262 BEGIN {	Line 268 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);
my ($extension,$category)=(split(/\s+/,$line,2));	my ($extension,$category)=(split(/\s+/,$line,2));
push @{$category_extensions{lc($category)}},$extension;	push(@{$category_extensions{lc($category)}},$extension);
}	}
close($fh);	close($fh);
}	}
Line 277 BEGIN {	Line 283 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 590 sub coursebrowser_javascript {	Line 596 sub coursebrowser_javascript {
if (formname == 'ccrs') {	if (formname == 'ccrs') {
var ownername = document.forms[formid].ccuname.value;	var ownername = document.forms[formid].ccuname.value;
var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;	var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
url += '&cloner='+ownername+':'+ownerdom+'&crscode='+document.forms[formid].crscode.value;	url += '&cloner='+ownername+':'+ownerdom;
	if (type == 'Course') {
	url += '&crscode='+document.forms[formid].crscode.value;
	}
}	}
if (formname == 'requestcrs') {	if (formname == 'requestcrs') {
url += '&crsdom=$domainfilter&crscode=$instcode';	url += '&crsdom=$domainfilter&crscode=$instcode';
Line 878 sub selectcourse_link {	Line 887 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 938 ENDSCRT	Line 949 ENDSCRT
}	}

sub select_timezone {	sub select_timezone {
my ($name,$selected,$onchange,$includeempty)=@_;	my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
my $output='<select name="'.$name.'" '.$onchange.'>'."\n";	my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
if ($includeempty) {	if ($includeempty) {
$output .= '<option value=""';	$output .= '<option value=""';
if (($selected eq '') \|\| ($selected eq 'local')) {	if (($selected eq '') \|\| ($selected eq 'local')) {
Line 960 sub select_timezone {	Line 971 sub select_timezone {
}	}

sub select_datelocale {	sub select_datelocale {
my ($name,$selected,$onchange,$includeempty)=@_;	my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
my $output='<select name="'.$name.'" '.$onchange.'>'."\n";	my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
if ($includeempty) {	if ($includeempty) {
$output .= '<option value=""';	$output .= '<option value=""';
if ($selected eq '') {	if ($selected eq '') {
Line 969 sub select_datelocale {	Line 980 sub select_datelocale {
}	}
$output .= '> </option>';	$output .= '> </option>';
}	}
	my @languages = &Apache::lonlocal::preferred_languages();
my (@possibles,%locale_names);	my (@possibles,%locale_names);
my @locales = DateTime::Locale::Catalog::Locales;	my @locales = DateTime::Locale->ids();
foreach my $locale (@locales) {	foreach my $id (@locales) {
if (ref($locale) eq 'HASH') {	if ($id ne '') {
my $id = $locale->{'id'};	my ($en_terr,$native_terr);
if ($id ne '') {	my $loc = DateTime::Locale->load($id);
my $en_terr = $locale->{'en_territory'};	if (ref($loc)) {
my $native_terr = $locale->{'native_territory'};	$en_terr = $loc->name();
my @languages = &Apache::lonlocal::preferred_languages();	$native_terr = $loc->native_name();
if (grep(/^en$/,@languages) \|\| !@languages) {	if (grep(/^en$/,@languages) \|\| !@languages) {
if ($en_terr ne '') {	if ($en_terr ne '') {
$locale_names{$id} = '('.$en_terr.')';	$locale_names{$id} = '('.$en_terr.')';
Line 992 sub select_datelocale {	Line 1004 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 1012 sub select_datelocale {	Line 1024 sub select_datelocale {
}	}

sub select_language {	sub select_language {
my ($name,$selected,$includeempty) = @_;	my ($name,$selected,$includeempty,$noedit) = @_;
my %langchoices;	my %langchoices;
if ($includeempty) {	if ($includeempty) {
%langchoices = ('' => 'No language preference');	%langchoices = ('' => 'No language preference');
Line 1024 sub select_language {	Line 1036 sub select_language {
}	}
}	}
%langchoices = &Apache::lonlocal::texthash(%langchoices);	%langchoices = &Apache::lonlocal::texthash(%langchoices);
return &select_form($selected,$name,\%langchoices);	return &select_form($selected,$name,\%langchoices,undef,$noedit);
}	}

=pod	=pod
Line 1048 sub list_languages {	Line 1060 sub list_languages {
if ($code) {	if ($code) {
my $selector = $supported_codes{$id};	my $selector = $supported_codes{$id};
my $description = &plainlanguagedescription($id);	my $description = &plainlanguagedescription($id);
push (@lang_choices, [$selector, $description]);	push(@lang_choices, [$selector, $description]);
}	}
}	}
return \@lang_choices;	return \@lang_choices;
Line 1088 linked_select_forms takes the following	Line 1100 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 1142 sub linked_select_forms {	Line 1157 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 1150 sub linked_select_forms {	Line 1166 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});
}	}
$result.="\"@s2texts\");\n";	$result.="\"@s2texts\");\n";
}	}
$"=' ';	$"=' ';
$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 1199 function select1_changed() {	Line 1213 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 1284 sub help_open_topic {	Line 1298 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 1296 sub help_open_topic {	Line 1314 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 1489 sub help_open_bug {	Line 1507 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 1767 RESIZE	Line 1790 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 1949 sub colorfuleditor_js {	Line 2128 sub colorfuleditor_js {
}	}
}	}

	$browse_or_search

// ]]>	// ]]>
</script>	</script>
Line 2001 sub insert_folding_button {	Line 2180 sub insert_folding_button {
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

=head1 Excel and CSV file utility routines	=head1 Excel and CSV file utility routines
Line 2188 sub create_text_file {	Line 2494 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 2260 sub multiple_select_form {	Line 2580 sub multiple_select_form {

=pod	=pod

=item * &select_form($defdom,$name,$hashref,$onchange)	=item * &select_form($defdom,$name,$hashref,$onchange,$readonly)

Returns a string containing a <select name='$name' size='1'> form to	Returns a string containing a <select name='$name' size='1'> form to
allow a user to select options from a ref to a hash containing:	allow a user to select options from a ref to a hash containing:
option_name => displayed text. An optional $onchange can include	option_name => displayed text. An optional $onchange can include
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
	to be disabled, e.g., for the case where an instructor has a section-
	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 2451 sub select_level_form {	Line 2774 sub select_level_form {

=pod	=pod

=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)	=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)

Returns a string containing a <select name='$name' size='1'> form to	Returns a string containing a <select name='$name' size='1'> form to
allow a user to select the domain to preform an operation in.	allow a user to select the domain to preform an operation in.
Line 2468 The optional $incdoms is a reference to	Line 2791 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.

=cut	=cut

#-------------------------------------------	#-------------------------------------------
sub select_dom_form {	sub select_dom_form {
my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;	my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
if ($onchange) {	if ($onchange) {
$onchange = ' onchange="'.$onchange.'"';	$onchange = ' onchange="'.$onchange.'"';
}	}
	if ($disabled) {
	$disabled = ' disabled="disabled"';
	}
my (@domains,%exclude);	my (@domains,%exclude);
if (ref($incdoms) eq 'ARRAY') {	if (ref($incdoms) eq 'ARRAY') {
@domains = sort {lc($a) cmp lc($b)} (@{$incdoms});	@domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
Line 2486 sub select_dom_form {	Line 2814 sub select_dom_form {
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>\n";	my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
foreach my $dom (@domains) {	foreach my $dom (@domains) {
next if ($exclude{$dom});	next if ($exclude{$dom});
$selectdomain.="<option value=\"$dom\" ".	$selectdomain.="<option value=\"$dom\" ".
Line 2712 This is not an optimal method, but it wo	Line 3040 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 2862 sub authform_kerberos {	Line 3192 sub authform_kerberos {
@_,	@_,
);	);
my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,	my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
$autharg,$jscall);	$autharg,$jscall,$disabled);
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
if ($in{'kerb_def_auth'} eq 'krb5') {	if ($in{'kerb_def_auth'} eq 'krb5') {
$check5 = ' checked="checked"';	$check5 = ' checked="checked"';
} else {	} else {
$check4 = ' checked="checked"';	$check4 = ' checked="checked"';
}	}
	if ($in{'readonly'}) {
	$disabled = ' disabled="disabled"';
	}
$krbarg = $in{'kerb_def_dom'};	$krbarg = $in{'kerb_def_dom'};
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'krb') {	if ($in{'curr_authtype'} eq 'krb') {
Line 2913 sub authform_kerberos {	Line 3246 sub authform_kerberos {
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="radio" name="login" value="krb" />';	$authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
}	}
}	}
}	}
Line 2922 sub authform_kerberos {	Line 3255 sub authform_kerberos {
if ($authtype eq '') {	if ($authtype eq '') {
$authtype = '<input type="radio" name="login" value="krb" '.	$authtype = '<input type="radio" name="login" value="krb" '.
'onclick="'.$jscall.'" onchange="'.$jscall.'"'.	'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
$krbcheck.' />';	$krbcheck.$disabled.' />';
}	}
if (($can_assign{'krb4'} && $can_assign{'krb5'}) \|\|	if (($can_assign{'krb4'} && $can_assign{'krb5'}) \|\|
($can_assign{'krb4'} && !$can_assign{'krb5'} &&	($can_assign{'krb4'} && !$can_assign{'krb5'} &&
Line 2935 sub authform_kerberos {	Line 3268 sub authform_kerberos {
'<label>'.$authtype,	'<label>'.$authtype,
'</label><input type="text" size="10" name="krbarg" '.	'</label><input type="text" size="10" name="krbarg" '.
'value="'.$krbarg.'" '.	'value="'.$krbarg.'" '.
'onchange="'.$jscall.'" />',	'onchange="'.$jscall.'"'.$disabled.' />',
'<label><input type="radio" name="krbver" value="4" '.$check4.' />',	'<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
'</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',	'</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
'</label>');	'</label>');
} elsif ($can_assign{'krb4'}) {	} elsif ($can_assign{'krb4'}) {
$result .= &mt	$result .= &mt
Line 2946 sub authform_kerberos {	Line 3279 sub authform_kerberos {
'<label>'.$authtype,	'<label>'.$authtype,
'</label><input type="text" size="10" name="krbarg" '.	'</label><input type="text" size="10" name="krbarg" '.
'value="'.$krbarg.'" '.	'value="'.$krbarg.'" '.
'onchange="'.$jscall.'" />',	'onchange="'.$jscall.'"'.$disabled.' />',
'<label><input type="hidden" name="krbver" value="4" />',	'<label><input type="hidden" name="krbver" value="4" />',
'</label>');	'</label>');
} elsif ($can_assign{'krb5'}) {	} elsif ($can_assign{'krb5'}) {
Line 2956 sub authform_kerberos {	Line 3289 sub authform_kerberos {
'<label>'.$authtype,	'<label>'.$authtype,
'</label><input type="text" size="10" name="krbarg" '.	'</label><input type="text" size="10" name="krbarg" '.
'value="'.$krbarg.'" '.	'value="'.$krbarg.'" '.
'onchange="'.$jscall.'" />',	'onchange="'.$jscall.'"'.$disabled.' />',
'<label><input type="hidden" name="krbver" value="5" />',	'<label><input type="hidden" name="krbver" value="5" />',
'</label>');	'</label>');
}	}
Line 2969 sub authform_internal {	Line 3302 sub authform_internal {
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);	my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
	if ($in{'readonly'}) {
	$disabled = ' disabled="disabled"';
	}
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'int') {	if ($in{'curr_authtype'} eq 'int') {
if ($can_assign{'int'}) {	if ($can_assign{'int'}) {
Line 2999 sub authform_internal {	Line 3335 sub authform_internal {
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="radio" name="login" value="int" />';	$authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
}	}
}	}
}	}
Line 3007 sub authform_internal {	Line 3343 sub authform_internal {
$jscall = "javascript:changed_radio('int',$in{'formname'});";	$jscall = "javascript:changed_radio('int',$in{'formname'});";
if ($authtype eq '') {	if ($authtype eq '') {
$authtype = '<input type="radio" name="login" value="int" '.$intcheck.	$authtype = '<input type="radio" name="login" value="int" '.$intcheck.
' onchange="'.$jscall.'" onclick="'.$jscall.'" />';	' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
}	}
$autharg = '<input type="password" size="10" name="intarg" value="'.	$autharg = '<input type="password" size="10" name="intarg" value="'.
$intarg.'" onchange="'.$jscall.'" />';	$intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
$result = &mt	$result = &mt
('[_1] Internally authenticated (with initial password [_2])',	('[_1] Internally authenticated (with initial password [_2])',
'<label>'.$authtype,'</label>'.$autharg);	'<label>'.$authtype,'</label>'.$autharg);
$result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';	$result.='<label><input type="checkbox" name="visible" onclick="if (this.checked) { this.form.intarg.type='."'text'".' } else { this.form.intarg.type='."'password'".' }"'.$disabled.' />'.&mt('Visible input').'</label>';
return $result;	return $result;
}	}

Line 3024 sub authform_local {	Line 3360 sub authform_local {
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);	my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
	if ($in{'readonly'}) {
	$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 3054 sub authform_local {	Line 3393 sub authform_local {
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="radio" name="login" value="loc" />';	$authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
}	}
}	}
}	}
Line 3063 sub authform_local {	Line 3402 sub authform_local {
if ($authtype eq '') {	if ($authtype eq '') {
$authtype = '<input type="radio" name="login" value="loc" '.	$authtype = '<input type="radio" name="login" value="loc" '.
$loccheck.' onchange="'.$jscall.'" onclick="'.	$loccheck.' onchange="'.$jscall.'" onclick="'.
$jscall.'" />';	$jscall.'"'.$disabled.' />';
}	}
$autharg = '<input type="text" size="10" name="locarg" value="'.	$autharg = '<input type="text" size="10" name="locarg" value="'.
$locarg.'" onchange="'.$jscall.'" />';	$locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
$result = &mt('[_1] Local Authentication with argument [_2]',	$result = &mt('[_1] Local Authentication with argument [_2]',
'<label>'.$authtype,'</label>'.$autharg);	'<label>'.$authtype,'</label>'.$autharg);
return $result;	return $result;
Line 3078 sub authform_filesystem {	Line 3417 sub authform_filesystem {
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my ($fsyscheck,$result,$authtype,$autharg,$jscall);	my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
	if ($in{'readonly'}) {
	$disabled = ' disabled="disabled"';
	}
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'fsys') {	if ($in{'curr_authtype'} eq 'fsys') {
if ($can_assign{'fsys'}) {	if ($can_assign{'fsys'}) {
Line 3092 sub authform_filesystem {	Line 3434 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 3105 sub authform_filesystem {	Line 3447 sub authform_filesystem {
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="radio" name="login" value="fsys" />';	$authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
}	}
}	}
}	}
Line 3114 sub authform_filesystem {	Line 3456 sub authform_filesystem {
if ($authtype eq '') {	if ($authtype eq '') {
$authtype = '<input type="radio" name="login" value="fsys" '.	$authtype = '<input type="radio" name="login" value="fsys" '.
$fsyscheck.' onchange="'.$jscall.'" onclick="'.	$fsyscheck.' onchange="'.$jscall.'" onclick="'.
$jscall.'" />';	$jscall.'"'.$disabled.' />';
}	}
$autharg = '<input type="text" size="10" name="fsysarg" value=""'.	$autharg = '<input type="password" size="10" name="fsysarg" value=""'.
' onchange="'.$jscall.'" />';	' 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.'" />',	return $result;
'</label><input type="password" size="10" name="fsysarg" value="" '.	}
'onchange="'.$jscall.'" />');
	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 3137 sub get_assignable_auth {	Line 3534 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 3145 sub get_assignable_auth {	Line 3543 sub get_assignable_auth {
my $context;	my $context;
if ($env{'request.role'} =~ /^au/) {	if ($env{'request.role'} =~ /^au/) {
$context = 'author';	$context = 'author';
} elsif ($env{'request.role'} =~ /^dc/) {	} elsif ($env{'request.role'} =~ /^(dc\|dh)/) {
$context = 'domain';	$context = 'domain';
} elsif ($env{'request.course.id'}) {	} elsif ($env{'request.course.id'}) {
$context = 'course';	$context = 'course';
Line 3866 category	Line 4264 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 4250 sub get_previous_attempt {	Line 4652 sub get_previous_attempt {
}	}
$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 4357 sub get_student_view {	Line 4765 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 4679 sub blockcheck {	Line 5090 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 '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 4763 sub blockcheck {	Line 5175 sub blockcheck {
$tdom,$spec,$trest,$area);	$tdom,$spec,$trest,$area);
}	}
}	}
my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);	my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {	if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
if ($1) {	if ($1) {
$no_userblock = 1;	$no_userblock = 1;
Line 4785 sub blockcheck {	Line 5197 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);
if (($start != 0) &&	if (($start != 0) &&
Line 4874 sub get_blocks {	Line 5286 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 4990 END_MYBLOCK	Line 5408 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 '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 5014 sub check_ip_acc {	Line 5436 sub check_ip_acc {
return 1;	return 1;
}	}
my $allowed;	my $allowed;
my $ip=$env{'request.host'} \|\| $ENV{'REMOTE_ADDR'} \|\| $clientip;	my $ip=$ENV{'REMOTE_ADDR'} \|\| $clientip \|\| $env{'request.host'};

my $name;	my $name;
my %access = (	my %access = (
Line 5229 sub get_legacy_domconf {	Line 5651 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 5418 sub CSTR_pageheader {	Line 5840 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 5432 sub CSTR_pageheader {	Line 5869 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 5482 Inputs:	Line 5924 Inputs:

=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 5498 other decorations will be returned.	Line 5957 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,$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 5507 sub bodytag {	Line 5966 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 5534 sub bodytag {	Line 5994 sub bodytag {
if ($env{'request.course.id'}) {	if ($env{'request.course.id'}) {
if ($env{'request.role'} !~ /^cr/) {	if ($env{'request.role'} !~ /^cr/) {
$role = &Apache::lonnet::plaintext($role,&course_type());	$role = &Apache::lonnet::plaintext($role,&course_type());
	} elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
	if ($env{'request.role.desc'}) {
	$role = $env{'request.role.desc'};
	} else {
	$role = &mt('Helpdesk[_1]',' '.$2);
	}
	} else {
	$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 5560 sub bodytag {	Line 6028 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 5573 sub bodytag {	Line 6052 sub bodytag {
$dc_info =~ s/\s+$//;	$dc_info =~ s/\s+$//;
}	}

$role = '<span class="LC_nobreak">('.$role.')</span>' if $role;	my $crstype;
	if ($env{'request.course.id'}) {
	$crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
	} elsif ($args->{'crstype'}) {
	$crstype = $args->{'crstype'};
	}
	if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
	undef($role);
	} 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') { $forcereg=1; }

Line 5584 sub bodytag {	Line 6073 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 />	$bodytag .= qq\|<div id="LC_nav_bar">$left $role<br />
<em>$realm</em> $dc_info</div>\|;	<em>$realm</em> $dc_info</div>\|;
return $bodytag;	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'}) {
Line 5612 sub bodytag {	Line 6103 sub 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'},
	$hostname,$ltiscope,$ltiuri);
} else {	} else {
$bodytag .=	$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);	$advtoolsref,'',$hostname);
}	}
}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 5876 div.LC_confirm_box .LC_success img {	Line 6372 div.LC_confirm_box .LC_success img {
vertical-align: middle;	vertical-align: middle;
}	}

	.LC_maxwidth {
	max-width: 100%;
	height: auto;
	}

	.LC_textsize_mobile {
	\@media only screen and (max-device-width: 480px) {
	-webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
	}
	}

.LC_icon {	.LC_icon {
border: none;	border: none;
vertical-align: middle;	vertical-align: middle;
Line 5981 ul.LC_breadcrumb_tools_outerlist li {	Line 6488 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 5997 table#LC_menubuttons img {	Line 6510 table#LC_menubuttons img {
vertical-align: middle;	vertical-align: middle;
}	}

	.LC_breadcrumbs_hoverable {
	background: $sidebg;
	}

td.LC_table_cell_checkbox {	td.LC_table_cell_checkbox {
text-align: center;	text-align: center;
}	}
Line 6067 td.LC_menubuttons_text {	Line 6584 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 6388 td.LC_parm_overview_restrictions {	Line 6910 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 6739 table.LC_data_table tr > td.LC_docs_entr	Line 7267 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 7759 section.role-warning>h1:before {	Line 8293 section.role-warning>h1:before {
content:url('/adm/daxe/images/section_icons/warning.png');	content:url('/adm/daxe/images/section_icons/warning.png');
}	}

	#LC_minitab_header {
	float:left;
	width:100%;
	background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
	font-size:93%;
	line-height:normal;
	margin: 0.5em 0 0.5em 0;
	}
	#LC_minitab_header ul {
	margin:0;
	padding:10px 10px 0;
	list-style:none;
	}
	#LC_minitab_header li {
	float:left;
	background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
	margin:0;
	padding:0 0 0 9px;
	}
	#LC_minitab_header a {
	display:block;
	background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
	padding:5px 15px 4px 6px;
	}
	#LC_minitab_header #LC_current_minitab {
	background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
	}
	#LC_minitab_header #LC_current_minitab a {
	background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
	padding-bottom:5px;
	}


END	END
}	}

Line 7940 OFFLOAD	Line 8507 OFFLOAD
$result .= '>'	$result .= '>'
.$inhibitprint	.$inhibitprint
.$head_extra;	.$head_extra;
if ($env{'browser.mobile'}) {	my $clientmobile;
	if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
	(undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
	} else {
	$clientmobile = $env{'browser.mobile'};
	}
	if ($clientmobile) {
$result .= '	$result .= '
<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">	<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
<meta name="apple-mobile-web-app-capable" content="yes" />';	<meta name="apple-mobile-web-app-capable" content="yes" />';
}	}
	$result .= '<meta name="google" content="notranslate" />'."\n";
return $result.'</head>';	return $result.'</head>';
}	}

Line 8124 $args - additional optional args support	Line 8698 $args - additional optional args support
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
	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 8138 sub start_page {	Line 8718 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 8156 sub start_page {	Line 8767 sub start_page {
$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,	$args->{'bgcolor'}, $args,
\@advtools);	\@advtools,$ltiscope,$ltiuri,\%ltimenu);
}	}
}	}

Line 8189 sub start_page {	Line 8800 sub start_page {
if (@advtools > 0) {	if (@advtools > 0) {
&Apache::lonmenu::advtools_crumbs(@advtools);	&Apache::lonmenu::advtools_crumbs(@advtools);
}	}
	my $menulink;
	# if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
	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;
	} else {
	undef($menulink);
	}
#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'});	$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
}else{	} else {
$result .= &Apache::lonhtmlcommon::breadcrumbs();	$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
}	}
}	}
return $result;	return $result;
Line 8291 var modalWindow = {	Line 8912 var modalWindow = {
};	};
var openMyModal = function(source,width,height,scrolling,transparency,style)	var openMyModal = function(source,width,height,scrolling,transparency,style)
{	{
source = source.replace("'","'");	source = source.replace(/'/g,"'");
modalWindow.windowId = "myModal";	modalWindow.windowId = "myModal";
modalWindow.width = width;	modalWindow.width = width;
modalWindow.height = height;	modalWindow.height = height;
Line 8420 sub end_togglebox {	Line 9041 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 8434 sub LCprogressbar_script {	Line 9056 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 8460 my $LCidcnt;	Line 9104 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 8675 function expand_div(caller) {	Line 9336 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 9310 Incoming parameters:	Line 9978 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 9385 sub get_user_quota {	Line 10053 sub get_user_quota {
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 9533 Inputs: 7	Line 10202 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 9609 sub get_secgrprole_info {	Line 10278 sub get_secgrprole_info {
}	}

sub user_picker {	sub user_picker {
my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;	my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
my $currdom = $dom;	my $currdom = $dom;
	my @alldoms = &Apache::lonnet::all_domains();
	if (@alldoms == 1) {
	my %domsrch = &Apache::lonnet::get_dom('configuration',
	['directorysrch'],$alldoms[0]);
	my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
	my $showdom = $domdesc;
	if ($showdom eq '') {
	$showdom = $dom;
	}
	if (ref($domsrch{'directorysrch'}) eq 'HASH') {
	if ((!$domsrch{'directorysrch'}{'available'}) &&
	($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
	return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
	}
	}
	}
my %curr_selected = (	my %curr_selected = (
srchin => 'dom',	srchin => 'dom',
srchby => 'lastname',	srchby => 'lastname',
Line 9657 sub user_picker {	Line 10342 sub user_picker {
);	);
&html_escape(\%html_lt);	&html_escape(\%html_lt);
&js_escape(\%js_lt);	&js_escape(\%js_lt);
my $domform = &select_dom_form($currdom,'srchdomain',1,1);	my $domform;
	my $allow_blank = 1;
	if ($fixeddom) {
	$allow_blank = 0;
	$domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
	} else {
	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">';

my @srchins = ('crs','dom','alc','instd');	my @srchins = ('crs','dom','alc','instd');
Line 9669 sub user_picker {	Line 10370 sub user_picker {
next if ($option eq 'alc');	next if ($option eq 'alc');
next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));	next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
next if ($option eq 'crs' && !$env{'request.course.id'});	next if ($option eq 'crs' && !$env{'request.course.id'});
	next if (($option eq 'instd') && ($noinstd));
if ($curr_selected{'srchin'} eq $option) {	if ($curr_selected{'srchin'} eq $option) {
$srchinsel .= '	$srchinsel .= '
<option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';	<option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
Line 9851 END_BLOCK	Line 10553 END_BLOCK
&Apache::lonhtmlcommon::row_closure(1).	&Apache::lonhtmlcommon::row_closure(1).
&Apache::lonhtmlcommon::end_pick_box().	&Apache::lonhtmlcommon::end_pick_box().
'<br />';	'<br />';
return $output;	return ($output,1);
}	}

sub user_rule_check {	sub user_rule_check {
Line 10166 sub get_institutional_codes {	Line 10868 sub get_institutional_codes {
foreach (@currxlists) {	foreach (@currxlists) {
if (m/^([^:]+):(\w*)$/) {	if (m/^([^:]+):(\w*)$/) {
unless (grep/^$1$/,@{$allcourses}) {	unless (grep/^$1$/,@{$allcourses}) {
push @{$allcourses},$1;	push(@{$allcourses},$1);
$$LC_code{$1} = $2;	$$LC_code{$1} = $2;
}	}
}	}
Line 10179 sub get_institutional_codes {	Line 10881 sub get_institutional_codes {
my $sec = $coursecode.$1;	my $sec = $coursecode.$1;
my $lc_sec = $2;	my $lc_sec = $2;
unless (grep/^$sec$/,@{$allcourses}) {	unless (grep/^$sec$/,@{$allcourses}) {
push @{$allcourses},$sec;	push(@{$allcourses},$sec);
$$LC_code{$sec} = $lc_sec;	$$LC_code{$sec} = $lc_sec;
}	}
}	}
Line 10277 reservable_now - ref to hash of student_	Line 10979 reservable_now - ref to hash of student_

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) endreserve: end date of reservation period.	(b) endreserve: end date of reservation period.
	(c) uniqueperiod: start,end dates when slot is to be uniquely
	selected.

sorted_future - ref to array of student_schedulable slots reservable in	sorted_future - ref to array of student_schedulable slots reservable in
the future, ordered by start date of reservation period.	the future, ordered by start date of reservation period.
Line 10287 future_reservable - ref to hash of stude	Line 10991 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
	selected.

=back	=back

Line 10363 sub get_future_slots {	Line 11069 sub get_future_slots {
my $startreserve = $slots{$slot}->{'startreserve'};	my $startreserve = $slots{$slot}->{'startreserve'};
my $endreserve = $slots{$slot}->{'endreserve'};	my $endreserve = $slots{$slot}->{'endreserve'};
my $symb = $slots{$slot}->{'symb'};	my $symb = $slots{$slot}->{'symb'};
	my $uniqueperiod;
	if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
	$uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
	}
if (($startreserve < $now) &&	if (($startreserve < $now) &&
(!$endreserve \|\| $endreserve > $now)) {	(!$endreserve \|\| $endreserve > $now)) {
my $lastres = $endreserve;	my $lastres = $endreserve;
Line 10371 sub get_future_slots {	Line 11081 sub get_future_slots {
}	}
$reservable_now{$slot} = {	$reservable_now{$slot} = {
symb => $symb,	symb => $symb,
endreserve => $lastres	endreserve => $lastres,
	uniqueperiod => $uniqueperiod,
};	};
} elsif (($startreserve > $now) &&	} elsif (($startreserve > $now) &&
(!$endreserve \|\| $endreserve > $startreserve)) {	(!$endreserve \|\| $endreserve > $startreserve)) {
$future_reservable{$slot} = {	$future_reservable{$slot} = {
symb => $symb,	symb => $symb,
startreserve => $startreserve	startreserve => $startreserve,
	uniqueperiod => $uniqueperiod,
};	};
}	}
}	}
Line 10535 sub get_env_multiple {	Line 11247 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 10551 sub ask_for_embedded_content {	Line 11279 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 10635 sub ask_for_embedded_content {	Line 11366 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 10677 sub ask_for_embedded_content {	Line 11418 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} = {};
Line 10752 sub ask_for_embedded_content {	Line 11506 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 10790 sub ask_for_embedded_content {	Line 11547 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 10818 sub ask_for_embedded_content {	Line 11577 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));
Line 10829 sub ask_for_embedded_content {	Line 11590 sub ask_for_embedded_content {
$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 11442 sub modify_html_refs {	Line 12209 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 11507 sub modify_html_refs {	Line 12274 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 12024 sub decompress_uploaded_file {	Line 12791 sub decompress_uploaded_file {

sub process_decompression {	sub process_decompression {
my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;	my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
	unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs\|supplemental)/(default\|\d+)/\d+$})) {
	return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
	&mt('Unexpected file path.').'</p>'."\n";
	}
	unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
	return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
	&mt('Unexpected course context.').'</p>'."\n";
	}
	unless ($file eq &Apache::lonnet::clean_filename($file)) {
	return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
	&mt('Filename contained unexpected characters.').'</p>'."\n";
	}
my ($dir,$error,$warning,$output);	my ($dir,$error,$warning,$output);
if ($file !~ /\.(zip\|tar\|bz2\|gz\|tar.gz\|tar.bz2\|tgz)$/i) {	if ($file !~ /\.(zip\|tar\|bz2\|gz\|tar.gz\|tar.bz2\|tgz)$/i) {
$error = &mt('Filename not a supported archive file type.').	$error = &mt('Filename not a supported archive file type.').
Line 12058 sub process_decompression {	Line 12837 sub process_decompression {
}	}
}	}
my $numskip = scalar(@to_skip);	my $numskip = scalar(@to_skip);
if (($numskip > 0) &&	my $numoverwrite = scalar(@to_overwrite);
($numskip == $env{'form.archive_itemcount'})) {	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.');
} elsif (!$error) {	} elsif (!$error) {
my ($decompressed,$display);	my ($decompressed,$display);
if ($numskip > 0) {	if (($numskip) \|\| ($numoverwrite)) {
my $tempdir = time.'_'.$$.int(rand(10000));	my $tempdir = time.'_'.$$.int(rand(10000));
mkdir("$dir/$tempdir",0755);	mkdir("$dir/$tempdir",0755);
system("mv $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") {
system("rm -rf $dir/$tempdir/$item");	&File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
	}
	}
	}
	foreach my $item (@to_overwrite) {
	if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
	if (($item ne '') && ($item !~ /\.\./)) {
	if (-f "$dir/$item") {
	unlink("$dir/$item");
	} elsif (-d "$dir/$item") {
	&File::Path::remove_tree("$dir/$item",{ safe => 1 });
	}
	&File::Copy::move("$dir/$tempdir/$item","$dir/$item");
	}
}	}
}	}
	if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
	&File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
	}
}	}
system("mv $dir/$tempdir/* $dir");
rmdir("$dir/$tempdir");
} else {	} else {
($decompressed,$display) =	($decompressed,$display) =
&decompress_uploaded_file($file,$dir);	&decompress_uploaded_file($file,$dir);
Line 12099 sub process_decompression {	Line 12892 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 12585 END	Line 13377 END
sub process_extracted_files {	sub process_extracted_files {
my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;	my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
my $numitems = $env{'form.archive_count'};	my $numitems = $env{'form.archive_count'};
return unless ($numitems);	return if ((!$numitems) \|\| ($numitems =~ /\D/));
my @ids=&Apache::lonnet::current_machine_ids();	my @ids=&Apache::lonnet::current_machine_ids();
my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,	my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
%folders,%containers,%mapinner,%prompttofetch);	%folders,%containers,%mapinner,%prompttofetch);
Line 12598 sub process_extracted_files {	Line 13390 sub process_extracted_files {
} else {	} else {
$prefix = $Apache::lonnet::perlvar{'lonDocRoot'};	$prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
$pathtocheck = "$dir_root/$docudom/$docuname/$destination";	$pathtocheck = "$dir_root/$docudom/$docuname/$destination";
$dir = "$dir_root/$docudom/$docuname";	$dir = "$dir_root/$docudom/$docuname";
}	}
my $currdir = "$dir_root/$destination";	my $currdir = "$dir_root/$destination";
(my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs\|supplemental)/(\w+)/});	(my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs\|supplemental)/(\w+)/});
Line 12687 sub process_extracted_files {	Line 13479 sub process_extracted_files {
'.'.$containers{$outer},1,1);	'.'.$containers{$outer},1,1);
$newseqid{$i} = $newidx;	$newseqid{$i} = $newidx;
unless ($errtext) {	unless ($errtext) {
$result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";	$result .= '<li>'.&mt('Folder: [_1] added to course',
	&HTML::Entities::encode($docstitle,'<>&"')).
	'</li>'."\n";
}	}
}	}
} else {	} else {
Line 12696 sub process_extracted_files {	Line 13490 sub process_extracted_files {
my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.	my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
$docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.	$docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
$title;	$title;
if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {	if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);	if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
}	mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
}
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
$newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
unless ($ishome) {
my $fetch = "$newdest{$i}/$title";
$fetch =~ s/^\Q$prefix$dir\E//;
$prompttofetch{$fetch} = 1;
}	}
}	if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
$LONCAPA::map::resources[$newidx]=	mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
$docstitle.':'.$url.':false:normal:res';	}
push(@LONCAPA::map::order, $newidx);	if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
my ($outtext,$errtext)=	if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
&LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.	$newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
$docuname.'/'.$folders{$outer}.	unless ($ishome) {
'.'.$containers{$outer},1,1);	my $fetch = "$newdest{$i}/$title";
unless ($errtext) {	$fetch =~ s/^\Q$prefix$dir\E//;
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {	$prompttofetch{$fetch} = 1;
$result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";	}
	}
	}
	$LONCAPA::map::resources[$newidx]=
	$docstitle.':'.$url.':false:normal:res';
	push(@LONCAPA::map::order, $newidx);
	my ($outtext,$errtext)=
	&LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
	$docuname.'/'.$folders{$outer}.
	'.'.$containers{$outer},1,1);
	unless ($errtext) {
	if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
	$result .= '<li>'.&mt('File: [_1] added to course',
	&HTML::Entities::encode($docstitle,'<>&"')).
	'</li>'."\n";
	}
}	}
	} else {
	$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
	&HTML::Entities::encode($path,'<>&"')).'<br />';
}	}
}	}
}	}
}	}
} else {	} else {
$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';	$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
	&HTML::Entities::encode($path,'<>&"')).'<br />';
}	}
}	}
for (my $i=1; $i<=$numitems; $i++) {	for (my $i=1; $i<=$numitems; $i++) {
Line 12788 sub process_extracted_files {	Line 13591 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 12797 sub process_extracted_files {	Line 13602 sub process_extracted_files {
} else {	} else {
$showpath = "/$title";	$showpath = "/$title";
}	}
$result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";	$result .= '<li>'.&mt('[_1] included as a dependency',
}	&HTML::Entities::encode($showpath,'<>&"')).
unless ($ishome) {	'</li>'."\n";
my $fetch = "$fullpath/$title";	unless ($ishome) {
$fetch =~ s/^\Q$prefix$dir\E//;	my $fetch = "$fullpath/$title";
$prompttofetch{$fetch} = 1;	$fetch =~ s/^\Q$prefix$dir\E//;
	$prompttofetch{$fetch} = 1;
	}
}	}
}	}
}	}
} elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {	} elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
$warning .= &mt('[_1] is a dependency of [_2], which was discarded.',	$warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
$path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';	&HTML::Entities::encode($path,'<>&"'),
	&HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
	'<br />';
}	}
} else {	} else {
$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';	$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
	&HTML::Entities::encode($path)).'<br />';
}	}
}	}
if (keys(%todelete)) {	if (keys(%todelete)) {
Line 13085 sub upfile_store {	Line 13895 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 13100 sub upfile_store {	Line 13913 sub upfile_store {

=pod	=pod

=item * &load_tmp_file($r)	=item * &load_tmp_file($r,$datatoken)

Load uploaded file from tmp, $r should be the HTTP Request object,	Load uploaded file from tmp, $r should be the HTTP Request object,
needs $env{'form.datatoken'},	$datatoken is the name to assign to the temporary file.
sets $env{'form.upfile'} to the contents of the file	sets $env{'form.upfile'} to the contents of the file

=cut	=cut

sub load_tmp_file {	sub load_tmp_file {
my $r=shift;	my ($r,$datatoken) = @_;
	return if ($datatoken eq '');
my @studentdata=();	my @studentdata=();
{	{
my $studentfile = $r->dir_config('lonDaemons').	my $studentfile = $r->dir_config('lonDaemons').
'/tmp/'.$env{'form.datatoken'}.'.tmp';	'/tmp/'.$datatoken.'.tmp';
if ( open(my $fh,"<$studentfile") ) {	if ( open(my $fh,'<',$studentfile) ) {
@studentdata=<$fh>;	@studentdata=<$fh>;
close($fh);	close($fh);
}	}
Line 13122 sub load_tmp_file {	Line 13936 sub load_tmp_file {
$env{'form.upfile'}=join('',@studentdata);	$env{'form.upfile'}=join('',@studentdata);
}	}

	sub valid_datatoken {
	my ($datatoken) = @_;
	if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(\|$match_domain\_$match_courseid)\_\d+_\d+$/) {
	return $datatoken;
	}
	return;
	}

=pod	=pod

=item * &upfile_record_sep()	=item * &upfile_record_sep()
Line 13562 sub DrawBarGraph {	Line 14384 sub DrawBarGraph {
@Labels = @$labels;	@Labels = @$labels;
} else {	} else {
for (my $i=0;$i<@{$Values[0]};$i++) {	for (my $i=0;$i<@{$Values[0]};$i++) {
push (@Labels,$i+1);	push(@Labels,$i+1);
}	}
}	}
#	#
Line 14008 requestsmail, updatesmail, or idconflict	Line 14830 requestsmail, updatesmail, or idconflict
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)

	$requdom domain of requester (if mailing type is helpdeskmail)

	$reqemail e-mail address of requester (if mailing type is helpdeskmail)


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

Line 14019 Returns: comma separated list of address	Line 14848 Returns: comma separated list of address
############################################################	############################################################
############################################################	############################################################
sub build_recipient_list {	sub build_recipient_list {
my ($defmail,$mailing,$defdom,$origmail) = @_;	my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
my @recipients;	my @recipients;
my $otheremails;	my ($otheremails,$lastresort,$allbcc,$addtext);
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['contacts'],$defdom);	&Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
if (ref($domconfig{'contacts'}) eq 'HASH') {	if (ref($domconfig{'contacts'}) eq 'HASH') {
if (exists($domconfig{'contacts'}{$mailing})) {	if (exists($domconfig{'contacts'}{$mailing})) {
if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {	if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
Line 14035 sub build_recipient_list {	Line 14864 sub build_recipient_list {
push(@recipients,$addr);	push(@recipients,$addr);
}	}
}	}
$otheremails = $domconfig{'contacts'}{$mailing}{'others'};	}
	$otheremails = $domconfig{'contacts'}{$mailing}{'others'};
	if ($mailing eq 'helpdeskmail') {
	if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
	my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
	my @ok_bccs;
	foreach my $bcc (@bccs) {
	$bcc =~ s/^\s+//g;
	$bcc =~ s/\s+$//g;
	if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
	if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
	push(@ok_bccs,$bcc);
	}
	}
	}
	if (@ok_bccs > 0) {
	$allbcc = join(', ',@ok_bccs);
	}
	}
	$addtext = $domconfig{'contacts'}{$mailing}{'include'};
}	}
}	}
} elsif ($origmail ne '') {	} elsif ($origmail ne '') {
push(@recipients,$origmail);	$lastresort = $origmail;
	}
	if ($mailing eq 'helpdeskmail') {
	if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
	(keys(%{$domconfig{'contacts'}{'overrides'}}))) {
	my ($inststatus,$inststatus_checked);
	if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
	($env{'user.domain'} ne 'public')) {
	$inststatus_checked = 1;
	$inststatus = $env{'environment.inststatus'};
	}
	unless ($inststatus_checked) {
	if (($requname ne '') && ($requdom ne '')) {
	if (($requname =~ /^$match_username$/) &&
	($requdom =~ /^$match_domain$/) &&
	(&Apache::lonnet::domain($requdom))) {
	my $requhome = &Apache::lonnet::homeserver($requname,
	$requdom);
	unless ($requhome eq 'no_host') {
	my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
	$inststatus = $userenv{'inststatus'};
	$inststatus_checked = 1;
	}
	}
	}
	}
	unless ($inststatus_checked) {
	if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
	my %srch = (srchby => 'email',
	srchdomain => $defdom,
	srchterm => $reqemail,
	srchtype => 'exact');
	my %srch_results = &Apache::lonnet::usersearch(\%srch);
	foreach my $uname (keys(%srch_results)) {
	if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
	$inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
	$inststatus_checked = 1;
	last;
	}
	}
	unless ($inststatus_checked) {
	my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
	if ($dirsrchres eq 'ok') {
	foreach my $uname (keys(%srch_results)) {
	if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
	$inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
	$inststatus_checked = 1;
	last;
	}
	}
	}
	}
	}
	}
	if ($inststatus ne '') {
	foreach my $status (split(/\:/,$inststatus)) {
	if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
	my @contacts = ('adminemail','supportemail');
	foreach my $item (@contacts) {
	if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
	my $addr = $domconfig{'contacts'}{'overrides'}{$status};
	if (!grep(/^\Q$addr\E$/,@recipients)) {
	push(@recipients,$addr);
	}
	}
	}
	$otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
	if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
	my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
	my @ok_bccs;
	foreach my $bcc (@bccs) {
	$bcc =~ s/^\s+//g;
	$bcc =~ s/\s+$//g;
	if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
	if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
	push(@ok_bccs,$bcc);
	}
	}
	}
	if (@ok_bccs > 0) {
	$allbcc = join(', ',@ok_bccs);
	}
	}
	$addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
	last;
	}
	}
	}
	}
}	}
} elsif ($origmail ne '') {	} elsif ($origmail ne '') {
push(@recipients,$origmail);	$lastresort = $origmail;
	}
	if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
	unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
	my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
	my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
	my %what = (
	perlvar => 1,
	);
	my $primary = &Apache::lonnet::domain($defdom,'primary');
	if ($primary) {
	my $gotaddr;
	my ($result,$returnhash) =
	&Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
	if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
	if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
	$lastresort = $returnhash->{'lonSupportEMail'};
	$gotaddr = 1;
	}
	}
	unless ($gotaddr) {
	my $uintdom = &Apache::lonnet::internet_dom($primary);
	my $intdom = &Apache::lonnet::internet_dom($lonhost);
	unless ($uintdom eq $intdom) {
	my %domconfig =
	&Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
	if (ref($domconfig{'contacts'}) eq 'HASH') {
	if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
	my @contacts = ('adminemail','supportemail');
	foreach my $item (@contacts) {
	if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
	my $addr = $domconfig{'contacts'}{$item};
	if (!grep(/^\Q$addr\E$/,@recipients)) {
	push(@recipients,$addr);
	}
	}
	}
	if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
	$otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
	}
	if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
	my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
	my @ok_bccs;
	foreach my $bcc (@bccs) {
	$bcc =~ s/^\s+//g;
	$bcc =~ s/\s+$//g;
	if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
	if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
	push(@ok_bccs,$bcc);
	}
	}
	}
	if (@ok_bccs > 0) {
	$allbcc = join(', ',@ok_bccs);
	}
	}
	$addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
	}
	}
	}
	}
	}
	}
}	}
if (defined($defmail)) {	if (defined($defmail)) {
if ($defmail ne '') {	if ($defmail ne '') {
Line 14062 sub build_recipient_list {	Line 15060 sub build_recipient_list {
}	}
}	}
}	}
my $recipientlist = join(',',@recipients);	if ($mailing eq 'helpdeskmail') {
return $recipientlist;	if ((!@recipients) && ($lastresort ne '')) {
	push(@recipients,$lastresort);
	}
	} elsif ($lastresort ne '') {
	if (!grep(/^\Q$lastresort\E$/,@recipients)) {
	push(@recipients,$lastresort);
	}
	}
	my $recipientlist = join(',',@recipients);
	if (wantarray) {
	return ($recipientlist,$allbcc,$addtext);
	} else {
	return $recipientlist;
	}
}	}

############################################################	############################################################
Line 14235 jsarray (reference to array of categorie	Line 15246 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 14242 Side effects: populates trails and allit	Line 15255 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 14254 sub extract_categories {	Line 15267 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 14268 sub extract_categories {	Line 15283 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 14311 Side effects: populates trails and allit	Line 15329 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 14338 sub recurse_categories {	Line 15356 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 14368 currcat - scalar with an & separated lis	Line 15391 currcat - scalar with an & separated lis

type - scalar contains course type (Course or Community).	type - scalar contains course type (Course or Community).

	disabled - scalar (optional) contains disabled="disabled" if input elements are
	to be readonly (e.g., Domain Helpdesk role viewing course settings).

Returns: $output (markup to be displayed)	Returns: $output (markup to be displayed)

=cut	=cut

sub assign_categories_table {	sub assign_categories_table {
my ($cathash,$currcat,$type) = @_;	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 14392 sub assign_categories_table {	Line 15418 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 14406 sub assign_categories_table {	Line 15434 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="'.
$item.'"'.$checked.' />'.$parent_title.'</span>'.	$item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
'<input type="hidden" name="catname" value="'.$parent.'" /></td>';	'<input type="hidden" name="catname" value="'.$parent.'" /></td>';
my $depth = 1;	my $depth = 1;
push(@path,$parent);	push(@path,$parent);
$table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);	$table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
pop(@path);	pop(@path);
$table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';	$table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
$itemcount ++;	$itemcount ++;
Line 14452 path - Array containing all categories b	Line 15482 path - Array containing all categories b

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

	disabled - scalar (optional) contains disabled="disabled" if input elements are
	to be readonly (e.g., Domain Helpdesk role viewing course settings).

Returns: $output (markup to be displayed).	Returns: $output (markup to be displayed).

=cut	=cut

sub assign_category_rows {	sub assign_category_rows {
my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;	my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
my ($text,$name,$item,$chgstr);	my ($text,$name,$item,$chgstr);
if (ref($cats) eq 'ARRAY') {	if (ref($cats) eq 'ARRAY') {
my $maxdepth = scalar(@{$cats});	my $maxdepth = scalar(@{$cats});
Line 14480 sub assign_category_rows {	Line 15513 sub assign_category_rows {
}	}
$text .= '<tr><td><span class="LC_nobreak"><label>'.	$text .= '<tr><td><span class="LC_nobreak"><label>'.
'<input type="checkbox" name="usecategory" value="'.	'<input type="checkbox" name="usecategory" value="'.
$item.'"'.$checked.' />'.$name.'</label></span>'.	$item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
'<input type="hidden" name="catname" value="'.$name.'" />'.	'<input type="hidden" name="catname" value="'.$name.'" />'.
'</td><td>';	'</td><td>';
if (ref($path) eq 'ARRAY') {	if (ref($path) eq 'ARRAY') {
push(@{$path},$name);	push(@{$path},$name);
$text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);	$text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
pop(@{$path});	pop(@{$path});
}	}
$text .= '</td></tr>';	$text .= '</td></tr>';
Line 14712 sub check_clone {	Line 15745 sub check_clone {
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
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'});	$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'});
return ($can_clone, $clonemsg, $cloneid, $clonehome);	return ($can_clone, $clonemsg, $cloneid, $clonehome);
}	}
}	}
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
(&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {	(&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
$can_clone = 1;	$can_clone = 1;
} else {	} else {
Line 14813 sub check_clone {	Line 15846 sub check_clone {
}	}

sub construct_course {	sub construct_course {
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;	my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
	$cnum,$category,$coderef) = @_;
my $outcome;	my $outcome;
my $linefeed = '<br />'."\n";	my $linefeed = '<br />'."\n";
if ($context eq 'auto') {	if ($context eq 'auto') {
Line 14841 sub construct_course {	Line 15875 sub construct_course {
#	#
# 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 14858 sub construct_course {	Line 15897 sub construct_course {
# 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;	$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
if ($$courseid =~ /^error:/) {	if ($$courseid =~ /^error:/) {
return (0,$outcome);	return (0,$outcome);
}	}
Line 14878 sub construct_course {	Line 15917 sub construct_course {
# Do the cloning	# Do the cloning
#	#
if ($can_clone && $cloneid) {	if ($can_clone && $cloneid) {
$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);	$clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
if ($context ne 'auto') {	if ($context ne 'auto') {
$clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';	$clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
}	}
Line 14961 sub construct_course {	Line 16000 sub construct_course {
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});	my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
$cenv{'internal.sectionnums'} .= $item.',';	$cenv{'internal.sectionnums'} .= $item.',';
unless ($addcheck eq 'ok') {	unless ($addcheck eq 'ok') {
push @badclasses, $class;	push(@badclasses,$class);
}	}
}	}
$cenv{'internal.sectionnums'} =~ s/,$//;	$cenv{'internal.sectionnums'} =~ s/,$//;
Line 14989 sub construct_course {	Line 16028 sub construct_course {
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});	my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
$cenv{'internal.crosslistings'} .= $item.',';	$cenv{'internal.crosslistings'} .= $item.',';
unless ($addcheck eq 'ok') {	unless ($addcheck eq 'ok') {
push @badclasses, $xl;	push(@badclasses,$xl);
}	}
}	}
$cenv{'internal.crosslistings'} =~ s/,$//;	$cenv{'internal.crosslistings'} =~ s/,$//;
Line 15024 sub construct_course {	Line 16063 sub construct_course {
}	}
if (@badclasses > 0) {	if (@badclasses > 0) {
my %lt=&Apache::lonlocal::texthash(	my %lt=&Apache::lonlocal::texthash(
'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',	'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
'dnhr' => 'does not have rights to access enrollment in these classes',	'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
'adby' => 'as determined by the policies of your institution on access to official classlists'	'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
);	);
my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.	my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
' ('.$lt{'adby'}.')';	&mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'};
if ($context eq 'auto') {	if ($context eq 'auto') {
$outcome .= $badclass_msg.$linefeed;	$outcome .= $badclass_msg.$linefeed;
	} else {
$outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";	$outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
foreach my $item (@badclasses) {	}
if ($context eq 'auto') {	foreach my $item (@badclasses) {
$outcome .= " - $item\n";
} else {
$outcome .= "<li>$item</li>\n";
}
}
if ($context eq 'auto') {	if ($context eq 'auto') {
$outcome .= $linefeed;	$outcome .= " - $item\n";
} else {	} else {
$outcome .= "</ul><br /><br /></div>\n";	$outcome .= "<li>$item</li>\n";
}	}
	}
	if ($context eq 'auto') {
	$outcome .= $linefeed;
	} else {
	$outcome .= "</ul><br /><br /></div>\n";
}	}
}	}
if ($args->{'no_end_date'}) {	if ($args->{'no_end_date'}) {
Line 15077 sub construct_course {	Line 16117 sub construct_course {
if ($args->{'setcontent'}) {	if ($args->{'setcontent'}) {
$cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};	$cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
}	}
	if ($args->{'setcomment'}) {
	$cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
	}
}	}
if ($args->{'reshome'}) {	if ($args->{'reshome'}) {
$cenv{'reshome'}=$args->{'reshome'}.'/';	$cenv{'reshome'}=$args->{'reshome'}.'/';
Line 15183 sub construct_course {	Line 16226 sub construct_course {
$outcome .= ($fatal?$errtext:'write ok').$linefeed;	$outcome .= ($fatal?$errtext:'write ok').$linefeed;
}	}

	#
	# 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);	return (1,$outcome);
}	}

Line 15243 sub generate_code {	Line 16310 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 15262 sub group_term {	Line 16328 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 15352 sub compare_arrays {	Line 16421 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 15359 sub init_user_environment {	Line 16446 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 15382 sub init_user_environment {	Line 16467 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 15422 sub init_user_environment {	Line 16524 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 15475 sub init_user_environment {	Line 16576 sub init_user_environment {
$env{'user.noloadbalance'} = $lonhost;	$env{'user.noloadbalance'} = $lonhost;
}	}

my %is_adv = ( is_adv => $env{'user.adv'} );	if ($form->{'noloadbalance'}) {
my %domdef;	my @hosts = &Apache::lonnet::current_machine_ids();
unless ($domain eq 'public') {	my $hosthere = $form->{'noloadbalance'};
%domdef = &Apache::lonnet::get_domain_defaults($domain);	if (grep(/^\Q$hosthere\E$/,@hosts)) {
	$initial_env{"user.noloadbalance"} = $hosthere;
	$env{'user.noloadbalance'} = $hosthere;
	}
}	}

foreach my $tool ('aboutme','blog','webdav','portfolio') {	unless ($domain eq 'public') {
$userenv{'availabletools.'.$tool} =	my %is_adv = ( is_adv => $env{'user.adv'} );
&Apache::lonnet::usertools_access($username,$domain,$tool,'reload',	my %domdef = &Apache::lonnet::get_domain_defaults($domain);
undef,\%userenv,\%domdef,\%is_adv);
}

foreach my $crstype ('official','unofficial','community','textbook') {	foreach my $tool ('aboutme','blog','webdav','portfolio') {
$userenv{'canrequest.'.$crstype} =	$userenv{'availabletools.'.$tool} =
&Apache::lonnet::usertools_access($username,$domain,$crstype,	&Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
'reload','requestcourses',	undef,\%userenv,\%domdef,\%is_adv);
\%userenv,\%domdef,\%is_adv);	}
}

$userenv{'canrequest.author'} =	foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
&Apache::lonnet::usertools_access($username,$domain,'requestauthor',	$userenv{'canrequest.'.$crstype} =
'reload','requestauthor',	&Apache::lonnet::usertools_access($username,$domain,$crstype,
\%userenv,\%domdef,\%is_adv);	'reload','requestcourses',
my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],	\%userenv,\%domdef,\%is_adv);
$domain,$username);
my $reqstatus = $reqauthor{'author_status'};
if ($reqstatus eq 'approval' \|\| $reqstatus eq 'approved') {
if (ref($reqauthor{'author'}) eq 'HASH') {
$userenv{'requestauthorqueued'} = $reqstatus.':'.
$reqauthor{'author'}{'timestamp'};
}	}
}

	$userenv{'canrequest.author'} =
	&Apache::lonnet::usertools_access($username,$domain,'requestauthor',
	'reload','requestauthor',
	\%userenv,\%domdef,\%is_adv);
	my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
	$domain,$username);
	my $reqstatus = $reqauthor{'author_status'};
	if ($reqstatus eq 'approval' \|\| $reqstatus eq 'approved') {
	if (ref($reqauthor{'author'}) eq 'HASH') {
	$userenv{'requestauthorqueued'} = $reqstatus.':'.
	$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 15735 sub build_filters {	Line 16872 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 15751 sub build_filters {	Line 16892 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 15759 sub build_filters {	Line 16902 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 16112 sub search_courses {	Line 17261 sub search_courses {
if (ref($courses{$cid}) eq 'HASH') {	if (ref($courses{$cid}) eq 'HASH') {
if (ref($courses{$cid}{roles}) eq 'ARRAY') {	if (ref($courses{$cid}{roles}) eq 'ARRAY') {
if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {	if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
push (@{$courses{$cid}{roles}},$courserole);	push(@{$courses{$cid}{roles}},$courserole);
}	}
} else {	} else {
$courses{$cid}{roles} = [$courserole];	$courses{$cid}{roles} = [$courserole];
Line 16308 sub needs_coursereinit {	Line 17457 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 16332 sub needs_coursereinit {	Line 17485 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 16360 sub update_content_constraints {	Line 17525 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 16382 sub allmaps_incourse {	Line 17577 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 16418 sub parse_supplemental_title {	Line 17613 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 16429 sub recurse_supplemental {	Line 17624 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 16438 sub recurse_supplemental {	Line 17637 sub recurse_supplemental {
}	}
}	}
}	}
return ($numfiles,$errors);	return ($numfiles,$numexttools,$errors);
}	}

sub symb_to_docspath {	sub symb_to_docspath {
my ($symb) = @_;	my ($symb,$navmapref) = @_;
return unless ($symb);	return unless ($symb && ref($navmapref));
my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);	my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
if ($resurl=~/\.(sequence\|page)$/) {	if ($resurl=~/\.(sequence\|page)$/) {
$mapurl=$resurl;	$mapurl=$resurl;
Line 16451 sub symb_to_docspath {	Line 17650 sub symb_to_docspath {
$mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};	$mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
}	}
my $mapresobj;	my $mapresobj;
my $navmap = Apache::lonnavmaps::navmap->new();	unless (ref($$navmapref)) {
if (ref($navmap)) {	$$navmapref = Apache::lonnavmaps::navmap->new();
$mapresobj = $navmap->getResourceByUrl($mapurl);	}
	if (ref($$navmapref)) {
	$mapresobj = $$navmapref->getResourceByUrl($mapurl);
}	}
$mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};	$mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
my $type=$2;	my $type=$2;
Line 16463 sub symb_to_docspath {	Line 17664 sub symb_to_docspath {
if ($pcslist ne '') {	if ($pcslist ne '') {
foreach my $pc (split(/,/,$pcslist)) {	foreach my $pc (split(/,/,$pcslist)) {
next if ($pc <= 1);	next if ($pc <= 1);
my $res = $navmap->getByMapPc($pc);	my $res = $$navmapref->getByMapPc($pc);
if (ref($res)) {	if (ref($res)) {
my $thisurl = $res->src();	my $thisurl = $res->src();
$thisurl=~s{^.*/([^/]+)\.\w+$}{$1};	$thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
Line 16510 sub symb_to_docspath {	Line 17711 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 16529 sub captcha_display {	Line 17730 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 16543 sub captcha_response {	Line 17744 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 16591 sub get_captcha_config {	Line 17792 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 16615 sub create_captcha {	Line 17837 sub create_captcha {
last;	last;
}	}
}	}
	if ($output eq '') {
	&Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
	}
return $output;	return $output;
}	}

Line 16672 sub check_recaptcha {	Line 17897 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 16705 sub check_recaptcha {	Line 17935 sub check_recaptcha {
}	}

sub emailusername_info {	sub emailusername_info {
my @fields = ('firstname','lastname','institution','web','location','officialemail');	my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
my %titles = &Apache::lonlocal::texthash (	my %titles = &Apache::lonlocal::texthash (
lastname => 'Last Name',	lastname => 'Last Name',
firstname => 'First Name',	firstname => 'First Name',
Line 16713 sub emailusername_info {	Line 17943 sub emailusername_info {
location => "School's city, state/province, country",	location => "School's city, state/province, country",
web => "School's web address",	web => "School's web address",
officialemail => 'E-mail address at institution (if different)',	officialemail => 'E-mail address at institution (if different)',
	id => 'Student/Employee ID',
);	);
return (\@fields,\%titles);	return (\@fields,\%titles);
}	}
Line 16741 sub cleanup_html {	Line 17972 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) {
	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'},	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});
Line 16809 sub des_decrypt {	Line 18056 sub des_decrypt {
return $plaintext;	return $plaintext;
}	}

	sub make_short_symbs {
	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);
	my %tocreate;
	if (keys(%resources)) {
	foreach my $item (sort {$a <=> $b} (@toshorten)) {
	my $symb = $resources{$item};
	if ($symb) {
	$tocreate{$cnum.'&'.$symb} = 1;
	}
	}
	}
	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;
	my $lockhash = {
	"lock\0$now" => $env{'user.name'}.
	':'.$env{'user.domain'},
	};
	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) = @_;
	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) = ($url =~ m{^(https?\://[^/?#]+)});
	$remotehost = lc($remotehost);
	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;
	}
	}
	}
	}
	}
	}
	}
	}
	}
	}
	return $uselink;
	}


1;	1;
__END__;	__END__;

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

Removed from v.1.1236
changed lines
	Added in v.1.1328