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.1305 and 1.1367

version 1.1305, 2017/12/22 02:00:46	version 1.1367, 2021/09/25 20:35:26
Line 72 use Apache::lonuserstate();	Line 72 use Apache::lonuserstate();
use Apache::courseclassifier();	use Apache::courseclassifier();
use LONCAPA qw(:DEFAULT :match);	use LONCAPA qw(:DEFAULT :match);
use LONCAPA::LWPReq;	use LONCAPA::LWPReq;
	use HTTP::Request;
use DateTime::TimeZone;	use DateTime::TimeZone;
use DateTime::Locale;	use DateTime::Locale;
use Encode();	use Encode();
Line 79 use Text::Aspell;	Line 80 use Text::Aspell;
use Authen::Captcha;	use Authen::Captcha;
use Captcha::reCAPTCHA;	use Captcha::reCAPTCHA;
use JSON::DWIW;	use JSON::DWIW;
use LWP::UserAgent;
use Crypt::DES;	use Crypt::DES;
use DynaLoader; # for Crypt::DES version	use DynaLoader; # for Crypt::DES version
use MIME::Lite;	use MIME::Lite;
use MIME::Types;	use MIME::Types;
use File::Copy();	use File::Copy();
use File::Path();	use File::Path();
	use String::CRC32();
	use Short::URL();

