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.612 and 1.643

version 1.612, 2007/11/10 03:51:46	version 1.643, 2008/03/03 10:50:26
Line 78 my $readit;	Line 78 my $readit;
## Global Variables	## Global Variables
##	##


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

	=pod

	=head1 Server Side incliude with retries:

	=over 4

	=item * ssi_with_retries(resource, retries form)

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

	Inputs:
	resource - Identifies the resource to insert.
	retries - Count of the number of retries allowed.
	form - Hash that identifies the rendering options.

	Returns:
	content - The content of the response. If retries were exhausted this is empty.
	response - The response from the last attempt (which may or may not have been successful.

	=cut

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


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

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

	do {
	($content, $response) = &Apache::lonnet::ssi($resource, %form);
	$ok = $response->is_success;
	$retries--;
	} while (!$ok && ($retries > 0));

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

	}



# ----------------------------------------------- Filetypes/Languages/Copyright	# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;	my %language;
my %supported_language;	my %supported_language;
Line 472 sub setsec_javascript {	Line 524 sub setsec_javascript {
my ($sec_element,$formname) = @_;	my ($sec_element,$formname) = @_;
my $setsections = qq\|	my $setsections = qq\|
function setSect(sectionlist) {	function setSect(sectionlist) {
var sectionsArray = sectionlist.split(",");	var sectionsArray = new Array();
	if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
	sectionsArray = sectionlist.split(",");
	}
var numSections = sectionsArray.length;	var numSections = sectionsArray.length;
document.$formname.$sec_element.length = 0;	document.$formname.$sec_element.length = 0;
if (numSections == 0) {	if (numSections == 0) {
Line 779 sub helpLatexCheatsheet {	Line 834 sub helpLatexCheatsheet {
}	}
return '<table><tr><td>'.	return '<table><tr><td>'.
$addOther .	$addOther .
&Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols',	&Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),
undef,undef,600)	undef,undef,600)
.'</td><td>'.	.'</td><td>'.
&Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols',	&Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),
undef,undef,600)	undef,undef,600)
.'</td></tr></table>';	.'</td></tr></table>';
}	}
Line 1942 sub authform_kerberos {	Line 1997 sub authform_kerberos {
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'krb') {	if ($in{'curr_authtype'} eq 'krb') {
$krbcheck = ' checked="on"';	$krbcheck = ' checked="on"';
	if (defined($in{'mode'})) {
	if ($in{'mode'} eq 'modifyuser') {
	$krbcheck = '';
	}
	}
if (defined($in{'curr_kerb_ver'})) {	if (defined($in{'curr_kerb_ver'})) {
if ($in{'curr_krb_ver'} eq '5') {	if ($in{'curr_krb_ver'} eq '5') {
$check5 = ' checked="on"';	$check5 = ' checked="on"';
Line 2039 sub authform_internal{	Line 2099 sub authform_internal{
if ($in{'curr_authtype'} eq 'int') {	if ($in{'curr_authtype'} eq 'int') {
if ($can_assign{'int'}) {	if ($can_assign{'int'}) {
$intcheck = 'checked="on" ';	$intcheck = 'checked="on" ';
	if (defined($in{'mode'})) {
	if ($in{'mode'} eq 'modifyuser') {
	$intcheck = '';
	}
	}
if (defined($in{'curr_autharg'})) {	if (defined($in{'curr_autharg'})) {
$intarg = $in{'curr_autharg'};	$intarg = $in{'curr_autharg'};
}	}
Line 2073 sub authform_internal{	Line 2138 sub authform_internal{
$result = &mt	$result = &mt
('[_1] Internally authenticated (with initial password [_2])',	('[_1] Internally authenticated (with initial password [_2])',
'<label>'.$authtype,'</label>'.$autharg);	'<label>'.$authtype,'</label>'.$autharg);
	$result.="<label><input type=\"checkbox\" name=\"visible\" onClick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
return $result;	return $result;
}	}

Line 2088 sub authform_local{	Line 2154 sub authform_local{
if ($in{'curr_authtype'} eq 'loc') {	if ($in{'curr_authtype'} eq 'loc') {
if ($can_assign{'loc'}) {	if ($can_assign{'loc'}) {
$loccheck = 'checked="on" ';	$loccheck = 'checked="on" ';
	if (defined($in{'mode'})) {
	if ($in{'mode'} eq 'modifyuser') {
	$loccheck = '';
	}
	}
if (defined($in{'curr_autharg'})) {	if (defined($in{'curr_autharg'})) {
$locarg = $in{'curr_autharg'};	$locarg = $in{'curr_autharg'};
}	}
Line 2137 sub authform_filesystem{	Line 2208 sub authform_filesystem{
if ($in{'curr_authtype'} eq 'fsys') {	if ($in{'curr_authtype'} eq 'fsys') {
if ($can_assign{'fsys'}) {	if ($can_assign{'fsys'}) {
$fsyscheck = 'checked="on" ';	$fsyscheck = 'checked="on" ';
	if (defined($in{'mode'})) {
	if ($in{'mode'} eq 'modifyuser') {
	$fsyscheck = '';
	}
	}
} else {	} else {
$result = &mt('Currently Filesystem Authenticated.');	$result = &mt('Currently Filesystem Authenticated.');
return $result;	return $result;
Line 2218 sub get_assignable_auth {	Line 2294 sub get_assignable_auth {
}	}

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

=pod

=head1 Domains and Authentication

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

=over 4

=item * get_auth_defaults

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

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

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

=cut

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

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

###############################################################
## Get Kerberos Defaults for Domain ##	## Get Kerberos Defaults for Domain ##
###############################################################	###############################################################
##	##
Line 2268 sub get_auth_defaults {	Line 2308 sub get_auth_defaults {
=item * get_kerberos_defaults	=item * get_kerberos_defaults

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

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

Line 2278 version 4 and the domain of the server.	Line 2318 version 4 and the domain of the server.
#-------------------------------------------	#-------------------------------------------
sub get_kerberos_defaults {	sub get_kerberos_defaults {
my $domain=shift;	my $domain=shift;
my ($krbdef,$krbdefdom) =	my ($krbdef,$krbdefdom);
&Apache::loncommon::get_auth_defaults($domain);	my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
unless ($krbdef =~/^krb/ && $krbdefdom) {	if (($domdefaults{'auth_def'} =~/^krb(4\|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
	$krbdef = $domdefaults{'auth_def'};
	$krbdefdom = $domdefaults{'auth_arg_def'};
	} else {
$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;	$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
my $krbdefdom=$1;	my $krbdefdom=$1;
$krbdefdom=~tr/a-z/A-Z/;	$krbdefdom=~tr/a-z/A-Z/;
Line 2859 sub preferred_languages {	Line 2902 sub preferred_languages {
map { (split(/\s;\s/,$_))[0] } (split(/\s,\s/,$browser));	map { (split(/\s;\s/,$_))[0] } (split(/\s,\s/,$browser));
push(@languages,@browser);	push(@languages,@browser);
}	}
if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) {
@languages=(@languages,	foreach my $domtype ($env{'user.domain'},$env{'request.role.domain'},
&Apache::lonnet::domain($env{'user.domain'},	$Apache::lonnet::perlvar{'lonDefDomain'}) {
'lang_def'));	if ($domtype ne '') {
}	my %domdefs = &Apache::lonnet::get_domain_defaults($domtype);
if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) {	if ($domdefs{'lang_def'} ne '') {
@languages=(@languages,	push(@languages,$domdefs{'lang_def'});
&Apache::lonnet::domain($env{'request.role.domain'},	}
'lang_def'));	}
}
if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
'lang_def')) {
@languages=(@languages,
&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
'lang_def'));
}	}
# turn "en-ca" into "en-ca,en"	# turn "en-ca" into "en-ca,en"
my @genlanguages;	my @genlanguages;
Line 3646 sub get_domainconf {	Line 3683 sub get_domainconf {

my %domconfig = &Apache::lonnet::get_dom('configuration',	my %domconfig = &Apache::lonnet::get_dom('configuration',
['login','rolecolors'],$udom);	['login','rolecolors'],$udom);
my %designhash;	my (%designhash,%legacy);
if (keys(%domconfig) > 0) {	if (keys(%domconfig) > 0) {
if (ref($domconfig{'login'}) eq 'HASH') {	if (ref($domconfig{'login'}) eq 'HASH') {
foreach my $key (keys(%{$domconfig{'login'}})) {	if (keys(%{$domconfig{'login'}})) {
$designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};	foreach my $key (keys(%{$domconfig{'login'}})) {
	$designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
	}
	} else {
	$legacy{'login'} = 1;
}	}
	} else {
	$legacy{'login'} = 1;
}	}
if (ref($domconfig{'rolecolors'}) eq 'HASH') {	if (ref($domconfig{'rolecolors'}) eq 'HASH') {
foreach my $role (keys(%{$domconfig{'rolecolors'}})) {	if (keys(%{$domconfig{'rolecolors'}})) {
if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {	foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {	if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
$designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};	foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
	$designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
	}
}	}
}	}
	} else {
	$legacy{'rolecolors'} = 1;
}	}
	} else {
	$legacy{'rolecolors'} = 1;
}	}
} else {	if (keys(%legacy) > 0) {
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';	my %legacyhash = &get_legacy_domconf($udom);
my $designfile = $designdir.'/'.$udom.'.tab';	foreach my $item (keys(%legacyhash)) {
if (-e $designfile) {	if ($item =~ /^\Q$udom\E\.login/) {
if ( open (my $fh,"<$designfile") ) {	if ($legacy{'login'}) {
while (my $line = <$fh>) {	$designhash{$item} = $legacyhash{$item};
next if ($line =~ /^\#/);	}
chomp($line);	} else {
my ($key,$val)=(split(/\=/,$line));	if ($legacy{'rolecolors'}) {
if ($val) { $designhash{$udom.'.'.$key}=$val; }	$designhash{$item} = $legacyhash{$item};
	}
}	}
close($fh);
}	}
}	}
if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {	} else {
$designhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";	%designhash = &get_legacy_domconf($udom);
}
}	}
&Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,	&Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
$cachetime);	$cachetime);
return %designhash;	return %designhash;
}	}

	sub get_legacy_domconf {
	my ($udom) = @_;
	my %legacyhash;
	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
	my $designfile = $designdir.'/'.$udom.'.tab';
	if (-e $designfile) {
	if ( open (my $fh,"<$designfile") ) {
	while (my $line = <$fh>) {
	next if ($line =~ /^\#/);
	chomp($line);
	my ($key,$val)=(split(/\=/,$line));
	if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
	}
	close($fh);
	}
	}
	if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
	$legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
	}
	return %legacyhash;
	}

=pod	=pod

=item * &domainlogo()	=item * &domainlogo()
Line 3734 Returns: value of designparamter $which	Line 3804 Returns: value of designparamter $which
sub designparm {	sub designparm {
my ($which,$domain)=@_;	my ($which,$domain)=@_;
if ($env{'browser.blackwhite'} eq 'on') {	if ($env{'browser.blackwhite'} eq 'on') {
if ($which=~/\.(font\|alink\|vlink\|link)$/) {	if ($which=~/\.(font\|alink\|vlink\|link\|textcol)$/) {
return '#000000';	return '#000000';
}	}
if ($which=~/\.(pgbg\|sidebg)$/) {	if ($which=~/\.(pgbg\|sidebg\|bgcol)$/) {
return '#FFFFFF';	return '#FFFFFF';
}	}
if ($which=~/\.tabbg$/) {	if ($which=~/\.tabbg$/) {
Line 3756 sub designparm {	Line 3826 sub designparm {
$output = $defaultdesign{$which};	$output = $defaultdesign{$which};
}	}
if (($which =~ /^(student\|coordinator\|author\|admin)\.img$/) \|\|	if (($which =~ /^(student\|coordinator\|author\|admin)\.img$/) \|\|
($which =~ /login\.(img\|logo\|domlogo)/)) {	($which =~ /login\.(img\|logo\|domlogo\|login)/)) {
if ($output =~ m{^/(adm\|res)/}) {	if ($output =~ m{^/(adm\|res)/}) {
if ($output =~ m{^/res/}) {	if ($output =~ m{^/res/}) {
my $local_name = &Apache::lonnet::filelocation('',$output);	my $local_name = &Apache::lonnet::filelocation('',$output);
Line 3947 ENDROLE	Line 4017 ENDROLE
$lastitem = $thisdisfn;	$lastitem = $thisdisfn;
}	}
$titleinfo =	$titleinfo =
&Apache::loncommon::help_open_menu('','',3,'Authoring').	&Apache::loncommon::help_open_menu('','',3,'Authoring')
'<b>Construction Space</b>: '.	.'<b>'.&mt('Construction Space').'</b>: '
'<form name="dirs" method="post" action="'.$formaction	.'<form name="dirs" method="post" action="'.$formaction
.'" target="_top"><tt><b>'	.'" target="_top"><tt><b>'
.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"	.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')	.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
Line 4073 sub make_attr_string {	Line 4143 sub make_attr_string {

Returns a uniform footer for LON-CAPA web pages.	Returns a uniform footer for LON-CAPA web pages.

Inputs: none	Inputs: 1 - optional reference to an args hash
	If in the hash, key for noredirectlink has a value which evaluates to true,
	a 'Continue' link is not displayed if the page contains an
	internal redirect in the <head></head> section,
	i.e., $env{'internal.head.redirect'} exists

=cut	=cut

sub endbodytag {	sub endbodytag {
	my ($args) = @_;
my $endbodytag='</body>';	my $endbodytag='</body>';
$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;	$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
if ( exists( $env{'internal.head.redirect'} ) ) {	if ( exists( $env{'internal.head.redirect'} ) ) {
$endbodytag=	if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
"<br /><a href=\"$env{'internal.head.redirect'}\">".	$endbodytag=
&mt('Continue').'</a>'.	"<br /><a href=\"$env{'internal.head.redirect'}\">".
$endbodytag;	&mt('Continue').'</a>'.
	$endbodytag;
	}
}	}
return $endbodytag;	return $endbodytag;
}	}
Line 4347 td.LC_menubuttons_img {	Line 4424 td.LC_menubuttons_img {
}	}
.LC_new_mail {	.LC_new_mail {
font-family: $sans;	font-family: $sans;
	background: $tabbg;
font-weight: bold;	font-weight: bold;
}	}

Line 4433 table.LC_aboutme_port tr.LC_even_row td	Line 4511 table.LC_aboutme_port tr.LC_even_row td
table.LC_data_table tr.LC_data_table_highlight td {	table.LC_data_table tr.LC_data_table_highlight td {
background-color: $data_table_darker;	background-color: $data_table_darker;
}	}
	table.LC_data_table tr td.LC_leftcol_header {
	background-color: $data_table_head;
	font-weight: bold;
	}
table.LC_data_table tr.LC_empty_row td,	table.LC_data_table tr.LC_empty_row td,
table.LC_nested tr.LC_empty_row td {	table.LC_nested tr.LC_empty_row td {
background-color: #FFFFFF;	background-color: #FFFFFF;
Line 4834 table.LC_descriptive_input td.LC_descrip	Line 4916 table.LC_descriptive_input td.LC_descrip
font-weight: bold;	font-weight: bold;
}	}
div.LC_feedback_link {	div.LC_feedback_link {
	clear: both;
background: white;	background: white;
width: 100%;	width: 100%;
}	}
Line 4921 span.LC_cusr_emph {	Line 5004 span.LC_cusr_emph {
font-style: italic;	font-style: italic;
}	}

	span.LC_cusr_subheading {
	font-weight: normal;
	font-size: 85%;
	}

table.LC_docs_documents {	table.LC_docs_documents {
background: #BBBBBB;	background: #BBBBBB;
border-width: 0px;	border-width: 0px;
Line 5037 div.LC_clear_float_footer {	Line 5125 div.LC_clear_float_footer {


div.LC_grade_select_mode {	div.LC_grade_select_mode {
float: left;
font-family: $sans;	font-family: $sans;
}	}
div.LC_grade_select_mode div div {	div.LC_grade_select_mode div div {
Line 5097 span.LC_grade_check_note {	Line 5184 span.LC_grade_check_note {
right: 1em;	right: 1em;
}	}

	table.LC_scantron_action {
	width: 100%;
	}
	table.LC_scantron_action tr th {
	font: normal bold $sans;
	}

div.LC_edit_problem_header {	div.LC_edit_problem_header,
	div.LC_edit_problem_footer {
font: normal medium $sans;	font: normal medium $sans;
margin: 2px;	margin: 2px;
}	}
div.LC_edit_problem_header,	div.LC_edit_problem_header,
div.LC_edit_problem_header div,	div.LC_edit_problem_header div,
	div.LC_edit_problem_footer,
	div.LC_edit_problem_footer div,
div.LC_edit_problem_editxml_header,	div.LC_edit_problem_editxml_header,
div.LC_edit_problem_editxml_header div {	div.LC_edit_problem_editxml_header div {
margin-top: 5px;	margin-top: 5px;
Line 5440 sub end_page {	Line 5536 sub end_page {
if ($args->{'frameset'}) {	if ($args->{'frameset'}) {
$result .= '</frameset>';	$result .= '</frameset>';
} else {	} else {
$result .= &endbodytag();	$result .= &endbodytag($args);
}	}
$result .= "\n</html>";	$result .= "\n</html>";

Line 5818 previous, future, or all.	Line 5914 previous, future, or all.
6. reference to results object (hash of hashes).	6. reference to results object (hash of hashes).
7. reference to optional userdata hash	7. reference to optional userdata hash
8. reference to optional statushash	8. reference to optional statushash
	9. flag if privileged users (except those set to unhide in
	course settings) should be excluded
Keys of top level results hash are roles.	Keys of top level results hash are roles.
Keys of inner hashes are username:domain, with	Keys of inner hashes are username:domain, with
values set to access type.	values set to access type.
Line 5834 of the possibility of multiple values fo	Line 5932 of the possibility of multiple values fo
###############################################	###############################################

sub get_course_users {	sub get_course_users {
my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash) = @_;	my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
my %idx = ();	my %idx = ();
my %seclists;	my %seclists;

Line 5851 sub get_course_users {	Line 5949 sub get_course_users {
my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);	my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
my $now = time;	my $now = time;
foreach my $student (keys(%{$classlist})) {	foreach my $student (keys(%{$classlist})) {
my $status;
my $match = 0;	my $match = 0;
my $secmatch = 0;	my $secmatch = 0;
my $section = $$classlist{$student}[$idx{section}];	my $section = $$classlist{$student}[$idx{section}];
Line 5911 sub get_course_users {	Line 6008 sub get_course_users {
active => 'Active',	active => 'Active',
future => 'Future',	future => 'Future',
);	);
	my %nothide;
	if ($hidepriv) {
	my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
	foreach my $user (split(/\s\,\s/,$coursehash{'nothideprivileged'})) {
	if ($user !~ /:/) {
	$nothide{join(':',split(/[\@]/,$user))}=1;
	} else {
	$nothide{$user} = 1;
	}
	}
	}
foreach my $person (sort(keys(%coursepersonnel))) {	foreach my $person (sort(keys(%coursepersonnel))) {
my $match = 0;	my $match = 0;
my $secmatch = 0;	my $secmatch = 0;
Line 5944 sub get_course_users {	Line 6052 sub get_course_users {
$usec = 'none';	$usec = 'none';
}	}
if ($uname ne '' && $udom ne '') {	if ($uname ne '' && $udom ne '') {
	if ($hidepriv) {
	if ((&Apache::lonnet::privileged($uname,$udom)) &&
	(!$nothide{$uname.':'.$udom})) {
	next;
	}
	}
if ($end > 0 && $end < $now) {	if ($end > 0 && $end < $now) {
$status = 'previous';	$status = 'previous';
} elsif ($start > $now) {	} elsif ($start > $now) {
Line 6138 sub default_quota {	Line 6252 sub default_quota {
my ($udom,$inststatus) = @_;	my ($udom,$inststatus) = @_;
my ($defquota,$settingstatus);	my ($defquota,$settingstatus);
my %quotahash = &Apache::lonnet::get_dom('configuration',	my %quotahash = &Apache::lonnet::get_dom('configuration',
['quota'],$udom);	['quotas'],$udom);
if (ref($quotahash{'quota'}) eq 'HASH') {	if (ref($quotahash{'quotas'}) eq 'HASH') {
if ($inststatus ne '') {	if ($inststatus ne '') {
my @statuses = split(/:/,$inststatus);	my @statuses = split(/:/,$inststatus);
foreach my $item (@statuses) {	foreach my $item (@statuses) {
if ($quotahash{'quota'}{$item} ne '') {	if ($quotahash{'quotas'}{$item} ne '') {
if ($defquota eq '') {	if ($defquota eq '') {
$defquota = $quotahash{'quota'}{$item};	$defquota = $quotahash{'quotas'}{$item};
$settingstatus = $item;	$settingstatus = $item;
} elsif ($quotahash{'quota'}{$item} > $defquota) {	} elsif ($quotahash{'quotas'}{$item} > $defquota) {
$defquota = $quotahash{'quota'}{$item};	$defquota = $quotahash{'quotas'}{$item};
$settingstatus = $item;	$settingstatus = $item;
}	}
}	}
}	}
}	}
if ($defquota eq '') {	if ($defquota eq '') {
$defquota = $quotahash{'quota'}{'default'};	$defquota = $quotahash{'quotas'}{'default'};
$settingstatus = 'default';	$settingstatus = 'default';
}	}
} else {	} else {
Line 6207 sub get_secgrprole_info {	Line 6321 sub get_secgrprole_info {
}	}

sub user_picker {	sub user_picker {
my ($dom,$srch,$forcenewuser,$caller) = @_;	my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_;
my $currdom = $dom;	my $currdom = $dom;
my %curr_selected = (	my %curr_selected = (
srchin => 'dom',	srchin => 'dom',
srchby => 'lastname',	srchby => 'lastname',
);	);
my $srchterm;	my $srchterm;
if (ref($srch) eq 'HASH') {	if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
if ($srch->{'srchby'} ne '') {	if ($srch->{'srchby'} ne '') {
$curr_selected{'srchby'} = $srch->{'srchby'};	$curr_selected{'srchby'} = $srch->{'srchby'};
}	}
Line 6301 sub user_picker {	Line 6415 sub user_picker {
if ($forcenewuser) {	if ($forcenewuser) {
if (ref($srch) eq 'HASH') {	if (ref($srch) eq 'HASH') {
if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {	if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $env{'request.role.domain'}) {
$new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>';	if ($cancreate) {
	$new_user_create = '<p> <input type="submit" name="forcenew" value="'.&HTML::Entities::encode(&mt('Make new user "[_1]"',$srchterm),'<>&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" /> </p>';
	} else {
	my $helplink = ' href="javascript:helpMenu('."'display'".')"';
	my %usertypetext = (
	official => 'institutional',
	unofficial => 'non-institutional',
	);
	$new_user_create = '<br /><span class="LC_warning">'.&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.").' '.&mt('Contact the <a[_1]>helpdesk</a> for assistance.',$helplink).'</span><br /><br />';
	}
}	}
}	}

Line 6431 END_BLOCK	Line 6554 END_BLOCK
}	}

sub user_rule_check {	sub user_rule_check {
my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules) = @_;	my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
my $response;	my $response;
if (ref($usershash) eq 'HASH') {	if (ref($usershash) eq 'HASH') {
my %got_rules;
foreach my $user (keys(%{$usershash})) {	foreach my $user (keys(%{$usershash})) {
my ($uname,$udom) = split(/:/,$user);	my ($uname,$udom) = split(/:/,$user);
next if ($udom eq '' \|\| $uname eq '');	next if ($udom eq '' \|\| $uname eq '');
my ($userstatus,$id);	my ($id,$newuser);
if (ref($usershash->{$user}) eq 'HASH') {	if (ref($usershash->{$user}) eq 'HASH') {
$userstatus = $usershash->{$user}->{'status'};	$newuser = $usershash->{$user}->{'newuser'};
$id = $usershash->{$user}->{'id'};	$id = $usershash->{$user}->{'id'};
}	}
my $inst_response;	my $inst_response;
if (ref($checks) eq 'HASH') {	if (ref($checks) eq 'HASH') {
if (defined($checks->{'username'})) {	if (defined($checks->{'username'})) {
($inst_response,%{$inst_results}) =	($inst_response,%{$inst_results->{$user}}) =
&Apache::lonnet::get_instuser($udom,$uname);	&Apache::lonnet::get_instuser($udom,$uname);
} elsif (defined($checks->{'id'})) {	} elsif (defined($checks->{'id'})) {
($inst_response,%{$inst_results}) =	($inst_response,%{$inst_results->{$user}}) =
&Apache::lonnet::get_instuser($udom,undef,$id);	&Apache::lonnet::get_instuser($udom,undef,$id);
}	}
	} else {
	($inst_response,%{$inst_results->{$user}}) =
	&Apache::lonnet::get_instuser($udom,$uname);
	return;
}	}
if (!$got_rules{$udom}) {	if (!$got_rules->{$udom}) {
my %domconfig = &Apache::lonnet::get_dom('configuration',	my %domconfig = &Apache::lonnet::get_dom('configuration',
['usercreation'],$udom);	['usercreation'],$udom);
if (ref($domconfig{'usercreation'}) eq 'HASH') {	if (ref($domconfig{'usercreation'}) eq 'HASH') {
foreach my $item (keys(%{$checks})) {	foreach my $item ('username','id') {
if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {	if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
$$curr_rules{$udom}{$item} =	$$curr_rules{$udom}{$item} =
$domconfig{'usercreation'}{$item.'_rule'};	$domconfig{'usercreation'}{$item.'_rule'};
}	}
}	}
}	}
$got_rules{$udom} = 1;	$got_rules->{$udom} = 1;
}	}
foreach my $item (keys(%{$checks})) {	foreach my $item (keys(%{$checks})) {
if (ref($$curr_rules{$udom}) eq 'HASH') {	if (ref($$curr_rules{$udom}) eq 'HASH') {
if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {	if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
if (@{$$curr_rules{$udom}{$item}} > 0) {	if (@{$$curr_rules{$udom}{$item}} > 0) {
my %rule_check;
my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});	my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
foreach my $rule (@{$$curr_rules{$udom}{$item}}) {	foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
if ($rule_check{$rule}) {	if ($rule_check{$rule}) {
$$rulematch{$user}{$item} = $rule;	$$rulematch{$user}{$item} = $rule;
if ($inst_response eq 'ok') {	if ($inst_response eq 'ok') {
if (keys(%{$inst_results}) == 0) {	if (ref($inst_results) eq 'HASH') {
if ($userstatus eq 'new') {	if (ref($inst_results->{$user}) eq 'HASH') {
$$alerts{$user}{$item} = 1;	if (keys(%{$inst_results->{$user}}) == 0) {
	$$alerts{$item}{$udom}{$uname} = 1;
	}
}	}
}	}
}	}
	last;
}	}
}	}
last;
}	}
}	}
}	}
Line 6522 sub user_rule_formats {	Line 6649 sub user_rule_formats {
}	}

sub instrule_disallow_msg {	sub instrule_disallow_msg {
my ($checkitem,$domdesc,$count) = @_;	my ($checkitem,$domdesc,$count,$mode) = @_;
my $response;	my $response;
my %text = (	my %text = (
item => 'username',	item => 'username',
Line 6543 sub instrule_disallow_msg {	Line 6670 sub instrule_disallow_msg {
$text{'items'} = 'IDs';	$text{'items'} = 'IDs';
$text{'item'} = 'ID';	$text{'item'} = 'ID';
$text{'action'} = 'an ID';	$text{'action'} = 'an ID';
	if ($count > 1) {
	$text{'item'} = 'IDs';
	$text{'action'} = 'IDs';
	}
}	}
$response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for <span class=\"LC_cusr_emph\">[_1]</span>, but the $text{'item'} $text{'do'} not exist in the institutional directory.",$domdesc).'<br />';	$response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for <span class=\"LC_cusr_emph\">[_1]</span>, but the $text{'item'} $text{'do'} not exist in the institutional directory.",$domdesc).'<br />';
if ($checkitem eq 'username') {	if ($mode eq 'upload') {
$response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");	if ($checkitem eq 'username') {
} elsif ($checkitem eq 'id') {	$response .= &mt("You will need to modify your upload file so it will include $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
$response .= &mt("You must either choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave this field blank.");	} elsif ($checkitem eq 'id') {
	$response .= &mt("Either upload a file which includes $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the ID/Student Number field.");
	}
	} else {
	if ($checkitem eq 'username') {
	$response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
	} elsif ($checkitem eq 'id') {
	$response .= &mt("You must either choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank.");
	}
}	}
return $response;	return $response;
}	}

	sub personal_data_fieldtitles {
	my %fieldtitles = &Apache::lonlocal::texthash (
	id => 'Student/Employee ID',
	permanentemail => 'E-mail address',
	lastname => 'Last Name',
	firstname => 'First Name',
	middlename => 'Middle Name',
	generation => 'Generation',
	gen => 'Generation',
	);
	return %fieldtitles;
	}

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

=pod	=pod

=back	=back
Line 7531 a hash ref describing the data to be sto	Line 7708 a hash ref describing the data to be sto

Returns: both routines return nothing	Returns: both routines return nothing

	=back

=cut	=cut

#######################################################	#######################################################
Line 7611 sub restore_settings {	Line 7790 sub restore_settings {
}	}
}	}

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

	=pod

	=head1 Domain E-mail Routines

	=over 4

	=item &build_recipient_list

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

	Inputs:
	defmail (scalar - email address of default recipient),
	mailing type (scalar - errormail, packagesmail, or helpdeskmail),
	defdom (domain for which to retrieve configuration settings),
	origmail (scalar - email address of recipient from loncapa.conf,
	i.e., predates configuration by DC via domainprefs.pm

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

	=cut

	############################################################
	############################################################
	sub build_recipient_list {
	my ($defmail,$mailing,$defdom,$origmail) = @_;
	my @recipients;
	my $otheremails;
	my %domconfig =
	&Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
	if (ref($domconfig{'contacts'}) eq 'HASH') {
	if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
	my @contacts = ('adminemail','supportemail');
	foreach my $item (@contacts) {
	if ($domconfig{'contacts'}{$mailing}{$item}) {
	my $addr = $domconfig{'contacts'}{$item};
	if (!grep(/^\Q$addr\E$/,@recipients)) {
	push(@recipients,$addr);
	}
	}
	$otheremails = $domconfig{'contacts'}{$mailing}{'others'};
	}
	}
	} elsif ($origmail ne '') {
	push(@recipients,$origmail);
	}
	if ($defmail ne '') {
	push(@recipients,$defmail);
	}
	if ($otheremails) {
	my @others;
	if ($otheremails =~ /,/) {
	@others = split(/,/,$otheremails);
	} else {
	push(@others,$otheremails);
	}
	foreach my $addr (@others) {
	if (!grep(/^\Q$addr\E$/,@recipients)) {
	push(@recipients,$addr);
	}
	}
	}
	my $recipientlist = join(',',@recipients);
	return $recipientlist;
	}

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

sub commit_customrole {	sub commit_customrole {
my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;	my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;
my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.'@'.$three.' in '.$url.	my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
($start?', '.&mt('starting').' '.localtime($start):'').	($start?', '.&mt('starting').' '.localtime($start):'').
($end?', ending '.localtime($end):'').': <b>'.	($end?', ending '.localtime($end):'').': <b>'.
&Apache::lonnet::assigncustomrole(	&Apache::lonnet::assigncustomrole(
Line 7637 sub commit_standardrole {	Line 7886 sub commit_standardrole {
my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,	my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
$one,$two,$sec,$context);	$one,$two,$sec,$context);
if (($result =~ /^error/) \|\| ($result eq 'not_in_class') \|\|	if (($result =~ /^error/) \|\| ($result eq 'not_in_class') \|\|
($result eq 'unknown_course')) {	($result eq 'unknown_course') \|\| ($result eq 'refused')) {
$output = "Error: $result\n";	$output = $logmsg.' '.&mt('Error: ').$result."\n";
} else {	} else {
$output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.	$output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
($start?', '.&mt('starting').' '.localtime($start):'').	($start?', '.&mt('starting').' '.localtime($start):'').
Line 7667 sub commit_standardrole {	Line 7916 sub commit_standardrole {

sub commit_studentrole {	sub commit_studentrole {
my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;	my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
my ($result,$linefeed);	my ($result,$linefeed,$oldsecurl,$newsecurl);
if ($context eq 'auto') {	if ($context eq 'auto') {
$linefeed = "\n";	$linefeed = "\n";
} else {	} else {
Line 7679 sub commit_studentrole {	Line 7928 sub commit_studentrole {
my $secchange = 0;	my $secchange = 0;
my $expire_role_result;	my $expire_role_result;
my $modify_section_result;	my $modify_section_result;
unless ($oldsec eq '-1') {	if ($oldsec ne '-1') {
unless ($sec eq $oldsec) {	if ($oldsec ne $sec) {
$secchange = 1;	$secchange = 1;
	my $now = time;
my $uurl='/'.$cid;	my $uurl='/'.$cid;
$uurl=~s/\_/\//g;	$uurl=~s/\_/\//g;
if ($oldsec) {	if ($oldsec) {
$uurl.='/'.$oldsec;	$uurl.='/'.$oldsec;
}	}
$expire_role_result = &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',time);	$oldsecurl = $uurl;
	$expire_role_result =
	&Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now);
	if ($env{'request.course.sec'} ne '') {
	if ($expire_role_result eq 'refused') {
	my @roles = ('st');
	my @statuses = ('previous');
	my @roledoms = ($one);
	my $withsec = 1;
	my %roleshash =
	&Apache::lonnet::get_my_roles($uname,$udom,'userroles',
	\@statuses,\@roles,\@roledoms,$withsec);
	if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
	my ($oldstart,$oldend) =
	split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
	if ($oldend > 0 && $oldend <= $now) {
	$expire_role_result = 'ok';
	}
	}
	}
	}
$result = $expire_role_result;	$result = $expire_role_result;
}	}
}	}
Line 7695 sub commit_studentrole {	Line 7965 sub commit_studentrole {
$modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid);	$modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid);
if ($modify_section_result =~ /^ok/) {	if ($modify_section_result =~ /^ok/) {
if ($secchange == 1) {	if ($secchange == 1) {
$$logmsg .= "Section for $uname switched from old section: $oldsec to new section: $sec".$linefeed;	if ($sec eq '') {
	$$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
	} else {
	$$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
	}
} elsif ($oldsec eq '-1') {	} elsif ($oldsec eq '-1') {
$$logmsg .= "New student role for $uname in section $sec in course $cid".$linefeed;	if ($sec eq '') {
	$$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
	} else {
	$$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
	}
} else {	} else {
$$logmsg .= "Student $uname assigned to unchanged section $sec in course $cid".$linefeed;	if ($sec eq '') {
	$$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
	} else {
	$$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
	}
}	}
} else {	} else {
$$logmsg .= "Error when attempting section change for $uname from old section $oldsec to new section: $sec in course $cid -error: $modify_section_result".$linefeed;	if ($secchange) {
	$$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed;
	} else {
	$$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
	}
}	}
$result = $modify_section_result;	$result = $modify_section_result;
} elsif ($secchange == 1) {	} elsif ($secchange == 1) {
$$logmsg .= "Error when attempting to expire role for $uname in old section $oldsec in course $cid -error: $expire_role_result".$linefeed;	if ($oldsec eq '') {
	$$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
	} else {
	$$logmsg .= &mt('Error when attempting to expire existing role for [_1] in section [_2] in course [_3] -error: ',$uname,$oldsec,$cid).' '.$expire_role_result.$linefeed;
	}
	if ($expire_role_result eq 'refused') {
	my $newsecurl = '/'.$cid;
	$newsecurl =~ s/\_/\//g;
	if ($sec ne '') {
	$newsecurl.='/'.$sec;
	}
	if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
	if ($sec eq '') {
	$$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments unaffiliated with any section.',$sec).$linefeed;
	} else {
	$$logmsg .= &mt('Although your current role has privileges to add students to section "[_1]", you do not have privileges to modify existing enrollments in other sections.',$sec).$linefeed;
	}
	}
	}
}	}
} else {	} else {
$$logmsg .= "Incomplete course id defined. Addition of user $uname from domain $udom to course $one\_$two, section $sec not completed.$linefeed";	$$logmsg .= &mt('Incomplete course id defined.').$linefeed.&mt('Addition of user [_1] from domain [_2] to course [_3], section [_4] not completed.',$uname,$udom,$one.'_'.$two,$sec).$linefeed;
$result = "error: incomplete course id\n";	$result = "error: incomplete course id\n";
}	}
return $result;	return $result;
Line 7821 sub construct_course {	Line 8125 sub construct_course {
$outcome .= $clonemsg.$linefeed;	$outcome .= $clonemsg.$linefeed;
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
# Copy all files	# Copy all files
&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid);	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
# Restore URL	# Restore URL
$cenv{'url'}=$oldcenv{'url'};	$cenv{'url'}=$oldcenv{'url'};
# Restore title	# Restore title
$cenv{'description'}=$oldcenv{'description'};	$cenv{'description'}=$oldcenv{'description'};
# restore grading mode
if (defined($oldcenv{'grading'})) {
$cenv{'grading'}=$oldcenv{'grading'};
}
# Mark as cloned	# Mark as cloned
$cenv{'clonedfrom'}=$cloneid;	$cenv{'clonedfrom'}=$cloneid;
delete($cenv{'default_enrollment_start_date'});	# Need to clone grading mode
delete($cenv{'default_enrollment_end_date'});	my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
	$cenv{'grading'}=$newenv{'grading'};
	# Do not clone these environment entries
	&Apache::lonnet::del('environment',
	['default_enrollment_start_date',
	'default_enrollment_end_date',
	'question.email',
	'policy.email',
	'comment.email',
	'pch.users.denied',
	'plc.users.denied'],
	$$crsudom,$$crsunum);
}	}

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

my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.	my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
if ($args->{'crssections'}) {	if ($args->{'crssections'}) {
$cenv{'internal.sectionnums'} = '';	$cenv{'internal.sectionnums'} = '';
Line 7921 sub construct_course {	Line 8231 sub construct_course {
}	}
if ($args->{'notify_dc'}) {	if ($args->{'notify_dc'}) {
if ($uname ne '') {	if ($uname ne '') {
push(@notified,$uname.'@'.$udom);	push(@notified,$uname.':'.$udom);
}	}
}	}
if (@notified > 0) {	if (@notified > 0) {

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

Removed from v.1.612
changed lines
	Added in v.1.643