Diff for /loncom/interface/loncommon.pm between versions 1.240 and 1.279

version 1.240, 2004/12/02 21:30:16 version 1.279, 2005/10/13 22:37:40
Line 55  redundancy from other modules and increa Line 55  redundancy from other modules and increa
 package Apache::loncommon;  package Apache::loncommon;
   
 use strict;  use strict;
 use Apache::lonnet();  use Apache::lonnet;
 use GDBM_File;  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
Line 152  BEGIN { Line 152  BEGIN {
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';      my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
     opendir(DIR,$designdir);      opendir(DIR,$designdir);
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
    if ($filename!~/\.tab$/) { next; }
  my ($domain)=($filename=~/^(\w+)\./);   my ($domain)=($filename=~/^(\w+)\./);
     {   {
         my $designfile = $designdir.'/'.$filename;      my $designfile = $designdir.'/'.$filename;
         if ( open (my $fh,"<$designfile") ) {      if ( open (my $fh,"<$designfile") ) {
             while (<$fh>) {   while (<$fh>) {
                 next if /^\#/;      next if /^\#/;
                 chomp;      chomp;
                 my ($key,$val)=(split(/\=/,$_));      my ($key,$val)=(split(/\=/,$_));
                 if ($val) { $designhash{$domain.'.'.$key}=$val; }      if ($val) { $designhash{$domain.'.'.$key}=$val; }
             }   }
             close($fh);   close($fh);
         }      }
     }   }
   
     }      }
     closedir(DIR);      closedir(DIR);
