Diff for /loncom/interface/loncommon.pm between versions 1.636.2.3 and 1.652

version 1.636.2.3, 2008/03/18 23:00:51 version 1.652, 2008/04/30 23:36:56
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;
           if (!$ok) {
               &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
           }
    $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 214  BEGIN { Line 284  BEGIN {
   
 =over 4  =over 4
   
 =item * browser_and_searcher_javascript ()  =item * &browser_and_searcher_javascript()
   
 X<browsing, javascript>X<searching, javascript>Returns a string  X<browsing, javascript>X<searching, javascript>Returns a string
 containing javascript with two functions, C<openbrowser> and  containing javascript with two functions, C<openbrowser> and
 C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>  C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
 tags.  tags.
   
 =item * openbrowser(formname,elementname,only,omit) [javascript]  =item * &openbrowser(formname,elementname,only,omit) [javascript]
   
 inputs: formname, elementname, only, omit  inputs: formname, elementname, only, omit
   
Line 234  with the given extension.  Can be a comm Line 304  with the given extension.  Can be a comm
 Specifying 'omit' will restrict the browser to NOT displaying files  Specifying 'omit' will restrict the browser to NOT displaying files
 with the given extension.  Can be a comma separated list.  with the given extension.  Can be a comma separated list.
   
 =item * opensearcher(formname, elementname) [javascript]  =item * &opensearcher(formname,elementname) [javascript]
   
 Inputs: formname, elementname  Inputs: formname, elementname
   
Line 319  sub storeresurl { Line 389  sub storeresurl {
     unless ($resurl=~/^\/res/) { return 0; }      unless ($resurl=~/^\/res/) { return 0; }
     $resurl=~s/\/$//;      $resurl=~s/\/$//;
     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});      &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
     &Apache::lonnet::appenv('environment.lastresurl' => $resurl);      &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
     return 1;      return 1;
 }  }
   
Line 542  ENDSCRT Line 612  ENDSCRT
   
 =pod  =pod
   
 =item * linked_select_forms(...)  =item * &linked_select_forms(...)
   
 linked_select_forms returns a string containing a <script></script> block  linked_select_forms returns a string containing a <script></script> block
 and html for two <select> menus.  The select menus will be linked in that  and html for two <select> menus.  The select menus will be linked in that
Line 707  END Line 777  END
   
 =pod  =pod
   
 =item * help_open_topic($topic, $text, $stayOnPage, $width, $height)  =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height)
   
 Returns a string corresponding to an HTML link to the given help  Returns a string corresponding to an HTML link to the given help
 $topic, where $topic corresponds to the name of a .tex file in  $topic, where $topic corresponds to the name of a .tex file in