# ---------------------------------------------- Designs	# ---------------------------------------------- Designs
use vars qw(%defaultdesign);	use vars qw(%defaultdesign);
Line 201 BEGIN {	Line 203 BEGIN {
{	{
my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/language.tab';	'/language.tab';
if ( open(my $fh,"<$langtabfile") ) {	if ( open(my $fh,'<',$langtabfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line=~/^\#/);	next if ($line=~/^\#/);
chomp($line);	chomp($line);
Line 223 BEGIN {	Line 225 BEGIN {
{	{
my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.	my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/copyright.tab';	'/copyright.tab';
if ( open (my $fh,"<$copyrightfile") ) {	if ( open (my $fh,'<',$copyrightfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line=~/^\#/);	next if ($line=~/^\#/);
chomp($line);	chomp($line);
Line 237 BEGIN {	Line 239 BEGIN {
{	{
my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.	my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/source_copyright.tab';	'/source_copyright.tab';
if ( open (my $fh,"<$sourcecopyrightfile") ) {	if ( open (my $fh,'<',$sourcecopyrightfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 251 BEGIN {	Line 253 BEGIN {
# -------------------------------------------------------------- default domain designs	# -------------------------------------------------------------- default domain designs
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
my $designfile = $designdir.'/default.tab';	my $designfile = $designdir.'/default.tab';
if ( open (my $fh,"<$designfile") ) {	if ( open (my $fh,'<',$designfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 265 BEGIN {	Line 267 BEGIN {
{	{
my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filecategories.tab';	'/filecategories.tab';
if ( open (my $fh,"<$categoryfile") ) {	if ( open (my $fh,'<',$categoryfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 280 BEGIN {	Line 282 BEGIN {
{	{
my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filetypes.tab';	'/filetypes.tab';
if ( open (my $fh,"<$typesfile") ) {	if ( open (my $fh,'<',$typesfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 433 sub studentbrowser_javascript {	Line 435 sub studentbrowser_javascript {
<script type="text/javascript" language="Javascript">	<script type="text/javascript" language="Javascript">
// <![CDATA[	// <![CDATA[
var stdeditbrowser;	var stdeditbrowser;
function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {	function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
var url = '/adm/pickstudent?';	var url = '/adm/pickstudent?';
var filter;	var filter;
if (!ignorefilter) {	if (!ignorefilter) {
Line 448 sub studentbrowser_javascript {	Line 450 sub studentbrowser_javascript {
'&udomelement='+udom+	'&udomelement='+udom+
'&clicker='+clicker;	'&clicker='+clicker;
if (roleflag) { url+="&roles=1"; }	if (roleflag) { url+="&roles=1"; }
if (courseadvonly) { url+="&courseadvonly=1"; }	if (courseadv == 'condition') {
	if (document.getElementById('courseadv')) {
	courseadv = document.getElementById('courseadv').value;
	}
	}
	if ((courseadv == 'only') \|\| (courseadv == 'none')) { url+="&courseadv="+courseadv; }
var title = 'Student_Browser';	var title = 'Student_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';	options += ',width=700,height=600';
Line 480 ENDRESBRW	Line 487 ENDRESBRW
}	}

sub selectstudent_link {	sub selectstudent_link {
my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;	my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".	my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
&Apache::lonhtmlcommon::entity_encode($unameele)."','".	&Apache::lonhtmlcommon::entity_encode($unameele)."','".
&Apache::lonhtmlcommon::entity_encode($udomele)."'";	&Apache::lonhtmlcommon::entity_encode($udomele)."'";
Line 491 sub selectstudent_link {	Line 498 sub selectstudent_link {
return '';	return '';
}	}
$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";	$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
if ($courseadvonly) {	if ($courseadv eq 'only') {
$callargs .= ",'',1,1";	$callargs .= ",'',1,'$courseadv'";
	} elsif ($courseadv eq 'none') {
	$callargs .= ",'','','$courseadv'";
	} elsif ($courseadv eq 'condition') {
	$callargs .= ",'','','$courseadv'";
}	}
return '<span class="LC_nobreak">'.	return '<span class="LC_nobreak">'.
'<a href="javascript:openstdbrowser('.$callargs.');">'.	'<a href="javascript:openstdbrowser('.$callargs.');">'.
Line 1295 sub help_open_topic {	Line 1306 sub help_open_topic {
}	}

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

Line 1307 sub help_open_topic {	Line 1322 sub help_open_topic {
if ($imgid ne '') {	if ($imgid ne '') {
$imgid = ' id="'.$imgid.'"';	$imgid = ' id="'.$imgid.'"';
}	}
$template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'	$template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
.'<img src="'.$helpicon.'" border="0"'	.'<img src="'.$helpicon.'" border="0"'
.' alt="'.&mt('Help: [_1]',$topic).'"'	.' alt="'.&mt('Help: [_1]',$topic).'"'
.' title="'.$title.'" style="vertical-align:middle;"'.$imgid	.' title="'.$title.'" style="vertical-align:middle;"'.$imgid
Line 1500 sub help_open_bug {	Line 1515 sub help_open_bug {
{	{
$link = $url;	$link = $url;
}	}

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

# Add the graphic	# Add the graphic
my $title = &mt('Report a Bug');	my $title = &mt('Report a Bug');
my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");	my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>	<a$target href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
ENDTEMPLATE	ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };	if ($text ne '') { $template.='</td></tr></table>' };
return $template;	return $template;
Line 2223 sub import_crsauthor_form {	Line 2243 sub import_crsauthor_form {
}	}
my @ordered = ();	my @ordered = ();
foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {	foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
	next if ($file =~ /\.rights$/);
if ($only) {	if ($only) {
my ($ext) = ($file =~ /\.([^.]+)$/);	my ($ext) = ($file =~ /\.([^.]+)$/);
unless ($possexts{lc($ext)}) {	unless ($possexts{lc($ext)}) {
Line 2266 sub import_crsauthor_form {	Line 2287 sub import_crsauthor_form {
unless ($possexts{lc($ext)}) {	unless ($possexts{lc($ext)}) {
next;	next;
}	}
	} else {
	next if ($file =~ /\.rights$/);
}	}
push(@singledirfiles,$file);	push(@singledirfiles,$file);
}	}
if (@singledirfiles) {	if (@singledirfiles) {
$possdirs == 1;	$possdirs = 1;
}	}
}	}
if (($possdirs == 1) && (@singledirfiles)) {	if (($possdirs == 1) && (@singledirfiles)) {
Line 3025 This is not an optimal method, but it wo	Line 3048 This is not an optimal method, but it wo

=item * authform_filesystem	=item * authform_filesystem

	=item * authform_lti

=back	=back

See loncreateuser.pm for invocation and use examples.	See loncreateuser.pm for invocation and use examples.
Line 3441 sub authform_filesystem {	Line 3466 sub authform_filesystem {
$fsyscheck.' onchange="'.$jscall.'" onclick="'.	$fsyscheck.' onchange="'.$jscall.'" onclick="'.
$jscall.'"'.$disabled.' />';	$jscall.'"'.$disabled.' />';
}	}
$autharg = '<input type="text" size="10" name="fsysarg" value=""'.	$autharg = '<input type="password" size="10" name="fsysarg" value=""'.
' onchange="'.$jscall.'"'.$disabled.' />';	' onchange="'.$jscall.'"'.$disabled.' />';
$result = &mt	$result = &mt
('[_1] Filesystem Authenticated (with initial password [_2])',	('[_1] Filesystem Authenticated (with initial password [_2])',
'<label><input type="radio" name="login" value="fsys" '.	'<label>'.$authtype,'</label>'.$autharg);
$fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',	return $result;
'</label><input type="password" size="10" name="fsysarg" value="" '.	}
'onchange="'.$jscall.'"'.$disabled.' />');
	sub authform_lti {
	my %in = (
	formname => 'document.cu',
	kerb_def_dom => 'MSU.EDU',
	@_,
	);
	my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
	if ($in{'readonly'}) {
	$disabled = ' disabled="disabled"';
	}
	if (defined($in{'curr_authtype'})) {
	if ($in{'curr_authtype'} eq 'lti') {
	if ($can_assign{'lti'}) {
	$lticheck = 'checked="checked" ';
	if (defined($in{'mode'})) {
	if ($in{'mode'} eq 'modifyuser') {
	$lticheck = '';
	}
	}
	} else {
	$result = &mt('Currently LTI Authenticated.');
	return $result;
	}
	}
	} else {
	if ($authnum == 1) {
	$authtype = '<input type="hidden" name="login" value="lti" />';
	}
	}
	if (!$can_assign{'lti'}) {
	return;
	} elsif ($authtype eq '') {
	if (defined($in{'mode'})) {
	if ($in{'mode'} eq 'modifycourse') {
	if ($authnum == 1) {
	$authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
	}
	}
	}
	}
	$jscall = "javascript:changed_radio('lti',$in{'formname'});";
	if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') \|\| ($in{'curr_authtype'} ne 'lti'))) {
	$authtype = '<input type="radio" name="login" value="lti" '.
	$lticheck.' onchange="'.$jscall.'" onclick="'.
	$jscall.'"'.$disabled.' />';
	}
	$autharg = '<input type="hidden" name="ltiarg" value="" />';
	if ($authtype) {
	$result = &mt('[_1] LTI Authenticated',
	'<label>'.$authtype.'</label>'.$autharg);
	} else {
	$result = '<b>'.&mt('LTI Authenticated').'</b>'.
	$autharg;
	}
return $result;	return $result;
}	}

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

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

###############################################################	###############################################################
## Get Kerberos Defaults for Domain ##	## Get Kerberos Defaults for Domain ##
###############################################################	###############################################################
Line 4692 sub get_student_view {	Line 4846 sub get_student_view {
}	}
if (defined($target)) { $form{'grade_target'} = $target; }	if (defined($target)) { $form{'grade_target'} = $target; }
$feedurl=&Apache::lonnet::clutter($feedurl);	$feedurl=&Apache::lonnet::clutter($feedurl);
	if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
	$feedurl =~ s{^/adm/wrapper}{};
	}
my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);	my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
$userview=~s/\<body[^\>]*\>//gi;	$userview=~s/\<body[^\>]*\>//gi;
$userview=~s/\<\/body\>//gi;	$userview=~s/\<\/body\>//gi;
Line 4736 sub get_student_view_with_retries {	Line 4893 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 4991 sub findallcourses {	Line 5201 sub findallcourses {
###############################################	###############################################

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

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

if (($activity eq 'boards' \|\| $activity eq 'chat' \|\|	if (($activity eq 'boards' \|\| $activity eq 'chat' \|\|
$activity eq 'groups' \|\| $activity eq 'printout' \|\|	$activity eq 'groups' \|\| $activity eq 'printout' \|\|
$activity eq 'reinit' \|\| $activity eq 'alert') &&	$activity eq 'search' \|\| $activity eq 'reinit' \|\|
	$activity eq 'alert') &&
($env{'request.course.id'})) {	($env{'request.course.id'})) {
foreach my $key (keys(%live_courses)) {	foreach my $key (keys(%live_courses)) {
if ($key ne $env{'request.course.id'}) {	if ($key ne $env{'request.course.id'}) {
Line 5125 sub blockcheck {	Line 5336 sub blockcheck {
# 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 5145 sub blockcheck {	Line 5356 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 5158 sub get_blocks {	Line 5369 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 5286 sub parse_block_record {	Line 5503 sub parse_block_record {
}	}

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

# check for active blocking	# check for active blocking
my ($startblock,$endblock,$triggerblock) =	my ($startblock,$endblock,$triggerblock) =
&blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);	&blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller);
my $blocked = 0;	my $blocked = 0;
if ($startblock && $endblock) {	if ($startblock && $endblock) {
$blocked = 1;	$blocked = 1;
Line 5302 sub blocking_status {	Line 5519 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 5332 END_MYBLOCK	Line 5554 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') {	} elsif ($activity eq 'alert') {
$text = &mt('Checking Critical Messages Blocked');	$text = &mt('Checking Critical Messages Blocked');
} elsif ($activity eq 'reinit') {	} elsif ($activity eq 'reinit') {
$text = &mt('Checking Course Update Blocked');	$text = &mt('Checking Course Update Blocked');
	} elsif ($activity eq 'about') {
	$text = &mt('Access to User Information Pages Blocked');
}	}
$output .= <<"END_BLOCK";	$output .= <<"END_BLOCK";
<div class='$class'>	<div class='$class'>
Line 5359 sub check_ip_acc {	Line 5587 sub check_ip_acc {
if (!defined($acc) \|\| $acc =~ /^\s$/ \|\| $acc =~/^\sno\s*$/i) {	if (!defined($acc) \|\| $acc =~ /^\s$/ \|\| $acc =~/^\sno\s*$/i) {
return 1;	return 1;
}	}
my $allowed;	my ($ip,$allowed);
my $ip=$ENV{'REMOTE_ADDR'} \|\| $clientip \|\| $env{'request.host'};	if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') \|\|
	($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
	$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;
my %access = (	my %access = (
Line 5511 sub get_domainconf {	Line 5745 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 5575 sub get_legacy_domconf {	Line 5820 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 5774 sub CSTR_pageheader {	Line 6019 sub CSTR_pageheader {
$title = &mt('Authoring Space');	$title = &mt('Authoring Space');
}	}

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

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

if ($lastitem) {	if ($lastitem) {
$output .=	$output .=
Line 5794 sub CSTR_pageheader {	Line 6044 sub CSTR_pageheader {
} else {	} else {
$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();
Line 5852 Inputs:	Line 6102 Inputs:
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 5863 other decorations will be returned.	Line 6126 other decorations will be returned.

sub bodytag {	sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,	my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
$no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;	$no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,
	$ltimenu,$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 5892 sub bodytag {	Line 6156 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+)$}) {	} elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
Line 5909 sub bodytag {	Line 6185 sub bodytag {
} else {	} else {
$role = (split(/\//,$role,4))[-1];	$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 5934 sub bodytag {	Line 6210 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;	my $crstype;
if ($env{'request.course.id'}) {	if ($cid) {
$crstype = $env{'course.'.$env{'request.course.id'}.'.type'};	$crstype = $env{'course.'.$cid.'.type'};
} elsif ($args->{'crstype'}) {	} elsif ($args->{'crstype'}) {
$crstype = $args->{'crstype'};	$crstype = $args->{'crstype'};
}	}
Line 5968 sub bodytag {	Line 6265 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($crstype);	unless ($args->{'no_primary_menu'}) {
	my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref);

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

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

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

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

#if directed to not display the secondary menu, don't.	#if directed to not display the secondary menu, don't.
if ($args->{'no_secondary_menu'}) {	if ($args->{'no_secondary_menu'}) {
Line 5996 sub bodytag {	Line 6295 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);
	}
$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'},'','',$hostname);	$args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri);
} elsif ($forcereg) {	} elsif ($forcereg) {
$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,	$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
$args->{'group'},	$args->{'group'},
$args->{'hide_buttons'},	$args->{'hide_buttons'},
$hostname);	$hostname,$ltiscope,$ltiuri);
} else {	} else {
$bodytag .=	$bodytag .=
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'},	&Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
Line 7075 table.LC_prior_tries td {	Line 7378 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 8071 ul.LC_funclist li {	Line 8375 ul.LC_funclist li {
cursor:pointer;	cursor:pointer;
}	}

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

/*	/*
styles used for response display	styles used for response display
*/	*/
Line 8321 ADDMETA	Line 8633 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 8378 function LC_Offload_Now() {	Line 8746 function LC_Offload_Now() {
// ]]>	// ]]>
</script>	</script>
OFFLOAD	OFFLOAD
}
}	}
}	}
}	}
Line 8608 sub start_page {	Line 8975 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 8626 sub start_page {	Line 9063 sub start_page {
$args->{'only_body'}, $args->{'domain'},	$args->{'only_body'}, $args->{'domain'},
$args->{'force_register'}, $args->{'no_nav_bar'},	$args->{'force_register'}, $args->{'no_nav_bar'},
$args->{'bgcolor'}, $args,	$args->{'bgcolor'}, $args,
\@advtools);	\@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu);
}	}
}	}

Line 8662 sub start_page {	Line 9099 sub start_page {
my $menulink;	my $menulink;
# if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.	# if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
if ((exists($args->{'bread_crumbs_nomenu'})) \|\|	if ((exists($args->{'bread_crumbs_nomenu'})) \|\|
	($ltiscope eq 'map') \|\| ($ltiscope eq 'resource') \|\|
((($args->{'crstype'} eq 'Placement') \|\| (($env{'request.course.id'}) &&	((($args->{'crstype'} eq 'Placement') \|\| (($env{'request.course.id'}) &&
($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&	($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
(!$env{'request.role.adv'}))) {	(!$env{'request.role.adv'}))) {
Line 8711 sub end_page {	Line 9149 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);
	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 {
	$deeplink = &Apache::lonnet::EXT('resource.0.deeplink');
	}
	} else {
	$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) = 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 8795 sub modal_link {	Line 9320 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 8812 sub modal_adhoc_script {	Line 9344 sub modal_adhoc_script {
modalWindow.height = $height;	modalWindow.height = $height;
modalWindow.content = '$content';	modalWindow.content = '$content';
modalWindow.open();	modalWindow.open();
	$mathjax
};	};
// ]]>	// ]]>
</script>	</script>
Line 8819 ENDADHOC	Line 9352 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 8828 sub modal_adhoc_inner {	Line 9361 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 10708 sub sorted_inst_types {	Line 11241 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 10723 sub get_institutional_codes {	Line 11260 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;
Line 10732 sub get_institutional_codes {	Line 11269 sub get_institutional_codes {
}	}
}	}
}	}

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(@{$unclutteredsec{$crskey}},$instsec);
	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);	push(@{$allcourses},$sec);
$$LC_code{$sec} = $lc_sec;	$$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
}	}
}	}
}	}
Line 12067 sub modify_html_refs {	Line 12617 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 12132 sub modify_html_refs {	Line 12682 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 13761 sub upfile_store {	Line 14311 sub upfile_store {
{	{
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 13786 sub load_tmp_file {	Line 14336 sub load_tmp_file {
{	{
my $studentfile = $r->dir_config('lonDaemons').	my $studentfile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp';	'/tmp/'.$datatoken.'.tmp';
if ( open(my $fh,"<$studentfile") ) {	if ( open(my $fh,'<',$studentfile) ) {
@studentdata=<$fh>;	@studentdata=<$fh>;
close($fh);	close($fh);
}	}
Line 13796 sub load_tmp_file {	Line 14346 sub load_tmp_file {

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

from - Sender's email address	from - Sender's email address

	replyto - Reply-To email address

to - Email address of recipient	to - Email address of recipient

subject - Subject of email	subject - Subject of email
Line 14962 cc_string - Carbon copy email ad	Line 15514 cc_string - Carbon copy email ad

bcc - Blind carbon copy email address	bcc - Blind carbon copy email address

type - File type of attachment

attachment_path - Path of file to be attached	attachment_path - Path of file to be attached

file_name - Name of file to be attached	file_name - Name of file to be attached
Line 14980 attachment_text - The body of an attac	Line 15530 attachment_text - The body of an attac
############################################################	############################################################

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

my $msg = MIME::Lite->new(	my $msg = MIME::Lite->new(
From => $from,	From => $from,
To => $to,	To => $to,
Line 14989 sub mime_email {	Line 15540 sub mime_email {
Type =>'TEXT',	Type =>'TEXT',
Data => $body,	Data => $body,
);	);
	if ($replyto ne '') {
	$msg->add("Reply-To" => $replyto);
	}
if ($cc_string ne '') {	if ($cc_string ne '') {
$msg->add("Cc" => $cc_string);	$msg->add("Cc" => $cc_string);
}	}
Line 15104 jsarray (reference to array of categorie	Line 15658 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 15111 Side effects: populates trails and allit	Line 15667 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 15139 sub extract_categories {	Line 15695 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 15182 Side effects: populates trails and allit	Line 15741 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 15209 sub recurse_categories {	Line 15768 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 15250 sub assign_categories_table {	Line 15814 sub assign_categories_table {
my ($cathash,$currcat,$type,$disabled) = @_;	my ($cathash,$currcat,$type,$disabled) = @_;
my $output;	my $output;
if (ref($cathash) eq 'HASH') {	if (ref($cathash) eq 'HASH') {
my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);	my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
&extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);	&extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
$maxdepth = scalar(@cats);	$maxdepth = scalar(@cats);
if (@cats > 0) {	if (@cats > 0) {
my $itemcount = 0;	my $itemcount = 0;
Line 15577 sub check_clone {	Line 16141 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 15585 sub check_clone {	Line 16150 sub check_clone {
}	}
if ($clonehome eq 'no_host') {	if ($clonehome eq 'no_host') {
if ($args->{'crstype'} eq 'Community') {	if ($args->{'crstype'} eq 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});	push(@clonemsg,({
	mt => 'No new community created.',
	args => [],
	},
	{
	mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
	args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
	}));
} else {	} else {
$clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});	push(@clonemsg,({
}	mt => 'No new course created.',
	args => [],
	},
	{
	mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
	args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
	}));
	}
} else {	} else {
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
	$clonetitle = $clonedesc{'description'};
if ($args->{'crstype'} eq 'Community') {	if ($args->{'crstype'} eq 'Community') {
if ($clonedesc{'type'} ne 'Community') {	if ($clonedesc{'type'} ne 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});	push(@clonemsg,({
return ($can_clone, $clonemsg, $cloneid, $clonehome);	mt => 'No new community created.',
	args => [],
	},
	{
	mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
	args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
	}));
	return ($can_clone,\@clonemsg,$cloneid,$clonehome);
}	}
}	}
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
Line 15683 sub check_clone {	Line 16270 sub check_clone {
}	}
unless ($can_clone) {	unless ($can_clone) {
if ($args->{'crstype'} eq 'Community') {	if ($args->{'crstype'} eq 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});	push(@clonemsg,({
	mt => 'No new community created.',
	args => [],
	},
	{
	mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',
	args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
	}));
} else {	} else {
$clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});	push(@clonemsg,({
	mt => 'No new course created.',
	args => [],
	},
	{
	mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',
	args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
	}));
}	}
}	}
}	}
}	}
return ($can_clone, $clonemsg, $cloneid, $clonehome);	return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
}	}

sub construct_course {	sub construct_course {
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,	my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
$cnum,$category,$coderef) = @_;	$cnum,$category,$coderef,$callercontext,$user_lh) = @_;
my $outcome;	my ($outcome,$msgref,$clonemsgref);
my $linefeed = '<br />'."\n";	my $linefeed = '<br />'."\n";
if ($context eq 'auto') {	if ($context eq 'auto') {
$linefeed = "\n";	$linefeed = "\n";
Line 15705 sub construct_course {	Line 16306 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 15739 sub construct_course {	Line 16333 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]',$showncrstype,$$courseid).$linefeed;	if (($callercontext eq 'auto') && ($user_lh ne '')) {
	$outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
	} else {
	$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
	}
if ($$courseid =~ /^error:/) {	if ($$courseid =~ /^error:/) {
return (0,$outcome);	return (0,$outcome,$clonemsgref);
}	}

#	#
Line 15756 sub construct_course {	Line 16355 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]',$showncrstype,$clonehome);	push(@clonemsg,
if ($context ne 'auto') {	{
$clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';	mt => 'Created [_1] by cloning from [_2]',
}	args => [$showncrstype,$clonetitle],
$outcome .= $clonemsg.$linefeed;	});
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
# Copy all files	# Copy all files
&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});	my @info =
	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
	$args->{'dateshift'},$args->{'crscode'},
	$args->{'ccuname'}.':'.$args->{'ccdomain'},
	$args->{'tinyurls'});
	if (@info) {
	push(@clonemsg,@info);
	}
# Restore URL	# Restore URL
$cenv{'url'}=$oldcenv{'url'};	$cenv{'url'}=$oldcenv{'url'};
# Restore title	# Restore title
Line 15797 sub construct_course {	Line 16410 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 16039 sub construct_course {	Line 16651 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 16098 sub construct_course {	Line 16715 sub construct_course {
('resourcedata',\%storecontent,$$crsudom,$$crsunum);	('resourcedata',\%storecontent,$$crsudom,$$crsunum);
}	}

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

sub make_unique_code {	sub make_unique_code {
Line 16182 sub group_term {	Line 16799 sub group_term {
}	}

sub course_types {	sub course_types {
my @types = ('official','unofficial','community','textbook','placement');	my @types = ('official','unofficial','community','textbook','placement','lti');
my %typename = (	my %typename = (
official => 'Official course',	official => 'Official course',
unofficial => 'Unofficial course',	unofficial => 'Unofficial course',
community => 'Community',	community => 'Community',
textbook => 'Textbook course',	textbook => 'Textbook course',
placement => 'Placement test',	placement => 'Placement test',
	lti => 'LTI provider',
);	);
return (\@types,\%typename);	return (\@types,\%typename);
}	}
Line 16268 sub compare_arrays {	Line 16886 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 16302 sub init_user_environment {	Line 16938 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$/) {
if ($ENV{'SERVER_PORT'} == 443) {	if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
	&GDBM_READER(),0640)) {
my $linkedfile;	my $linkedfile;
if (tie(my %oldenv,'GDBM_File',"$lonids/$cookie.id",	if (exists($oldenv{'user.linkedenv'})) {
&GDBM_READER(),0640)) {	$linkedfile = $oldenv{'user.linkedenv'};
if (exists($oldenv{'user.linkedenv'})) {
$linkedfile = $oldenv{'user.linkedenv'};
}
untie(%oldenv);
}	}
if (unlink($lonids.'/'.$filename)) {	untie(%oldenv);
if ($linkedfile =~ /^[a-f0-9]+_linked\.id$/) {	if (unlink("$lonids/$filename")) {
unlink($lonids.'/'.$linkedfile);	if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
	if (-l "$lonids/$linkedfile.id") {
	unlink("$lonids/$linkedfile.id");
	}
}	}
}	}
} else {	} else {
Line 16368 sub init_user_environment {	Line 17004 sub init_user_environment {
# --------------------------------------------------------- Write first profile	# --------------------------------------------------------- Write first profile

{	{
	my $ip = &Apache::lonnet::get_requestor_ip($r);
my %initial_env =	my %initial_env =
("user.name" => $username,	("user.name" => $username,
"user.domain" => $domain,	"user.domain" => $domain,
Line 16386 sub init_user_environment {	Line 17023 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 16424 sub init_user_environment {	Line 17061 sub init_user_environment {
undef,\%userenv,\%domdef,\%is_adv);	undef,\%userenv,\%domdef,\%is_adv);
}	}

foreach my $crstype ('official','unofficial','community','textbook','placement') {	foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
$userenv{'canrequest.'.$crstype} =	$userenv{'canrequest.'.$crstype} =
&Apache::lonnet::usertools_access($username,$domain,$crstype,	&Apache::lonnet::usertools_access($username,$domain,$crstype,
'reload','requestcourses',	'reload','requestcourses',
Line 17314 sub needs_coursereinit {	Line 17951 sub needs_coursereinit {
}	}

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

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

sub symb_to_docspath {	sub symb_to_docspath {
Line 17494 sub symb_to_docspath {	Line 18177 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 17513 sub captcha_display {	Line 18196 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 17527 sub captcha_response {	Line 18210 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 17575 sub get_captcha_config {	Line 18258 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 17592 sub create_captcha {	Line 18296 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 17637 sub check_captcha {	Line 18345 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 17655 sub create_recaptcha {	Line 18364 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 %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 $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');	my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
$request->content(join('&',map {	$request->content(join('&',map {
Line 17682 sub check_recaptcha {	Line 18392 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 17734 sub cleanup_html {	Line 18444 sub cleanup_html {
# $context is the calling context -- roles, grades, contents, menu or flip.	# $context is the calling context -- roles, grades, contents, menu or flip.
sub critical_redirect {	sub critical_redirect {
my ($interval,$context) = @_;	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'))) {	if (($env{'request.course.id'}) && (($context eq 'flip') \|\| ($context eq 'contents'))) {
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
Line 17755 sub critical_redirect {	Line 18468 sub critical_redirect {
&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 17815 sub des_decrypt {	Line 18528 sub des_decrypt {
return $plaintext;	return $plaintext;
}	}

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

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

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

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

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

	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 '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.1305
changed lines
	Added in v.1.1367