Line 311  END Line 312  END
 }  }
   
 sub lastresurl {  sub lastresurl {
     if ($ENV{'environment.lastresurl'}) {      if ($env{'environment.lastresurl'}) {
  return $ENV{'environment.lastresurl'}   return $env{'environment.lastresurl'}
     } else {      } else {
  return '/res';   return '/res';
     }      }
Line 329  sub storeresurl { Line 330  sub storeresurl {
   
 sub studentbrowser_javascript {  sub studentbrowser_javascript {
    unless (     unless (
             (($ENV{'request.course.id'}) &&               (($env{'request.course.id'}) && 
              (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})))               (&Apache::lonnet::allowed('srm',$env{'request.course.id'})))
          || ($ENV{'request.role'}=~/^(au|dc|su)/)           || ($env{'request.role'}=~/^(au|dc|su)/)
           ) { return ''; }              ) { return ''; }  
    return (<<'ENDSTDBRW');     return (<<'ENDSTDBRW');
 <script type="text/javascript" language="Javascript" >  <script type="text/javascript" language="Javascript" >
Line 360  ENDSTDBRW Line 361  ENDSTDBRW
   
 sub selectstudent_link {  sub selectstudent_link {
    my ($form,$unameele,$udomele)=@_;     my ($form,$unameele,$udomele)=@_;
    if ($ENV{'request.course.id'}) {       if ($env{'request.course.id'}) {  
        unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {         unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
    return '';     return '';
        }         }
        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.         return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'");'."'>".&mt('Select User')."</a>";          '","'.$udomele.'");'."'>".&mt('Select User')."</a>";
    }     }
    if ($ENV{'request.role'}=~/^(au|dc|su)/) {     if ($env{'request.role'}=~/^(au|dc|su)/) {
        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.         return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";          '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
    }     }
Line 418  sub selectcourse_link { Line 419  sub selectcourse_link {
         '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>";          '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>";
 }  }
   
   sub check_uncheck_jscript {
       my $jscript = <<"ENDSCRT";
   function checkAll(field) {
       if (field.length > 0) {
           for (i = 0; i < field.length; i++) {
               field[i].checked = true ;
           }
       } else {
           field.checked = true
       }
   }
    
   function uncheckAll(field) {
       if (field.length > 0) {
           for (i = 0; i < field.length; i++) {
               field[i].checked = false ;
           }     } else {
           field.checked = false ;
       }
   }
   ENDSCRT
       return $jscript;
   }
   
   
 =pod  =pod
   
 =item * linked_select_forms(...)  =item * linked_select_forms(...)
Line 547  END Line 573  END
     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";      $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
     foreach my $value (sort(keys(%$hashref))) {      foreach my $value (sort(keys(%$hashref))) {
         $result.="    <option value=\"$value\" ";          $result.="    <option value=\"$value\" ";
         $result.=" selected=\"true\" " if ($value eq $firstdefault);          $result.=" selected=\"selected\" " if ($value eq $firstdefault);
         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";          $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
     }      }
     $result .= "</select>\n";      $result .= "</select>\n";
Line 557  END Line 583  END
     my $seconddefault = $hashref->{$firstdefault}->{'default'};      my $seconddefault = $hashref->{$firstdefault}->{'default'};
     foreach my $value (sort(keys(%select2))) {      foreach my $value (sort(keys(%select2))) {
         $result.="    <option value=\"$value\" ";                  $result.="    <option value=\"$value\" ";        
         $result.=" selected=\"true\" " if ($value eq $seconddefault);          $result.=" selected=\"selected\" " if ($value eq $seconddefault);
         $result.=">".&mt($select2{$value})."</option>\n";          $result.=">".&mt($select2{$value})."</option>\n";
     }      }
     $result .= "</select>\n";      $result .= "</select>\n";
Line 593  sub help_open_topic { Line 619  sub help_open_topic {
     my ($topic, $text, $stayOnPage, $width, $height) = @_;      my ($topic, $text, $stayOnPage, $width, $height) = @_;
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     if ($ENV{'browser.interface'} eq 'textual' ||      if ($env{'browser.interface'} eq 'textual' ||
  $ENV{'environment.remote'} eq 'off' ) {   $env{'environment.remote'} eq 'off' ) {
  $stayOnPage=1;   $stayOnPage=1;
     }      }
     $width = 350 if (not defined $width);      $width = 350 if (not defined $width);
Line 659  sub help_open_menu { Line 685  sub help_open_menu {
     my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;      my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     if ($ENV{'browser.interface'} eq 'textual' ||      if ($env{'browser.interface'} eq 'textual' ||
         $ENV{'environment.remote'} eq 'off' ) {          $env{'environment.remote'} eq 'off' ) {
         $stayOnPage=1;          $stayOnPage=1;
     }      }
     $width = 620 if (not defined $width);      $width = 620 if (not defined $width);
Line 673  sub help_open_menu { Line 699  sub help_open_menu {
     foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {      foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
         $$_ = &Apache::lonnet::escape($$_);          $$_ = &Apache::lonnet::escape($$_);
     }      }
   
     if (!$stayOnPage) {      if (!$stayOnPage) {
          $link = "javascript:helpMenu('open')";           $link = "javascript:helpMenu('open')";
     } else {      } else {
Line 684  sub help_open_menu { Line 709  sub help_open_menu {
     my $template;      my $template;
     if ($text ne "") {      if ($text ne "") {
  $template .=    $template .= 
   "<table bgcolor='#773311' cellspacing='1' cellpadding='1' border='0'><tr>".    "<table bgcolor='#CC3300' cellspacing='1' cellpadding='1' border='0'><tr>".
   "<td bgcolor='#886622'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";    "<td bgcolor='#CC6600'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
     }      }
       my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
       my $html=&Apache::lonxml::xmlbegin();
     my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");      my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <script type="text/javascript">   <script type="text/javascript">
 //<!-- BEGIN LON-CAPA Internal  // <!-- BEGIN LON-CAPA Internal
 function helpMenu(caller) {  // <![CDATA[
     if (caller == 'open') {  function helpMenu(target) {
         newWindow =  window.open("","helpmenu","HEIGHT=$height,WIDTH=$width,resize=yes,scrollbars=yes" )      var caller = this;
         caller = newWindow.document      if (target == 'open') {
     } else {          var newWindow = null;
         caller = this.document          try {
     }              newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
     caller.write("<html><head><title>LON-CAPA Help Menu</title><meta http-equiv='pragma' content='no-cache'></head>")          }
     caller.write("<frameset rows='105,*' border='0'><frame name='bannerframe'  src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")          catch(error) {
     caller.write("</html>")              writeHelp(caller);
     caller.close()              return;
     if (caller == newWindow.document) {          }
         caller.focus()          if (newWindow) {
               caller = newWindow;
           }
     }      }
       writeHelp(caller);
       return;
   }
   function writeHelp(caller) {
       caller.document.writeln('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>')
       caller.document.writeln("<frameset rows='105,*' border='0'><frame name='bannerframe'  src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
       caller.document.writeln("</html>")
       caller.document.close()
       caller.focus()
 }  }
   // ]]>
 // END LON-CAPA Internal -->  // END LON-CAPA Internal -->
  </script>   </script>
  <a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>   <a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>
Line 729  ENDTEMPLATE Line 768  ENDTEMPLATE
   
 sub help_open_bug {  sub help_open_bug {
     my ($topic, $text, $stayOnPage, $width, $height) = @_;      my ($topic, $text, $stayOnPage, $width, $height) = @_;
     unless ($ENV{'user.adv'}) { return ''; }      unless ($env{'user.adv'}) { return ''; }
     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }      unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     if ($ENV{'browser.interface'} eq 'textual' ||      if ($env{'browser.interface'} eq 'textual' ||
  $ENV{'environment.remote'} eq 'off' ) {   $env{'environment.remote'} eq 'off' ) {
  $stayOnPage=1;   $stayOnPage=1;
     }      }
     $width = 600 if (not defined $width);      $width = 600 if (not defined $width);
Line 774  ENDTEMPLATE Line 813  ENDTEMPLATE
   
 sub help_open_faq {  sub help_open_faq {
     my ($topic, $text, $stayOnPage, $width, $height) = @_;      my ($topic, $text, $stayOnPage, $width, $height) = @_;
     unless ($ENV{'user.adv'}) { return ''; }      unless ($env{'user.adv'}) { return ''; }
     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }      unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     if ($ENV{'browser.interface'} eq 'textual' ||      if ($env{'browser.interface'} eq 'textual' ||
  $ENV{'environment.remote'} eq 'off' ) {   $env{'environment.remote'} eq 'off' ) {
  $stayOnPage=1;   $stayOnPage=1;
     }      }
     $width = 350 if (not defined $width);      $width = 350 if (not defined $width);
Line 822  ENDTEMPLATE Line 861  ENDTEMPLATE
   
 =pod  =pod
   
   =item * change_content_javascript():
   
   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
   Javascript, even in Netscape 4.
   
   The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
   must be written to the HTML page once. It will prove the Javascript
   function "change(name, content)". Calling the change function with the
   name of the section 
   you want to update, matching the name passed to C<changable_area>, and
   the new content you want to put in there, will put the content into
   that area.
   
   B<Note>: Netscape 4 only reserves enough space for the changable area
   to contain room for the original contents. You need to "make space"
   for whatever changes you wish to make, and be B<sure> to check your
   code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
   it's adequate for updating a one-line status display, but little more.
   This script will set the space to 100% width, so you only need to
   worry about height in Netscape 4.
   
   Modern browsers are much less limiting, and if you can commit to the
   user not using Netscape 4, this feature may be used freely with
   pretty much any HTML.
   
   =cut
   
   sub change_content_javascript {
       # If we're on Netscape 4, we need to use Layer-based code
       if ($env{'browser.type'} eq 'netscape' &&
    $env{'browser.version'} =~ /^4\./) {
    return (<<NETSCAPE4);
    function change(name, content) {
       doc = document.layers[name+"___escape"].layers[0].document;
       doc.open();
       doc.write(content);
       doc.close();
    }
   NETSCAPE4
       } else {
    # Otherwise, we need to use semi-standards-compliant code
    # (technically, "innerHTML" isn't standard but the equivalent
    # is really scary, and every useful browser supports it
    return (<<DOMBASED);
    function change(name, content) {
       element = document.getElementById(name);
       element.innerHTML = content;
    }
   DOMBASED
       }
   }
   
   =pod
   
   =item * changable_area($name, $origContent):
   
   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 name you will use to reference the area later; do not repeat the
   same name on a given HTML page more then once. $origContent is what
   the area will originally contain, which can be left blank.
   
   =cut
   
   sub changable_area {
       my ($name, $origContent) = @_;
   
       if ($env{'browser.type'} eq 'netscape' &&
    $env{'browser.version'} =~ /^4\./) {
    # If this is netscape 4, we need to use the Layer tag
    return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
       } else {
    return "<span id='$name'>$origContent</span>";
       }
   }
   
   =pod
   
   =back
   
   =head1 Excel and CSV file utility routines
   
   =over 4
   
   =cut
   
   ###############################################################
   ###############################################################
   
   =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' 
Line 838  sub csv_translate { Line 969  sub csv_translate {
     return $text;      return $text;
 }  }
   
   
 ###############################################################  ###############################################################
 ###############################################################  ###############################################################
   
Line 862  Currently supported formats: Line 992  Currently supported formats:
   
 =item h3  =item h3
   
   =item h4
   
   =item i
   
 =item date  =item date
   
 =back  =back
Line 884  sub define_excel_formats { Line 1018  sub define_excel_formats {
     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);      $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);      $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);      $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
       $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
       $format->{'i'}    = $workbook->add_format(italic=>1);
     $format->{'date'} = $workbook->add_format(num_format=>      $format->{'date'} = $workbook->add_format(num_format=>
                                             'mm/dd/yyyy hh:mm:ss');                                              'mm/dd/yyyy hh:mm:ss');
     return $format;      return $format;
Line 894  sub define_excel_formats { Line 1030  sub define_excel_formats {
   
 =pod  =pod
   
 =item * change_content_javascript():  =item * create_workbook
   
 This and the next function allow you to create small sections of an  Create an Excel worksheet.  If it fails, output message on the
 otherwise static HTML page that you can update on the fly with  request object and return undefs.
 Javascript, even in Netscape 4.  
   
 The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)  Inputs: Apache request object
 must be written to the HTML page once. It will prove the Javascript  
 function "change(name, content)". Calling the change function with the  
 name of the section   
 you want to update, matching the name passed to C<changable_area>, and  
 the new content you want to put in there, will put the content into  
 that area.  
   
 B<Note>: Netscape 4 only reserves enough space for the changable area  
 to contain room for the original contents. You need to "make space"  
 for whatever changes you wish to make, and be B<sure> to check your  
 code in Netscape 4. This feature in Netscape 4 is B<not> powerful;  
 it's adequate for updating a one-line status display, but little more.  
 This script will set the space to 100% width, so you only need to  
 worry about height in Netscape 4.  
   
 Modern browsers are much less limiting, and if you can commit to the  Returns (undef) on failure, 
 user not using Netscape 4, this feature may be used freely with      Excel worksheet object, scalar with filename, and formats 
 pretty much any HTML.      from &Apache::loncommon::define_excel_formats on success
   
 =cut  =cut
   
 sub change_content_javascript {  ###############################################################
     # If we're on Netscape 4, we need to use Layer-based code  ###############################################################
     if ($ENV{'browser.type'} eq 'netscape' &&  sub create_workbook {
  $ENV{'browser.version'} =~ /^4\./) {      my ($r) = @_;
  return (<<NETSCAPE4);          #
  function change(name, content) {      # Create the excel spreadsheet
     doc = document.layers[name+"___escape"].layers[0].document;      my $filename = '/prtspool/'.
     doc.open();          $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
     doc.write(content);          time.'_'.rand(1000000000).'.xls';
     doc.close();      my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
  }      if (! defined($workbook)) {
 NETSCAPE4          $r->log_error("Error creating excel spreadsheet $filename: $!");
     } else {          $r->print('<p>'.&mt("Unable to create new Excel file.  ".
  # Otherwise, we need to use semi-standards-compliant code                              "This error has been logged.  ".
  # (technically, "innerHTML" isn't standard but the equivalent                              "Please alert your LON-CAPA administrator").
  # is really scary, and every useful browser supports it                    '</p>');
  return (<<DOMBASED);          return (undef);
  function change(name, content) {  
     element = document.getElementById(name);  
     element.innerHTML = content;  
  }  
 DOMBASED  
     }      }
       #
       $workbook->set_tempdir('/home/httpd/perl/tmp');
       #
       my $format = &Apache::loncommon::define_excel_formats($workbook);
       return ($workbook,$filename,$format);
 }  }
   
   ###############################################################
   ###############################################################
   
 =pod  =pod
   
 =item * changable_area($name, $origContent):  =item * create_text_file
   
 This provides a "changable area" that can be modified on the fly via  Create a file to write to and eventually make available to the usre.
 the Javascript code provided in C<change_content_javascript>. $name is  If file creation fails, outputs an error message on the request object and 
 the name you will use to reference the area later; do not repeat the  return undefs.
 same name on a given HTML page more then once. $origContent is what  
 the area will originally contain, which can be left blank.  
   
 =cut  Inputs: Apache request object, and file suffix
   
 sub changable_area {  Returns (undef) on failure, 
     my ($name, $origContent) = @_;      Filehandle and filename on success.
   
     if ($ENV{'browser.type'} eq 'netscape' &&  =cut
  $ENV{'browser.version'} =~ /^4\./) {  
  # If this is netscape 4, we need to use the Layer tag  ###############################################################
  return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";  ###############################################################
     } else {  sub create_text_file {
  return "<span id='$name'>$origContent</span>";      my ($r,$suffix) = @_;
       if (! defined($suffix)) { $suffix = 'txt'; };
       my $fh;
       my $filename = '/prtspool/'.
           $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
           time.'_'.rand(1000000000).'.'.$suffix;
       $fh = Apache::File->new('>/home/httpd'.$filename);
       if (! defined($fh)) {
           $r->log_error("Couldn't open $filename for output $!");
           $r->print("Problems occured in creating the output file.  ".
                     "This error has been logged.  ".
                     "Please alert your LON-CAPA administrator.");
     }      }
       return ($fh,$filename)
 }  }
   
 =pod  
   =pod 
   
 =back  =back
   
Line 1033  sub multiple_select_form { Line 1168  sub multiple_select_form {
     $output.="\n<select name='$name' size='$size' multiple='1'>";      $output.="\n<select name='$name' size='$size' multiple='1'>";
     foreach (sort(keys(%hash))) {      foreach (sort(keys(%hash))) {
         $output.='<option value="'.$_.'" ';          $output.='<option value="'.$_.'" ';
         $output.='selected ' if ($selected{$_});          $output.='selected="selected" ' if ($selected{$_});
         $output.='>'.$hash{$_}."</option>\n";          $output.='>'.$hash{$_}."</option>\n";
     }      }
     $output.="</select>\n";      $output.="</select>\n";
Line 1064  sub select_form { Line 1199  sub select_form {
     }      }
     foreach (@keys) {      foreach (@keys) {
         $selectform.="<option value=\"$_\" ".          $selectform.="<option value=\"$_\" ".
             ($_ eq $def ? 'selected' : '').              ($_ eq $def ? 'selected="selected" ' : '').
                 ">".&mt($hash{$_})."</option>\n";                  ">".&mt($hash{$_})."</option>\n";
     }      }
     $selectform.="</select>";      $selectform.="</select>";
Line 1101  sub select_level_form { Line 1236  sub select_level_form {
     my $selectform = "<select name=\"$name\" size=\"1\">\n";      my $selectform = "<select name=\"$name\" size=\"1\">\n";
     for (my $i=0; $i<=18; $i++) {      for (my $i=0; $i<=18; $i++) {
         $selectform.="<option value=\"$i\" ".          $selectform.="<option value=\"$i\" ".
             ($i==$deflevel ? 'selected' : '').              ($i==$deflevel ? 'selected="selected" ' : '').
                 ">".&gradeleveldescription($i)."</option>\n";                  ">".&gradeleveldescription($i)."</option>\n";
     }      }
     $selectform.="</select>";      $selectform.="</select>";
Line 1131  sub select_dom_form { Line 1266  sub select_dom_form {
     my $selectdomain = "<select name=\"$name\" size=\"1\">\n";      my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
     foreach (@domains) {      foreach (@domains) {
         $selectdomain.="<option value=\"$_\" ".          $selectdomain.="<option value=\"$_\" ".
             ($_ eq $defdom ? 'selected' : '').              ($_ eq $defdom ? 'selected="selected" ' : '').
                 ">$_</option>\n";                  ">$_</option>\n";
     }      }
     $selectdomain.="</select>";      $selectdomain.="</select>";
Line 1230  Outputs: Line 1365  Outputs:
 ###############################################################  ###############################################################
 ###############################################################  ###############################################################
 sub decode_user_agent {  sub decode_user_agent {
       my ($r)=@_;
     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});      my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});      my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};      my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
       if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
     my $clientbrowser='unknown';      my $clientbrowser='unknown';
     my $clientversion='0';      my $clientversion='0';
     my $clientmathml='';      my $clientmathml='';
Line 1793  if the user does not Line 1930  if the user does not
 sub nickname {  sub nickname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     my %names;      my %names;
     if ($uname eq $ENV{'user.name'} &&      if ($uname eq $env{'user.name'} &&
  $udom eq $ENV{'user.domain'}) {   $udom eq $env{'user.domain'}) {
  %names=('nickname'   => $ENV{'environment.nickname'}  ,   %names=('nickname'   => $env{'environment.nickname'}  ,
  'firstname'  => $ENV{'environment.firstname'} ,   'firstname'  => $env{'environment.firstname'} ,
  'middlename' => $ENV{'environment.middlename'},   'middlename' => $env{'environment.middlename'},
  'lastname'   => $ENV{'environment.lastname'}  ,   'lastname'   => $env{'environment.lastname'}  ,
  'generation' => $ENV{'environment.generation'});   'generation' => $env{'environment.generation'});
     } else {      } else {
  %names=&Apache::lonnet::get('environment',   %names=&Apache::lonnet::get('environment',
     ['nickname','firstname','middlename',      ['nickname','firstname','middlename',
Line 1830  Gets a users screenname and returns it a Line 1967  Gets a users screenname and returns it a
   
 sub screenname {  sub screenname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     if ($uname eq $ENV{'user.name'} &&      if ($uname eq $env{'user.name'} &&
  $udom eq $ENV{'user.domain'}) {return $ENV{'environment.screenname'};}   $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);      my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
     return $names{'screenname'};      return $names{'screenname'};
 }  }
Line 1873  sub syllabuswrapper { Line 2010  sub syllabuswrapper {
 }  }
   
 sub track_student_link {  sub track_student_link {
     my ($linktext,$sname,$sdom,$target) = @_;      my ($linktext,$sname,$sdom,$target,$start) = @_;
     my $link ="/adm/trackstudent";      my $link ="/adm/trackstudent?";
     my $title = 'View recent activity';      my $title = 'View recent activity';
     if (defined($sname) && $sname !~ /^\s*$/ &&      if (defined($sname) && $sname !~ /^\s*$/ &&
         defined($sdom)  && $sdom  !~ /^\s*$/) {          defined($sdom)  && $sdom  !~ /^\s*$/) {
         $link .= "?selected_student=$sname:$sdom";          $link .= "selected_student=$sname:$sdom";
         $title .= ' of this student';          $title .= ' of this student';
     }      } 
     if (defined($target) && $target !~ /^\s*$/) {      if (defined($target) && $target !~ /^\s*$/) {
         $target = qq{target="$target"};          $target = qq{target="$target"};
     } else {      } else {
         $target = '';          $target = '';
     }      }
       if ($start) { $link.='&amp;start='.$start; }
     return qq{<a href="$link" title="$title" $target>$linktext</a>};      return qq{<a href="$link" title="$title" $target>$linktext</a>};
 }  }
   
   
   
 =pod  =pod
   
 =back  =back
Line 2079  sub display_languages { Line 2215  sub display_languages {
  $languages{$_}=1;   $languages{$_}=1;
     }      }
     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);      &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
     if ($ENV{'form.displaylanguage'}) {      if ($env{'form.displaylanguage'}) {
  foreach (split(/\s*(\,|\;|\:)\s*/,$ENV{'form.displaylanguage'})) {   foreach (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
     $languages{$_}=1;      $languages{$_}=1;
         }          }
     }      }
Line 2089  sub display_languages { Line 2225  sub display_languages {
   
 sub preferred_languages {  sub preferred_languages {
     my @languages=();      my @languages=();
     if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {      if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
  @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,   @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
          $ENV{'course.'.$ENV{'request.course.id'}.'.languages'}));           $env{'course.'.$env{'request.course.id'}.'.languages'}));
     }      }
     if ($ENV{'environment.languages'}) {      if ($env{'environment.languages'}) {
  @languages=split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'});   @languages=split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'});
     }      }
     my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];      my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];
     if ($browser) {      if ($browser) {
  @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));   @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));
     }      }
     if ($Apache::lonnet::domain_lang_def{$ENV{'user.domain'}}) {      if ($Apache::lonnet::domain_lang_def{$env{'user.domain'}}) {
  @languages=(@languages,   @languages=(@languages,
  $Apache::lonnet::domain_lang_def{$ENV{'user.domain'}});   $Apache::lonnet::domain_lang_def{$env{'user.domain'}});
     }      }
     if ($Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}}) {      if ($Apache::lonnet::domain_lang_def{$env{'request.role.domain'}}) {
  @languages=(@languages,   @languages=(@languages,
  $Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}});   $Apache::lonnet::domain_lang_def{$env{'request.role.domain'}});
     }      }
     if ($Apache::lonnet::domain_lang_def{      if ($Apache::lonnet::domain_lang_def{
                           $Apache::lonnet::perlvar{'lonDefDomain'}}) {                            $Apache::lonnet::perlvar{'lonDefDomain'}}) {
Line 2325  sub get_student_answers { Line 2461  sub get_student_answers {
   
 =item * &submlink()  =item * &submlink()
   
 Inputs: $text $uname $udom $symb  Inputs: $text $uname $udom $symb $target
   
 Returns: A link to grades.pm such as to see the SUBM view of a student  Returns: A link to grades.pm such as to see the SUBM view of a student
   
Line 2333  Returns: A link to grades.pm such as to Line 2469  Returns: A link to grades.pm such as to
   
 ###############################################  ###############################################
 sub submlink {  sub submlink {
     my ($text,$uname,$udom,$symb)=@_;      my ($text,$uname,$udom,$symb,$target)=@_;
     if (!($uname && $udom)) {      if (!($uname && $udom)) {
  (my $cursymb, my $courseid,$udom,$uname)=   (my $cursymb, my $courseid,$udom,$uname)=
     &Apache::lonxml::whichuser($symb);      &Apache::lonxml::whichuser($symb);
  if (!$symb) { $symb=$cursymb; }   if (!$symb) { $symb=$cursymb; }
     }      }
     if (!$symb) { $symb=&symbread(); }      if (!$symb) { $symb=&Apache::lonnet::symbread(); }
     return '<a href="/adm/grades?symb='.$symb.'&student='.$uname.      $symb=&Apache::lonnet::escape($symb);
  '&userdom='.$udom.'&command=submission">'.$text.'</a>';      if ($target) { $target="target=\"$target\""; }
       return '<a href="/adm/grades?&command=submission&'.
    'symb='.$symb.'&student='.$uname.
    '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
   }
   ##############################################
   
   =pod
   
   =item * &pgrdlink()
   
   Inputs: $text $uname $udom $symb $target
   
   Returns: A link to grades.pm such as to see the PGRD view of a student
   
   =cut
   
   ###############################################
   sub pgrdlink {
       my $link=&submlink(@_);
       $link=~s/(&command=submission)/$1&showgrading=yes/;
       return $link;
   }
   ##############################################
   
   =pod
   
   =item * &pprmlink()
   
   Inputs: $text $uname $udom $symb $target
   
   Returns: A link to parmset.pm such as to see the PPRM view of a
   student andn resource
   
   =cut
   
   ###############################################
   sub pprmlink {
       my ($text,$uname,$udom,$symb,$target)=@_;
       if (!($uname && $udom)) {
    (my $cursymb, my $courseid,$udom,$uname)=
       &Apache::lonxml::whichuser($symb);
    if (!$symb) { $symb=$cursymb; }
       }
       if (!$symb) { $symb=&Apache::lonnet::symbread(); }
       $symb=&Apache::lonnet::escape($symb);
       if ($target) { $target="target=\"$target\""; }
       return '<a href="/adm/parmset?&command=set&'.
    'symb='.$symb.'&uname='.$uname.
    '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
 }  }
 ##############################################  ##############################################
   
Line 2379  sub maketime { Line 2564  sub maketime {
 sub findallcourses {  sub findallcourses {
     my %courses=();      my %courses=();
     my $now=time;      my $now=time;
     foreach (keys %ENV) {      foreach (keys %env) {
  if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {   if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {
     my ($starttime,$endtime)=$ENV{$_};      my ($starttime,$endtime)=$env{$_};
             my $active=1;              my $active=1;
             if ($starttime) {              if ($starttime) {
  if ($now<$starttime) { $active=0; }   if ($now<$starttime) { $active=0; }
Line 2418  sub determinedomain { Line 2603  sub determinedomain {
    if (! $domain) {     if (! $domain) {
         # Determine domain if we have not been given one          # Determine domain if we have not been given one
         $domain = $Apache::lonnet::perlvar{'lonDefDomain'};          $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
         if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; }          if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
         if ($ENV{'request.role.domain'}) {           if ($env{'request.role.domain'}) { 
             $domain=$ENV{'request.role.domain'};               $domain=$env{'request.role.domain'}; 
         }          }
     }      }
     return $domain;      return $domain;
Line 2465  Returns: value of designparamter $which Line 2650  Returns: value of designparamter $which
 ##############################################  ##############################################
 sub designparm {  sub designparm {
     my ($which,$domain)=@_;      my ($which,$domain)=@_;
     if ($ENV{'browser.blackwhite'} eq 'on') {      if ($env{'browser.blackwhite'} eq 'on') {
  if ($which=~/\.(font|alink|vlink|link)$/) {   if ($which=~/\.(font|alink|vlink|link)$/) {
     return '#000000';      return '#000000';
  }   }
Line 2476  sub designparm { Line 2661  sub designparm {
     return '#CCCCCC';      return '#CCCCCC';
  }   }
     }      }
     if ($ENV{'environment.color.'.$which}) {      if ($env{'environment.color.'.$which}) {
  return $ENV{'environment.color.'.$which};   return $env{'environment.color.'.$which};
     }      }
     $domain=&determinedomain($domain);      $domain=&determinedomain($domain);
     if ($designhash{$domain.'.'.$which}) {      if ($designhash{$domain.'.'.$which}) {
Line 2529  other decorations will be returned. Line 2714  other decorations will be returned.
 =cut  =cut
   
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle)=@_;      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,$notopbar)=@_;
     $title=&mt($title);      $title=&mt($title);
     $function = &get_users_function() if (!$function);      $function = &get_users_function() if (!$function);
     my $img=&designparm($function.'.img',$domain);      my $img=&designparm($function.'.img',$domain);
Line 2543  sub bodytag { Line 2728  sub bodytag {
 # Accessibility font enhance  # Accessibility font enhance
     unless ($addentries) { $addentries=''; }      unless ($addentries) { $addentries=''; }
     my $addstyle='';      my $addstyle='';
     if ($ENV{'browser.fontenhance'} eq 'on') {      if ($env{'browser.fontenhance'} eq 'on') {
  $addstyle=' font-size: x-large;';   $addstyle=' font-size: x-large;';
     }      }
  # role and realm   # role and realm
     my ($role,$realm)      my ($role,$realm)
        =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);         =&Apache::lonnet::plaintext((split(/\./,$env{'request.role'}))[0]);
 # realm  # realm
     if ($ENV{'request.course.id'}) {      if ($env{'request.course.id'}) {
  $realm=   $realm=
          $ENV{'course.'.$ENV{'request.course.id'}.'.description'};           $env{'course.'.$env{'request.course.id'}.'.description'};
     }      }
     unless ($realm) { $realm='&nbsp;'; }      unless ($realm) { $realm='&nbsp;'; }
 # Set messages  # Set messages
Line 2569  a:focus { color: red; background: yellow Line 2754  a:focus { color: red; background: yellow
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"  <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
 style="margin-top: 0px;$addstyle" $addentries>  style="margin-top: 0px;$addstyle" $addentries>
 END  END
       &Apache::lontexconvert::jsMath_reset();
       if ($env{'environment.texengine'} eq 'jsMath') {
    $bodytag.=&Apache::lontexconvert::jsMath_header();
       }
   
     my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.      my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
                    $lonhttpdPort.$img.'" alt="'.$function.'" />';                     $lonhttpdPort.$img.'" alt="'.$function.'" />';
     if ($bodyonly) {      if ($bodyonly) {
         return $bodytag;          return $bodytag;
     } elsif ($ENV{'browser.interface'} eq 'textual') {      } elsif ($env{'browser.interface'} eq 'textual') {
 # Accessibility  # Accessibility
                       
         return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',          return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
                                                       $forcereg).                                                        $forcereg).
                '<h1>LON-CAPA: '.$title.'</h1>';                 '<h1>LON-CAPA: '.$title.'</h1>';
     } elsif ($ENV{'environment.remote'} eq 'off') {      } elsif ($env{'environment.remote'} eq 'off') {
 # No Remote  # No Remote
  my $roleinfo=(<<ENDROLE);   my $roleinfo=(<<ENDROLE);
 <td bgcolor="$tabbg" align="right">  <td bgcolor="$tabbg" align="right">
 <font size="2" face="Arial, Helvetica, sans-serif">  <font size="2" face="Arial, Helvetica, sans-serif">
     $ENV{'environment.firstname'}      $env{'environment.firstname'}
     $ENV{'environment.middlename'}      $env{'environment.middlename'}
     $ENV{'environment.lastname'}      $env{'environment.lastname'}
     $ENV{'environment.generation'}      $env{'environment.generation'}
     </font>&nbsp;      </font>&nbsp;
 <br />  <br />
 <font size="2" face="Arial, Helvetica, sans-serif">$role</font>&nbsp;  <font size="2" face="Arial, Helvetica, sans-serif">$role</font>&nbsp;
Line 2601  ENDROLE Line 2791  ENDROLE
             $titleinfo = $customtitle;              $titleinfo = $customtitle;
         }          }
   
  if ($ENV{'request.state'} eq 'construct') {   if ($env{'request.state'} eq 'construct') {
     my ($uname,$thisdisfn)=      my ($uname,$thisdisfn)=
  ($ENV{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);   ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
     my $formaction='/priv/'.$uname.'/'.$thisdisfn;      my $formaction='/priv/'.$uname.'/'.$thisdisfn;
     $formaction=~s/\/+/\//g;      $formaction=~s/\/+/\//g;
             unless ($customtitle) {  #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm                unless ($customtitle) {  #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm  
                 my $parentpath = '';                  my $parentpath = '';
                 if ($thisdisfn =~ m-(.+/)[^/]*$-) {                  my $lastitem = '';
                   if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                     $parentpath = $1;                      $parentpath = $1;
                       $lastitem = $2;
                   } else {
                       $lastitem = $thisdisfn;
                 }                  }
         $titleinfo = &Apache::loncommon::help_open_menu('','','','',3,'Authoring').          $titleinfo = &Apache::loncommon::help_open_menu('','','','',3,'Authoring').
                       '<font face="Arial, Helvetica, sans-serif"><b>Construction Space</b>:</font>&nbsp;'.                         '<font face="Arial, Helvetica, sans-serif"><b>Construction Space</b>:</font>&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)."</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>'
     .&Apache::lonmenu::constspaceform();      .&Apache::lonmenu::constspaceform();
Line 2625  ENDROLE Line 2819  ENDROLE
         }          }
         my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.          my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.
                          'cellspacing="3" cellpadding="3">'.                           'cellspacing="3" cellpadding="3">'.
                          '<tr><td rowspan="3" bgcolor="'.$tabbg.'">'.                           '<tr><td bgcolor="'.$tabbg.'">'.
                          $titleinfo.'</td>'.$roleinfo.'</tr></table>';                           $titleinfo.'</td>'.$roleinfo.'</tr></table>';
         if ($ENV{'request.state'} eq 'construct') {          if ($env{'request.state'} eq 'construct') {
             $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);              if ($notopbar) {
                   $bodytag .= $titletable;
               } else {
                   $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);
               }
  } else {   } else {
             $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).              if ($notopbar) {
                   $bodytag .= $titletable;
               } else {
                   $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).
                         $titletable;                          $titletable;
               }
         }          }
         return $bodytag;          return $bodytag;
     }      }
Line 2643  ENDROLE Line 2845  ENDROLE
     if ($customtitle) {      if ($customtitle) {
         $titleinfo = $customtitle;          $titleinfo = $customtitle;
     }      }
       #
       # Extra info if you are the DC
       my $dc_info = '';
       if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                           $env{'course.'.$env{'request.course.id'}.
                                    '.domain'}.'/'})) {
           my $cid = $env{'request.course.id'};
           $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
           $dc_info = '('.$dc_info.')';
       }
       #
     return(<<ENDBODY);      return(<<ENDBODY);
 $bodytag  $bodytag
 <table width="100%" cellspacing="0" border="0" cellpadding="0">  <table width="100%" cellspacing="0" border="0" cellpadding="0">
Line 2652  $upperleft</td> Line 2865  $upperleft</td>
 </tr>  </tr>
 <tr>  <tr>
 <td rowspan="3" bgcolor="$tabbg">  <td rowspan="3" bgcolor="$tabbg">
 $titleinfo  $titleinfo $dc_info
 <td bgcolor="$tabbg" align="right">  </td><td bgcolor="$tabbg" align="right">
 <font size="2" face="Arial, Helvetica, sans-serif">  <font size="2" face="Arial, Helvetica, sans-serif">
     $ENV{'environment.firstname'}      $env{'environment.firstname'}
     $ENV{'environment.middlename'}      $env{'environment.middlename'}
     $ENV{'environment.lastname'}      $env{'environment.lastname'}
     $ENV{'environment.generation'}      $env{'environment.generation'}
     </font>&nbsp;      </font>&nbsp;
 </td>  </td>
 </tr>  </tr>
Line 2672  ENDBODY Line 2885  ENDBODY
 }  }
   
 ###############################################  ###############################################
   ###############################################
   
   =pod
   
   =back
   
   =head1 HTTP Helpers
   
   =over 4
   
   =item * &endbodytag()
   
   Returns a uniform footer for LON-CAPA web pages.
   
   Inputs: 
   
   =over 4
   
   =back
   
   Returns: A uniform footer for LON-CAPA web pages.  
   
   =cut
   
   sub endbodytag {
       my $endbodytag='</body>';
       $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
       return $endbodytag;
   }
   
   ###############################################
   
 =pod  =pod
   
Line 2685  Returns either 'student','coordinator',' Line 2929  Returns either 'student','coordinator','
 ###############################################  ###############################################
 sub get_users_function {  sub get_users_function {
     my $function = 'student';      my $function = 'student';
     if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {      if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
         $function='coordinator';          $function='coordinator';
     }      }
     if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {      if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
         $function='admin';          $function='admin';
     }      }
     if (($ENV{'request.role'}=~/^(au|ca)/) ||      if (($env{'request.role'}=~/^(au|ca)/) ||
         ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {          ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
         $function='author';          $function='author';
     }      }
Line 2702  sub get_users_function { Line 2946  sub get_users_function {
   
 =pod  =pod
   
   =item check_user_status
   
   Determines current status of supplied role for a
   specific user. Roles can be active, previous or future.
   
   Inputs: 
   user's domain, user's username, course's domain,
   course's number, optional section/group.
   
   Outputs:
   role status: active, previous or future. 
   
   =cut
   
   sub check_user_status {
       my ($udom,$uname,$cdom,$crs,$role,$secgrp) = @_;
       my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
       my @uroles = keys %userinfo;
       my $srchstr;
       my $active_chk = 'none';
       if (@uroles > 0) {
           if (($role eq 'cc') || ($secgrp eq '') || (!defined($secgrp))) {
               $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
           } else {
               $srchstr = '/'.$cdom.'/'.$crs.'/'.$secgrp.'_'.$role;         }
           if (grep/^$srchstr$/,@uroles) {
               my $role_end = 0;
               my $role_start = 0;
               $active_chk = 'active';
               if ($userinfo{$srchstr} =~ m/^($role)_(\d+)/) {
                   $role_end = $2;
                   if ($userinfo{$srchstr} =~ m/^($role)_($role_end)_(\d+)$/) {
                       $role_start = $3;
                   }
               }
               if ($role_start > 0) {
                   if (time < $role_start) {
                       $active_chk = 'future';
                   }
               }
               if ($role_end > 0) {
                   if (time > $role_end) {
                       $active_chk = 'previous';
                   }
               }
           }
       }
       return $active_chk;
   }
   
   ###############################################
   
   =pod
   
 =item get_sections  =item get_sections
   
 Determines all the sections for a course including  Determines all the sections for a course including
Line 2720  Returns number of sections. Line 3018  Returns number of sections.
 sub get_sections {  sub get_sections {
     my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;      my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;
     if (!($cdom && $cnum)) { return 0; }      if (!($cdom && $cnum)) { return 0; }
     my $cid = $cdom.'_'.$cnum;  
     my $numsections = 0;      my $numsections = 0;
   
     if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) {      if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) {
  my ($classlist) = &Apache::loncoursedata::get_classlist($cid,$cdom,$cnum);   my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
  my $sec_index = &Apache::loncoursedata::CL_SECTION();   my $sec_index = &Apache::loncoursedata::CL_SECTION();
  my $status_index = &Apache::loncoursedata::CL_STATUS();   my $status_index = &Apache::loncoursedata::CL_STATUS();
  while (my ($student,$data) = each %$classlist) {   while (my ($student,$data) = each %$classlist) {
Line 2754  sub get_sections { Line 3051  sub get_sections {
     return $numsections;      return $numsections;
 }  }
   
   ###############################################
   
   =pod
                                                                                   
   =item get_course_users
                                                                                   
   Retrieves usernames:domains for users in the specified course
   with specific role(s), and access status. 
   
   Incoming parameters:
   1. course domain
   2. course number
   3. access status: users must have - either active, 
   previous, future, or all.
   4. reference to array of permissible roles
   5. reference to results object (hash of hashes).
   Keys of top level hash are roles.
   Keys of inner hashes are username:domain, with 
   values set to access type.
                                                                                   
   =cut
                                                                                   
   ###############################################
                                                                                   
   sub get_course_users {
       my ($cdom,$cnum,$types,$roles,$users) = @_;
       if (grep/^st$/,@{$roles}) {
           my $statusidx = &Apache::loncoursedata::CL_STATUS();
           my $startidx = &Apache::loncoursedata::CL_START();
           my $endidx = &Apache::loncoursedata::CL_END();
           my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
           my $now = time;
           foreach my $student (keys(%{$classlist})) {
               if (defined($$types{'active'})) {
                   if ($$classlist{$student}[$statusidx] eq 'Active') {
                       push(@{$$users{st}{$student}},'active');
                   }
               }
               if (defined($$types{'previous'})) {
                   if ($$classlist{$student}[$endidx] <= $now) {
                       push(@{$$users{st}{$student}},'previous');
                   }
               }
               if (defined($$types{'future'})) {
                   if (($$classlist{$student}[$startidx] > $now) && ($$classlist{$student}[$endidx] > $now) || ($$classlist{$student}[$endidx] == 0) || ($$classlist{$student}[$endidx] eq '')) {
                       push(@{$$users{st}{$student}},'future');
                   }
               }
           }
       }
       if ((@{$roles} > 0) && (@{$roles} ne "st")) {
           my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);
           foreach my $person (@coursepersonnel) {
               my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);
               $user =~ s/:$//;
               if (($role) && (grep(/^$role$/,@{$roles}))) {
                   my ($uname,$udom) = split(/:/,$user);
                   if ($uname ne '' && $udom ne '') {
                       my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);
                       foreach my $type (keys(%{$types})) { 
                           if ($status eq $type) {
                               $$users{$role}{$user} = $type;
                           }
                       }
                   }
               }
           }
           if (grep/^ow$/,@{$roles}) {
               if ((defined($cdom)) && (defined($cnum))) {
                   my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   if ( defined($csettings{'internal.courseowner'}) ) {
                       my $owner = $csettings{'internal.courseowner'};
                       $$users{'ow'}{$owner.':'.$cdom} = 'any';
                   }
               }
           }
       }
       return;
   }
   
   
   
   ###############################################
   
 sub get_posted_cgi {  sub get_posted_cgi {
     my $r=shift;      my $r=shift;
   
     my $buffer;      my $buffer;
           if ($r->header_in('Content-length')) {
     $r->read($buffer,$r->header_in('Content-length'),0);   $r->read($buffer,$r->header_in('Content-length'),0);
       }
     unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {      unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
  my @pairs=split(/&/,$buffer);   my @pairs=split(/&/,$buffer);
  my $pair;   my $pair;
Line 2785  sub get_posted_cgi { Line 3166  sub get_posted_cgi {
  if ($name) {   if ($name) {
     chomp($value);      chomp($value);
     if ($fname) {      if ($fname) {
  $ENV{"form.$name.filename"}=$fname;   $env{"form.$name.filename"}=$fname;
  $ENV{"form.$name.mimetype"}=$fmime;   $env{"form.$name.mimetype"}=$fmime;
     } else {      } else {
  $value=~s/\s+$//s;   $value=~s/\s+$//s;
     }      }
Line 2818  sub get_posted_cgi { Line 3199  sub get_posted_cgi {
     }      }
  }   }
     }      }
     $ENV{'request.method'}=$ENV{'REQUEST_METHOD'};      $env{'request.method'}=$ENV{'REQUEST_METHOD'};
     $r->method_number(M_GET);      $r->method_number(M_GET);
     $r->method('GET');      $r->method('GET');
     $r->headers_in->unset('Content-length');      $r->headers_in->unset('Content-length');
Line 2828  sub get_posted_cgi { Line 3209  sub get_posted_cgi {
   
 =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),
 will be set in $ENV{'form.name'} if they do not already exist.  will be set in $env{'form.name'} if they do not already exist.
   
 Typically called with $ENV{'QUERY_STRING'} as the first parameter.    Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
 $possible_names is an ref to an array of form element names.  As an example:  $possible_names is an ref to an array of form element names.  As an example:
 get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);  get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
 will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.  will result in $env{'form.uname'} and $env{'form.udom'} being set.
   
 =cut  =cut
   
Line 2848  sub get_unprocessed_cgi { Line 3229  sub get_unprocessed_cgi {
     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {      if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
       $value =~ tr/+/ /;        $value =~ tr/+/ /;
       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
       &Apache::lonxml::debug("Seting :$name: to :$value:");        unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
       unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };  
     }      }
   }    }
 }  }
Line 2863  returns cache-controlling header code Line 3243  returns cache-controlling header code
 =cut  =cut
   
 sub cacheheader {  sub cacheheader {
     unless ($ENV{'request.method'} eq 'GET') { return ''; }      unless ($env{'request.method'} eq 'GET') { return ''; }
     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);      my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />      my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />                  <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
Line 2882  specifies header code to not have cache Line 3262  specifies header code to not have cache
 sub no_cache {  sub no_cache {
     my ($r) = @_;      my ($r) = @_;
     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&      if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
  $ENV{'request.method'} ne 'GET') { return ''; }   $env{'request.method'} ne 'GET') { return ''; }
     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));      my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
     $r->no_cache(1);      $r->no_cache(1);
     $r->header_out("Expires" => $date);      $r->header_out("Expires" => $date);
Line 2891  sub no_cache { Line 3271  sub no_cache {
   
 sub content_type {  sub content_type {
     my ($r,$type,$charset) = @_;      my ($r,$type,$charset) = @_;
       if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
     unless ($charset) {      unless ($charset) {
  $charset=&Apache::lonlocal::current_encoding;   $charset=&Apache::lonlocal::current_encoding;
     }      }
Line 2906  sub content_type { Line 3287  sub content_type {
   
 =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
 reference and $value is added to the array.  reference and $value is added to the array.
   
Line 2914  reference and $value is added to the arr Line 3295  reference and $value is added to the arr
   
 sub add_to_env {  sub add_to_env {
   my ($name,$value)=@_;    my ($name,$value)=@_;
   if (defined($ENV{$name})) {    if (defined($env{$name})) {
     if (ref($ENV{$name})) {      if (ref($env{$name})) {
       #already have multiple values        #already have multiple values
       push(@{ $ENV{$name} },$value);        push(@{ $env{$name} },$value);
     } else {      } else {
       #first time seeing multiple values, convert hash entry to an arrayref        #first time seeing multiple values, convert hash entry to an arrayref
       my $first=$ENV{$name};        my $first=$env{$name};
       undef($ENV{$name});        undef($env{$name});
       push(@{ $ENV{$name} },$first,$value);        push(@{ $env{$name} },$first,$value);
     }      }
   } else {    } else {
     $ENV{$name}=$value;      $env{$name}=$value;
   }    }
 }  }
   
Line 2933  sub add_to_env { Line 3314  sub add_to_env {
   
 =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.
   
 returns an array of values  returns an array of values
Line 2943  returns an array of values Line 3324  returns an array of values
 sub get_env_multiple {  sub get_env_multiple {
     my ($name) = @_;      my ($name) = @_;
     my @values;      my @values;
     if (defined($ENV{$name})) {      if (defined($env{$name})) {
         # exists is it an array          # exists is it an array
         if (ref($ENV{$name})) {          if (ref($env{$name})) {
             @values=@{ $ENV{$name} };              @values=@{ $env{$name} };
         } else {          } else {
             $values[0]=$ENV{$name};              $values[0]=$env{$name};
         }          }
     }      }
     return(@values);      return(@values);
Line 2966  sub get_env_multiple { Line 3347  sub get_env_multiple {
 =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'}
 returns $datatoken to be put into hidden field  returns $datatoken to be put into hidden field
   
 =cut  =cut
   
 sub upfile_store {  sub upfile_store {
     my $r=shift;      my $r=shift;
     $ENV{'form.upfile'}=~s/\r/\n/gs;      $env{'form.upfile'}=~s/\r/\n/gs;
     $ENV{'form.upfile'}=~s/\f/\n/gs;      $env{'form.upfile'}=~s/\f/\n/gs;
     $ENV{'form.upfile'}=~s/\n+/\n/gs;      $env{'form.upfile'}=~s/\n+/\n/gs;
     $ENV{'form.upfile'}=~s/\n+$//gs;      $env{'form.upfile'}=~s/\n+$//gs;
   
     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.      my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
  '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;   '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
     {      {
         my $datafile = $r->dir_config('lonDaemons').          my $datafile = $r->dir_config('lonDaemons').
                            '/tmp/'.$datatoken.'.tmp';                             '/tmp/'.$datatoken.'.tmp';
         if ( open(my $fh,">$datafile") ) {          if ( open(my $fh,">$datafile") ) {
             print $fh $ENV{'form.upfile'};              print $fh $env{'form.upfile'};
             close($fh);              close($fh);
         }          }
     }      }
Line 2996  sub upfile_store { Line 3377  sub upfile_store {
 =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'},
 sets $ENV{'form.upfile'} to the contents of the file  sets $env{'form.upfile'} to the contents of the file
   
 =cut  =cut
   
Line 3006  sub load_tmp_file { Line 3387  sub load_tmp_file {
     my @studentdata=();      my @studentdata=();
     {      {
         my $studentfile = $r->dir_config('lonDaemons').          my $studentfile = $r->dir_config('lonDaemons').
                               '/tmp/'.$ENV{'form.datatoken'}.'.tmp';                                '/tmp/'.$env{'form.datatoken'}.'.tmp';
         if ( open(my $fh,"<$studentfile") ) {          if ( open(my $fh,"<$studentfile") ) {
             @studentdata=<$fh>;              @studentdata=<$fh>;
             close($fh);              close($fh);
         }          }
     }      }
     $ENV{'form.upfile'}=join('',@studentdata);      $env{'form.upfile'}=join('',@studentdata);
 }  }
   
 =pod  =pod
Line 3021  sub load_tmp_file { Line 3402  sub load_tmp_file {
   
 Separate uploaded file into records  Separate uploaded file into records
 returns array of records,  returns array of records,
 needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}  needs $env{'form.upfile'} and $env{'form.upfiletype'}
   
 =cut  =cut
   
 sub upfile_record_sep {  sub upfile_record_sep {
     if ($ENV{'form.upfiletype'} eq 'xml') {      if ($env{'form.upfiletype'} eq 'xml') {
     } else {      } else {
  return split(/\n/,$ENV{'form.upfile'});   my @records;
    foreach my $line (split(/\n/,$env{'form.upfile'})) {
       if ($line=~/^\s*$/) { next; }
       push(@records,$line);
    }
    return @records;
     }      }
 }  }
   
Line 3036  sub upfile_record_sep { Line 3422  sub upfile_record_sep {
   
 =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'}
   
 =cut  =cut
   
   sub takeleft {
       my $index=shift;
       return substr('0000'.$index,-4,4);
   }
   
 sub record_sep {  sub record_sep {
     my $record=shift;      my $record=shift;
     my %components=();      my %components=();
     if ($ENV{'form.upfiletype'} eq 'xml') {      if ($env{'form.upfiletype'} eq 'xml') {
     } elsif ($ENV{'form.upfiletype'} eq 'space') {      } elsif ($env{'form.upfiletype'} eq 'space') {
         my $i=0;          my $i=0;
         foreach (split(/\s+/,$record)) {          foreach (split(/\s+/,$record)) {
             my $field=$_;              my $field=$_;
             $field=~s/^(\"|\')//;              $field=~s/^(\"|\')//;
             $field=~s/(\"|\')$//;              $field=~s/(\"|\')$//;
             $components{$i}=$field;              $components{&takeleft($i)}=$field;
             $i++;              $i++;
         }          }
     } elsif ($ENV{'form.upfiletype'} eq 'tab') {      } elsif ($env{'form.upfiletype'} eq 'tab') {
         my $i=0;          my $i=0;
         foreach (split(/\t/,$record)) {          foreach (split(/\t/,$record)) {
             my $field=$_;              my $field=$_;
             $field=~s/^(\"|\')//;              $field=~s/^(\"|\')//;
             $field=~s/(\"|\')$//;              $field=~s/(\"|\')$//;
             $components{$i}=$field;              $components{&takeleft($i)}=$field;
             $i++;              $i++;
         }          }
     } else {      } else {
Line 3077  sub record_sep { Line 3468  sub record_sep {
                 $field=~s/^\s*$delimiter//;                  $field=~s/^\s*$delimiter//;
                 $field=~s/$delimiter\s*$//;                  $field=~s/$delimiter\s*$//;
             }              }
             $components{$i}=$field;              $components{&takeleft($i)}=$field;
     $i++;      $i++;
         }          }
     }      }
Line 3186  sub csv_print_select_table { Line 3577  sub csv_print_select_table {
  $r->print('<option value="none"></option>');   $r->print('<option value="none"></option>');
  foreach (sort({$a <=> $b} keys(%sone))) {   foreach (sort({$a <=> $b} keys(%sone))) {
     $r->print('<option value="'.$_.'"'.      $r->print('<option value="'.$_.'"'.
                       ($_ eq $defaultcol ? ' selected ' : '').                        ($_ eq $defaultcol ? ' selected="selected" ' : '').
                       '>Column '.($_+1).'</option>');                        '>Column '.($_+1).'</option>');
  }   }
  $r->print('</select></td></tr>'."\n");   $r->print('</select></td></tr>'."\n");
Line 3230  sub csv_samples_select_table { Line 3621  sub csv_samples_select_table {
  foreach (@$d) {   foreach (@$d) {
     my ($value,$display,$defaultcol)=@{ $_ };      my ($value,$display,$defaultcol)=@{ $_ };
     $r->print('<option value="'.$value.'"'.      $r->print('<option value="'.$value.'"'.
                       ($i eq $defaultcol ? ' selected ':'').'>'.                        ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
                       $display.'</option>');                        $display.'</option>');
  }   }
  $r->print('</select></td><td>');   $r->print('</select></td><td>');
  if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }   if (defined($sone{$_})) { $r->print($sone{$_}."<br />\n"); }
  if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }   if (defined($stwo{$_})) { $r->print($stwo{$_}."<br />\n"); }
  if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }   if (defined($sthree{$_})) { $r->print($sthree{$_}."<br />\n"); }
  $r->print('</td></tr>');   $r->print('</td></tr>');
  $i++;   $i++;
     }      }
Line 3744  Returns: both routines return nothing Line 4135  Returns: both routines return nothing
 sub store_course_settings {  sub store_course_settings {
     # save to the environment      # save to the environment
     # appenv the same items, just to be safe      # appenv the same items, just to be safe
     my $courseid = $ENV{'request.course.id'};      my $courseid = $env{'request.course.id'};
     my $coursedom = $ENV{'course.'.$courseid.'.domain'};      my $coursedom = $env{'course.'.$courseid.'.domain'};
     my ($prefix,$Settings) = @_;      my ($prefix,$Settings) = @_;
     my %SaveHash;      my %SaveHash;
     my %AppHash;      my %AppHash;
     while (my ($setting,$type) = each(%$Settings)) {      while (my ($setting,$type) = each(%$Settings)) {
         my $basename = 'internal.'.$prefix.'.'.$setting;          my $basename = 'internal.'.$prefix.'.'.$setting;
         my $envname = 'course.'.$courseid.'.'.$basename;          my $envname = 'course.'.$courseid.'.'.$basename;
         if (exists($ENV{'form.'.$setting})) {          if (exists($env{'form.'.$setting})) {
             # Save this value away              # Save this value away
             if ($type eq 'scalar' &&              if ($type eq 'scalar' &&
                 (! exists($ENV{$envname}) ||                   (! exists($env{$envname}) || 
                  $ENV{$envname} ne $ENV{'form.'.$setting})) {                   $env{$envname} ne $env{'form.'.$setting})) {
                 $SaveHash{$basename} = $ENV{'form.'.$setting};                  $SaveHash{$basename} = $env{'form.'.$setting};
                 $AppHash{$envname}   = $ENV{'form.'.$setting};                  $AppHash{$envname}   = $env{'form.'.$setting};
             } elsif ($type eq 'array') {              } elsif ($type eq 'array') {
                 my $stored_form;                  my $stored_form;
                 if (ref($ENV{'form.'.$setting})) {                  if (ref($env{'form.'.$setting})) {
                     $stored_form = join(',',                      $stored_form = join(',',
                                         map {                                          map {
                                             &Apache::lonnet::escape($_);                                              &Apache::lonnet::escape($_);
                                         } sort(@{$ENV{'form.'.$setting}}));                                          } sort(@{$env{'form.'.$setting}}));
                 } else {                  } else {
                     $stored_form =                       $stored_form = 
                         &Apache::lonnet::escape($ENV{'form.'.$setting});                          &Apache::lonnet::escape($env{'form.'.$setting});
                 }                  }
                 # Determine if the array contents are the same.                  # Determine if the array contents are the same.
                 if ($stored_form ne $ENV{$envname}) {                  if ($stored_form ne $env{$envname}) {
                     $SaveHash{$basename} = $stored_form;                      $SaveHash{$basename} = $stored_form;
                     $AppHash{$envname}   = $stored_form;                      $AppHash{$envname}   = $stored_form;
                 }                  }
Line 3780  sub store_course_settings { Line 4171  sub store_course_settings {
     }      }
     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,      my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
                                           $coursedom,                                            $coursedom,
                                           $ENV{'course.'.$courseid.'.num'});                                            $env{'course.'.$courseid.'.num'});
     if ($put_result !~ /^(ok|delayed)/) {      if ($put_result !~ /^(ok|delayed)/) {
         &Apache::lonnet::logthis('unable to save form parameters, '.          &Apache::lonnet::logthis('unable to save form parameters, '.
                                  'got error:'.$put_result);                                   'got error:'.$put_result);
Line 3791  sub store_course_settings { Line 4182  sub store_course_settings {
 }  }
   
 sub restore_course_settings {  sub restore_course_settings {
     my $courseid = $ENV{'request.course.id'};      my $courseid = $env{'request.course.id'};
     my ($prefix,$Settings) = @_;      my ($prefix,$Settings) = @_;
     while (my ($setting,$type) = each(%$Settings)) {      while (my ($setting,$type) = each(%$Settings)) {
         next if (exists($ENV{'form.'.$setting}));          next if (exists($env{'form.'.$setting}));
         my $envname = 'course.'.$courseid.'.internal.'.$prefix.          my $envname = 'course.'.$courseid.'.internal.'.$prefix.
             '.'.$setting;              '.'.$setting;
         if (exists($ENV{$envname})) {          if (exists($env{$envname})) {
             if ($type eq 'scalar') {              if ($type eq 'scalar') {
                 $ENV{'form.'.$setting} = $ENV{$envname};                  $env{'form.'.$setting} = $env{$envname};
             } elsif ($type eq 'array') {              } elsif ($type eq 'array') {
                 $ENV{'form.'.$setting} = [                   $env{'form.'.$setting} = [ 
                                            map {                                              map { 
                                                &Apache::lonnet::unescape($_);                                                  &Apache::lonnet::unescape($_); 
                                            } split(',',$ENV{$envname})                                             } split(',',$env{$envname})
                                            ];                                             ];
             }              }
         }          }
Line 3837  sub icon { Line 4228  sub icon {
  $curfext.".gif";   $curfext.".gif";
  }   }
     }      }
     return $iconname;      return &lonhttpdurl($iconname);
 }   } 
   
 sub lonhttpdurl {  sub lonhttpdurl {

Removed from v.1.240  
changed lines
  Added in v.1.279


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