Line 761  sub help_open_topic { Line 831  sub help_open_topic {
   
     # Add the graphic      # Add the graphic
     my $title = &mt('Online Help');      my $title = &mt('Online Help');
     my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");      my $helpicon=&lonhttpdurl("/res/adm/pages/help.png");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>   <a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
Line 1017  ENDTEMPLATE Line 1087  ENDTEMPLATE
   
 =pod  =pod
   
 =item * change_content_javascript():  =item * &change_content_javascript():
   
 This and the next function allow you to create small sections of an  This and the next function allow you to create small sections of an
 otherwise static HTML page that you can update on the fly with  otherwise static HTML page that you can update on the fly with
Line 1072  DOMBASED Line 1142  DOMBASED
   
 =pod  =pod
   
 =item * changable_area($name, $origContent):  =item * &changable_area($name,$origContent):
   
 This provides a "changable area" that can be modified on the fly via  This provides a "changable area" that can be modified on the fly via
 the Javascript code provided in C<change_content_javascript>. $name is  the Javascript code provided in C<change_content_javascript>. $name is
Line 1096  sub changable_area { Line 1166  sub changable_area {
   
 =pod  =pod
   
 =item * viewport_geometry_js {  =item * &viewport_geometry_js 
   
 Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.  Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
   
Line 1143  GEOMETRY Line 1213  GEOMETRY
   
 =pod  =pod
   
 =item * viewport_size_js {  =item * &viewport_size_js()
   
 Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window.   Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window. 
   
Line 1167  DIMS Line 1237  DIMS
   
 =pod  =pod
   
 =item * resize_textarea_js  =item * &resize_textarea_js()
   
 emits the needed javascript to resize a textarea to be as big as possible  emits the needed javascript to resize a textarea to be as big as possible
   
Line 1176  the id of the element to resize, second Line 1246  the id of the element to resize, second
 surrounds everything that comes after the textarea, this routine needs  surrounds everything that comes after the textarea, this routine needs
 to be attached to the <body> for the onload and onresize events.  to be attached to the <body> for the onload and onresize events.
   
   =back
   
 =cut  =cut
   
Line 1228  RESIZE Line 1299  RESIZE
   
 =pod  =pod
   
 =back  
    
 =head1 Excel and CSV file utility routines  =head1 Excel and CSV file utility routines
   
 =over 4  =over 4
Line 1241  RESIZE Line 1310  RESIZE
   
 =pod  =pod
   
 =item * csv_translate($text)   =item * &csv_translate($text) 
   
 Translate $text to allow it to be output as a 'comma separated values'   Translate $text to allow it to be output as a 'comma separated values' 
 format.  format.
Line 1262  sub csv_translate { Line 1331  sub csv_translate {
   
 =pod  =pod
   
 =item * define_excel_formats  =item * &define_excel_formats()
   
 Define some commonly used Excel cell formats.  Define some commonly used Excel cell formats.
   
Line 1318  sub define_excel_formats { Line 1387  sub define_excel_formats {
   
 =pod  =pod
   
 =item * create_workbook  =item * &create_workbook()
   
 Create an Excel worksheet.  If it fails, output message on the  Create an Excel worksheet.  If it fails, output message on the
 request object and return undefs.  request object and return undefs.
Line 1361  sub create_workbook { Line 1430  sub create_workbook {
   
 =pod  =pod
   
 =item * create_text_file  =item * &create_text_file()
   
 Create a file to write to and eventually make available to the user.  Create a file to write to and eventually make available to the user.
 If file creation fails, outputs an error message on the request object and   If file creation fails, outputs an error message on the request object and 
Line 1429  sub domain_select { Line 1498  sub domain_select {
   
 =over 4  =over 4
   
 =item * multiple_select_form($name,$value,$size,$hash,$order)  =item * &multiple_select_form($name,$value,$size,$hash,$order)
   
 Returns a string containing a <select> element int multiple mode  Returns a string containing a <select> element int multiple mode
   
Line 1479  sub multiple_select_form { Line 1548  sub multiple_select_form {
   
 =pod  =pod
   
 =item * select_form($defdom,$name,%hash)  =item * &select_form($defdom,$name,%hash)
   
 Returns a string containing a <select name='$name' size='1'> form to   Returns a string containing a <select name='$name' size='1'> form to 
 allow a user to select options from a hash option_name => displayed text.    allow a user to select options from a hash option_name => displayed text.  
Line 1566  sub select_level_form { Line 1635  sub select_level_form {
   
 =pod  =pod
   
 =item * select_dom_form($defdom,$name,$includeempty,$showdomdesc)  =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc)
   
 Returns a string containing a <select name='$name' size='1'> form to   Returns a string containing a <select name='$name' size='1'> form to 
 allow a user to select the domain to preform an operation in.    allow a user to select the domain to preform an operation in.  
Line 1606  sub select_dom_form { Line 1675  sub select_dom_form {
   
 =pod  =pod
   
 =item * home_server_form_item($domain,$name,$defaultflag)  =item * &home_server_form_item($domain,$name,$defaultflag)
   
 input: 4 arguments (two required, two optional) -   input: 4 arguments (two required, two optional) - 
     $domain - domain of new user      $domain - domain of new user
Line 1766  sub decode_user_agent { Line 1835  sub decode_user_agent {
   
 =over 4  =over 4
   
 =item * authform_xxxxxx  =item * &authform_xxxxxx()
   
 The authform_xxxxxx subroutines provide javascript and html forms which   The authform_xxxxxx subroutines provide javascript and html forms which 
 handle some of the conveniences required for authentication forms.    handle some of the conveniences required for authentication forms.  
 This is not an optimal method, but it works.    This is not an optimal method, but it works.  
   
 See loncreateuser.pm for invocation and use examples.  
   
 =over 4  =over 4
   
 =item * authform_header  =item * authform_header
Line 1790  See loncreateuser.pm for invocation and Line 1857  See loncreateuser.pm for invocation and
   
 =back  =back
   
 =back   See loncreateuser.pm for invocation and use examples.
   
 =cut  =cut
   
Line 2242  sub get_assignable_auth { Line 2309  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 2289  sub get_auth_defaults { Line 2320  sub get_auth_defaults {
   
 =pod  =pod
   
 =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.
   
   =over 4
   
 ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);  ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
   
   =back
   
   =back
   
 =cut  =cut
   
 #-------------------------------------------  #-------------------------------------------
 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 2313  sub get_kerberos_defaults { Line 2353  sub get_kerberos_defaults {
     return ($krbdef,$krbdefdom);      return ($krbdef,$krbdefdom);
 }  }
   
 =pod  
   
 =back  
   
 =cut  
   
 ###############################################################  ###############################################################
 ##                Thesaurus Functions                        ##  ##                Thesaurus Functions                        ##
Line 2329  sub get_kerberos_defaults { Line 2364  sub get_kerberos_defaults {
   
 =over 4  =over 4
   
 =item * initialize_keywords  =item * &initialize_keywords()
   
 Initializes the package variable %Keywords if it is empty.  Uses the  Initializes the package variable %Keywords if it is empty.  Uses the
 package variable $thesaurus_db_file.  package variable $thesaurus_db_file.
Line 2374  sub initialize_keywords { Line 2409  sub initialize_keywords {
   
 =pod  =pod
   
 =item * keyword($word)  =item * &keyword($word)
   
 Returns true if $word is a keyword.  A keyword is a word that appears more   Returns true if $word is a keyword.  A keyword is a word that appears more 
 than the average number of times in the thesaurus database.  Calls   than the average number of times in the thesaurus database.  Calls 
Line 2395  sub keyword { Line 2430  sub keyword {
   
 =pod   =pod 
   
 =item * get_related_words  =item * &get_related_words()
   
 Look up a word in the thesaurus.  Takes a scalar argument and returns  Look up a word in the thesaurus.  Takes a scalar argument and returns
 an array of words.  If the keyword is not in the thesaurus, an empty array  an array of words.  If the keyword is not in the thesaurus, an empty array
Line 2453  sub get_related_words { Line 2488  sub get_related_words {
   
 =over 4  =over 4
   
 =item * plainname($uname,$udom,$first)  =item * &plainname($uname,$udom,$first)
   
 Takes a users logon name and returns it as a string in  Takes a users logon name and returns it as a string in
 "first middle last generation" form   "first middle last generation" form 
Line 2482  sub plainname { Line 2517  sub plainname {
 # -------------------------------------------------------------------- Nickname  # -------------------------------------------------------------------- Nickname
 =pod  =pod
   
 =item * nickname($uname,$udom)  =item * &nickname($uname,$udom)
   
 Gets a users name and returns it as a string as  Gets a users name and returns it as a string as
   
Line 2532  sub getnames { Line 2567  sub getnames {
 }  }
   
 # -------------------------------------------------------------------- getemails  # -------------------------------------------------------------------- getemails
   
 =pod  =pod
   
 =item * getemails($uname,$udom)  =item * &getemails($uname,$udom)
   
 Gets a user's email information and returns it as a hash with keys:  Gets a user's email information and returns it as a hash with keys:
 notification, critnotification, permanentemail  notification, critnotification, permanentemail
   
 For notification and critnotification, values are comma-separated lists   For notification and critnotification, values are comma-separated lists 
 of e-mail address(es); for permanentemail, value is a single e-mail address.  of e-mail addresses; for permanentemail, value is a single e-mail address.
     
   
 =cut  =cut
   
   
 sub getemails {  sub getemails {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     if ($udom eq 'public' && $uname eq 'public') {      if ($udom eq 'public' && $uname eq 'public') {
Line 2578  sub flush_email_cache { Line 2616  sub flush_email_cache {
   
 =pod  =pod
   
 =item * screenname($uname,$udom)  =item * &screenname($uname,$udom)
   
 Gets a users screenname and returns it as a string  Gets a users screenname and returns it as a string
   
Line 2674  sub student_image_tag { Line 2712  sub student_image_tag {
   
 =over 4  =over 4
   
 =item * languageids()   =item * &languageids() 
   
 returns list of all language ids  returns list of all language ids
   
Line 2686  sub languageids { Line 2724  sub languageids {
   
 =pod  =pod
   
 =item * languagedescription()   =item * &languagedescription() 
   
 returns description of a specified language id  returns description of a specified language id
   
Line 2711  sub supportedlanguagecode { Line 2749  sub supportedlanguagecode {
   
 =pod  =pod
   
 =item * copyrightids()   =item * &copyrightids() 
   
 returns list of all copyrights  returns list of all copyrights
   
Line 2723  sub copyrightids { Line 2761  sub copyrightids {
   
 =pod  =pod
   
 =item * copyrightdescription()   =item * &copyrightdescription() 
   
 returns description of a specified copyright id  returns description of a specified copyright id
   
Line 2735  sub copyrightdescription { Line 2773  sub copyrightdescription {
   
 =pod  =pod
   
 =item * source_copyrightids()   =item * &source_copyrightids() 
   
 returns list of all source copyrights  returns list of all source copyrights
   
Line 2747  sub source_copyrightids { Line 2785  sub source_copyrightids {
   
 =pod  =pod
   
 =item * source_copyrightdescription()   =item * &source_copyrightdescription() 
   
 returns description of a specified source copyright id  returns description of a specified source copyright id
   
Line 2759  sub source_copyrightdescription { Line 2797  sub source_copyrightdescription {
   
 =pod  =pod
   
 =item * filecategories()   =item * &filecategories() 
   
 returns list of all file categories  returns list of all file categories
   
Line 2771  sub filecategories { Line 2809  sub filecategories {
   
 =pod  =pod
   
 =item * filecategorytypes()   =item * &filecategorytypes() 
   
 returns list of file types belonging to a given file  returns list of file types belonging to a given file
 category  category
Line 2785  sub filecategorytypes { Line 2823  sub filecategorytypes {
   
 =pod  =pod
   
 =item * fileembstyle()   =item * &fileembstyle() 
   
 returns embedding style for a specified file type  returns embedding style for a specified file type
   
Line 2809  sub filecategoryselect { Line 2847  sub filecategoryselect {
   
 =pod  =pod
   
 =item * filedescription()   =item * &filedescription() 
   
 returns description for a specified file type  returns description for a specified file type
   
Line 2823  sub filedescription { Line 2861  sub filedescription {
   
 =pod  =pod
   
 =item * filedescriptionex()   =item * &filedescriptionex() 
   
 returns description for a specified file type with  returns description for a specified file type with
 extra formatting  extra formatting
Line 2883  sub preferred_languages { Line 2921  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 2947  sub languages { Line 2979  sub languages {
   
 =over 4  =over 4
   
 =item * get_previous_attempt($symb, $username, $domain, $course,  =item * &get_previous_attempt($symb, $username, $domain, $course,
     $getattempt, $regexp, $gradesub)      $getattempt, $regexp, $gradesub)
   
 Return string with previous attempt on problem. Arguments:  Return string with previous attempt on problem. Arguments:
Line 3091  sub relative_to_absolute { Line 3123  sub relative_to_absolute {
   
 =pod  =pod
   
 =item * get_student_view  =item * &get_student_view()
   
 show a snapshot of what student was looking at  show a snapshot of what student was looking at
   
Line 3110  sub get_student_view { Line 3142  sub get_student_view {
   }    }
   if (defined($target)) { $form{'grade_target'} = $target; }    if (defined($target)) { $form{'grade_target'} = $target; }
   $feedurl=&Apache::lonnet::clutter($feedurl);    $feedurl=&Apache::lonnet::clutter($feedurl);
   my $userview=&Apache::lonnet::ssi_body($feedurl,%form);    my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
   $userview=~s/\<body[^\>]*\>//gi;    $userview=~s/\<body[^\>]*\>//gi;
   $userview=~s/\<\/body\>//gi;    $userview=~s/\<\/body\>//gi;
   $userview=~s/\<html\>//gi;    $userview=~s/\<html\>//gi;
Line 3119  sub get_student_view { Line 3151  sub get_student_view {
   $userview=~s/\<\/head\>//gi;    $userview=~s/\<\/head\>//gi;
   $userview=~s/action\s*\=/would_be_action\=/gi;    $userview=~s/action\s*\=/would_be_action\=/gi;
   $userview=&relative_to_absolute($feedurl,$userview);    $userview=&relative_to_absolute($feedurl,$userview);
   return $userview;    if (wantarray) {
        return ($userview,$response);
     } else {
        return $userview;
     }
   }
   
   sub get_student_view_with_retries {
     my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
   
       my $ok = 0;                 # True if we got a good response.
       my $content;
       my $response;
   
       # Try to get the student_view done. within the retries count:
       
       do {
            ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
            $ok      = $response->is_success;
            if (!$ok) {
               &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
            }
            $retries--;
       } while (!$ok && ($retries > 0));
       
       if (!$ok) {
          $content = '';          # On error return an empty content.
       }
       if (wantarray) {
          return ($content, $response);
       } else {
          return $content;
       }
 }  }
   
 =pod  =pod
   
 =item * get_student_answers()   =item * &get_student_answers() 
   
 show a snapshot of how student was answering problem  show a snapshot of how student was answering problem
   
Line 3981  ENDROLE Line 4045  ENDROLE
         $dc_info = '('.$dc_info.')';          $dc_info = '('.$dc_info.')';
     }      }
   
     if ($env{'environment.remote'} eq 'off') {      if (($env{'environment.remote'} eq 'off') || ($args->{'suppress_header_logos'})) {
         # No Remote          # No Remote
  if ($env{'request.state'} eq 'construct') {   if ($env{'request.state'} eq 'construct') {
     $forcereg=1;      $forcereg=1;
Line 4006  ENDROLE Line 4070  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 4777  table.LC_pick_box td.LC_pick_box_title { Line 4841  table.LC_pick_box td.LC_pick_box_title {
   width: 184px;    width: 184px;
   padding: 8px;    padding: 8px;
 }  }
   table.LC_pick_box td.LC_selfenroll_pick_box_title {
     background: $tabbg;
     font-weight: bold;
     text-align: right;
     width: 350px;
     padding: 8px;
   }
   
 table.LC_pick_box td.LC_pick_box_value {  table.LC_pick_box td.LC_pick_box_value {
   text-align: left;    text-align: left;
   padding: 8px;    padding: 8px;
Line 5321  Inputs: none Line 5393  Inputs: none
   
 sub font_settings {  sub font_settings {
     my $headerstring='';      my $headerstring='';
     if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) {       if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
  $headerstring.=  
     '<meta Content-Type="text/html; charset=x-mac-roman" />';  
     } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) {  
  $headerstring.=   $headerstring.=
     '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';      '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
     }      }
Line 5383  sub endheadtag { Line 5452  sub endheadtag {
   
 Returns a uniform complete <head>..</head> section for LON-CAPA web pages.  Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
   
 Inputs: $title - optional title for the page  Inputs:
         $head_extra - optional extra HTML to put inside the <head>  
   =over 4
   
   $title - optional title for the page
   
   $head_extra - optional extra HTML to put inside the <head>
   
   =back
   
 =cut  =cut
   
Line 5399  sub head { Line 5475  sub head {
   
 Returns a complete <html> .. <body> section for LON-CAPA web pages.  Returns a complete <html> .. <body> section for LON-CAPA web pages.
   
 Inputs: $title - optional title for the page  Inputs:
         $head_extra - optional extra HTML to incude inside the <head>  
         $args - additional optional args supported are:  =over 4
                   only_body      -> is true will set &bodytag() onlybodytag  
   $title - optional title for the page
   
   $head_extra - optional extra HTML to incude inside the <head>
   
   $args - additional optional args supported are:
   
   =over 8
   
                only_body      -> is true will set &bodytag() onlybodytag
                                     arg on                                      arg on
                   no_nav_bar     -> is true will set &bodytag() notopbar arg on               no_nav_bar     -> is true will set &bodytag() notopbar arg on
                   add_entries    -> additional attributes to add to the  <body>               add_entries    -> additional attributes to add to the  <body>
                   domain         -> force to color decorate a page for a                domain         -> force to color decorate a page for a 
                                     specific domain                                      specific domain
                   function       -> force usage of a specific rolish color               function       -> force usage of a specific rolish color
                                     scheme                                      scheme
                   redirect       -> see &headtag()               redirect       -> see &headtag()
                   bgcolor        -> override the default page bg color               bgcolor        -> override the default page bg color
                   js_ready       -> return a string ready for being used in                js_ready       -> return a string ready for being used in 
                                     a javascript writeln                                      a javascript writeln
                   html_encode    -> return a string ready for being used in                html_encode    -> return a string ready for being used in 
                                     a html attribute                                      a html attribute
                   force_register -> if is true will turn on the &bodytag()               force_register -> if is true will turn on the &bodytag()
                                     $forcereg arg                                      $forcereg arg
                   body_title     -> alternate text to use instead of $title               body_title     -> alternate text to use instead of $title
                                     in the title box that appears, this text                                      in the title box that appears, this text
                                     is not auto translated like the $title is                                      is not auto translated like the $title is
                   frameset       -> if true will start with a <frameset>               frameset       -> if true will start with a <frameset>
                                     rather than <body>                                      rather than <body>
                   no_title       -> if true the title bar won't be shown               no_title       -> if true the title bar won't be shown
                   skip_phases    -> hash ref of                skip_phases    -> hash ref of 
                                     head -> skip the <html><head> generation                                      head -> skip the <html><head> generation
                                     body -> skip all <body> generation                                      body -> skip all <body> generation
                no_inline_link -> if true and in remote mode, don't show the 
                   no_inline_link -> if true and in remote mode, don't show the   
                                     'Switch To Inline Menu' link                                      'Switch To Inline Menu' link
                no_auto_mt_title -> prevent &mt()ing the title arg
                   no_auto_mt_title -> prevent &mt()ing the title arg               inherit_jsmath -> when creating popup window in a page,
   
                   inherit_jsmath -> when creating popup window in a page,  
                                     should it have jsmath forced on by the                                      should it have jsmath forced on by the
                                     current page                                      current page
   
   =back
   
   =back
   
 =cut  =cut
   
 sub start_page {  sub start_page {
Line 6692  sub personal_data_fieldtitles { Line 6778  sub personal_data_fieldtitles {
     return %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);
   }
   
   sub get_institutional_codes {
       my ($settings,$allcourses,$LC_code) = @_;
   # Get complete list of course sections to update
       my @currsections = ();
       my @currxlists = ();
       my $coursecode = $$settings{'internal.coursecode'};
   
       if ($$settings{'internal.sectionnums'} ne '') {
           @currsections = split(/,/,$$settings{'internal.sectionnums'});
       }
   
       if ($$settings{'internal.crosslistings'} ne '') {
           @currxlists = split(/,/,$$settings{'internal.crosslistings'});
       }
   
       if (@currxlists > 0) {
           foreach (@currxlists) {
               if (m/^([^:]+):(\w*)$/) {
                   unless (grep/^$1$/,@{$allcourses}) {
                       push @{$allcourses},$1;
                       $$LC_code{$1} = $2;
                   }
               }
           }
       }
    
       if (@currsections > 0) {
           foreach (@currsections) {
               if (m/^(\w+):(\w*)$/) {
                   my $sec = $coursecode.$1;
                   my $lc_sec = $2;
                   unless (grep/^$sec$/,@{$allcourses}) {
                       push @{$allcourses},$sec;
                       $$LC_code{$sec} = $lc_sec;
                   }
               }
           }
       }
       return;
   }
   
 =pod  =pod
   
 =back  =back
Line 6700  sub personal_data_fieldtitles { Line 6852  sub personal_data_fieldtitles {
   
 =over 4  =over 4
   
 =item * get_unprocessed_cgi($query,$possible_names)  =item * &get_unprocessed_cgi($query,$possible_names)
   
 Modify the %env hash to contain unprocessed CGI form parameters held in  Modify the %env hash to contain unprocessed CGI form parameters held in
 $query.  The parameters listed in $possible_names (an array reference),  $query.  The parameters listed in $possible_names (an array reference),
Line 6729  sub get_unprocessed_cgi { Line 6881  sub get_unprocessed_cgi {
   
 =pod  =pod
   
 =item * cacheheader()   =item * &cacheheader() 
   
 returns cache-controlling header code  returns cache-controlling header code
   
Line 6746  sub cacheheader { Line 6898  sub cacheheader {
   
 =pod  =pod
   
 =item * no_cache($r)   =item * &no_cache($r) 
   
 specifies header code to not have cache  specifies header code to not have cache
   
Line 6782  sub content_type { Line 6934  sub content_type {
   
 =pod  =pod
   
 =item * add_to_env($name,$value)   =item * &add_to_env($name,$value) 
   
 adds $name to the %env hash with value  adds $name to the %env hash with value
 $value, if $name already exists, the entry is converted to an array  $value, if $name already exists, the entry is converted to an array
Line 6809  sub add_to_env { Line 6961  sub add_to_env {
   
 =pod  =pod
   
 =item * get_env_multiple($name)   =item * &get_env_multiple($name) 
   
 gets $name from the %env hash, it seemlessly handles the cases where multiple  gets $name from the %env hash, it seemlessly handles the cases where multiple
 values may be defined and end up as an array ref.  values may be defined and end up as an array ref.
Line 6841  sub get_env_multiple { Line 6993  sub get_env_multiple {
   
 =over 4  =over 4
   
 =item * upfile_store($r)  =item * &upfile_store($r)
   
 Store uploaded file, $r should be the HTTP Request object,  Store uploaded file, $r should be the HTTP Request object,
 needs $env{'form.upfile'}  needs $env{'form.upfile'}
Line 6871  sub upfile_store { Line 7023  sub upfile_store {
   
 =pod  =pod
   
 =item * load_tmp_file($r)  =item * &load_tmp_file($r)
   
 Load uploaded file from tmp, $r should be the HTTP Request object,  Load uploaded file from tmp, $r should be the HTTP Request object,
 needs $env{'form.datatoken'},  needs $env{'form.datatoken'},
Line 6895  sub load_tmp_file { Line 7047  sub load_tmp_file {
   
 =pod  =pod
   
 =item * upfile_record_sep()  =item * &upfile_record_sep()
   
 Separate uploaded file into records  Separate uploaded file into records
 returns array of records,  returns array of records,
Line 6917  sub upfile_record_sep { Line 7069  sub upfile_record_sep {
   
 =pod  =pod
   
 =item * record_sep($record)  =item * &record_sep($record)
   
 Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}  Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
   
Line 7002  sub record_sep { Line 7154  sub record_sep {
   
 =pod  =pod
   
 =item * upfile_select_html()  =item * &upfile_select_html()
   
 Return HTML code to select a file from the users machine and specify   Return HTML code to select a file from the users machine and specify 
 the file type.  the file type.
Line 7049  sub get_samples { Line 7201  sub get_samples {
   
 =pod  =pod
   
 =item * csv_print_samples($r,$records)  =item * &csv_print_samples($r,$records)
   
 Prints a table of sample values from each column uploaded $r is an  Prints a table of sample values from each column uploaded $r is an
 Apache Request ref, $records is an arrayref from  Apache Request ref, $records is an arrayref from
Line 7085  sub csv_print_samples { Line 7237  sub csv_print_samples {
   
 =pod  =pod
   
 =item * csv_print_select_table($r,$records,$d)  =item * &csv_print_select_table($r,$records,$d)
   
 Prints a table to create associations between values and table columns.  Prints a table to create associations between values and table columns.
   
Line 7131  sub csv_print_select_table { Line 7283  sub csv_print_select_table {
   
 =pod  =pod
   
 =item * csv_samples_select_table($r,$records,$d)  =item * &csv_samples_select_table($r,$records,$d)
   
 Prints a table of sample values from the upload and can make associate samples to internal names.  Prints a table of sample values from the upload and can make associate samples to internal names.
   
Line 7181  sub csv_samples_select_table { Line 7333  sub csv_samples_select_table {
   
 =pod  =pod
   
 =item clean_excel_name($name)  =item * &clean_excel_name($name)
   
 Returns a replacement for $name which does not contain any illegal characters.  Returns a replacement for $name which does not contain any illegal characters.
   
Line 7200  sub clean_excel_name { Line 7352  sub clean_excel_name {
   
 =pod  =pod
   
 =item * check_if_partid_hidden($id,$symb,$udom,$uname)  =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
   
 Returns either 1 or undef  Returns either 1 or undef
   
Line 7241  sub check_if_partid_hidden { Line 7393  sub check_if_partid_hidden {
   
 =over 4  =over 4
   
 =item get_cgi_id  =item * &get_cgi_id()
   
 Inputs: none  Inputs: none
   
Line 7265  sub get_cgi_id { Line 7417  sub get_cgi_id {
   
 =pod  =pod
   
 =item DrawBarGraph  =item * &DrawBarGraph()
   
 Facilitates the plotting of data in a (stacked) bar graph.  Facilitates the plotting of data in a (stacked) bar graph.
 Puts plot definition data into the users environment in order for   Puts plot definition data into the users environment in order for 
Line 7400  sub DrawBarGraph { Line 7552  sub DrawBarGraph {
         $ValuesHash{$id.'.'.$key} = $value;          $ValuesHash{$id.'.'.$key} = $value;
     }      }
     #      #
     &Apache::lonnet::appenv(%ValuesHash);      &Apache::lonnet::appenv(\%ValuesHash);
     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';      return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
 }  }
   
Line 7409  sub DrawBarGraph { Line 7561  sub DrawBarGraph {
   
 =pod  =pod
   
 =item DrawXYGraph  =item * &DrawXYGraph()
   
 Facilitates the plotting of data in an XY graph.  Facilitates the plotting of data in an XY graph.
 Puts plot definition data into the users environment in order for   Puts plot definition data into the users environment in order for 
Line 7490  sub DrawXYGraph { Line 7642  sub DrawXYGraph {
         $ValuesHash{$id.'.'.$key} = $value;          $ValuesHash{$id.'.'.$key} = $value;
     }      }
     #      #
     &Apache::lonnet::appenv(%ValuesHash);      &Apache::lonnet::appenv(\%ValuesHash);
     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';      return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
 }  }
   
Line 7499  sub DrawXYGraph { Line 7651  sub DrawXYGraph {
   
 =pod  =pod
   
 =item DrawXYYGraph  =item * &DrawXYYGraph()
   
 Facilitates the plotting of data in an XY graph with two Y axes.  Facilitates the plotting of data in an XY graph with two Y axes.
 Puts plot definition data into the users environment in order for   Puts plot definition data into the users environment in order for 
Line 7592  sub DrawXYYGraph { Line 7744  sub DrawXYYGraph {
         $ValuesHash{$id.'.'.$key} = $value;          $ValuesHash{$id.'.'.$key} = $value;
     }      }
     #      #
     &Apache::lonnet::appenv(%ValuesHash);      &Apache::lonnet::appenv(\%ValuesHash);
     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';      return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
 }  }
   
Line 7609  Bad place for them but what the hell. Line 7761  Bad place for them but what the hell.
   
 =over 4  =over 4
   
 =item &chartlink  =item * &chartlink()
   
 Returns a link to the chart for a specific student.    Returns a link to the chart for a specific student.  
   
Line 7648  sub chartlink { Line 7800  sub chartlink {
   
 =over 4  =over 4
   
 =item &restore_course_settings   =item * &restore_course_settings()
   
 =item &store_course_settings  =item * &store_course_settings()
   
 Restores/Store indicated form parameters from the course environment.  Restores/Store indicated form parameters from the course environment.
 Will not overwrite existing values of the form parameters.  Will not overwrite existing values of the form parameters.
Line 7724  sub store_settings { Line 7876  sub store_settings {
                                  'got error:'.$put_result);                                   'got error:'.$put_result);
     }      }
     # Make sure these settings stick around in this session, too      # Make sure these settings stick around in this session, too
     &Apache::lonnet::appenv(%AppHash);      &Apache::lonnet::appenv(\%AppHash);
     return;      return;
 }  }
   
Line 7761  sub restore_settings { Line 7913  sub restore_settings {
   
 =over 4  =over 4
   
 =item &build_recipient_list  =item * &build_recipient_list()
   
 Build recipient lists for three types of e-mail:  Build recipient lists for three types of e-mail:
 (a) Error Reports, (b) Package Updates, (c) Help requests, generated by  (a) Error Reports, (b) Package Updates, (c) Help requests, generated by
Line 7866  sub commit_standardrole { Line 8018  sub commit_standardrole {
         $output = &mt('Assigning').' '.$three.' in '.$url.          $output = &mt('Assigning').' '.$three.' in '.$url.
                ($start?', '.&mt('starting').' '.localtime($start):'').                 ($start?', '.&mt('starting').' '.localtime($start):'').
                ($end?', '.&mt('ending').' '.localtime($end):'').': ';                 ($end?', '.&mt('ending').' '.localtime($end):'').': ';
         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start);          my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
         if ($context eq 'auto') {          if ($context eq 'auto') {
             $output .= $result.$linefeed;              $output .= $result.$linefeed;
         } else {          } else {
Line 7901  sub commit_studentrole { Line 8053  sub commit_studentrole {
                 }                  }
                 $oldsecurl = $uurl;                  $oldsecurl = $uurl;
                 $expire_role_result =                   $expire_role_result = 
                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now);                      &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
                 if ($env{'request.course.sec'} ne '') {                   if ($env{'request.course.sec'} ne '') { 
                     if ($expire_role_result eq 'refused') {                      if ($expire_role_result eq 'refused') {
                         my @roles = ('st');                          my @roles = ('st');
Line 7924  sub commit_studentrole { Line 8076  sub commit_studentrole {
             }              }
         }          }
         if (($expire_role_result eq 'ok') || ($secchange == 0)) {          if (($expire_role_result eq 'ok') || ($secchange == 0)) {
             $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,'',$context);
             if ($modify_section_result =~ /^ok/) {              if ($modify_section_result =~ /^ok/) {
                 if ($secchange == 1) {                  if ($secchange == 1) {
                     if ($sec eq '') {                      if ($sec eq '') {
Line 8087  sub construct_course { Line 8239  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 8134  sub construct_course { Line 8286  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.3  
changed lines
  Added in v.1.652


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