loncom/interface/loncommon.pm - diff

Return to loncommon.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.245 and 1.344

-version 1.245, 2005/01/04 14:46:17
+version 1.344, 2006/04/20 02:24:08
  Line 55  redundancy from other modules and increa
  package Apache::loncommon;
  use strict;
- use Apache::lonnet();
+ use Apache::lonnet;
  use GDBM_File;
  use POSIX qw(strftime mktime);
- use Apache::Constants qw(:common :http :methods);
  use Apache::lonmenu();
  use Apache::lonlocal;
  use HTML::Entities;
+ use Apache::lonhtmlcommon();
+ use Apache::loncoursedata();
+ use Apache::lontexconvert();
  my $readit;
- Line 152  BEGIN {
+ Line 154  BEGIN {
      my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
      opendir(DIR,$designdir);
      while ($filename=readdir(DIR)) {
+ 	if ($filename!~/\.tab$/) { next; }
  	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);
- Line 311  END
+ Line 314  END
  }
  sub lastresurl {
-     if ($ENV{'environment.lastresurl'}) {
+     if ($env{'environment.lastresurl'}) {
- 	return $ENV{'environment.lastresurl'}
+ 	return $env{'environment.lastresurl'}
      } else {
  	return '/res';
      }
- Line 329  sub storeresurl {
+ Line 332  sub storeresurl {
  sub studentbrowser_javascript {
     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)/)
+ 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
+ 					  '/'.$env{'request.course.sec'})
+ 	      ))
+          || ($env{'request.role'}=~/^(au|dc|su)/)
            ) { return ''; }
     return (<<'ENDSTDBRW');
  <script type="text/javascript" language="Javascript" >
- Line 360  ENDSTDBRW
+ Line 366  ENDSTDBRW
  sub selectstudent_link {
     my ($form,$unameele,$udomele)=@_;
-    if ($ENV{'request.course.id'}) {
+    if ($env{'request.course.id'}) {
-        unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
+        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
+ 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
+ 					'/'.$env{'request.course.sec'})) {
  	   return '';
         }
         return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
          '","'.$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.
          '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
     }
