--- loncom/interface/loncommon.pm 2007/12/08 00:03:32 1.622 +++ loncom/interface/loncommon.pm 2008/03/03 10:50:26 1.643 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.622 2007/12/08 00:03:32 raeburn Exp $ +# $Id: loncommon.pm,v 1.643 2008/03/03 10:50:26 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -78,6 +78,58 @@ my $readit; ## 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 my %language; my %supported_language; @@ -472,7 +524,10 @@ sub setsec_javascript { my ($sec_element,$formname) = @_; my $setsections = qq| function setSect(sectionlist) { - var sectionsArray = sectionlist.split(","); + var sectionsArray = new Array(); + if ((sectionlist != '') && (typeof sectionlist != "undefined")) { + sectionsArray = sectionlist.split(","); + } var numSections = sectionsArray.length; document.$formname.$sec_element.length = 0; if (numSections == 0) { @@ -779,10 +834,10 @@ sub helpLatexCheatsheet { } return '
'. $addOther . - &Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols', + &Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'), undef,undef,600) .''. - &Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols', + &Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'), undef,undef,600) .'
'; } @@ -1942,6 +1997,11 @@ sub authform_kerberos { if (defined($in{'curr_authtype'})) { if ($in{'curr_authtype'} eq 'krb') { $krbcheck = ' checked="on"'; + if (defined($in{'mode'})) { + if ($in{'mode'} eq 'modifyuser') { + $krbcheck = ''; + } + } if (defined($in{'curr_kerb_ver'})) { if ($in{'curr_krb_ver'} eq '5') { $check5 = ' checked="on"'; @@ -2039,6 +2099,11 @@ sub authform_internal{ if ($in{'curr_authtype'} eq 'int') { if ($can_assign{'int'}) { $intcheck = 'checked="on" '; + if (defined($in{'mode'})) { + if ($in{'mode'} eq 'modifyuser') { + $intcheck = ''; + } + } if (defined($in{'curr_autharg'})) { $intarg = $in{'curr_autharg'}; } @@ -2089,6 +2154,11 @@ sub authform_local{ if ($in{'curr_authtype'} eq 'loc') { if ($can_assign{'loc'}) { $loccheck = 'checked="on" '; + if (defined($in{'mode'})) { + if ($in{'mode'} eq 'modifyuser') { + $loccheck = ''; + } + } if (defined($in{'curr_autharg'})) { $locarg = $in{'curr_autharg'}; } @@ -2138,6 +2208,11 @@ sub authform_filesystem{ if ($in{'curr_authtype'} eq 'fsys') { if ($can_assign{'fsys'}) { $fsyscheck = 'checked="on" '; + if (defined($in{'mode'})) { + if ($in{'mode'} eq 'modifyuser') { + $fsyscheck = ''; + } + } } else { $result = &mt('Currently Filesystem Authenticated.'); return $result; @@ -2219,42 +2294,6 @@ 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 ## ############################################################### ## @@ -2269,8 +2308,8 @@ sub get_auth_defaults { =item * get_kerberos_defaults get_kerberos_defaults($target_domain) returns the default kerberos -version and domain. If not found in domain.tabs, it defaults to -version 4 and the domain of the server. +version and domain. If not found, it defaults to version 4 and the +domain of the server. ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain); @@ -2279,9 +2318,12 @@ version 4 and the domain of the server. #------------------------------------------- sub get_kerberos_defaults { my $domain=shift; - my ($krbdef,$krbdefdom) = - &Apache::loncommon::get_auth_defaults($domain); - unless ($krbdef =~/^krb/ && $krbdefdom) { + my ($krbdef,$krbdefdom); + my %domdefaults = &Apache::lonnet::get_domain_defaults($domain); + 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+)$/; my $krbdefdom=$1; $krbdefdom=~tr/a-z/A-Z/; @@ -2860,21 +2902,15 @@ sub preferred_languages { map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser)); push(@languages,@browser); } - if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) { - @languages=(@languages, - &Apache::lonnet::domain($env{'user.domain'}, - 'lang_def')); - } - if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) { - @languages=(@languages, - &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')); + + foreach my $domtype ($env{'user.domain'},$env{'request.role.domain'}, + $Apache::lonnet::perlvar{'lonDefDomain'}) { + if ($domtype ne '') { + my %domdefs = &Apache::lonnet::get_domain_defaults($domtype); + if ($domdefs{'lang_def'} ne '') { + push(@languages,$domdefs{'lang_def'}); + } + } } # turn "en-ca" into "en-ca,en" my @genlanguages; @@ -3647,45 +3683,78 @@ sub get_domainconf { my %domconfig = &Apache::lonnet::get_dom('configuration', ['login','rolecolors'],$udom); - my %designhash; + my (%designhash,%legacy); if (keys(%domconfig) > 0) { if (ref($domconfig{'login'}) eq 'HASH') { - foreach my $key (keys(%{$domconfig{'login'}})) { - $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key}; + if (keys(%{$domconfig{'login'}})) { + 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') { - foreach my $role (keys(%{$domconfig{'rolecolors'}})) { - if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') { - foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) { - $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item}; + if (keys(%{$domconfig{'rolecolors'}})) { + foreach my $role (keys(%{$domconfig{'rolecolors'}})) { + if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') { + foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) { + $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item}; + } } } + } else { + $legacy{'rolecolors'} = 1; } + } else { + $legacy{'rolecolors'} = 1; } - } else { - 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) { $designhash{$udom.'.'.$key}=$val; } + if (keys(%legacy) > 0) { + my %legacyhash = &get_legacy_domconf($udom); + foreach my $item (keys(%legacyhash)) { + if ($item =~ /^\Q$udom\E\.login/) { + if ($legacy{'login'}) { + $designhash{$item} = $legacyhash{$item}; + } + } else { + if ($legacy{'rolecolors'}) { + $designhash{$item} = $legacyhash{$item}; + } } - close($fh); } } - if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') { - $designhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif"; - } + } else { + %designhash = &get_legacy_domconf($udom); } &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash, $cachetime); 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 =item * &domainlogo() @@ -3735,10 +3804,10 @@ Returns: value of designparamter $which sub designparm { my ($which,$domain)=@_; if ($env{'browser.blackwhite'} eq 'on') { - if ($which=~/\.(font|alink|vlink|link)$/) { + if ($which=~/\.(font|alink|vlink|link|textcol)$/) { return '#000000'; } - if ($which=~/\.(pgbg|sidebg)$/) { + if ($which=~/\.(pgbg|sidebg|bgcol)$/) { return '#FFFFFF'; } if ($which=~/\.tabbg$/) { @@ -3757,7 +3826,7 @@ sub designparm { $output = $defaultdesign{$which}; } 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{^/res/}) { my $local_name = &Apache::lonnet::filelocation('',$output); @@ -3948,9 +4017,9 @@ ENDROLE $lastitem = $thisdisfn; } $titleinfo = - &Apache::loncommon::help_open_menu('','',3,'Authoring'). - 'Construction Space: '. - '
' .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."$lastitem
" .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') @@ -4074,18 +4143,25 @@ sub make_attr_string { 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 section, +i.e., $env{'internal.head.redirect'} exists =cut sub endbodytag { + my ($args) = @_; my $endbodytag=''; $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag; if ( exists( $env{'internal.head.redirect'} ) ) { - $endbodytag= - "
". - &mt('Continue').''. - $endbodytag; + if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) { + $endbodytag= + "
". + &mt('Continue').''. + $endbodytag; + } } return $endbodytag; } @@ -4348,6 +4424,7 @@ td.LC_menubuttons_img { } .LC_new_mail { font-family: $sans; + background: $tabbg; font-weight: bold; } @@ -4434,6 +4511,10 @@ table.LC_aboutme_port tr.LC_even_row td table.LC_data_table tr.LC_data_table_highlight td { 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_nested tr.LC_empty_row td { background-color: #FFFFFF; @@ -4923,6 +5004,11 @@ span.LC_cusr_emph { font-style: italic; } +span.LC_cusr_subheading { + font-weight: normal; + font-size: 85%; +} + table.LC_docs_documents { background: #BBBBBB; border-width: 0px; @@ -5450,7 +5536,7 @@ sub end_page { if ($args->{'frameset'}) { $result .= ''; } else { - $result .= &endbodytag(); + $result .= &endbodytag($args); } $result .= "\n"; @@ -5828,6 +5914,8 @@ previous, future, or all. 6. reference to results object (hash of hashes). 7. reference to optional userdata hash 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 inner hashes are username:domain, with values set to access type. @@ -5844,7 +5932,7 @@ of the possibility of multiple values fo ############################################### 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 %seclists; @@ -5920,6 +6008,17 @@ sub get_course_users { active => 'Active', 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))) { my $match = 0; my $secmatch = 0; @@ -5953,6 +6052,12 @@ sub get_course_users { $usec = 'none'; } if ($uname ne '' && $udom ne '') { + if ($hidepriv) { + if ((&Apache::lonnet::privileged($uname,$udom)) && + (!$nothide{$uname.':'.$udom})) { + next; + } + } if ($end > 0 && $end < $now) { $status = 'previous'; } elsif ($start > $now) { @@ -6216,14 +6321,14 @@ sub get_secgrprole_info { } sub user_picker { - my ($dom,$srch,$forcenewuser,$caller) = @_; + my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype) = @_; my $currdom = $dom; my %curr_selected = ( srchin => 'dom', srchby => 'lastname', ); my $srchterm; - if (ref($srch) eq 'HASH') { + if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) { if ($srch->{'srchby'} ne '') { $curr_selected{'srchby'} = $srch->{'srchby'}; } @@ -6310,7 +6415,16 @@ sub user_picker { if ($forcenewuser) { 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'}) { - $new_user_create = '

