--- loncom/interface/loncommon.pm 2008/03/18 23:00:51 1.636.2.3 +++ loncom/interface/loncommon.pm 2008/03/03 16:41:42 1.644 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.636.2.3 2008/03/18 23:00:51 raeburn Exp $ +# $Id: loncommon.pm,v 1.644 2008/03/03 16:41:42 www 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; @@ -3981,7 +3994,7 @@ ENDROLE $dc_info = '('.$dc_info.')'; } - if ($env{'environment.remote'} eq 'off') { + if (($env{'environment.remote'} eq 'off') || ($args->{'suppress_header_logos'})) { # No Remote if ($env{'request.state'} eq 'construct') { $forcereg=1; @@ -4006,8 +4019,8 @@ ENDROLE $titleinfo = &Apache::loncommon::help_open_menu('','',3,'Authoring') .''.&mt('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()') .'' @@ -6692,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 @@ -8087,7 +8125,7 @@ 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 @@ -8134,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'} = '';