- Line 379  sub coursebrowser_javascript {
+ Line 387  sub coursebrowser_javascript {
     return (<<ENDSTDBRW);
  <script type="text/javascript" language="Javascript" >
      var stdeditbrowser;
-     function opencrsbrowser(formname,uname,udom,desc,extra_element) {
+     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) {
          var url = '/adm/pickcourse?';
          var filter;
          if (filter != null) {
- Line 402  sub coursebrowser_javascript {
+ Line 410  sub coursebrowser_javascript {
                  url += '&domainfilter='+extra_element;
              }
          }
+         if (multflag !=null && multflag != '') {
+             url += '&multiple='+multflag;
+         }
          var title = 'Course_Browser';
          var options = 'scrollbars=1,resizable=1,menubar=0';
          options += ',width=700,height=600';
- Line 413  ENDSTDBRW
+ Line 424  ENDSTDBRW
  }
  sub selectcourse_link {
-    my ($form,$unameele,$udomele,$desc,$extra_element)=@_;
+    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag)=@_;
      return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
-         '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>";
+         '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'");'."'>".&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
- Line 547  END
+ Line 583  END
      $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
      foreach my $value (sort(keys(%$hashref))) {
          $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 .= "</select>\n";
- Line 557  END
+ Line 593  END
      my $seconddefault = $hashref->{$firstdefault}->{'default'};
      foreach my $value (sort(keys(%select2))) {
          $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 .= "</select>\n";
- Line 593  sub help_open_topic {
+ Line 629  sub help_open_topic {
      my ($topic, $text, $stayOnPage, $width, $height) = @_;
      $text = "" if (not defined $text);
      $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;
      }
      $width = 350 if (not defined $width);
- Line 659  sub help_open_menu {
+ Line 695  sub help_open_menu {
      my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;
      $text = "" if (not defined $text);
      $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;
      }
      $width = 620 if (not defined $width);
- Line 673  sub help_open_menu {
+ Line 709  sub help_open_menu {
      foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
          $$_ = &Apache::lonnet::escape($$_);
      }
      if (!$stayOnPage) {
           $link = "javascript:helpMenu('open')";
      } else {
- Line 684  sub help_open_menu {
+ Line 719  sub help_open_menu {
      my $template;
      if ($text ne "") {
  	$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 $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
+     my $start_page =
+         &Apache::loncommon::start_page('Help Menu', undef,
+ 				       {'frameset'    => 1,
+ 					'js_ready'    => 1,
+ 					'add_entries' => {
+ 					    'border' => '0',
+ 					    'rows'   => "105,*",},});
+     my $end_page =
+         &Apache::loncommon::end_page({'frameset' => 1,
+ 				      'js_ready' => 1,});
      $template .= <<"ENDTEMPLATE";
   <script type="text/javascript">
- //<!-- BEGIN LON-CAPA Internal
+ // <!-- BEGIN LON-CAPA Internal
+ // <![CDATA[
  function helpMenu(target) {
      var caller = this;
      if (target == 'open') {
          var newWindow = null;
          try {
-             newWindow =  window.open("","helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
+             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
          }
          catch(error) {
              writeHelp(caller);
- Line 710  function helpMenu(target) {
+ Line 758  function helpMenu(target) {
      return;
  }
  function writeHelp(caller) {
-     caller.document.write("<html><head><title>LON-CAPA Help Menu</title><meta http-equiv='pragma' content='no-cache'></head>")
+     caller.document.writeln('$start_page<frame name="bannerframe"  src="$banner_link" /><frame name="bodyframe" src="$details_link" /> $end_page')
-     caller.document.write("<frameset rows='105,*' border='0'><frame name='bannerframe'  src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
-     caller.document.write("</html>")
      caller.document.close()
      caller.focus()
  }
+ // ]]>
  // END LON-CAPA Internal -->
   </script>
   <a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>
- Line 739  ENDTEMPLATE
+ Line 786  ENDTEMPLATE
  sub help_open_bug {
      my ($topic, $text, $stayOnPage, $width, $height) = @_;
-     unless ($ENV{'user.adv'}) { return ''; }
+     unless ($env{'user.adv'}) { return ''; }
      unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
      $text = "" if (not defined $text);
      $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;
      }
      $width = 600 if (not defined $width);
- Line 784  ENDTEMPLATE
+ Line 831  ENDTEMPLATE
  sub help_open_faq {
      my ($topic, $text, $stayOnPage, $width, $height) = @_;
-     unless ($ENV{'user.adv'}) { return ''; }
+     unless ($env{'user.adv'}) { return ''; }
      unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
      $text = "" if (not defined $text);
      $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;
      }
      $width = 350 if (not defined $width);
- Line 832  ENDTEMPLATE
+ Line 879  ENDTEMPLATE
  =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)
  Translate $text to allow it to be output as a 'comma separated values'
- Line 848  sub csv_translate {
+ Line 987  sub csv_translate {
      return $text;
  }
  ###############################################################
  ###############################################################
- Line 872  Currently supported formats:
+ Line 1010  Currently supported formats:
  =item h3
+ =item h4
+ =item i
  =item date
  =back
- Line 894  sub define_excel_formats {
+ Line 1036  sub define_excel_formats {
      $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
      $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
      $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=>
                                              'mm/dd/yyyy hh:mm:ss');
      return $format;
- Line 904  sub define_excel_formats {
+ Line 1048  sub define_excel_formats {
  =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)
- 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
+ Inputs: Apache request object
- 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
- 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
- =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
- Line 1024  sub domain_select {
+ Line 1167  sub domain_select {
      } &get_domains;
      if ($multiple) {
  	$domains{''}=&mt('Any domain');
- 	return &multiple_select_form($name,$value,4,%domains);
+ 	return &multiple_select_form($name,$value,4,\%domains);
      } else {
  	return &select_form($name,$value,%domains);
      }
  }
+ #-------------------------------------------
+ =pod
+ =item * multiple_select_form($name,$value,$size,$hash,$order)
+ Returns a string containing a <select> element int multiple mode
+ Args:
+   $name - name of the <select> element
+   $value - sclara or array ref of values that should already be selected
+   $size - number of rows long the select element is
+   $hash - the elements should be 'option' => 'shown text'
+           (shown text should already have been &mt())
+   $order - (optional) array ref of the order to show the elments in
+ =cut
+ #-------------------------------------------
  sub multiple_select_form {
-     my ($name,$value,$size,%hash)=@_;
+     my ($name,$value,$size,$hash,$order)=@_;
      my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
      my $output='';
      if (! defined($size)) {
          $size = 4;
-         if (scalar(keys(%hash))<4) {
+         if (scalar(keys(%$hash))<4) {
-             $size = scalar(keys(%hash));
+             $size = scalar(keys(%$hash));
          }
      }
      $output.="\n<select name='$name' size='$size' multiple='1'>";
-     foreach (sort(keys(%hash))) {
+     my @order = ref($order) ? @$order
-         $output.='<option value="'.$_.'" ';
+                             : sort(keys(%$hash));
-         $output.='selected ' if ($selected{$_});
+     foreach my $key (@order) {
-         $output.='>'.$hash{$_}."</option>\n";
+         $output.='<option value="'.$key.'" ';
+         $output.='selected="selected" ' if ($selected{$key});
+         $output.='>'.$hash->{$key}."</option>\n";
      }
      $output.="</select>\n";
      return $output;
- Line 1074  sub select_form {
+ Line 1239  sub select_form {
      }
      foreach (@keys) {
          $selectform.="<option value=\"$_\" ".
-             ($_ eq $def ? 'selected' : '').
+             ($_ eq $def ? 'selected="selected" ' : '').
                  ">".&mt($hash{$_})."</option>\n";
      }
      $selectform.="</select>";
- Line 1111  sub select_level_form {
+ Line 1276  sub select_level_form {
      my $selectform = "<select name=\"$name\" size=\"1\">\n";
      for (my $i=0; $i<=18; $i++) {
          $selectform.="<option value=\"$i\" ".
-             ($i==$deflevel ? 'selected' : '').
+             ($i==$deflevel ? 'selected="selected" ' : '').
                  ">".&gradeleveldescription($i)."</option>\n";
      }
      $selectform.="</select>";
- Line 1141  sub select_dom_form {
+ Line 1306  sub select_dom_form {
      my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
      foreach (@domains) {
          $selectdomain.="<option value=\"$_\" ".
-             ($_ eq $defdom ? 'selected' : '').
+             ($_ eq $defdom ? 'selected="selected" ' : '').
                  ">$_</option>\n";
      }
      $selectdomain.="</select>";
- Line 1240  Outputs:
+ Line 1405  Outputs:
  ###############################################################
  ###############################################################
  sub decode_user_agent {
+     my ($r)=@_;
      my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
      my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
      my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
+     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
      my $clientbrowser='unknown';
      my $clientversion='0';
      my $clientmathml='';
- Line 1438  sub authform_nochange{
+ Line 1605  sub authform_nochange{
                kerb_def_dom => 'MSU.EDU',
                @_,
            );
-     my $result = &mt('[_1] Do not change login data',
+     my $result = '<label>'.&mt('[_1] Do not change login data',
                       '<input type="radio" name="login" value="nochange" '.
                       'checked="checked" onclick="'.
-             "javascript:changed_radio('nochange',$in{'formname'});".'" />');
+             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
+ 	    '</label>';
      return $result;
  }
- Line 1473  sub authform_kerberos{
+ Line 1641  sub authform_kerberos{
      my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
      my $result .= &mt
          ('[_1] Kerberos authenticated with domain [_2] '.
-          '[_3] Version 4 [_4] Version 5',
+          '[_3] Version 4 [_4] Version 5 [_5]',
-          '<input type="radio" name="login" value="krb" '.
+          '<label><input type="radio" name="login" value="krb" '.
               'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />',
-          '<input type="text" size="10" name="krbarg" '.
+          '</label><input type="text" size="10" name="krbarg" '.
               'value="'.$krbarg.'" '.
               'onchange="'.$jscall.'" />',
-          '<input type="radio" name="krbver" value="4" '.$check4.' />',
+          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
-          '<input type="radio" name="krbver" value="5" '.$check5.' />');
+          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
+ 	 '</label>');
      return $result;
  }
- Line 1505  sub authform_internal{
+ Line 1674  sub authform_internal{
      my $jscall = "javascript:changed_radio('int',$args{'formname'});";
      my $result.=&mt
          ('[_1] Internally authenticated (with initial password [_2])',
-          '<input type="radio" name="login" value="int" '.$intcheck.
+          '<label><input type="radio" name="login" value="int" '.$intcheck.
               ' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
-          '<input type="text" size="10" name="intarg" '.$intarg.
+          '</label><input type="text" size="10" name="intarg" '.$intarg.
               ' onchange="'.$jscall.'" />');
      return $result;
  }
- Line 1532  sub authform_local{
+ Line 1701  sub authform_local{
      my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
      my $result.=&mt('[_1] Local Authentication with argument [_2]',
-                     '<input type="radio" name="login" value="loc" '.$loccheck.
+                     '<label><input type="radio" name="login" value="loc" '.$loccheck.
                          ' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
-                     '<input type="text" size="10" name="locarg" '.$locarg.
+                     '</label><input type="text" size="10" name="locarg" '.$locarg.
                          ' onchange="'.$jscall.'" />');
      return $result;
  }
- Line 1548  sub authform_filesystem{
+ Line 1717  sub authform_filesystem{
      my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
      my $result.= &mt
          ('[_1] Filesystem Authenticated (with initial password [_2])',
-          '<input type="radio" name="login" value="fsys" '.
+          '<label><input type="radio" name="login" value="fsys" '.
           'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
-          '<input type="text" size="10" name="fsysarg" value="" '.
+          '</label><input type="text" size="10" name="fsysarg" value="" '.
                    'onchange="'.$jscall.'" />');
      return $result;
  }
- Line 1766  if $first is set to 'lastname' then it r
+ Line 1935  if $first is set to 'lastname' then it r
  =cut
  ###############################################################
  sub plainname {
      my ($uname,$udom,$first)=@_;
-     my %names=&Apache::lonnet::get('environment',
+     my %names=&getnames($uname,$udom);
-                     ['firstname','middlename','lastname','generation'],
- 					 $udom,$uname);
      my $name=&Apache::lonnet::format_name($names{'firstname'},
  					  $names{'middlename'},
  					  $names{'lastname'},
- Line 1802  if the user does not
+ Line 1970  if the user does not
  sub nickname {
      my ($uname,$udom)=@_;
-     my %names;
+     my %names=&getnames($uname,$udom);
-     if ($uname eq $ENV{'user.name'} &&
- 	$udom eq $ENV{'user.domain'}) {
- 	%names=('nickname'   => $ENV{'environment.nickname'}  ,
- 		'firstname'  => $ENV{'environment.firstname'} ,
- 		'middlename' => $ENV{'environment.middlename'},
- 		'lastname'   => $ENV{'environment.lastname'}  ,
- 		'generation' => $ENV{'environment.generation'});
-     } else {
- 	%names=&Apache::lonnet::get('environment',
- 				    ['nickname','firstname','middlename',
- 				     'lastname','generation'],$udom,$uname);
-     }
      my $name=$names{'nickname'};
      if ($name) {
         $name='&quot;'.$name.'&quot;';
- Line 1827  sub nickname {
+ Line 1983  sub nickname {
      return $name;
  }
+ sub getnames {
+     my ($uname,$udom)=@_;
+     my $id=$uname.':'.$udom;
+     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
+     if ($cached) {
+ 	return %{$names};
+     } else {
+ 	my %loadnames=&Apache::lonnet::get('environment',
+                     ['firstname','middlename','lastname','generation','nickname'],
+ 					 $udom,$uname);
+ 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
+ 	return %loadnames;
+     }
+ }
  # ------------------------------------------------------------------ Screenname
- Line 1840  Gets a users screenname and returns it a
+ Line 2010  Gets a users screenname and returns it a
  sub screenname {
      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);
      return $names{'screenname'};
  }
- Line 1883  sub syllabuswrapper {
+ Line 2053  sub syllabuswrapper {
  }
  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';
      if (defined($sname) && $sname !~ /^\s*$/ &&
          defined($sdom)  && $sdom  !~ /^\s*$/) {
-         $link .= "?selected_student=$sname:$sdom";
+         $link .= "selected_student=$sname:$sdom";
          $title .= ' of this student';
      }
      if (defined($target) && $target !~ /^\s*$/) {
          $target = qq{target="$target"};
      } else {
          $target = '';
      }
+     if ($start) { $link.='&amp;start='.$start; }
      return qq{<a href="$link" title="$title" $target>$linktext</a>};
  }
  =pod
  =back
- Line 2089  sub display_languages {
+ Line 2258  sub display_languages {
  	$languages{$_}=1;
      }
      &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;
          }
      }
- Line 2099  sub display_languages {
+ Line 2268  sub display_languages {
  sub preferred_languages {
      my @languages=();
-     if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {
+     if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
  	@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];
      if ($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,
- 		$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,
- 		$Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}});
+ 		$Apache::lonnet::domain_lang_def{$env{'request.role.domain'}});
      }
      if ($Apache::lonnet::domain_lang_def{
  	                          $Apache::lonnet::perlvar{'lonDefDomain'}}) {
- Line 2349  sub submlink {
+ Line 2518  sub submlink {
  	    &Apache::lonxml::whichuser($symb);
  	if (!$symb) { $symb=$cursymb; }
      }
-     if (!$symb) { $symb=&symbread(); }
+     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
      $symb=&Apache::lonnet::escape($symb);
      if ($target) { $target="target=\"$target\""; }
      return '<a href="/adm/grades?&command=submission&'.
- Line 2383  sub pgrdlink {
+ Line 2552  sub pgrdlink {
  Inputs: $text $uname $udom $symb $target
  Returns: A link to parmset.pm such as to see the PPRM view of a
- student andn resource
+ student and a specific resource
  =cut
- Line 2395  sub pprmlink {
+ Line 2564  sub pprmlink {
  	    &Apache::lonxml::whichuser($symb);
  	if (!$symb) { $symb=$cursymb; }
      }
-     if (!$symb) { $symb=&symbread(); }
+     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
      $symb=&Apache::lonnet::escape($symb);
      if ($target) { $target="target=\"$target\""; }
      return '<a href="/adm/parmset?&command=set&'.
- Line 2438  sub maketime {
+ Line 2607  sub maketime {
  sub findallcourses {
      my %courses=();
      my $now=time;
-     foreach (keys %ENV) {
+     foreach (keys %env) {
  	if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {
- 	    my ($starttime,$endtime)=$ENV{$_};
+ 	    my ($starttime,$endtime)=$env{$_};
              my $active=1;
              if ($starttime) {
  		if ($now<$starttime) { $active=0; }
- Line 2477  sub determinedomain {
+ Line 2646  sub determinedomain {
     if (! $domain) {
          # Determine domain if we have not been given one
          $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;
- Line 2524  Returns: value of designparamter $which
+ Line 2693  Returns: value of designparamter $which
  ##############################################
  sub designparm {
      my ($which,$domain)=@_;
-     if ($ENV{'browser.blackwhite'} eq 'on') {
+     if ($env{'browser.blackwhite'} eq 'on') {
  	if ($which=~/\.(font|alink|vlink|link)$/) {
  	    return '#000000';
  	}
- Line 2535  sub designparm {
+ Line 2704  sub designparm {
  	    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);
      if ($designhash{$domain.'.'.$which}) {
- Line 2578  Inputs:
+ Line 2747  Inputs:
  =item * $forcereg, if page should register as content page (relevant for
              text interface only)
+ =item * $customtitle, alternate text to use instead of $title
+                       in the title box that appears, this text
+                       is not auto translated like the $title is
+ =item * $notopbar, if true, keep the 'what is this' info but remove the
+                    navigational links
+ =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
+ =item * $notitle, if true keep the nav controls, but remove the title bar
  =back
  Returns: A uniform header for LON-CAPA web pages.
- Line 2588  other decorations will be returned.
+ Line 2769  other decorations will be returned.
  =cut
  sub bodytag {
-     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle)=@_;
+     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
+ 	$notopbar,$bgcolor,$notitle)=@_;
      $title=&mt($title);
      $function = &get_users_function() if (!$function);
-     my $img=&designparm($function.'.img',$domain);
+     my $img =    &designparm($function.'.img',$domain);
-     my $pgbg=&designparm($function.'.pgbg',$domain);
+     my $tabbg =  &designparm($function.'.tabbg',$domain);
-     my $tabbg=&designparm($function.'.tabbg',$domain);
+     my $font =   &designparm($function.'.font',$domain);
-     my $font=&designparm($function.'.font',$domain);
+     my $sidebg = &designparm($function.'.sidebg',$domain);
-     my $link=&designparm($function.'.link',$domain);
+     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
-     my $alink=&designparm($function.'.alink',$domain);
-     my $vlink=&designparm($function.'.vlink',$domain);
+     my %design = ( 'style'   => 'margin-top: 0px',
-     my $sidebg=&designparm($function.'.sidebg',$domain);
+ 		   'bgcolor' => $pgbg,
- # Accessibility font enhance
+ 		   'text'    => $font,
-     unless ($addentries) { $addentries=''; }
+                    'alink'   => &designparm($function.'.alink',$domain),
-     my $addstyle='';
+ 		   'vlink'   => &designparm($function.'.vlink',$domain),
-     if ($ENV{'browser.fontenhance'} eq 'on') {
+ 		   'link'    => &designparm($function.'.link',$domain),);
- 	$addstyle=' font-size: x-large;';
+     @$addentries{keys(%design)} = @design{keys(%design)};
-     }
   # role and realm
      my ($role,$realm)
-        =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
+        =&Apache::lonnet::plaintext((split(/\./,$env{'request.role'}))[0]);
  # realm
-     if ($ENV{'request.course.id'}) {
+     if ($env{'request.course.id'}) {
  	$realm=
-          $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
+          $env{'course.'.$env{'request.course.id'}.'.description'};
      }
      unless ($realm) { $realm='&nbsp;'; }
  # Set messages
- Line 2619  sub bodytag {
+ Line 2803  sub bodytag {
  # Port for miniserver
      my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
      if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
+     my $extra_body_attr = &make_attr_string($forcereg,$addentries);
  # construct main body tag
      my $bodytag = <<END;
- <style type="text/css">
+ <body $extra_body_attr>
- h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
- a:focus { color: red; background: yellow }
- </style>
- <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
- style="margin-top: 0px;$addstyle" $addentries>
  END
+     $bodytag .= &Apache::lontexconvert::init_math_support();
      my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
                     $lonhttpdPort.$img.'" alt="'.$function.'" />';
-     if ($bodyonly) {
+     if ($bodyonly
+ 	|| ($env{'request.state'} eq 'construct'
+ 	    && $env{'environment.remote'} ne 'off' )) {
          return $bodytag;
-     } elsif ($ENV{'browser.interface'} eq 'textual') {
+     } elsif ($env{'browser.interface'} eq 'textual') {
  # Accessibility
-         return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
+ 	$bodytag.=&Apache::lonmenu::menubuttons($forcereg,$forcereg);
-                                                       $forcereg).
+ 	if (!$notitle) {
-                '<h1>LON-CAPA: '.$title.'</h1>';
+ 	    $bodytag.='<h1>LON-CAPA: '.$title.'</h1>';
-     } elsif ($ENV{'environment.remote'} eq 'off') {
+ 	}
+ 	return $bodytag;
+     } elsif ($env{'environment.remote'} eq 'off') {
  # No Remote
  	my $roleinfo=(<<ENDROLE);
  <td bgcolor="$tabbg" align="right">
  <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;
  <br />
  <font size="2" face="Arial, Helvetica, sans-serif">$role</font>&nbsp;
- Line 2660  ENDROLE
+ Line 2849  ENDROLE
              $titleinfo = $customtitle;
          }
- 	if ($ENV{'request.state'} eq 'construct') {
+ 	if ($env{'request.state'} eq 'construct') {
  	    my ($uname,$thisdisfn)=
- 		($ENV{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
+ 		($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
  	    my $formaction='/priv/'.$uname.'/'.$thisdisfn;
  	    $formaction=~s/\/+/\//g;
              unless ($customtitle) {  #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm
- Line 2686  ENDROLE
+ Line 2875  ENDROLE
              }
  	    $forcereg=1;
          }
-         my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.
+         my $titletable;
+ 	if (!$notitle) {
+ 	    $titletable =
+ 		'<table bgcolor="'.$pgbg.'" width="100%" border="0" '.
                           'cellspacing="3" cellpadding="3">'.
-                          '<tr><td rowspan="3" bgcolor="'.$tabbg.'">'.
+                          '<tr><td bgcolor="'.$tabbg.'">'.
                           $titleinfo.'</td>'.$roleinfo.'</tr></table>';
-         if ($ENV{'request.state'} eq 'construct') {
+ 	}
-             $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);
+ 	if ($env{'request.state'} eq 'construct') {
+             if ($notopbar) {
+                 $bodytag .= $titletable;
+             } else {
+                 $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
+ 							  $titletable);
+             }
  	} else {
-             $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).
+             if ($notopbar) {
+                 $bodytag .= $titletable;
+             } else {
+                 $bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
                          $titletable;
+             }
          }
          return $bodytag;
      }
- Line 2709  ENDROLE
+ Line 2911  ENDROLE
      #
      # Extra info if you are the DC
      my $dc_info = '';
-     if ($ENV{'user.adv'} && exists($ENV{'user.role.dc./'.
+     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
-                         $ENV{'course.'.$ENV{'request.course.id'}.
+                         $env{'course.'.$env{'request.course.id'}.
                                   '.domain'}.'/'})) {
-         my $cid = $ENV{'request.course.id'};
+         my $cid = $env{'request.course.id'};
-         $dc_info.= $cid.' '.$ENV{'course.'.$cid.'.internal.coursecode'};
+         $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
          $dc_info = '('.$dc_info.')';
      }
+     # Explicit link to get inline menu
+     my $menu='<br /><font size="2" face="Arial, Helvetica, sans-serif">&nbsp;<a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a></font>';
      #
+     if ($notitle) {
+ 	return $bodytag;
+     }
      return(<<ENDBODY);
  $bodytag
  <table width="100%" cellspacing="0" border="0" cellpadding="0">
- Line 2726  $upperleft</td>
+ Line 2933  $upperleft</td>
  </tr>
  <tr>
  <td rowspan="3" bgcolor="$tabbg">
- $titleinfo $dc_info
+ $titleinfo $dc_info $menu
- <td bgcolor="$tabbg" align="right">
+ </td><td bgcolor="$tabbg" align="right">
  <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;
  </td>
  </tr>
- Line 2745  $titleinfo $dc_info
+ Line 2952  $titleinfo $dc_info
  ENDBODY
  }
+ sub make_attr_string {
+     my ($register,$attr_ref) = @_;
+     if ($attr_ref && !ref($attr_ref)) {
+ 	die("addentries Must be a hash ref ".
+ 	    join(':',caller(1))." ".
+ 	    join(':',caller(0))." ");
+     }
+     if ($register) {
+ 	my ($on_load,$on_unload);
+ 	foreach my $key (keys(%{$attr_ref})) {
+ 	    if      (lc($key) eq 'onload') {
+ 		$on_load.=$attr_ref->{$key}.';';
+ 		delete($attr_ref->{$key});
+ 	    } elsif (lc($key) eq 'onunload') {
+ 		$on_unload.=$attr_ref->{$key}.';';
+ 		delete($attr_ref->{$key});
+ 	    }
+ 	}
+ 	$attr_ref->{'onload'}  =
+ 	    &Apache::lonmenu::loadevents().  $on_load;
+ 	$attr_ref->{'onunload'}=
+ 	    &Apache::lonmenu::unloadevents().$on_unload;
+     }
+ # Accessibility font enhance
+     if ($env{'browser.fontenhance'} eq 'on') {
+ 	my $style;
+ 	foreach my $key (keys(%{$attr_ref})) {
+ 	    if (lc($key) eq 'style') {
+ 		$style.=$attr_ref->{$key}.';';
+ 		delete($attr_ref->{$key});
+ 	    }
+ 	}
+ 	$attr_ref->{'style'}=$style.'; font-size: x-large;';
+     }
+     if ($env{'browser.blackwhite'} eq 'on') {
+ 	delete($attr_ref->{'font'});
+ 	delete($attr_ref->{'link'});
+ 	delete($attr_ref->{'alink'});
+ 	delete($attr_ref->{'vlink'});
+ 	delete($attr_ref->{'bgcolor'});
+ 	delete($attr_ref->{'background'});
+     }
+     my $attr_string;
+     foreach my $attr (keys(%$attr_ref)) {
+ 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
+     }
+     return $attr_string;
+ }
+ ###############################################
  ###############################################
  =pod
+ =back
+ =head1 HTML Helpers
+ =over 4
+ =item * &endbodytag()
+ Returns a uniform footer for LON-CAPA web pages.
+ Inputs: none
+ =back
+ =cut
+ sub endbodytag {
+     my $endbodytag='</body>';
+     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
+     if ( exists( $env{'internal.head.redirect'} ) ) {
+ 	$endbodytag=
+ 	    "<br /><a href=\"$env{'internal.head.redirect'}\">".
+ 	    &mt('Continue').'</a>'.
+ 	    $endbodytag;
+     }
+     return $endbodytag;
+ }
+ sub standard_css {
+     return <<END;
+ <style type="text/css">
+ h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
+ a:focus { color: red; background: yellow }
+ table.thinborder { border-collapse: collapse; }
+ table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}
+ form, .inline { display: inline; }
+ .center { text-align: center; }
+ .filename {font-family: monospace;}
+ </style>
+ END
+ }
+ =pod
+ =over 4
+ =item * &headtag()
+ Returns a uniform footer for LON-CAPA web pages.
+ Inputs: $title - optional title for the head
+         $head_extra - optional extra HTML to put inside the <head>
+         $args - optional arguments
+             force_register - if is true call registerurl so the remote is
+                              informed
+             redirect - array ref of seconds before redirect occurs
+                                     url to redirect to
+                            (side effect of setting
+                                $env{'internal.head.redirect'} to the url
+                                redirected too)
+ =back
+ =cut
+ sub headtag {
+     my ($title,$head_extra,$args) = @_;
+     my $result =
+ 	'<head>'.
+ 	&standard_css().
+ 	&font_settings().
+ 	&Apache::lonhtmlcommon::htmlareaheaders();
+     if ($args->{'force_register'}) {
+ 	$result .= &Apache::lonmenu::registerurl(1);
+     }
+     if (ref($args->{'redirect'})) {
+ 	my ($time,$url) = @{$args->{'redirect'}};
+ 	$url = &Apache::lonenc::check_encrypt($url);
+ 	$env{'internal.head.redirect'} = $url;
+ 	$result.=<<ADDMETA
+ <meta http-equiv="pragma" content="no-cache" />
+ <meta http-equiv="Refresh" content="$time; url=$url" />
+ ADDMETA
+     }
+     if (!defined($title)) {
+ 	$title = 'The LearningOnline Network with CAPA';
+     }
+     $result .= '<title> LON-CAPA '.&mt($title).'</title>'.$head_extra;
+     return $result;
+ }
+ =pod
+ =over 4
+ =item * &font_settings()
+ Returns neccessary <meta> to set the proper encoding
+ Inputs: none
+ =back
+ =cut
+ sub font_settings {
+     my $headerstring='';
+     if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) {
+ 	$headerstring.=
+ 	    '<meta Content-Type="text/html; charset=x-mac-roman" />';
+     } elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
+ 	$headerstring.=
+ 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
+     }
+     return $headerstring;
+ }
+ =pod
+ =over 4
+ =item * &xml_begin()
+ Returns the needed doctype and <html>
+ Inputs: none
+ =back
+ =cut
+ sub xml_begin {
+     my $output='';
+     &Apache::lonhtmlcommon::init_htmlareafields();
+     if ($env{'browser.mathml'}) {
+ 	$output='<?xml version="1.0"?>'
+             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
+ #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
+ #	    .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" [<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">] >'
+ 	    .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'
+             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
+ 	    .'xmlns="http://www.w3.org/1999/xhtml">';
+     } else {
+ 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html>';
+     }
+     return $output;
+ }
+ =pod
+ =over 4
+ =item * &endheadtag()
+ Returns a uniform </head> for LON-CAPA web pages.
+ Inputs: none
+ =back
+ =cut
+ sub endheadtag {
+     return '</head>';
+ }
+ =pod
+ =over 4
+ =item * &head()
+ Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
+ Inputs: $title - optional title for the page
+         $head_extra - optional extra HTML to put inside the <head>
+ =back
+ =cut
+ sub head {
+     my ($title,$head_extra,$args) = @_;
+     return &headtag($title,$head_extra,$args).&endheadtag();
+ }
+ =pod
+ =over 4
+ =item * &start_page()
+ Returns a complete <html> .. <body> section for LON-CAPA web pages.
+ Inputs: $title - optional title for the page
+         $head_extra - optional extra HTML to incude inside the <head>
+         $args - additional optional args supported are:
+                   only_body      -> is true will set &bodytag() onlybodytag
+                                     arg on
+                   no_nav_bar     -> is true will set &bodytag() notopbar arg on
+                   add_entries    -> additional attributes to add to the  <body>
+                   domain         -> force to color decorate a page for a
+                                     specific domain
+                   function       -> force usage of a specific rolish color
+                                     scheme
+                   redirect       -> see &headtag()
+                   bgcolor        -> override the default page bg color
+                   js_ready       -> return a string ready for being used in
+                                     a javascript writeln
+                   html_encode    -> return a string ready for being used in
+                                     a html attribute
+                   force_register -> if is true will turn on the &bodytag()
+                                     $forcereg arg
+                   body_title     -> alternate text to use instead of $title
+                                     in the title box that appears, this text
+                                     is not auto translated like the $title is
+                   frameset       -> if true will start with a <frameset>
+                                     rather than <body>
+                   no_title       -> if true the title bar won't be shown
+                   skip_phases    -> hash ref of
+                                     head -> skip the <html><head> generation
+                                     body -> skip all <body> generation
+ =back
+ =cut
+ sub start_page {
+     my ($title,$head_extra,$args) = @_;
+     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
+     my %head_args;
+     foreach my $arg ('redirect','force_register') {
+ 	if (defined($args->{$arg})) {
+ 	    $head_args{$arg} = $args->{$arg};
+ 	}
+     }
+     $env{'internal.start_page'}++;
+     my $result;
+     if (! exists($args->{'skip_phases'}{'head'}) ) {
+ 	$result.=
+ 	    &xml_begin().
+ 	    &headtag($title,$head_extra,\%head_args).&endheadtag();
+     }
+     if (! exists($args->{'skip_phases'}{'body'}) ) {
+ 	if ($args->{'frameset'}) {
+ 	    my $attr_string = &make_attr_string($args->{'force_register'},
+ 						$args->{'add_entries'});
+ 	    $result .= "\n<frameset $attr_string>\n";
+ 	} else {
+ 	    $result .=
+ 		&bodytag($title,
+ 			 $args->{'function'},       $args->{'add_entries'},
+ 			 $args->{'only_body'},      $args->{'domain'},
+ 			 $args->{'force_register'}, $args->{'body_title'},
+ 			 $args->{'no_nav_bar'},     $args->{'bgcolor'},
+ 			 $args->{'no_title'});
+ 	}
+     }
+     if ($args->{'js_ready'}) {
+ 	$result = &js_ready($result);
+     }
+     if ($args->{'html_encode'}) {
+ 	$result = &html_encode($result);
+     }
+     return $result;
+ }
+ =pod
+ =over 4
+ =item * &head()
+ Returns a complete </body></html> section for LON-CAPA web pages.
+ Inputs:         $args - additional optional args supported are:
+                  js_ready     -> return a string ready for being used in
+                                  a javascript writeln
+                  html_encode  -> return a string ready for being used in
+                                  a html attribute
+                  frameset     -> if true will start with a <frameset>
+                                  rather than <body>
+ =back
+ =cut
+ sub end_page {
+     my ($args) = @_;
+     #&Apache::lonnet::logthis("end_page ".join(':',caller(0)));
+     $env{'internal.end_page'}++;
+     my $result;
+     if ($args->{'discussion'}) {
+ 	my ($target,$parser);
+ 	if (ref($args->{'discussion'})) {
+ 	    ($target,$parser) =($args->{'discussion'}{'target'},
+ 				$args->{'discussion'}{'parser'});
+ 	}
+ 	$result .= &Apache::lonxml::xmlend($target,$parser);
+     }
+     if ($args->{'frameset'}) {
+ 	$result .= '</frameset>';
+     } else {
+ 	$result .= &endbodytag();
+     }
+     $result .= "\n</html>";
+     if ($args->{'js_ready'}) {
+ 	$result = &js_ready($result);
+     }
+     if ($args->{'html_encode'}) {
+ 	$result = &html_encode($result);
+     }
+     return $result;
+ }
+ sub html_encode {
+     my ($result) = @_;
+     $result = &HTML::Entities::encode($result,'<>&"');
+     return $result;
+ }
+ sub js_ready {
+     my ($result) = @_;
+     $result =~ s/[\n\r]/ /xmsg;
+     $result =~ s/\\/\\\\/xmsg;
+     $result =~ s/'/\\'/xmsg;
+     $result =~ s{</script>}{</scrip'+'t>}xmsg;
+     return $result;
+ }
+ sub validate_page {
+     if (  exists($env{'internal.start_page'})
+ 	  &&     $env{'internal.start_page'} > 1) {
+ 	&Apache::lonnet::logthis('start_page called multiple times '.
+ 				 $env{'internal.start_page'}.' '.
+ 				 $ENV{'request.filename'});
+     }
+     if (  exists($env{'internal.end_page'})
+ 	  &&     $env{'internal.end_page'} > 1) {
+ 	&Apache::lonnet::logthis('end_page called multiple times '.
+ 				 $env{'internal.end_page'}.' '.
+ 				 $env{'request.filename'});
+     }
+     if (     exists($env{'internal.start_page'})
+ 	&& ! exists($env{'internal.end_page'})) {
+ 	&Apache::lonnet::logthis('start_page called without end_page '.
+ 				 $env{'request.filename'});
+     }
+     if (   ! exists($env{'internal.start_page'})
+ 	&&   exists($env{'internal.end_page'})) {
+ 	&Apache::lonnet::logthis('end_page called without start_page'.
+ 				 $env{'request.filename'});
+     }
+ }
+ sub simple_error_page {
+     my ($r,$title,$msg) = @_;
+     my $page =
+ 	&Apache::loncommon::start_page($title).
+ 	&mt($msg).
+ 	&Apache::loncommon::end_page();
+     if (ref($r)) {
+ 	$r->print($page);
+ 	return;
+     }
+     return $page;
+ }
+ ###############################################
+ =pod
+ =over 4
  =item get_users_function
  Used by &bodytag to determine the current users primary role.
- Line 2759  Returns either 'student','coordinator','
+ Line 3411  Returns either 'student','coordinator','
  ###############################################
  sub get_users_function {
      my $function = 'student';
-     if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
+     if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
          $function='coordinator';
      }
-     if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
+     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
          $function='admin';
      }
-     if (($ENV{'request.role'}=~/^(au|ca)/) ||
+     if (($env{'request.role'}=~/^(au|ca)/) ||
          ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
          $function='author';
      }
- Line 2776  sub get_users_function {
+ Line 3428  sub get_users_function {
  =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
  Determines all the sections for a course including
- Line 2794  Returns number of sections.
+ Line 3500  Returns number of sections.
  sub get_sections {
      my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;
      if (!($cdom && $cnum)) { return 0; }
-     my $cid = $cdom.'_'.$cnum;
      my $numsections = 0;
      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 $status_index = &Apache::loncoursedata::CL_STATUS();
  	while (my ($student,$data) = each %$classlist) {
- Line 2828  sub get_sections {
+ Line 3533  sub get_sections {
      return $numsections;
  }
+ ###############################################
+ =pod
+ =item coursegroups
+ Retrieve information about groups in a course,
- sub get_posted_cgi {
+ Input:
-     my $r=shift;
+. Reference to hash to populate with group information.
+. Optional course domain
+. Optional course number
+. Optional group name
+ Course domain and number will be taken from user's
+ environment if not supplied. Optional group name will'
+ be passed to lonnet::get_coursegroups() as a regexp to
+ use in the call to the dump function.
+ Output
+ Returns number of groups in the course (subject to the
+ optional group name filter).
+ Side effects:
+ Populates the referenced curr_groups hash, with key,
+ value pairs. Keys are group names, corresponding values
+ are scalars containing group information in XML. This
+ can be sent to &get_group_settings() to be parsed.
-     my $buffer;
+ =cut
-     $r->read($buffer,$r->header_in('Content-length'),0);
+ ###############################################
-     unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
- 	my @pairs=split(/&/,$buffer);
+ sub coursegroups {
- 	my $pair;
+     my ($curr_groups,$cdom,$cnum,$group) = @_;
- 	foreach $pair (@pairs) {
+     my $numgroups;
- 	    my ($name,$value) = split(/=/,$pair);
+     if (!defined($cdom) || !defined($cnum)) {
- 	    $value =~ tr/+/ /;
+         my $cid =  $env{'request.course.id'};
- 	    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
+         $cdom = $env{'course.'.$cid.'.domain'};
- 	    $name  =~ tr/+/ /;
+         $cnum = $env{'course.'.$cid.'.num'};
- 	    $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
+     }
- 	    &add_to_env("form.$name",$value);
+     %{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
- 	}
+     my ($tmp) = keys(%{$curr_groups});
-     } else {
+     if ($tmp=~/^error:/) {
- 	my $contentsep=$1;
+         unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') {
- 	my @lines = split (/\n/,$buffer);
+             &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.
- 	my $name='';
+                                                                    $cdom);
- 	my $value='';
+         }
- 	my $fname='';
+         $numgroups = 0;
- 	my $fmime='';
+     } else {
- 	my $i;
+         $numgroups = keys(%{$curr_groups});
- 	for ($i=0;$i<=$#lines;$i++) {
+     }
- 	    if ($lines[$i]=~/^$contentsep/) {
+     return $numgroups;
- 		if ($name) {
+ }
- 		    chomp($value);
- 		    if ($fname) {
+ ###############################################
- 			$ENV{"form.$name.filename"}=$fname;
- 			$ENV{"form.$name.mimetype"}=$fmime;
+ =pod
- 		    } else {
- 			$value=~s/\s+$//s;
+ =item get_group_settings
- 		    }
- 		    &add_to_env("form.$name",$value);
+ Uses TokeParser to extract group information from the
+ XML used to describe course groups.
+ Input:
+ Scalar containing XML  - as retrieved from &coursegroups().
+ Output:
+ Hash containing group information as key=values for (a), and
+ hash of hashes for (b)
+ Keys (in two categories):
+ (a) groupname, creator, creation, modified, startdate,enddate.
+ Corresponding values are name of the group, creator of the group
+ (username:domain), UNIX time for date group was created, and
+ settings were last modified, and default start and end access
+ times for group members.
+ (b) functions returned in hash of hashes.
+ Outer hash key is functions.
+ Inner hash keys are chat,discussion,email,files,homepage,roster.
+ Corresponding values are either on or off, depending on
+ whether this type of functionality is available for the group.
+ =cut
+ ###############################################
+ sub get_group_settings {
+     my ($groupinfo)=@_;
+     my $parser=HTML::TokeParser->new(\$groupinfo);
+     my $token;
+     my $tool = '';
+     my $role = '';
+     my %content=();
+     while ($token=$parser->get_token) {
+         if ($token->[0] eq 'S')  {
+             my $entry=$token->[1];
+             if ($entry eq 'functions' || $entry eq 'autosec') {
+                 %{$content{$entry}} = ();
+                 $tool = $entry;
+             } elsif ($entry eq 'role') {
+                 if ($tool eq 'autosec') {
+                     $role = $token->[2]{id};
+                 }
+             } else {
+                 my $value=$parser->get_text('/'.$entry);
+                 if ($entry eq 'name') {
+                     if ($tool eq 'functions') {
+                         my $function = $token->[2]{id};
+                         $content{$tool}{$function} = $value;
+                     }
+                 } elsif ($entry eq 'groupname') {
+                     $content{$entry}=&Apache::lonnet::unescape($value);
+                 } elsif (($entry eq 'roles') || ($entry eq 'types') ||
+                          ($entry eq 'sectionpick') || ($entry eq 'defpriv')) {
+                     push(@{$content{$entry}},$value);
+                 } elsif ($entry eq 'section') {
+                     if ($tool eq 'autosec'  && $role ne '') {
+                         push(@{$content{$tool}{$role}},$value);
+                     }
+                 } else {
+                     $content{$entry}=$value;
+                 }
+             }
+         } elsif ($token->[0] eq 'E') {
+             if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') {
+                 $tool = '';
+             } elsif ($token->[1] eq 'role') {
+                 $role = '';
+             }
+         }
+     }
+     return %content;
+ }
+ sub check_group_access {
+     my ($group) = @_;
+     my $access = 1;
+     my $now = time;
+     my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
+     if (($end!=0) && ($end<$now)) { $access = 0; }
+     if (($start!=0) && ($start>$now)) { $access=0; }
+     return $access;
+ }
+ ###############################################
+ =pod
+ =item get_course_users
+ Retrieves usernames:domains for users in the specified course
+ with specific role(s), and access status.
+ Incoming parameters:
+. course domain
+. course number
+. access status: users must have - either active,
+ previous, future, or all.
+. reference to array of permissible roles
+. reference to array of section restrictions (optional)
+. reference to results object (hash of hashes).
+. reference to optional userdata hash
+ Keys of top level hash are roles.
+ Keys of inner hashes are username:domain, with
+ values set to access type.
+ Optional userdata hash returns an array with arguments in the
+ same order as loncoursedata::get_classlist() for student data.
+ Entries for end, start, section and status are blank because
+ of the possibility of multiple values for non-student roles.
+ =cut
+ ###############################################
+ sub get_course_users {
+     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_;
+     my %idx = ();
+     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
+     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
+     $idx{end} = &Apache::loncoursedata::CL_END();
+     $idx{start} = &Apache::loncoursedata::CL_START();
+     $idx{id} = &Apache::loncoursedata::CL_ID();
+     $idx{section} = &Apache::loncoursedata::CL_SECTION();
+     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
+     $idx{status} = &Apache::loncoursedata::CL_STATUS();
+     if (grep(/^st$/,@{$roles})) {
+         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
+         my $now = time;
+         foreach my $student (keys(%{$classlist})) {
+             my $match = 0;
+             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
+ 		unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/,
+ 			    @{$sections})) {
+ 		    next;
  		}
- 		if ($i<$#lines) {
+             }
- 		    $i++;
+             if (defined($$types{'active'})) {
- 		    $lines[$i]=~
+                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
- 		/Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i;
+                     push(@{$$users{st}{$student}},'active');
- 		    $name=$1;
+                     $match = 1;
- 		    $value='';
+                 }
- 		    if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {
+             }
- 			$fname=$1;
+             if (defined($$types{'previous'})) {
- 			if
+                 if ($$classlist{$student}[$idx{end}] <= $now) {
-                             ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {
+                     push(@{$$users{st}{$student}},'previous');
- 				$fmime=$1;
+                     $match = 1;
- 				$i++;
+                 }
- 			    } else {
+             }
- 				$fmime='';
+             if (defined($$types{'future'})) {
- 			    }
+                 if (($$classlist{$student}[$idx{start}] > $now) && ($$classlist{$student}[$idx{end}] > $now) || ($$classlist{$student}[$idx{end}] == 0) || ($$classlist{$student}[$idx{end}] eq '')) {
- 		    } else {
+                     push(@{$$users{st}{$student}},'future');
- 			$fname='';
+                     $match = 1;
- 			$fmime='';
+                 }
+             }
+             if ($match && defined($userdata)) {
+                 $$userdata{$student} = $$classlist{$student};
+             }
+         }
+     }
+     if ((@{$roles} > 0) && (@{$roles} ne "st")) {
+         my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);
+         foreach my $person (@coursepersonnel) {
+             my $match = 0;
+             my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);
+             $user =~ s/:$//;
+             if (($role) && (grep(/^\Q$role\E$/,@{$roles}))) {
+                 my ($uname,$udom,$usec) = split(/:/,$user);
+                 if ($usec ne '' && (ref($sections) eq 'ARRAY') &&
+ 		    @{$sections} > 0) {
+ 		    unless(grep(/^\Q$usec\E$/,@{$sections})) {
+ 			next;
  		    }
- 		    $i++;
+                 }
- 		}
+                 if ($uname ne '' && $udom ne '') {
- 	    } else {
+                     my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);
- 		$value.=$lines[$i]."\n";
+                     foreach my $type (keys(%{$types})) {
- 	    }
+                         if ($status eq $type) {
- 	}
+                             @{$$users{$role}{$user}} = $type;
+                             $match = 1;
+                         }
+                     }
+                     if ($match && defined($userdata) &&
+                         !exists($$userdata{$uname.':'.$udom})) {
+ 			&get_user_info($udom,$uname,\%idx,$userdata);
+                     }
+                 }
+             }
+         }
+         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';
+                     if (defined($userdata) &&
+ 			!exists($$userdata{$owner.':'.$cdom})) {
+ 			&get_user_info($cdom,$owner,\%idx,$userdata);
+ 		    }
+                 }
+             }
+         }
      }
-     $ENV{'request.method'}=$ENV{'REQUEST_METHOD'};
+     return;
-     $r->method_number(M_GET);
+ }
-     $r->method('GET');
-     $r->headers_in->unset('Content-length');
+ sub get_user_info {
+     my ($udom,$uname,$idx,$userdata) = @_;
+     $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
+ 	&plainname($uname,$udom,'lastname');
+     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
+     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
+     return;
  }
  =pod
  =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),
- 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.
  $possible_names is an ref to an array of form element names.  As an example:
  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
- Line 2922  sub get_unprocessed_cgi {
+ Line 3837  sub get_unprocessed_cgi {
      if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
        $value =~ tr/+/ /;
        $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 2937  returns cache-controlling header code
+ Line 3851  returns cache-controlling header code
  =cut
  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 $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                  <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
- Line 2956  specifies header code to not have cache
+ Line 3870  specifies header code to not have cache
  sub no_cache {
      my ($r) = @_;
      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));
      $r->no_cache(1);
      $r->header_out("Expires" => $date);
- Line 2965  sub no_cache {
+ Line 3879  sub no_cache {
  sub content_type {
      my ($r,$type,$charset) = @_;
+     if ($r) {
+ 	#  Note that printout.pl calls this with undef for $r.
+ 	&no_cache($r);
+     }
+     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
      unless ($charset) {
  	$charset=&Apache::lonlocal::current_encoding;
      }
- Line 2980  sub content_type {
+ Line 3899  sub content_type {
  =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
  reference and $value is added to the array.
- Line 2988  reference and $value is added to the arr
+ Line 3907  reference and $value is added to the arr
  sub add_to_env {
    my ($name,$value)=@_;
-   if (defined($ENV{$name})) {
+   if (defined($env{$name})) {
-     if (ref($ENV{$name})) {
+     if (ref($env{$name})) {
        #already have multiple values
-       push(@{ $ENV{$name} },$value);
+       push(@{ $env{$name} },$value);
      } else {
        #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 {
-     $ENV{$name}=$value;
+     $env{$name}=$value;
    }
  }
- Line 3007  sub add_to_env {
+ Line 3926  sub add_to_env {
  =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.
  returns an array of values
- Line 3017  returns an array of values
+ Line 3936  returns an array of values
  sub get_env_multiple {
      my ($name) = @_;
      my @values;
-     if (defined($ENV{$name})) {
+     if (defined($env{$name})) {
          # exists is it an array
-         if (ref($ENV{$name})) {
+         if (ref($env{$name})) {
-             @values=@{ $ENV{$name} };
+             @values=@{ $env{$name} };
          } else {
-             $values[0]=$ENV{$name};
+             $values[0]=$env{$name};
          }
      }
      return(@values);
- Line 3040  sub get_env_multiple {
+ Line 3959  sub get_env_multiple {
  =item * upfile_store($r)
  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
  =cut
  sub upfile_store {
      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').
                             '/tmp/'.$datatoken.'.tmp';
          if ( open(my $fh,">$datafile") ) {
-             print $fh $ENV{'form.upfile'};
+             print $fh $env{'form.upfile'};
              close($fh);
          }
      }
- Line 3070  sub upfile_store {
+ Line 3989  sub upfile_store {
  =item * load_tmp_file($r)
  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
- Line 3080  sub load_tmp_file {
+ Line 3999  sub load_tmp_file {
      my @studentdata=();
      {
          my $studentfile = $r->dir_config('lonDaemons').
-                               '/tmp/'.$ENV{'form.datatoken'}.'.tmp';
+                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
          if ( open(my $fh,"<$studentfile") ) {
              @studentdata=<$fh>;
              close($fh);
          }
      }
-     $ENV{'form.upfile'}=join('',@studentdata);
+     $env{'form.upfile'}=join('',@studentdata);
  }
  =pod
- Line 3095  sub load_tmp_file {
+ Line 4014  sub load_tmp_file {
  Separate uploaded file into records
  returns array of records,
- needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}
+ needs $env{'form.upfile'} and $env{'form.upfiletype'}
  =cut
  sub upfile_record_sep {
-     if ($ENV{'form.upfiletype'} eq 'xml') {
+     if ($env{'form.upfiletype'} eq 'xml') {
      } 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 3110  sub upfile_record_sep {
+ Line 4034  sub upfile_record_sep {
  =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
+ sub takeleft {
+     my $index=shift;
+     return substr('0000'.$index,-4,4);
+ }
  sub record_sep {
      my $record=shift;
      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;
          foreach (split(/\s+/,$record)) {
              my $field=$_;
              $field=~s/^(\"|\')//;
              $field=~s/(\"|\')$//;
-             $components{$i}=$field;
+             $components{&takeleft($i)}=$field;
              $i++;
          }
-     } elsif ($ENV{'form.upfiletype'} eq 'tab') {
+     } elsif ($env{'form.upfiletype'} eq 'tab') {
          my $i=0;
          foreach (split(/\t/,$record)) {
              my $field=$_;
              $field=~s/^(\"|\')//;
              $field=~s/(\"|\')$//;
-             $components{$i}=$field;
+             $components{&takeleft($i)}=$field;
              $i++;
          }
      } else {
- Line 3151  sub record_sep {
+ Line 4080  sub record_sep {
                  $field=~s/^\s*$delimiter//;
                  $field=~s/$delimiter\s*$//;
              }
-             $components{$i}=$field;
+             $components{&takeleft($i)}=$field;
  	    $i++;
          }
      }
- Line 3188  sub upfile_select_html {
+ Line 4117  sub upfile_select_html {
      return $Str;
  }
+ sub get_samples {
+     my ($records,$toget) = @_;
+     my @samples=({});
+     my $got=0;
+     foreach my $rec (@$records) {
+ 	my %temp = &record_sep($rec);
+ 	if (! grep(/\S/, values(%temp))) { next; }
+ 	if (%temp) {
+ 	    $samples[$got]=\%temp;
+ 	    $got++;
+ 	    if ($got == $toget) { last; }
+ 	}
+     }
+     return \@samples;
+ }
  ######################################################
  ######################################################
- Line 3205  Apache Request ref, $records is an array
+ Line 4150  Apache Request ref, $records is an array
  ######################################################
  sub csv_print_samples {
      my ($r,$records) = @_;
-     my (%sone,%stwo,%sthree);
+     my $samples = &get_samples($records,3);
-     %sone=&record_sep($$records[0]);
-     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
-     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
-     #
      $r->print(&mt('Samples').'<br /><table border="2"><tr>');
-     foreach (sort({$a <=> $b} keys(%sone))) {
+     foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
          $r->print('<th>'.&mt('Column&nbsp;[_1]',($_+1)).'</th>'); }
      $r->print('</tr>');
-     foreach my $hash (\%sone,\%stwo,\%sthree) {
+     foreach my $hash (@$samples) {
  	$r->print('<tr>');
- 	foreach (sort({$a <=> $b} keys(%sone))) {
+ 	foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
  	    $r->print('<td>');
  	    if (defined($$hash{$_})) { $r->print($$hash{$_}); }
  	    $r->print('</td>');
- Line 3245  $d is an array of 2 element arrays (inte
+ Line 4187  $d is an array of 2 element arrays (inte
  ######################################################
  sub csv_print_select_table {
      my ($r,$records,$d) = @_;
-     my $i=0;my %sone;
+     my $i=0;
-     %sone=&record_sep($$records[0]);
+     my $samples = &get_samples($records,1);
      $r->print(&mt('Associate columns with student attributes.')."\n".
  	     '<table border="2"><tr>'.
                '<th>'.&mt('Attribute').'</th>'.
- Line 3258  sub csv_print_select_table {
+ Line 4200  sub csv_print_select_table {
  	$r->print('<td><select name=f'.$i.
  		  ' onchange="javascript:flip(this.form,'.$i.');">');
  	$r->print('<option value="none"></option>');
- 	foreach (sort({$a <=> $b} keys(%sone))) {
+ 	foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
  	    $r->print('<option value="'.$_.'"'.
-                       ($_ eq $defaultcol ? ' selected ' : '').
+                       ($_ eq $defaultcol ? ' selected="selected" ' : '').
                        '>Column '.($_+1).'</option>');
  	}
  	$r->print('</select></td></tr>'."\n");
- Line 3289  $d is an array of 2 element arrays (inte
+ Line 4231  $d is an array of 2 element arrays (inte
  ######################################################
  sub csv_samples_select_table {
      my ($r,$records,$d) = @_;
-     my %sone; my %stwo; my %sthree;
      my $i=0;
      #
+     my $samples = &get_samples($records,3);
      $r->print('<table border=2><tr><th>'.
                &mt('Field').'</th><th>'.&mt('Samples').'</th></tr>');
-     %sone=&record_sep($$records[0]);
-     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
+     foreach my $key (sort(keys(%{ $samples->[0] }))) {
-     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
-     #
-     foreach (sort keys %sone) {
  	$r->print('<tr><td><select name="f'.$i.'"'.
  		  ' onchange="javascript:flip(this.form,'.$i.');">');
- 	foreach (@$d) {
+ 	foreach my $option (@$d) {
- 	    my ($value,$display,$defaultcol)=@{ $_ };
+ 	    my ($value,$display,$defaultcol)=@{ $option };
  	    $r->print('<option value="'.$value.'"'.
-                       ($i eq $defaultcol ? ' selected ':'').'>'.
+                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
                        $display.'</option>');
  	}
  	$r->print('</select></td><td>');
- 	if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
+ 	foreach my $line (0..2) {
- 	if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }
+ 	    if (defined($samples->[$line]{$key})) {
- 	if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }
+ 		$r->print($samples->[$line]{$key}."<br />\n");
+ 	    }
+ 	}
  	$r->print('</td></tr>');
  	$i++;
      }
- Line 3399  the routine &Apache::lonnet::transfer_pr
+ Line 4340  the routine &Apache::lonnet::transfer_pr
  my $uniq=0;
  sub get_cgi_id {
      $uniq=($uniq+1)%100000;
-     return (time.'_'.$uniq);
+     return (time.'_'.$$.'_'.$uniq);
  }
  ############################################################
- Line 3818  Returns: both routines return nothing
+ Line 4759  Returns: both routines return nothing
  sub store_course_settings {
      # save to the environment
      # 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 $udom  = $env{'user.domain'};
+     my $uname = $env{'user.name'};
      my ($prefix,$Settings) = @_;
      my %SaveHash;
      my %AppHash;
      while (my ($setting,$type) = each(%$Settings)) {
-         my $basename = 'internal.'.$prefix.'.'.$setting;
+         my $basename = join('.','internal',$courseid,$prefix,$setting);
-         my $envname = 'course.'.$courseid.'.'.$basename;
+         my $envname = 'environment.'.$basename;
-         if (exists($ENV{'form.'.$setting})) {
+         if (exists($env{'form.'.$setting})) {
              # Save this value away
              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') {
                  my $stored_form;
-                 if (ref($ENV{'form.'.$setting})) {
+                 if (ref($env{'form.'.$setting})) {
                      $stored_form = join(',',
                                          map {
                                              &Apache::lonnet::escape($_);
-                                         } sort(@{$ENV{'form.'.$setting}}));
+                                         } sort(@{$env{'form.'.$setting}}));
                  } else {
                      $stored_form =
-                         &Apache::lonnet::escape($ENV{'form.'.$setting});
+                         &Apache::lonnet::escape($env{'form.'.$setting});
                  }
                  # Determine if the array contents are the same.
-                 if ($stored_form ne $ENV{$envname}) {
+                 if ($stored_form ne $env{$envname}) {
                      $SaveHash{$basename} = $stored_form;
                      $AppHash{$envname}   = $stored_form;
                  }
- Line 3853  sub store_course_settings {
+ Line 4795  sub store_course_settings {
          }
      }
      my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
-                                           $coursedom,
+                                           $udom,$uname);
-                                           $ENV{'course.'.$courseid.'.num'});
      if ($put_result !~ /^(ok|delayed)/) {
          &Apache::lonnet::logthis('unable to save form parameters, '.
                                   'got error:'.$put_result);
- Line 3865  sub store_course_settings {
+ Line 4806  sub store_course_settings {
  }
  sub restore_course_settings {
-     my $courseid = $ENV{'request.course.id'};
+     my $courseid = $env{'request.course.id'};
      my ($prefix,$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 = 'environment.internal.'.$courseid.'.'.$prefix.
              '.'.$setting;
-         if (exists($ENV{$envname})) {
+         if (exists($env{$envname})) {
              if ($type eq 'scalar') {
-                 $ENV{'form.'.$setting} = $ENV{$envname};
+                 $env{'form.'.$setting} = $env{$envname};
              } elsif ($type eq 'array') {
-                 $ENV{'form.'.$setting} = [
+                 $env{'form.'.$setting} = [
                                             map {
                                                 &Apache::lonnet::unescape($_);
-                                            } split(',',$ENV{$envname})
+                                            } split(',',$env{$envname})
                                             ];
              }
          }
- Line 3911  sub icon {
+ Line 4852  sub icon {
  		$curfext.".gif";
  	}
      }
-     return $iconname;
+     return &lonhttpdurl($iconname);
  }
  sub lonhttpdurl {

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

Removed from v.1.245
changed lines
	Added in v.1.344