--- loncom/interface/loncommon.pm 2008/01/22 22:37:18 1.637 +++ 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.637 2008/01/22 22:37:18 www 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; @@ -2242,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 ## ############################################################### ## @@ -2292,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); @@ -2302,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/; @@ -2883,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; @@ -4004,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()') @@ -4498,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; @@ -6688,6 +6705,31 @@ sub personal_data_fieldtitles { 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 @@ -8088,14 +8130,21 @@ sub construct_course { $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); } # @@ -8123,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'} = '';