loncom/interface/loncommon.pm - diff

Return to loncommon.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.1075.2.114 and 1.1075.2.161.2.6

version 1.1075.2.114, 2016/09/18 20:56:04	version 1.1075.2.161.2.6, 2022/05/30 13:30:03
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 HTTP::Request;
use DateTime::TimeZone;	use DateTime::TimeZone;
use DateTime::Locale;	use DateTime::Locale;
use Encode();	use Encode();
Line 80 use JSON::DWIW;	Line 81 use JSON::DWIW;
use LWP::UserAgent;	use LWP::UserAgent;
use Crypt::DES;	use Crypt::DES;
use DynaLoader; # for Crypt::DES version	use DynaLoader; # for Crypt::DES version
	use File::Copy();
	use File::Path();
	use String::CRC32();
	use Short::URL();

# ---------------------------------------------- Designs	# ---------------------------------------------- Designs
use vars qw(%defaultdesign);	use vars qw(%defaultdesign);
Line 194 BEGIN {	Line 199 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 215 BEGIN {	Line 220 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 229 BEGIN {	Line 234 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 243 BEGIN {	Line 248 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 257 BEGIN {	Line 262 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 272 BEGIN {	Line 277 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 425 sub studentbrowser_javascript {	Line 430 sub studentbrowser_javascript {
<script type="text/javascript" language="Javascript">	<script type="text/javascript" language="Javascript">
// <![CDATA[	// <![CDATA[
var stdeditbrowser;	var stdeditbrowser;
function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {	function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
var url = '/adm/pickstudent?';	var url = '/adm/pickstudent?';
var filter;	var filter;
if (!ignorefilter) {	if (!ignorefilter) {
Line 440 sub studentbrowser_javascript {	Line 445 sub studentbrowser_javascript {
'&udomelement='+udom+	'&udomelement='+udom+
'&clicker='+clicker;	'&clicker='+clicker;
if (roleflag) { url+="&roles=1"; }	if (roleflag) { url+="&roles=1"; }
if (courseadvonly) { url+="&courseadvonly=1"; }	if (courseadv == 'condition') {
	if (document.getElementById('courseadv')) {
	courseadv = document.getElementById('courseadv').value;
	}
	}
	if ((courseadv == 'only') \|\| (courseadv == 'none')) { url+="&courseadv="+courseadv; }
var title = 'Student_Browser';	var title = 'Student_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';	options += ',width=700,height=600';
Line 472 ENDRESBRW	Line 482 ENDRESBRW
}	}

sub selectstudent_link {	sub selectstudent_link {
my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;	my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".	my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
&Apache::lonhtmlcommon::entity_encode($unameele)."','".	&Apache::lonhtmlcommon::entity_encode($unameele)."','".
&Apache::lonhtmlcommon::entity_encode($udomele)."'";	&Apache::lonhtmlcommon::entity_encode($udomele)."'";
Line 483 sub selectstudent_link {	Line 493 sub selectstudent_link {
return '';	return '';
}	}
$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";	$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
if ($courseadvonly) {	if ($courseadv eq 'only') {
$callargs .= ",'',1,1";	$callargs .= ",'',1,'$courseadv'";
	} elsif ($courseadv eq 'none') {
	$callargs .= ",'','','$courseadv'";
	} elsif ($courseadv eq 'condition') {
	$callargs .= ",'','','$courseadv'";
}	}
return '<span class="LC_nobreak">'.	return '<span class="LC_nobreak">'.
'<a href="javascript:openstdbrowser('.$callargs.');">'.	'<a href="javascript:openstdbrowser('.$callargs.');">'.
Line 936 ENDSCRT	Line 950 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 958 sub select_timezone {	Line 972 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 1011 sub select_datelocale {	Line 1025 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 1023 sub select_language {	Line 1037 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 1138 sub linked_select_forms {	Line 1152 sub linked_select_forms {
$result.="select2data.d_$s1.texts = new Array(";	$result.="select2data.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";
}	}
Line 1207 END	Line 1221 END

=pod	=pod

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

Returns a string corresponding to an HTML link to the given help	Returns a string corresponding to an HTML link to the given help
$topic, where $topic corresponds to the name of a .tex file in	$topic, where $topic corresponds to the name of a .tex file in
Line 1231 $imgid is the id of the img tag used for	Line 1245 $imgid is the id of the img tag used for
used in a javascript call to switch the image src. See	used in a javascript call to switch the image src. See
lonhtmlcommon::htmlareaselectactive() for an example.	lonhtmlcommon::htmlareaselectactive() for an example.

	$links_target will optionally be set to a target (_top, _parent or _self).

=cut	=cut

sub help_open_topic {	sub help_open_topic {
my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;	my ($topic, $text, $stayOnPage, $width, $height, $imgid, $links_target) = @_;
$text = "" if (not defined $text);	$text = "" if (not defined $text);
$stayOnPage = 0 if (not defined $stayOnPage);	$stayOnPage = 0 if (not defined $stayOnPage);
$width = 500 if (not defined $width);	$width = 500 if (not defined $width);
Line 1260 sub help_open_topic {	Line 1276 sub help_open_topic {
}	}

# Add the text	# Add the text
	my $target = ' target="_top"';
	if ($links_target) {
	$target = ' target="'.$links_target.'"';
	} elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self')) {
	$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 1272 sub help_open_topic {	Line 1294 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 1345 ENDOUTPUT	Line 1367 ENDOUTPUT

# now just updates the help link and generates a blue icon	# now just updates the help link and generates a blue icon
sub help_open_menu {	sub help_open_menu {
my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)	my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text,$links_target)
= @_;	= @_;
$stayOnPage = 1;	$stayOnPage = 1;
my $output;	my $output;
if ($component_help) {	if ($component_help) {
if (!$text) {	if (!$text) {
$output=&help_open_topic($component_help,undef,$stayOnPage,	$output=&help_open_topic($component_help,undef,$stayOnPage,
$width,$height);	$width,$height,'',$links_target);
} else {	} else {
my $help_text;	my $help_text;
$help_text=&unescape($topic);	$help_text=&unescape($topic);
$output='<table><tr><td>'.	$output='<table><tr><td>'.
&help_open_topic($component_help,$help_text,$stayOnPage,	&help_open_topic($component_help,$help_text,$stayOnPage,
$width,$height).'</td></tr></table>';	$width,$height,'',$links_target).'</td></tr></table>';
}	}
}	}
my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);	my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
Line 1366 sub help_open_menu {	Line 1388 sub help_open_menu {
}	}

sub top_nav_help {	sub top_nav_help {
my ($text) = @_;	my ($text,$linkattr) = @_;
$text = &mt($text);	$text = &mt($text);
my $stay_on_page;	my $stay_on_page;
unless ($env{'environment.remote'} eq 'on') {	unless ($env{'environment.remote'} eq 'on') {
Line 1382 sub top_nav_help {	Line 1404 sub top_nav_help {
if ($link) {	if ($link) {
return <<"END";	return <<"END";
$banner_link	$banner_link
<a href="$link" title="$title">$text</a>	<a href="$link" title="$title" $linkattr>$text</a>
END	END
} else {	} else {
return ' '.$text.' ';	return ' '.$text.' ';
Line 1401 sub help_menu_js {	Line 1423 sub help_menu_js {
&Apache::loncommon::start_page('Help Menu', undef,	&Apache::loncommon::start_page('Help Menu', undef,
{'frameset' => 1,	{'frameset' => 1,
'js_ready' => 1,	'js_ready' => 1,
'use_absolute' => $httphost,	'use_absolute' => $httphost,
'add_entries' => {	'add_entries' => {
'border' => '0',	'border' => '0',
'rows' => "110,*",},});	'rows' => "110,*",},});
Line 1467 sub help_open_bug {	Line 1489 sub help_open_bug {
{	{
$link = $url;	$link = $url;
}	}

	my $target = '_top';
	if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) \|\|
	(($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
	$target = '_blank';
	}

# 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=\"$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="$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 2239 sub multiple_select_form {	Line 2268 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 2252 See lonrights.pm for an example invocati	Line 2284 See lonrights.pm for an example invocati

#-------------------------------------------	#-------------------------------------------
sub select_form {	sub select_form {
my ($def,$name,$hashref,$onchange) = @_;	my ($def,$name,$hashref,$onchange,$readonly) = @_;
return unless (ref($hashref) eq 'HASH');	return unless (ref($hashref) eq 'HASH');
if ($onchange) {	if ($onchange) {
$onchange = ' onchange="'.$onchange.'"';	$onchange = ' onchange="'.$onchange.'"';
}	}
my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";	my $disabled;
	if ($readonly) {
	$disabled = ' disabled="disabled"';
	}
	my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
my @keys;	my @keys;
if (exists($hashref->{'select_form_order'})) {	if (exists($hashref->{'select_form_order'})) {
@keys=@{$hashref->{'select_form_order'}};	@keys=@{$hashref->{'select_form_order'}};
Line 2426 sub select_level_form {	Line 2462 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 2441 The optional $onchange argument specifie	Line 2477 The optional $onchange argument specifie

The optional $incdoms is a reference to an array of domains which will be the only available options.	The optional $incdoms is a reference to an array of domains which will be the only available options.

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 2461 sub select_dom_form {	Line 2502 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 2837 sub authform_kerberos {	Line 2878 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 2888 sub authform_kerberos {	Line 2932 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 2897 sub authform_kerberos {	Line 2941 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 2910 sub authform_kerberos {	Line 2954 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 2921 sub authform_kerberos {	Line 2965 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 2931 sub authform_kerberos {	Line 2975 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 2944 sub authform_internal {	Line 2988 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 2974 sub authform_internal {	Line 3021 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 2982 sub authform_internal {	Line 3029 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 2999 sub authform_local {	Line 3046 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 3029 sub authform_local {	Line 3079 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 3038 sub authform_local {	Line 3088 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 3053 sub authform_filesystem {	Line 3103 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 3080 sub authform_filesystem {	Line 3133 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 3089 sub authform_filesystem {	Line 3142 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.'" />',
'</label><input type="password" size="10" name="fsysarg" value="" '.
'onchange="'.$jscall.'" />');
return $result;	return $result;
}	}

Line 3120 sub get_assignable_auth {	Line 3170 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 3144 sub get_assignable_auth {	Line 3194 sub get_assignable_auth {
return ($authnum,%can_assign);	return ($authnum,%can_assign);
}	}

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

	sub passwd_validation_js {
	my ($currpasswdval,$domain,$context,$id) = @_;
	my (%passwdconf,$alertmsg);
	if ($context eq 'linkprot') {
	my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
	if (ref($domconfig{'ltisec'}) eq 'HASH') {
	if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
	%passwdconf = %{$domconfig{'ltisec'}{'rules'}};
	}
	}
	if ($id eq 'add') {
	$alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
	} elsif ($id =~ /^\d+$/) {
	my $pos = $id+1;
	$alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
	} else {
	$alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
	}
	} else {
	%passwdconf = &Apache::lonnet::get_passwdconf($domain);
	$alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
	}
	my ($min,$max,@chars,$numrules,$intargjs,%alert);
	$numrules = 0;
	$min = $Apache::lonnet::passwdmin;
	if (ref($passwdconf{'chars'}) eq 'ARRAY') {
	if ($passwdconf{'min'} =~ /^\d+$/) {
	if ($passwdconf{'min'} > $min) {
	$min = $passwdconf{'min'};
	}
	}
	if ($passwdconf{'max'} =~ /^\d+$/) {
	$max = $passwdconf{'max'};
	$numrules ++;
	}
	@chars = @{$passwdconf{'chars'}};
	if (@chars) {
	$numrules ++;
	}
	}
	if ($min > 0) {
	$numrules ++;
	}
	if (($min > 0) \|\| ($max ne '') \|\| (@chars > 0)) {
	if ($min) {
	$alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
	}
	if ($max) {
	$alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
	}
	my (@charalerts,@charrules);
	if (@chars) {
	if (grep(/^uc$/,@chars)) {
	push(@charalerts,&mt('contain at least one upper case letter'));
	push(@charrules,'uc');
	}
	if (grep(/^lc$/,@chars)) {
	push(@charalerts,&mt('contain at least one lower case letter'));
	push(@charrules,'lc');
	}
	if (grep(/^num$/,@chars)) {
	push(@charalerts,&mt('contain at least one number'));
	push(@charrules,'num');
	}
	if (grep(/^spec$/,@chars)) {
	push(@charalerts,&mt('contain at least one non-alphanumeric'));
	push(@charrules,'spec');
	}
	}
	$intargjs = qq\| var rulesmsg = '';\n\|.
	qq\| var currpwval = $currpasswdval;\n\|;
	if ($min) {
	$intargjs .= qq\|
	if (currpwval.length < $min) {
	rulesmsg += ' - $alert{min}';
	}
	\|;
	}
	if ($max) {
	$intargjs .= qq\|
	if (currpwval.length > $max) {
	rulesmsg += ' - $alert{max}';
	}
	\|;
	}
	if (@chars > 0) {
	my $charrulestr = '"'.join('","',@charrules).'"';
	my $charalertstr = '"'.join('","',@charalerts).'"';
	$intargjs .= qq\| var brokerules = new Array();\n\|.
	qq\| var charrules = new Array($charrulestr);\n\|.
	qq\| var charalerts = new Array($charalertstr);\n\|;
	my %rules;
	map { $rules{$_} = 1; } @chars;
	if ($rules{'uc'}) {
	$intargjs .= qq\|
	var ucRegExp = /[A-Z]/;
	if (!ucRegExp.test(currpwval)) {
	brokerules.push('uc');
	}
	\|;
	}
	if ($rules{'lc'}) {
	$intargjs .= qq\|
	var lcRegExp = /[a-z]/;
	if (!lcRegExp.test(currpwval)) {
	brokerules.push('lc');
	}
	\|;
	}
	if ($rules{'num'}) {
	$intargjs .= qq\|
	var numRegExp = /[0-9]/;
	if (!numRegExp.test(currpwval)) {
	brokerules.push('num');
	}
	\|;
	}
	if ($rules{'spec'}) {
	$intargjs .= q\|
	var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\\|}~]/;
	if (!specRegExp.test(currpwval)) {
	brokerules.push('spec');
	}
	\|;
	}
	$intargjs .= qq\|
	if (brokerules.length > 0) {
	for (var i=0; i<brokerules.length; i++) {
	for (var j=0; j<charrules.length; j++) {
	if (brokerules[i] == charrules[j]) {
	rulesmsg += ' - '+charalerts[j]+'\\n';
	break;
	}
	}
	}
	}
	\|;
	}
	$intargjs .= qq\|
	if (rulesmsg != '') {
	rulesmsg = '$alertmsg'+rulesmsg;
	alert(rulesmsg);
	return false;
	}
	\|;
	}
	return ($numrules,$intargjs);
	}

###############################################################	###############################################################
## Get Kerberos Defaults for Domain ##	## Get Kerberos Defaults for Domain ##
###############################################################	###############################################################
Line 4314 sub get_student_view_with_retries {	Line 4586 sub get_student_view_with_retries {
}	}
}	}

	sub css_links {
	my ($currsymb,$level) = @_;
	my ($links,@symbs,%cssrefs,%httpref);
	if ($level eq 'map') {
	my $navmap = Apache::lonnavmaps::navmap->new();
	if (ref($navmap)) {
	my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
	my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
	foreach my $res (@resources) {
	if (ref($res) && $res->symb()) {
	push(@symbs,$res->symb());
	}
	}
	}
	} else {
	@symbs = ($currsymb);
	}
	foreach my $symb (@symbs) {
	my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
	if ($css_href =~ /\S/) {
	unless ($css_href =~ m{https?://}) {
	my $url = (&Apache::lonnet::decode_symb($symb))[-1];
	my $proburl = &Apache::lonnet::clutter($url);
	my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
	unless ($css_href =~ m{^/}) {
	$css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
	}
	if ($css_href =~ m{^/(res\|uploaded)/}) {
	unless (($httpref{'httpref.'.$css_href}) \|\|
	(&Apache::lonnet::is_on_map($css_href))) {
	my $thisurl = $proburl;
	if ($env{'httpref.'.$proburl}) {
	$thisurl = $env{'httpref.'.$proburl};
	}
	$httpref{'httpref.'.$css_href} = $thisurl;
	}
	}
	}
	$cssrefs{$css_href} = 1;
	}
	}
	if (keys(%httpref)) {
	&Apache::lonnet::appenv(\%httpref);
	}
	if (keys(%cssrefs)) {
	foreach my $css_href (keys(%cssrefs)) {
	next unless ($css_href =~ m{^(/res/\|/uploaded/\|https?://)});
	$links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
	}
	}
	return $links;
	}

=pod	=pod

=item * &get_student_answers()	=item * &get_student_answers()
Line 4569 sub findallcourses {	Line 4894 sub findallcourses {
###############################################	###############################################

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

	unless (($activity eq 'docs') \|\| ($activity eq 'reinit') \|\| ($activity eq 'alert')) {
	my ($has_evb,$check_ipaccess);
	my $dom = $env{'user.domain'};
	if ($env{'request.course.id'}) {
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	my $checkrole = "cm./$cdom/$cnum";
	my $sec = $env{'request.course.sec'};
	if ($sec ne '') {
	$checkrole .= "/$sec";
	}
	if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
	($env{'request.role'} !~ /^st/)) {
	$has_evb = 1;
	}
	unless ($has_evb) {
	if (($activity eq 'printout') \|\| ($activity eq 'grades') \|\| ($activity eq 'search') \|\|
	($activity eq 'boards') \|\| ($activity eq 'groups') \|\| ($activity eq 'chat')) {
	if ($udom eq $cdom) {
	$check_ipaccess = 1;
	}
	}
	}
	} elsif (($activity eq 'com') \|\| ($activity eq 'port') \|\| ($activity eq 'blogs') \|\|
	($activity eq 'about') \|\| ($activity eq 'wishlist') \|\| ($activity eq 'passwd')) {
	my $checkrole;
	if ($env{'request.role.domain'} eq '') {
	$checkrole = "cm./$env{'user.domain'}/";
	} else {
	$checkrole = "cm./$env{'request.role.domain'}/";
	}
	if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
	$has_evb = 1;
	}
	}
	unless ($has_evb \|\| $check_ipaccess) {
	my @machinedoms = &Apache::lonnet::current_machine_domains();
	if (($dom eq 'public') && ($activity eq 'port')) {
	$dom = $udom;
	}
	if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
	$check_ipaccess = 1;
	} else {
	my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
	my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
	my $prim = &Apache::lonnet::domain($dom,'primary');
	my $intdom = &Apache::lonnet::internet_dom($prim);
	if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
	if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
	$check_ipaccess = 1;
	}
	}
	}
	}
	if ($check_ipaccess) {
	my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
	unless (defined($cached)) {
	my %domconfig =
	&Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
	$ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
	}
	if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
	foreach my $id (keys(%{$ipaccessref})) {
	if (ref($ipaccessref->{$id}) eq 'HASH') {
	my $range = $ipaccessref->{$id}->{'ip'};
	if ($range) {
	if (&Apache::lonnet::ip_match($clientip,$range)) {
	if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
	if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
	return ('','','',$id,$dom);
	last;
	}
	}
	}
	}
	}
	}
	}
	}
	if (($activity eq 'wishlist') \|\| ($activity eq 'annotate')) {
	return ();
	}
	}
if (defined($udom) && defined($uname)) {	if (defined($udom) && defined($uname)) {
# If uname and udom are for a course, check for blocks in the course.	# If uname and udom are for a course, check for blocks in the course.
if (($is_course) \|\| (&Apache::lonnet::is_course($udom,$uname))) {	if (($is_course) \|\| (&Apache::lonnet::is_course($udom,$uname))) {
my ($startblock,$endblock,$triggerblock) =	my ($startblock,$endblock,$triggerblock) =
&get_blocks($setters,$activity,$udom,$uname,$url);	&get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
return ($startblock,$endblock,$triggerblock);	return ($startblock,$endblock,$triggerblock);
}	}
} else {	} else {
Line 4586 sub blockcheck {	Line 4994 sub blockcheck {
my $startblock = 0;	my $startblock = 0;
my $endblock = 0;	my $endblock = 0;
my $triggerblock = '';	my $triggerblock = '';
my %live_courses = &findallcourses(undef,$uname,$udom);	my %live_courses;
	unless (($activity eq 'wishlist') \|\| ($activity eq 'annotate')) {
	%live_courses = &findallcourses(undef,$uname,$udom);
	}

# If uname is for a user, and activity is course-specific, i.e.,	# If uname is for a user, and activity is course-specific, i.e.,
# 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' \|\|
($env{'request.course.id'})) {	$activity eq 'search' \|\| $activity eq 'reinit' \|\|
	$activity eq 'alert') && ($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'}) {
delete($live_courses{$key});	delete($live_courses{$key});
Line 4676 sub blockcheck {	Line 5088 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 4698 sub blockcheck {	Line 5110 sub blockcheck {
($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));	($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
next if ($no_userblock);	next if ($no_userblock);

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

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

sub get_blocks {	sub get_blocks {
my ($setters,$activity,$cdom,$cnum,$url) = @_;	my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
my $startblock = 0;	my $startblock = 0;
my $endblock = 0;	my $endblock = 0;
my $triggerblock = '';	my $triggerblock = '';
Line 4735 sub get_blocks {	Line 5147 sub get_blocks {
my $now = time;	my $now = time;
my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);	my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
if ($activity eq 'docs') {	if ($activity eq 'docs') {
@blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);	my ($blocked,$nosymbcache,$noenccheck);
	if (($caller eq 'blockedaccess') \|\| ($caller eq 'blockingstatus')) {
	$blocked = 1;
	$nosymbcache = 1;
	$noenccheck = 1;
	}
	@blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
foreach my $block (@blockers) {	foreach my $block (@blockers) {
if ($block =~ /^firstaccess____(.+)$/) {	if ($block =~ /^firstaccess____(.+)$/) {
my $item = $1;	my $item = $1;
Line 4787 sub get_blocks {	Line 5205 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 4857 sub parse_block_record {	Line 5281 sub parse_block_record {
}	}

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

# check for active blocking	# check for active blocking
my ($startblock,$endblock,$triggerblock) =	if ($clientip eq '') {
&blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);	$clientip = &Apache::lonnet::get_requestor_ip();
	}
	my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
	&blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
my $blocked = 0;	my $blocked = 0;
if ($startblock && $endblock) {	if (($startblock && $endblock) \|\| ($by_ip)) {
$blocked = 1;	$blocked = 1;
}	}

Line 4873 sub blocking_status {	Line 5300 sub blocking_status {

# build a link to a popup window containing the details	# build a link to a popup window containing the details
my $querystring = "?activity=$activity";	my $querystring = "?activity=$activity";
# $uname and $udom decide whose portfolio the user is trying to look at	# $uname and $udom decide whose portfolio (or information page) the user is trying to look at
if (($activity eq 'port') \|\| ($activity eq 'passwd')) {	if (($activity eq 'port') \|\| ($activity eq 'about') \|\| ($activity eq 'passwd')) {
$querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);	$querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
$querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);	$querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
} elsif ($activity eq 'docs') {	} elsif ($activity eq 'docs') {
$querystring .= '&url='.&HTML::Entities::encode($url,'&"');	my $showurl = &Apache::lonenc::check_encrypt($url);
	$querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
	if ($symb) {
	my $showsymb = &Apache::lonenc::check_encrypt($symb);
	$querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
	}
}	}

my $output .= <<'END_MYBLOCK';	my $output .= <<'END_MYBLOCK';
Line 4903 END_MYBLOCK	Line 5335 END_MYBLOCK
$text = &mt('Printing Blocked');	$text = &mt('Printing Blocked');
} elsif ($activity eq 'passwd') {	} elsif ($activity eq 'passwd') {
$text = &mt('Password Changing Blocked');	$text = &mt('Password Changing Blocked');
	} elsif ($activity eq 'grades') {
	$text = &mt('Gradebook Blocked');
	} elsif ($activity eq 'search') {
	$text = &mt('Search Blocked');
	} elsif ($activity eq 'alert') {
	$text = &mt('Checking Critical Messages Blocked');
	} elsif ($activity eq 'reinit') {
	$text = &mt('Checking Course Update Blocked');
	} elsif ($activity eq 'about') {
	$text = &mt('Access to User Information Pages Blocked');
	} elsif ($activity eq 'wishlist') {
	$text = &mt('Access to Stored Links Blocked');
	} elsif ($activity eq 'annotate') {
	$text = &mt('Access to Annotations Blocked');
}	}
$output .= <<"END_BLOCK";	$output .= <<"END_BLOCK";
<div class='$class'>	<div class='$class'>
Line 4927 sub check_ip_acc {	Line 5373 sub check_ip_acc {
return 1;	return 1;
}	}
my $allowed=0;	my $allowed=0;
my $ip=$ENV{'REMOTE_ADDR'} \|\| $clientip \|\| $env{'request.host'};	my $ip;
	if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') \|\|
	($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
	$ip = $env{'request.host'} \|\| $ENV{'REMOTE_ADDR'} \|\| $clientip;
	} else {
	my $remote_ip = &Apache::lonnet::get_requestor_ip();
	$ip = $remote_ip \|\| $env{'request.host'} \|\| $clientip;
	}

my $name;	my $name;
foreach my $pattern (split(',',$acc)) {	my %access = (
$pattern =~ s/^\s*//;	allowfrom => 1,
$pattern =~ s/\s*$//;	denyfrom => 0,
	);
	my @allows;
	my @denies;
	foreach my $item (split(',',$acc)) {
	$item =~ s/^\s*//;
	$item =~ s/\s*$//;
	if ($item =~ /^\!(.+)$/) {
	push(@denies,$1);
	} else {
	push(@allows,$item);
	}
	}
	my $numdenies = scalar(@denies);
	my $numallows = scalar(@allows);
	my $count = 0;
	foreach my $pattern (@denies,@allows) {
	$count ++;
	my $acctype = 'allowfrom';
	if ($count <= $numdenies) {
	$acctype = 'denyfrom';
	}
if ($pattern =~ /\*$/) {	if ($pattern =~ /\*$/) {
#35.8.*	#35.8.*
$pattern=~s/\*//;	$pattern=~s/\*//;
if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }	if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
} elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {	} elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
#35.8.3.[34-56]	#35.8.3.[34-56]
my $low=$2;	my $low=$2;
Line 4944 sub check_ip_acc {	Line 5418 sub check_ip_acc {
$pattern=$1;	$pattern=$1;
if ($ip =~ /^\Q$pattern\E/) {	if ($ip =~ /^\Q$pattern\E/) {
my $last=(split(/\./,$ip))[3];	my $last=(split(/\./,$ip))[3];
if ($last <=$high && $last >=$low) { $allowed=1; }	if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
}	}
} elsif ($pattern =~ /^\*/) {	} elsif ($pattern =~ /^\*/) {
#*.msu.edu	#*.msu.edu
Line 4954 sub check_ip_acc {	Line 5428 sub check_ip_acc {
my $netaddr=inet_aton($ip);	my $netaddr=inet_aton($ip);
($name)=gethostbyaddr($netaddr,AF_INET);	($name)=gethostbyaddr($netaddr,AF_INET);
}	}
if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }	if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
} elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {	} elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
#127.0.0.1	#127.0.0.1
if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }	if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
} else {	} else {
#some.name.com	#some.name.com
if (!defined($name)) {	if (!defined($name)) {
Line 4965 sub check_ip_acc {	Line 5439 sub check_ip_acc {
my $netaddr=inet_aton($ip);	my $netaddr=inet_aton($ip);
($name)=gethostbyaddr($netaddr,AF_INET);	($name)=gethostbyaddr($netaddr,AF_INET);
}	}
if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }	if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
	}
	if ($allowed =~ /^(0\|1)$/) { last; }
	}
	if ($allowed eq '') {
	if ($numdenies && !$numallows) {
	$allowed = 1;
	} else {
	$allowed = 0;
}	}
if ($allowed) { last; }
}	}
return $allowed;	return $allowed;
}	}
Line 5048 sub get_domainconf {	Line 5529 sub get_domainconf {
}	}
}	}
}	}
	} elsif ($key eq 'saml') {
	if (ref($domconfig{'login'}{$key}) eq 'HASH') {
	foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
	if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
	$designhash{$udom.'.login.'.$key.'_'.$host} = 1;
	foreach my $item ('text','img','alt','url','title','notsso') {
	$designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
	}
	}
	}
	}
} else {	} else {
foreach my $img (keys(%{$domconfig{'login'}{$key}})) {	foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
$designhash{$udom.'.login.'.$key.'_'.$img} =	$designhash{$udom.'.login.'.$key.'_'.$img} =
Line 5112 sub get_legacy_domconf {	Line 5604 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 5152 sub domainlogo {	Line 5644 sub domainlogo {
&Apache::lonnet::repcopy($local_name);	&Apache::lonnet::repcopy($local_name);
}	}
$imgsrc = &lonhttpdurl($imgsrc);	$imgsrc = &lonhttpdurl($imgsrc);
}	}
return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';	my $alttext = $domain;
	if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
	$alttext = $designhash{$domain.'.login.alttext_domlogo'};
	}
	return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
} elsif (defined(&Apache::lonnet::domain($domain,'description'))) {	} elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
return &Apache::lonnet::domain($domain,'description');	return &Apache::lonnet::domain($domain,'description');
} else {	} else {
Line 5271 sub head_subbox {	Line 5767 sub head_subbox {
Input: (optional) filename from which breadcrumb trail is built.	Input: (optional) filename from which breadcrumb trail is built.
In most cases no input as needed, as $env{'request.filename'}	In most cases no input as needed, as $env{'request.filename'}
is appropriate for use in building the breadcrumb trail.	is appropriate for use in building the breadcrumb trail.
	frameset flag
	If page header is being requested for use in a frameset, then
	the second (option) argument -- frameset will be true, and
	the target attribute set for links should be target="_parent".

Returns: HTML div with CSTR path and recent box	Returns: HTML div with CSTR path and recent box
To be included on Authoring Space pages	To be included on Authoring Space pages
Line 5278 Returns: HTML div with CSTR path and rec	Line 5778 Returns: HTML div with CSTR path and rec
=cut	=cut

sub CSTR_pageheader {	sub CSTR_pageheader {
my ($trailfile) = @_;	my ($trailfile,$frameset) = @_;
if ($trailfile eq '') {	if ($trailfile eq '') {
$trailfile = $env{'request.filename'};	$trailfile = $env{'request.filename'};
}	}
Line 5301 sub CSTR_pageheader {	Line 5801 sub CSTR_pageheader {
$lastitem = $thisdisfn;	$lastitem = $thisdisfn;
}	}

	my ($target,$crumbtarget) = (' target="_top"','_top');
	if ($frameset) {
	$target = ' target="_parent"';
	$crumbtarget = '_parent';
	} elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
	$target = ' target="'.$env{'request.deeplink.target'}.'"';
	$crumbtarget = $env{'request.deeplink.target'};
	}

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>'.&mt('Authoring Space:').'</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 5317 sub CSTR_pageheader {	Line 5825 sub CSTR_pageheader {
}	}
$output .=	$output .=
'<br />'	'<br />'
#FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"	#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()')	.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
.'</form>'	.'</form>'
.&Apache::lonmenu::constspaceform()	.&Apache::lonmenu::constspaceform($frameset)
.'</div>';	.'</div>';

return $output;	return $output;
Line 5368 Inputs:	Line 5876 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 5384 other decorations will be returned.	Line 5909 other decorations will be returned.

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

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 5393 sub bodytag {	Line 5919 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 5412 sub bodytag {	Line 5939 sub bodytag {
if ($realm) {	if ($realm) {
$realm = '/'.$realm;	$realm = '/'.$realm;
}	}
if ($role eq 'ca') {	if ($role eq 'ca') {
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});	my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
$realm = &plainname($rname,$rdom);	$realm = &plainname($rname,$rdom);
}	}
# realm	# realm
	my ($cid,$sec);
if ($env{'request.course.id'}) {	if ($env{'request.course.id'}) {
	$cid = $env{'request.course.id'};
	if ($env{'request.course.sec'}) {
	$sec = $env{'request.course.sec'};
	}
	} elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:\|/(\w+))$}) {
	if (&Apache::lonnet::is_course($1,$2)) {
	$cid = $1.'_'.$2;
	$sec = $3;
	}
	}
	if ($cid) {
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 ($sec) {
$role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};	$role .= (' 'x2).'- '.&mt('section:').' '.$sec;
}	}
$realm = $env{'course.'.$env{'request.course.id'}.'.description'};	$realm = $env{'course.'.$cid.'.description'};
} else {	} else {
$role = &Apache::lonnet::plaintext($role);	$role = &Apache::lonnet::plaintext($role);
}	}
Line 5446 sub bodytag {	Line 5993 sub bodytag {
if ($public) {	if ($public) {
undef($role);	undef($role);
}	}

	my $showcrstitle = 1;
	if (($cid) && ($env{'request.lti.login'})) {
	if (ref($ltimenu) eq 'HASH') {
	unless ($ltimenu->{'role'}) {
	undef($role);
	}
	unless ($ltimenu->{'coursetitle'}) {
	$realm=' ';
	$showcrstitle = 0;
	}
	}
	} elsif (($cid) && ($menucoll)) {
	if (ref($menuref) eq 'HASH') {
	unless ($menuref->{'role'}) {
	undef($role);
	}
	unless ($menuref->{'crs'}) {
	$realm=' ';
	$showcrstitle = 0;
	}
	}
	}

my $titleinfo = '<h1>'.$title.'</h1>';	my $titleinfo = '<h1>'.$title.'</h1>';
#	#
# Extra info if you are the DC	# Extra info if you are the DC
my $dc_info = '';	my $dc_info = '';
if ($env{'user.adv'} && exists($env{'user.role.dc./'.	if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
$env{'course.'.$env{'request.course.id'}.	(exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
'.domain'}.'/'})) {
my $cid = $env{'request.course.id'};
$dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};	$dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
$dc_info =~ s/\s+$//;	$dc_info =~ s/\s+$//;
}	}

	my $crstype;
	if ($cid) {
	$crstype = $env{'course.'.$cid.'.type'};
	} elsif ($args->{'crstype'}) {
	$crstype = $args->{'crstype'};
	}

$role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});	$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 5473 sub bodytag {	Line 6048 sub bodytag {
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'},	&Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
$forcereg,$args->{'group'},	$forcereg,$args->{'group'},
$args->{'bread_crumbs'},	$args->{'bread_crumbs'},
$advtoolsref,'',\$forbodytag);	$advtoolsref,'','',\$forbodytag);
unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {	unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
$funclist = $forbodytag;	$funclist = $forbodytag;
}	}
Line 5486 sub bodytag {	Line 6061 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,$menucoll,$menuref,
if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {	$args->{'links_disabled'},
if ($dc_info) {	$args->{'links_target'});
$dc_info = qq\|<span class="LC_cusr_subheading">$dc_info</span>\|;	if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
	if ($dc_info) {
	$dc_info = qq\|<span class="LC_cusr_subheading">$dc_info</span>\|;
	}
	$bodytag .= qq\|<div id="LC_nav_bar">$left $role<br />
	<em>$realm</em> $dc_info</div>\|;
	return $bodytag;
}	}
$bodytag .= qq\|<div id="LC_nav_bar">$left $role<br />
<em>$realm</em> $dc_info</div>\|;
return $bodytag;
}

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

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

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

#if directed to not display the secondary menu, don't.	#if directed to not display the secondary menu, don't.
if ($args->{'no_secondary_menu'}) {	if ($args->{'no_secondary_menu'}) {
Line 5514 sub bodytag {	Line 6092 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'},
	$menucoll,$menuref,
	$args->{'links_disabled'},
	$args->{'links_target'});
	}
$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 {
my $forbodytag;	my $forbodytag;
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'},	&Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
$forcereg,$args->{'group'},	$forcereg,$args->{'group'},
$args->{'bread_crumbs'},	$args->{'bread_crumbs'},
$advtoolsref,'',\$forbodytag);	$advtoolsref,'',$hostname,
	\$forbodytag);
unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {	unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
$bodytag .= $forbodytag;	$bodytag .= $forbodytag;
}	}
Line 6042 td.LC_menubuttons_text {	Line 6629 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 6632 table.LC_prior_tries td {	Line 7224 table.LC_prior_tries td {
padding: 6px;	padding: 6px;
}	}

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

	.LC_domprefs_email,
.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 7622 ul.LC_funclist li {	Line 8216 ul.LC_funclist li {
cursor:pointer;	cursor:pointer;
}	}

	.LCisDisabled {
	cursor: not-allowed;
	opacity: 0.5;
	}

	a[aria-disabled="true"] {
	color: currentColor;
	display: inline-block; /* For IE11/ MS Edge bug */
	pointer-events: none;
	text-decoration: none;
	}

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

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

	#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 7748 ADDMETA	Line 8395 ADDMETA
my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};	my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {	unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);	my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
	my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
	my ($offload,$offloadoth);
if (ref($domdefs{'offloadnow'}) eq 'HASH') {	if (ref($domdefs{'offloadnow'}) eq 'HASH') {
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
if ($domdefs{'offloadnow'}{$lonhost}) {	if ($domdefs{'offloadnow'}{$lonhost}) {
my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);	$offload = 1;
if (($newserver) && ($newserver ne $lonhost)) {	if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
my $numsec = 5;	(!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
my $timeout = $numsec * 1000;	unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
my ($newurl,$locknum,%locks,$msg);	$offloadoth = 1;
if ($env{'request.role.adv'}) {	$dom_in_use = $env{'user.domain'};
($locknum,%locks) = &Apache::lonnet::get_locks();
}	}
my $disable_submit = 0;	}
if ($requrl =~ /$LONCAPA::assess_re/) {	}
$disable_submit = 1;	}
	unless ($offload) {
	if (ref($domdefs{'offloadoth'}) eq 'HASH') {
	if ($domdefs{'offloadoth'}{$lonhost}) {
	if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
	(!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
	unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
	$offload = 1;
	$offloadoth = 1;
	$dom_in_use = $env{'user.domain'};
	}
}	}
if ($locknum) {	}
my @lockinfo = sort(values(%locks));	}
$msg = &mt('Once the following tasks are complete: ')."\\n".	}
join(", ",sort(values(%locks)))."\\n".	if ($offload) {
&mt('your session will be transferred to a different server, after you click "Roles".');	my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
	if (($newserver eq '') && ($offloadoth)) {
	my @domains = &Apache::lonnet::current_machine_domains();
	if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
	($newserver) = &Apache::lonnet::choose_server($dom_in_use);
	}
	}
	if (($newserver) && ($newserver ne $lonhost)) {
	my $numsec = 5;
	my $timeout = $numsec * 1000;
	my ($newurl,$locknum,%locks,$msg);
	if ($env{'request.role.adv'}) {
	($locknum,%locks) = &Apache::lonnet::get_locks();
	}
	my $disable_submit = 0;
	if ($requrl =~ /$LONCAPA::assess_re/) {
	$disable_submit = 1;
	}
	if ($locknum) {
	my @lockinfo = sort(values(%locks));
	$msg = &mt('Once the following tasks are complete:')." \n".
	join(", ",sort(values(%locks)))."\n";
	if (&show_course()) {
	$msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
} else {	} else {
if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {	$msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
$msg = &mt('Your LON-CAPA submission has been recorded')."\\n";	}
}	} else {
$msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);	if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
$newurl = '/adm/switchserver?otherserver='.$newserver;	$msg = &mt('Your LON-CAPA submission has been recorded')."\n";
if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {	}
$newurl .= '&role='.$env{'request.role'};	$msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
	$newurl = '/adm/switchserver?otherserver='.$newserver;
	if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
	$newurl .= '&role='.$env{'request.role'};
	}
	if ($env{'request.symb'}) {
	my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
	if ($shownsymb =~ m{^/enc/}) {
	my $reqdmajor = 2;
	my $reqdminor = 11;
	my $reqdsubminor = 3;
	my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
	my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
	my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+\|)[\w.\-]+\'?$/);
	if (($major eq '' && $minor eq '') \|\|
	(($reqdmajor > $major) \|\| (($reqdmajor == $major) && ($reqdminor > $minor)) \|\|
	(($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') \|\|
	($reqdsubminor > $subminor))))) {
	undef($shownsymb);
	}
}	}
if ($env{'request.symb'}) {	if ($shownsymb) {
$newurl .= '&symb='.$env{'request.symb'};	&js_escape(\$shownsymb);
} else {	$newurl .= '&symb='.$shownsymb;
$newurl .= '&origurl='.$requrl;
}	}
	} else {
	my $shownurl = &Apache::lonenc::check_encrypt($requrl);
	&js_escape(\$shownurl);
	$newurl .= '&origurl='.$shownurl;
}	}
&js_escape(\$msg);	}
$result.=<<OFFLOAD	&js_escape(\$msg);
	$result.=<<OFFLOAD
<meta http-equiv="pragma" content="no-cache" />	<meta http-equiv="pragma" content="no-cache" />
<script type="text/javascript">	<script type="text/javascript">
// <![CDATA[	// <![CDATA[
Line 7805 function LC_Offload_Now() {	Line 8508 function LC_Offload_Now() {
// ]]>	// ]]>
</script>	</script>
OFFLOAD	OFFLOAD
}
}	}
}	}
}	}
Line 7835 OFFLOAD	Line 8537 OFFLOAD
<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 7903 sub print_suppression {	Line 8606 sub print_suppression {
}	}
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);	my $clientip = &Apache::lonnet::get_requestor_ip();
	my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
if ($blocked) {	if ($blocked) {
my $checkrole = "cm./$cdom/$cnum";	my $checkrole = "cm./$cdom/$cnum";
if ($env{'request.course.sec'} ne '') {	if ($env{'request.course.sec'} ne '') {
Line 8016 $args - additional optional args support	Line 8720 $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).
	links_disabled -> Links in primary and secondary menus are disabled
	(Can enable them once page has loaded - see lonroles.pm
	for an example).
	links_target -> Target for links, e.g., _parent (optional).

=back	=back

Line 8030 sub start_page {	Line 8744 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,$menucoll,%menu);

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'});
	} elsif ($env{'request.course.id'}) {
	my $expiretime=600;
	if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
	&Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
	}
	my ($deeplinkmenu,$menuref);
	($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
	if ($menucoll) {
	if (ref($menuref) eq 'HASH') {
	%menu = %{$menuref};
	}
	if ($menu{'top'} eq 'n') {
	$args->{'no_primary_menu'} = 1;
	}
	if ($menu{'inline'} eq 'n') {
	unless (&Apache::lonnet::allowed('opa')) {
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	my $crstype = &course_type();
	my $now = time;
	my $ccrole;
	if ($crstype eq 'Community') {
	$ccrole = 'co';
	} else {
	$ccrole = 'cc';
	}
	if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
	my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
	if ((($start) && ($start<0)) \|\|
	(($end) && ($end<$now)) \|\|
	(($start) && ($now<$start))) {
	$args->{'no_inline_menu'} = 1;
	}
	} else {
	$args->{'no_inline_menu'} = 1;
	}
	}
	}
	}
	}

if (! exists($args->{'skip_phases'}{'body'}) ) {	if (! exists($args->{'skip_phases'}{'body'}) ) {
if ($args->{'frameset'}) {	if ($args->{'frameset'}) {
my $attr_string = &make_attr_string($args->{'force_register'},	my $attr_string = &make_attr_string($args->{'force_register'},
Line 8048 sub start_page {	Line 8832 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->{'no_inline_link'},	$args->{'bgcolor'}, $args->{'no_inline_link'},
$args, \@advtools);	$args, \@advtools,
	$ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu);
}	}
}	}

Line 8081 sub start_page {	Line 8866 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')) {
	$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);
}	}
} elsif (($env{'environment.remote'} eq 'on') &&	} elsif (($env{'environment.remote'} eq 'on') &&
($env{'form.inhibitmenu'} ne 'yes') &&	($env{'form.inhibitmenu'} ne 'yes') &&
Line 8129 sub end_page {	Line 8921 sub end_page {
return $result;	return $result;
}	}

	sub menucoll_in_effect {
	my ($menucoll,$deeplinkmenu,%menu);
	if ($env{'request.course.id'}) {
	$menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
	if ($env{'request.deeplink.login'}) {
	my ($deeplink_symb,$deeplink,$check_login_symb);
	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	if ($env{'request.noversionuri'} =~ m{^/(res\|uploaded)/}) {
	if ($env{'request.noversionuri'} =~ /\.(page\|sequence)$/) {
	my $navmap = Apache::lonnavmaps::navmap->new();
	if (ref($navmap)) {
	$deeplink = $navmap->get_mapparam(undef,
	&Apache::lonnet::declutter($env{'request.noversionuri'}),
	'0.deeplink');
	} else {
	$check_login_symb = 1;
	}
	} else {
	my $symb=&Apache::lonnet::symbread();
	if ($symb) {
	$deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
	} else {
	$check_login_symb = 1;
	}
	}
	} else {
	$check_login_symb = 1;
	}
	if ($check_login_symb) {
	$deeplink_symb = &deeplink_login_symb($cnum,$cdom);
	if ($deeplink_symb =~ /\.(page\|sequence)$/) {
	my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
	my $navmap = Apache::lonnavmaps::navmap->new();
	if (ref($navmap)) {
	$deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
	}
	} else {
	$deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
	}
	}
	if ($deeplink ne '') {
	my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
	if ($display =~ /^\d+$/) {
	$deeplinkmenu = 1;
	$menucoll = $display;
	}
	}
	}
	if ($menucoll) {
	%menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
	}
	}
	return ($menucoll,$deeplinkmenu,\%menu);
	}

	sub deeplink_login_symb {
	my ($cnum,$cdom) = @_;
	my $login_symb;
	if ($env{'request.deeplink.login'}) {
	$login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
	}
	return $login_symb;
	}

	sub symb_from_tinyurl {
	my ($url,$cnum,$cdom) = @_;
	if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
	my $key = $1;
	my ($tinyurl,$login);
	my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
	if (defined($cached)) {
	$tinyurl = $result;
	} else {
	my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
	my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
	if ($currtiny{$key} ne '') {
	$tinyurl = $currtiny{$key};
	&Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
	}
	}
	if ($tinyurl ne '') {
	my ($cnumreq,$symb) = split(/\&/,$tinyurl);
	if (wantarray) {
	return ($cnumreq,$symb);
	} elsif ($cnumreq eq $cnum) {
	return $symb;
	}
	}
	}
	if (wantarray) {
	return ();
	} else {
	return;
	}
	}

sub wishlist_window {	sub wishlist_window {
return(<<'ENDWISHLIST');	return(<<'ENDWISHLIST');
<script type="text/javascript">	<script type="text/javascript">
Line 8188 var modalWindow = {	Line 9077 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 8213 sub modal_link {	Line 9102 sub modal_link {
$target_attr = 'target="'.$target.'"';	$target_attr = 'target="'.$target.'"';
}	}
return <<"ENDLINK";	return <<"ENDLINK";
<a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">	<a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
$linktext</a>
ENDLINK	ENDLINK
}	}

sub modal_adhoc_script {	sub modal_adhoc_script {
my ($funcname,$width,$height,$content)=@_;	my ($funcname,$width,$height,$content,$possmathjax)=@_;
	my $mathjax;
	if ($possmathjax) {
	$mathjax = <<'ENDJAX';
	if (typeof MathJax == 'object') {
	MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
	}
	ENDJAX
	}
return (<<ENDADHOC);	return (<<ENDADHOC);
<script type="text/javascript">	<script type="text/javascript">
// <![CDATA[	// <![CDATA[
Line 8230 sub modal_adhoc_script {	Line 9126 sub modal_adhoc_script {
modalWindow.height = $height;	modalWindow.height = $height;
modalWindow.content = '$content';	modalWindow.content = '$content';
modalWindow.open();	modalWindow.open();
	$mathjax
};	};
// ]]>	// ]]>
</script>	</script>
Line 8237 ENDADHOC	Line 9134 ENDADHOC
}	}

sub modal_adhoc_inner {	sub modal_adhoc_inner {
my ($funcname,$width,$height,$content)=@_;	my ($funcname,$width,$height,$content,$possmathjax)=@_;
my $innerwidth=$width-20;	my $innerwidth=$width-20;
$content=&js_ready(	$content=&js_ready(
&start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).	&start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
Line 8246 sub modal_adhoc_inner {	Line 9143 sub modal_adhoc_inner {
&end_scrollbox().	&end_scrollbox().
&end_page()	&end_page()
);	);
return &modal_adhoc_script($funcname,$width,$height,$content);	return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
}	}

sub modal_adhoc_window {	sub modal_adhoc_window {
my ($funcname,$width,$height,$content,$linktext)=@_;	my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
return &modal_adhoc_inner($funcname,$width,$height,$content).	return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
"<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";	"<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
}	}

Line 8317 sub end_togglebox {	Line 9214 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 8331 sub LCprogressbar_script {	Line 9229 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 8357 my $LCidcnt;	Line 9277 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 8572 function expand_div(caller) {	Line 9509 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 9504 sub get_secgrprole_info {	Line 10448 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();	my @alldoms = &Apache::lonnet::all_domains();
if (@alldoms == 1) {	if (@alldoms == 1) {
Line 9568 sub user_picker {	Line 10512 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 {
	$domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
	}
my $srchinsel = ' <select name="srchin">';	my $srchinsel = ' <select name="srchin">';

my @srchins = ('crs','dom','alc','instd');	my @srchins = ('crs','dom','alc','instd');
Line 9580 sub user_picker {	Line 10531 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 10059 sub sorted_inst_types {	Line 11011 sub sorted_inst_types {
}	}

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

if ($$settings{'internal.sectionnums'} ne '') {	if ($$settings{'internal.sectionnums'} ne '') {
@currsections = split(/,/,$$settings{'internal.sectionnums'});	@currsections = split(/,/,$$settings{'internal.sectionnums'});
Line 10074 sub get_institutional_codes {	Line 11030 sub get_institutional_codes {
}	}

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

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

	if (@{$unclutteredsec{$crskey}} > 0) {
	my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
	if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
	for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
	my $sec = $coursecode.$formattedsec{$crskey}[$i];
	unless (grep/^\Q$sec\E$/,@{$allcourses}) {
	push(@{$allcourses},$sec);
	$$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
}	}
}	}
}	}
Line 11341 sub modify_html_refs {	Line 12310 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 11406 sub modify_html_refs {	Line 12375 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 11923 sub decompress_uploaded_file {	Line 12892 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 11957 sub process_decompression {	Line 12938 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 11998 sub process_decompression {	Line 12993 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 12484 END	Line 13478 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 12497 sub process_extracted_files {	Line 13491 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 12586 sub process_extracted_files {	Line 13580 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 12595 sub process_extracted_files {	Line 13591 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);
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',$docstitle).'</li>'."\n";
}	}
	if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
	if (rename("$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;
	}
	}
	}
	$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 12687 sub process_extracted_files {	Line 13692 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 12696 sub process_extracted_files {	Line 13703 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 12984 sub upfile_store {	Line 13996 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 12999 sub upfile_store {	Line 14014 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 13021 sub load_tmp_file {	Line 14037 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 13461 sub DrawBarGraph {	Line 14485 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 13909 defdom (domain for which to retrieve con	Line 14933 defdom (domain for which to retrieve con
origmail (scalar - email address of recipient from loncapa.conf,	origmail (scalar - email address of recipient from loncapa.conf,
i.e., predates configuration by DC via domainprefs.pm	i.e., predates configuration by DC via domainprefs.pm

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

=back	=back
Line 13918 Returns: comma separated list of address	Line 14948 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 13934 sub build_recipient_list {	Line 14964 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 13961 sub build_recipient_list {	Line 15160 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 14053 jsarray (reference to array of categorie	Line 15265 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 14060 Side effects: populates trails and allit	Line 15274 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 14086 sub extract_categories {	Line 15300 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 14129 Side effects: populates trails and allit	Line 15346 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 14156 sub recurse_categories {	Line 15373 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 14186 currcat - scalar with an & separated lis	Line 15408 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 14227 sub assign_categories_table {	Line 15452 sub assign_categories_table {
}	}
$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 14270 path - Array containing all categories b	Line 15495 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 14298 sub assign_category_rows {	Line 15526 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 14514 sub check_clone {	Line 15742 sub check_clone {
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};	my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);	my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);	my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
my $clonemsg;	my $clonetitle;
	my @clonemsg;
my $can_clone = 0;	my $can_clone = 0;
my $lctype = lc($args->{'crstype'});	my $lctype = lc($args->{'crstype'});
if ($lctype ne 'community') {	if ($lctype ne 'community') {
Line 14522 sub check_clone {	Line 15751 sub check_clone {
}	}
if ($clonehome eq 'no_host') {	if ($clonehome eq 'no_host') {
if ($args->{'crstype'} eq 'Community') {	if ($args->{'crstype'} eq 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});	push(@clonemsg,({
	mt => 'No new community created.',
	args => [],
	},
	{
	mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
	args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
	}));
} else {	} else {
$clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});	push(@clonemsg,({
}	mt => 'No new course created.',
	args => [],
	},
	{
	mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
	args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
	}));
	}
} else {	} else {
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
	$clonetitle = $clonedesc{'description'};
if ($args->{'crstype'} eq 'Community') {	if ($args->{'crstype'} eq 'Community') {
if ($clonedesc{'type'} ne 'Community') {	if ($clonedesc{'type'} ne 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});	push(@clonemsg,({
return ($can_clone, $clonemsg, $cloneid, $clonehome);	mt => 'No new community created.',
	args => [],
	},
	{
	mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
	args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
	}));
	return ($can_clone,\@clonemsg,$cloneid,$clonehome);
}	}
}	}
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
(&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 14620 sub check_clone {	Line 15871 sub check_clone {
}	}
unless ($can_clone) {	unless ($can_clone) {
if ($args->{'crstype'} eq 'Community') {	if ($args->{'crstype'} eq 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});	push(@clonemsg,({
	mt => 'No new community created.',
	args => [],
	},
	{
	mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',
	args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
	}));
} else {	} else {
$clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});	push(@clonemsg,({
	mt => 'No new course created.',
	args => [],
	},
	{
	mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',
	args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
	}));
}	}
}	}
}	}
}	}
return ($can_clone, $clonemsg, $cloneid, $clonehome);	return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
}	}

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

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

Line 14670 sub construct_course {	Line 15929 sub construct_course {
$args->{'ccuname'}.':'.	$args->{'ccuname'}.':'.
$args->{'ccdomain'},	$args->{'ccdomain'},
$args->{'crstype'},	$args->{'crstype'},
$cnum,$context,$category);	$cnum,$context,$category,
	$callercontext);

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

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

#	#
# Do the cloning	# Do the cloning
#	#
	my @clonemsg;
if ($can_clone && $cloneid) {	if ($can_clone && $cloneid) {
$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);	push(@clonemsg,
if ($context ne 'auto') {	{
$clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';	mt => 'Created [_1] by cloning from [_2]',
}	args => [$crstype,$clonetitle],
$outcome .= $clonemsg.$linefeed;	});
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
# Copy all files	# Copy all files
&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});	my @info =
	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
	$args->{'dateshift'},$args->{'crscode'},
	$args->{'ccuname'}.':'.$args->{'ccdomain'},
	$args->{'tinyurls'});
	if (@info) {
	push(@clonemsg,@info);
	}
# Restore URL	# Restore URL
$cenv{'url'}=$oldcenv{'url'};	$cenv{'url'}=$oldcenv{'url'};
# Restore title	# Restore title
Line 14728 sub construct_course {	Line 16006 sub construct_course {
'plc.users.denied',	'plc.users.denied',
'hidefromcat',	'hidefromcat',
'checkforpriv',	'checkforpriv',
'categories',	'categories'],
'internal.uniquecode'],
$$crsudom,$$crsunum);	$$crsudom,$$crsunum);
if ($args->{'textbook'}) {	if ($args->{'textbook'}) {
$cenv{'internal.textbook'} = $args->{'textbook'};	$cenv{'internal.textbook'} = $args->{'textbook'};
Line 14779 sub construct_course {	Line 16056 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 14807 sub construct_course {	Line 16084 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 14842 sub construct_course {	Line 16119 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'}) {
$args->{'endaccess'} = 0;	$args->{'endaccess'} = 0;
Line 14969 sub construct_course {	Line 16247 sub construct_course {
# Open all assignments	# Open all assignments
#	#
if ($args->{'openall'}) {	if ($args->{'openall'}) {
	my $opendate = time;
	if ($args->{'openallfrom'} =~ /^\d+$/) {
	$opendate = $args->{'openallfrom'};
	}
my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';	my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
my %storecontent = ($storeunder => time,	my %storecontent = ($storeunder => $opendate,
$storeunder.'.type' => 'date_start');	$storeunder.'.type' => 'date_start');
	$outcome .= &mt('All assignments open starting [_1]',
$outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput	&Apache::lonlocal::locallocaltime($opendate)).': '.
('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;	&Apache::lonnet::cput
	('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
}	}
#	#
# Set first page	# Set first page
Line 15004 sub construct_course {	Line 16287 sub construct_course {
$outcome .= ($fatal?$errtext:'write ok').$linefeed;	$outcome .= ($fatal?$errtext:'write ok').$linefeed;
}	}

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

sub make_unique_code {	sub make_unique_code {
Line 15173 sub compare_arrays {	Line 16456 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 15208 sub init_user_environment {	Line 16509 sub init_user_environment {
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 15259 sub init_user_environment {	Line 16576 sub init_user_environment {
# --------------------------------------------------------- Write first profile	# --------------------------------------------------------- Write first profile

{	{
	my $ip = &Apache::lonnet::get_requestor_ip();
my %initial_env =	my %initial_env =
("user.name" => $username,	("user.name" => $username,
"user.domain" => $domain,	"user.domain" => $domain,
Line 15277 sub init_user_environment {	Line 16595 sub init_user_environment {
"request.course.sec" => '',	"request.course.sec" => '',
"request.role" => 'cm',	"request.role" => 'cm',
"request.role.adv" => $env{'user.adv'},	"request.role.adv" => $env{'user.adv'},
"request.host" => $ENV{'REMOTE_ADDR'},);	"request.host" => $ip,);

if ($form->{'localpath'}) {	if ($form->{'localpath'}) {
$initial_env{"browser.localpath"} = $form->{'localpath'};	$initial_env{"browser.localpath"} = $form->{'localpath'};
Line 15296 sub init_user_environment {	Line 16614 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') {
&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') {	$userenv{'canrequest.author'} =
if (ref($reqauthor{'author'}) eq 'HASH') {	&Apache::lonnet::usertools_access($username,$domain,'requestauthor',
$userenv{'requestauthorqueued'} = $reqstatus.':'.	'reload','requestauthor',
$reqauthor{'author'}{'timestamp'};	\%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'};
	}
}	}
}	}

Line 15933 sub search_courses {	Line 17259 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 16129 sub needs_coursereinit {	Line 17455 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',undef,$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 16263 sub recurse_supplemental {	Line 17593 sub recurse_supplemental {
}	}

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 16272 sub symb_to_docspath {	Line 17602 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 16284 sub symb_to_docspath {	Line 17616 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 16331 sub symb_to_docspath {	Line 17663 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 16350 sub captcha_display {	Line 17682 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 16364 sub captcha_response {	Line 17696 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 16412 sub get_captcha_config {	Line 17744 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 16429 sub create_captcha {	Line 17782 sub create_captcha {

if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {	if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
$output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".	$output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
	'<span class="LC_nobreak">'.
&mt('Type in the letters/numbers shown below').' '.	&mt('Type in the letters/numbers shown below').' '.
'<input type="text" size="5" name="code" value="" autocomplete="off" />'.	'<input type="text" size="5" name="code" value="" autocomplete="off" />'.
'<br />'.	'</span><br />'.
'<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';	'<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
last;	last;
}	}
}	}
	if ($output eq '') {
	&Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
	}
return $output;	return $output;
}	}

Line 16474 sub check_captcha {	Line 17831 sub check_captcha {
sub create_recaptcha {	sub create_recaptcha {
my ($pubkey,$version) = @_;	my ($pubkey,$version) = @_;
if ($version >= 2) {	if ($version >= 2) {
return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';	return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
	'<div style="padding:0;clear:both;margin:0;border:0"></div>';
} else {	} else {
my $use_ssl;	my $use_ssl;
if ($ENV{'SERVER_PORT'} == 443) {	if ($ENV{'SERVER_PORT'} == 443) {
Line 16492 sub create_recaptcha {	Line 17850 sub create_recaptcha {
sub check_recaptcha {	sub check_recaptcha {
my ($privkey,$version) = @_;	my ($privkey,$version) = @_;
my $captcha_chk;	my $captcha_chk;
	my $ip = &Apache::lonnet::get_requestor_ip();
if ($version >= 2) {	if ($version >= 2) {
my $ua = LWP::UserAgent->new;	my $ua = LWP::UserAgent->new;
$ua->timeout(10);	$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 => $ip,
);	);
my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);	my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
if ($response->is_success) {	if ($response->is_success) {
Line 16514 sub check_recaptcha {	Line 17873 sub check_recaptcha {
my $captcha_result =	my $captcha_result =
$captcha->check_answer(	$captcha->check_answer(
$privkey,	$privkey,
$ENV{'REMOTE_ADDR'},	$ip,
$env{'form.recaptcha_challenge_field'},	$env{'form.recaptcha_challenge_field'},
$env{'form.recaptcha_response_field'},	$env{'form.recaptcha_response_field'},
);	);
Line 16563 sub cleanup_html {	Line 17922 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) = @_;
	unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
	return ();
	}
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',undef,$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});
my $redirecturl;	my $redirecturl;
if ($what[0]) {	if ($what[0]) {
if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {	if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
$redirecturl='/adm/email?critical=display';	$redirecturl='/adm/email?critical=display';
my $url=&Apache::lonnet::absolute_url().$redirecturl;	my $url=&Apache::lonnet::absolute_url().$redirecturl;
return (1, $url);	return (1, $url);
Line 16631 sub des_decrypt {	Line 18009 sub des_decrypt {
return $plaintext;	return $plaintext;
}	}

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

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

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

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

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

	sub page_menu {
	my ($menucolls,$menunum) = @_;
	my %menu;
	foreach my $item (split(/;/,$menucolls)) {
	my ($num,$value) = split(/\%/,$item);
	if ($num eq $menunum) {
	my @entries = split(/\&/,$value);
	foreach my $entry (@entries) {
	my ($name,$fields) = split(/=/,$entry);
	if (($name eq 'top') \|\| ($name eq 'inline') \|\| ($name eq 'foot') \|\| ($name eq 'main')) {
	$menu{$name} = $fields;
	} else {
	my @shown;
	if ($fields =~ /,/) {
	@shown = split(/,/,$fields);
	} else {
	@shown = ($fields);
	}
	if (@shown) {
	foreach my $field (@shown) {
	next if ($field eq '');
	$menu{$field} = 1;
	}
	}
	}
	}
	}
	}
	return %menu;
	}

1;	1;
__END__;	__END__;

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

Removed from v.1.1075.2.114
changed lines
	Added in v.1.1075.2.161.2.6