&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" />

'; + if ($cancreate) { + $new_user_create = '

&"').'" onclick="javascript:setSearch(\'1\','.$caller.');" />

'; + } else { + my $helplink = ' href="javascript:helpMenu('."'display'".')"'; + my %usertypetext = ( + official => 'institutional', + unofficial => 'non-institutional', + ); + $new_user_create = '
'.&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.").' '.&mt('Contact the helpdesk for assistance.',$helplink).'

'; + } } } @@ -6578,6 +6692,44 @@ sub instrule_disallow_msg { 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 =back @@ -7556,6 +7708,8 @@ a hash ref describing the data to be sto Returns: both routines return nothing +=back + =cut ####################################################### @@ -7711,7 +7865,7 @@ sub build_recipient_list { sub commit_customrole { 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):''). ($end?', ending '.localtime($end):'').': '. &Apache::lonnet::assigncustomrole( @@ -7732,8 +7886,8 @@ sub commit_standardrole { my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end, $one,$two,$sec,$context); if (($result =~ /^error/) || ($result eq 'not_in_class') || - ($result eq 'unknown_course')) { - $output = "Error: $result\n"; + ($result eq 'unknown_course') || ($result eq 'refused')) { + $output = $logmsg.' '.&mt('Error: ').$result."\n"; } else { $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url. ($start?', '.&mt('starting').' '.localtime($start):''). @@ -7762,7 +7916,7 @@ sub commit_standardrole { sub commit_studentrole { my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_; - my ($result,$linefeed); + my ($result,$linefeed,$oldsecurl,$newsecurl); if ($context eq 'auto') { $linefeed = "\n"; } else { @@ -7774,15 +7928,36 @@ sub commit_studentrole { my $secchange = 0; my $expire_role_result; my $modify_section_result; - unless ($oldsec eq '-1') { - unless ($sec eq $oldsec) { + if ($oldsec ne '-1') { + if ($oldsec ne $sec) { $secchange = 1; + my $now = time; my $uurl='/'.$cid; $uurl=~s/\_/\//g; if ($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; } } @@ -7790,21 +7965,55 @@ sub commit_studentrole { $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 ($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') { - $$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 { - $$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 { - $$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; } 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 { - $$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"; } return $result; @@ -7916,19 +8125,26 @@ sub construct_course { $outcome .= $clonemsg.$linefeed; my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); # Copy all files - &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid); + &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'}); # Restore URL $cenv{'url'}=$oldcenv{'url'}; # Restore title $cenv{'description'}=$oldcenv{'description'}; -# restore grading mode - if (defined($oldcenv{'grading'})) { - $cenv{'grading'}=$oldcenv{'grading'}; - } # Mark as cloned $cenv{'clonedfrom'}=$cloneid; - delete($cenv{'default_enrollment_start_date'}); - delete($cenv{'default_enrollment_end_date'}); +# Need to clone grading mode + 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); } # @@ -7956,7 +8172,6 @@ sub construct_course { } else { $cenv{'internal.courseowner'} = $args->{'curruser'}; } - my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner. if ($args->{'crssections'}) { $cenv{'internal.sectionnums'} = ''; @@ -8016,7 +8231,7 @@ sub construct_course { } if ($args->{'notify_dc'}) { if ($uname ne '') { - push(@notified,$uname.'@'.$udom); + push(@notified,$uname.':'.$udom); } } if (@notified > 0) {