[BACK]Return to loncommon.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.636.2.4 and 1.641

version 1.636.2.4, 2008/03/23 23:06:31 version 1.641, 2008/02/24 22:59:13
Line 78  my $readit; Line 78  my $readit;
 ## Global Variables  ## Global Variables
 ##  ##
   
 # ----------------------------------------------- SSI with retries:  
 #  
   
 =pod  
   
 =head1 Server Side include 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:  
   
 =over 4  
   
 resource   - Identifies the resource to insert.  
   
 retries    - Count of the number of retries allowed.  
   
 form       - Hash that identifies the rendering options.  
   
 =back  
   
 Returns:  
   
 =over 4  
   
 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.  
   
 =back  
   
 =back  
   
 =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 2308  sub get_assignable_auth { Line 2242  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 2358  sub get_auth_defaults { Line 2256  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 2368  version 4 and the domain of the server. Line 2266  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 2949  sub preferred_languages { Line 2850  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 4072  ENDROLE Line 3967  ENDROLE
     $titleinfo =       $titleinfo = 
  &Apache::loncommon::help_open_menu('','',3,'Authoring')   &Apache::loncommon::help_open_menu('','',3,'Authoring')
  .'<b>'.&mt('Construction Space').'</b>:&nbsp;'   .'<b>'.&mt('Construction Space').'</b>:&nbsp;'
  .'<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()')
  .'</form>'   .'</form>'
Line 8153  sub construct_course { Line 8048  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
Line 8200  sub construct_course { Line 8095  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'} = '';
Removed from v.1.636.2.4  
changed lines
  Added in v.1.641

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