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

Diff for /loncom/interface/loncommon.pm between versions 1.275 and 1.329

version 1.275, 2005/10/04 16:34:40 version 1.329, 2006/04/10 19:54:54
Line 58  use strict; Line 58  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::lonmenu();  use Apache::lonmenu();
 use Apache::lonlocal;  use Apache::lonlocal;
 use HTML::Entities;  use HTML::Entities;
Line 331  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'})
         || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
     '/'.$env{'request.course.sec'})
         ))
          || ($env{'request.role'}=~/^(au|dc|su)/)           || ($env{'request.role'}=~/^(au|dc|su)/)
           ) { return ''; }              ) { return ''; }  
    return (<<'ENDSTDBRW');     return (<<'ENDSTDBRW');
Line 362  ENDSTDBRW Line 364  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'})) {         if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
      && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
    '/'.$env{'request.course.sec'})) {
    return '';     return '';
        }         }
        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.         return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
Line 380  sub coursebrowser_javascript { Line 384  sub coursebrowser_javascript {
    return (<<ENDSTDBRW);     return (<<ENDSTDBRW);
 <script type="text/javascript" language="Javascript" >  <script type="text/javascript" language="Javascript" >
     var stdeditbrowser;      var stdeditbrowser;
     function opencrsbrowser(formname,uname,udom,desc,extra_element) {      function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) {
         var url = '/adm/pickcourse?';          var url = '/adm/pickcourse?';
         var filter;          var filter;
         if (filter != null) {          if (filter != null) {
Line 403  sub coursebrowser_javascript { Line 407  sub coursebrowser_javascript {
                 url += '&domainfilter='+extra_element;                  url += '&domainfilter='+extra_element;
             }              }
         }          }
           if (multflag !=null && multflag != '') {
               url += '&multiple='+multflag;
           }
         var title = 'Course_Browser';          var title = 'Course_Browser';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
         options += ',width=700,height=600';          options += ',width=700,height=600';
Line 414  ENDSTDBRW Line 421  ENDSTDBRW
 }  }
   
 sub selectcourse_link {  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.      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 {  sub check_uncheck_jscript {
Line 1149  sub domain_select { Line 1156  sub domain_select {
     } &get_domains;      } &get_domains;
     if ($multiple) {      if ($multiple) {
  $domains{''}=&mt('Any domain');   $domains{''}=&mt('Any domain');
  return &multiple_select_form($name,$value,4,%domains);   return &multiple_select_form($name,$value,4,\%domains);
     } else {      } else {
  return &select_form($name,$value,%domains);   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 {  sub multiple_select_form {
     my ($name,$value,$size,%hash)=@_;      my ($name,$value,$size,$hash,$order)=@_;
     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);      my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
     my $output='';      my $output='';
     if (! defined($size)) {      if (! defined($size)) {
         $size = 4;          $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'>";      $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="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";      $output.="</select>\n";
     return $output;      return $output;
Line 1565  sub authform_nochange{ Line 1594  sub authform_nochange{
               kerb_def_dom => 'MSU.EDU',                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" '.                       '<input type="radio" name="login" value="nochange" '.
                      'checked="checked" onclick="'.                       'checked="checked" onclick="'.
             "javascript:changed_radio('nochange',$in{'formname'});".'" />');              "javascript:changed_radio('nochange',$in{'formname'});".'" />').
       '</label>';
     return $result;      return $result;
 }  }
   
Line 1600  sub authform_kerberos{ Line 1630  sub authform_kerberos{
     my $jscall = "javascript:changed_radio('krb',$in{'formname'});";      my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
     my $result .= &mt      my $result .= &mt
         ('[_1] Kerberos authenticated with domain [_2] '.          ('[_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.' />',               'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />',
          '<input type="text" size="10" name="krbarg" '.           '</label><input type="text" size="10" name="krbarg" '.
              'value="'.$krbarg.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'" />',               '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;      return $result;
 }  }
   
Line 1632  sub authform_internal{ Line 1663  sub authform_internal{
     my $jscall = "javascript:changed_radio('int',$args{'formname'});";      my $jscall = "javascript:changed_radio('int',$args{'formname'});";
     my $result.=&mt      my $result.=&mt
         ('[_1] Internally authenticated (with initial password [_2])',          ('[_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.'" />',               ' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
          '<input type="text" size="10" name="intarg" '.$intarg.           '</label><input type="text" size="10" name="intarg" '.$intarg.
              ' onchange="'.$jscall.'" />');               ' onchange="'.$jscall.'" />');
     return $result;      return $result;
 }  }
Line 1659  sub authform_local{ Line 1690  sub authform_local{
   
     my $jscall = "javascript:changed_radio('loc',$in{'formname'});";      my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
     my $result.=&mt('[_1] Local Authentication with argument [_2]',      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.'" />',                          ' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
                     '<input type="text" size="10" name="locarg" '.$locarg.                      '</label><input type="text" size="10" name="locarg" '.$locarg.
                         ' onchange="'.$jscall.'" />');                          ' onchange="'.$jscall.'" />');
     return $result;      return $result;
 }  }
Line 1675  sub authform_filesystem{ Line 1706  sub authform_filesystem{
     my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";      my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
     my $result.= &mt      my $result.= &mt
         ('[_1] Filesystem Authenticated (with initial password [_2])',          ('[_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.'" />',           'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
          '<input type="text" size="10" name="fsysarg" value="" '.           '</label><input type="text" size="10" name="fsysarg" value="" '.
                   'onchange="'.$jscall.'" />');                    'onchange="'.$jscall.'" />');
     return $result;      return $result;
 }  }
Line 1893  if $first is set to 'lastname' then it r Line 1924  if $first is set to 'lastname' then it r
   
 =cut  =cut
   
   
 ###############################################################  ###############################################################
 sub plainname {  sub plainname {
     my ($uname,$udom,$first)=@_;      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'},      my $name=&Apache::lonnet::format_name($names{'firstname'},
   $names{'middlename'},    $names{'middlename'},
   $names{'lastname'},    $names{'lastname'},
Line 1929  if the user does not Line 1959  if the user does not
   
 sub nickname {  sub nickname {
     my ($uname,$udom)=@_;      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'};      my $name=$names{'nickname'};
     if ($name) {      if ($name) {
        $name='&quot;'.$name.'&quot;';          $name='&quot;'.$name.'&quot;'; 
Line 1954  sub nickname { Line 1972  sub nickname {
     return $name;      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  # ------------------------------------------------------------------ Screenname
   
Line 2509  sub pgrdlink { Line 2541  sub pgrdlink {
 Inputs: $text $uname $udom $symb $target  Inputs: $text $uname $udom $symb $target
   
 Returns: A link to parmset.pm such as to see the PPRM view of a  Returns: A link to parmset.pm such as to see the PPRM view of a
 student andn resource  student and a specific resource
   
 =cut  =cut
   
Line 2704  Inputs: Line 2736  Inputs:
 =item * $forcereg, if page should register as content page (relevant for   =item * $forcereg, if page should register as content page (relevant for 
             text interface only)              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 bg coor on a webpage to a specific value
   
 =back  =back
   
 Returns: A uniform header for LON-CAPA web pages.    Returns: A uniform header for LON-CAPA web pages.  
Line 2714  other decorations will be returned. Line 2755  other decorations will be returned.
 =cut  =cut
   
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,$notopbar)=@_;      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
    $notopbar,$bgcolor)=@_;
     $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);
     my $pgbg=&designparm($function.'.pgbg',$domain);      my $pgbg= $bgcolor || &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 $link=&designparm($function.'.link',$domain);      my $link=&designparm($function.'.link',$domain);
Line 2726  sub bodytag { Line 2768  sub bodytag {
     my $vlink=&designparm($function.'.vlink',$domain);      my $vlink=&designparm($function.'.vlink',$domain);
     my $sidebg=&designparm($function.'.sidebg',$domain);      my $sidebg=&designparm($function.'.sidebg',$domain);
 # Accessibility font enhance  # Accessibility font enhance
     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;';
Line 2745  sub bodytag { Line 2786  sub bodytag {
 # Port for miniserver  # Port for miniserver
     my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};      my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
     if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }      if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
       my $extra_body_attr;
       if ($forcereg) {
    if (ref($addentries)) {
       $addentries->{'onload'}   = &Apache::lonmenu::loadevents().
    $addentries->{'onload'};
       $addentries->{'onunload'} = &Apache::lonmenu::unloadevents().
    $addentries->{'onunload'};
    } else {
       $extra_body_attr.=' onload="'.&Apache::lonmenu::loadevents().
    '" onunload="'.&Apache::lonmenu::unloadevents().'"';
    }
       }
       if (!ref($addentries)) {
    $extra_body_attr .= $addentries;
       } else {
    foreach my $attr (keys(%$addentries)) {
       $extra_body_attr .= " $attr=\"".$addentries->{$attr}.'" ';
    }
       }
   
 # construct main body tag  # construct main body tag
     my $bodytag = <<END;      my $bodytag = <<END;
 <style type="text/css">  <style type="text/css">
 h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }  h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
 a:focus { color: red; background: yellow }   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>  </style>
 <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" $extra_body_attr>
 END  END
     &Apache::lontexconvert::jsMath_reset();      &Apache::lontexconvert::jsMath_reset();
     if ($env{'environment.texengine'} eq 'jsMath') {      if ($env{'environment.texengine'} eq 'jsMath' ||
    $env{'form.texengine'}        eq 'jsMath' ) {
  $bodytag.=&Apache::lontexconvert::jsMath_header();   $bodytag.=&Apache::lontexconvert::jsMath_header();
     }      }
   
Line 2855  ENDROLE Line 2922  ENDROLE
         $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};          $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
         $dc_info = '('.$dc_info.')';          $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>';
     #      #
     return(<<ENDBODY);      return(<<ENDBODY);
 $bodytag  $bodytag
Line 2865  $upperleft</td> Line 2934  $upperleft</td>
 </tr>  </tr>
 <tr>  <tr>
 <td rowspan="3" bgcolor="$tabbg">  <td rowspan="3" bgcolor="$tabbg">
 $titleinfo $dc_info  $titleinfo $dc_info $menu
 </td><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'}
Line 2891  ENDBODY Line 2960  ENDBODY
   
 =back  =back
   
 =head1 HTTP Helpers  =head1 HTML Helpers
   
 =over 4  =over 4
   
Line 2899  ENDBODY Line 2968  ENDBODY
   
 Returns a uniform footer for LON-CAPA web pages.  Returns a uniform footer for LON-CAPA web pages.
   
 Inputs:   Inputs: none
   
 =over 4  
   
 =back  =back
   
 Returns: A uniform footer for LON-CAPA web pages.    
   
 =cut  =cut
   
 sub endbodytag {  sub endbodytag {
     my $endbodytag='</body>';      my $endbodytag='</body>';
     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;      $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;      return $endbodytag;
 }  }
   
   =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>'.
    &Apache::lonxml::fontsettings().
    &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 * &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
   
   =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 = 
    &Apache::lonxml::xmlbegin().
    &headtag($title,$head_extra,\%head_args).&endheadtag().
    &bodytag($title, 
    $args->{'function'},       $args->{'add_entries'},
    $args->{'only_body'},      $args->{'domain'},
    $args->{'force_register'}, $args->{'body_title'},
    $args->{'no_nav_bar'},     $args->{'bgcolor'});
       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
   =back
   
   =cut
   
   sub end_page {
       my ($args) = @_;
       #&Apache::lonnet::logthis("end_page ".join(':',caller(0)));
       $env{'internal.end_page'}++;
       my $result = &endbodytag()."\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  =pod
   
   =over 4
   
 =item get_users_function  =item get_users_function
   
 Used by &bodytag to determine the current users primary role.  Used by &bodytag to determine the current users primary role.
Line 3018  Returns number of sections. Line 3329  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 3053  sub get_sections { Line 3363  sub get_sections {
 }  }
   
 ###############################################  ###############################################
                                                                                     
   =pod
                                                                                     
   =item coursegroups
   
   Retrieve information about groups in a course,
   
   Input:
   1. Reference to hash to populate with group information. 
   2. Optional course domain
   3. Optional course number
   4. 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.     
   
   =cut 
   
   ###############################################
   
   sub coursegroups {
       my ($curr_groups,$cdom,$cnum,$group) = @_;
       my $numgroups;
       if (!defined($cdom) || !defined($cnum)) {
           my $cid =  $env{'request.course.id'};
           $cdom = $env{'course.'.$cid.'.domain'};
           $cnum = $env{'course.'.$cid.'.num'};
       }
       %{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
       my ($tmp) = keys(%{$curr_groups});
       if ($tmp=~/^error:/) {
           unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') {
               &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.
                                                                      $cdom);
           }
           $numgroups = 0;
       } else {
           $numgroups = keys(%{$curr_groups});
       }
       return $numgroups;
   }
   
   ###############################################
   
   =pod
   
   =item get_group_settings
   
   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  =pod
                                                                                                                                                                   
Line 3062  Retrieves usernames:domains for users in Line 3519  Retrieves usernames:domains for users in
 with specific role(s), and access status.   with specific role(s), and access status. 
   
 Incoming parameters:  Incoming parameters:
 1. course_id  1. course domain
 2. course domain  2. course number
 3. course number  3. access status: users must have - either active, 
 4. access status: users must have - either active,   
 previous, future, or all.  previous, future, or all.
 5. reference to array of permissible roles  4. reference to array of permissible roles
   5. reference to array of section restrictions (optional)
 6. reference to results object (hash of hashes).  6. reference to results object (hash of hashes).
   7. reference to optional userdata hash
 Keys of top level hash are roles.  Keys of top level hash are roles.
 Keys of inner hashes are username:domain, with   Keys of inner hashes are username:domain, with 
 values set to access type.  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  =cut
                                                                                                                                                                   
 ###############################################  ###############################################
                                                                                                                                                                   
 sub get_course_users {  sub get_course_users {
     my ($course_id,$cdom,$cnum,$types,$roles,$users) = @_;      my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_;
     if (grep/^st$/,@{$roles}) {      my %idx = ();
         my $statusidx = &Apache::loncoursedata::CL_STATUS;  
         my $startidx = &Apache::loncoursedata::CL_START;      $idx{udom} = &Apache::loncoursedata::CL_SDOM();
         my $endidx = &Apache::loncoursedata::CL_END;      $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($course_id,$cdom,$cnum);      $idx{end} = &Apache::loncoursedata::CL_END();
         foreach my $student (keys (%{$classlist})) {      $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 (defined($$types{'active'})) {              if (defined($$types{'active'})) {
                 if ($$classlist{$student}[$statusidx] eq 'Active') {                  if ($$classlist{$student}[$idx{status}] eq 'Active') {
                     push(@{$$users{st}{$student}},'active');                      push(@{$$users{st}{$student}},'active');
                       $match = 1;
                 }                  }
             }              }
             if (defined($$types{'previous'})) {              if (defined($$types{'previous'})) {
                 if ($$classlist{$student}[$endidx] <= time) {                  if ($$classlist{$student}[$idx{end}] <= $now) {
                     push(@{$$users{st}{$student}},'previous');                      push(@{$$users{st}{$student}},'previous');
                       $match = 1;
                 }                  }
             }              }
             if (defined($$types{'future'})) {              if (defined($$types{'future'})) {
                 if (($$classlist{$student}[$startidx] > 0) && ($$classlist{$student}[$endidx] > time) || ($$classlist{$student}[$endidx] == 0) || ($$classlist{$student}[$endidx] eq '')) {                  if (($$classlist{$student}[$idx{start}] > $now) && ($$classlist{$student}[$idx{end}] > $now) || ($$classlist{$student}[$idx{end}] == 0) || ($$classlist{$student}[$idx{end}] eq '')) {
                     push(@{$$users{st}{$student}},'future');                      push(@{$$users{st}{$student}},'future');
                       $match = 1;
                 }                  }
             }              }
               if ($match && defined($userdata)) {
                   $$userdata{$student} = $$classlist{$student};
               }
         }          }
     }      }
     if ((@{$roles} > 0) && (@{$roles} ne "st")) {      if ((@{$roles} > 0) && (@{$roles} ne "st")) {
         my ($cdom,$cnum) = split/_/,$course_id;  
         my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);          my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);
         foreach my $person (@coursepersonnel) {          foreach my $person (@coursepersonnel) {
               my $match = 0;
             my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);              my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);
             $user =~ s/:$//;              $user =~ s/:$//;
             if (($role) && (grep/^$role$/,@{$roles})) {              if (($role) && (grep(/^\Q$role\E$/,@{$roles}))) {
                 my ($uname,$udom) = split/:/,$user;                  my ($uname,$udom,$usec) = split(/:/,$user);
                   if ($usec ne '' && (ref($sections) eq 'ARRAY') && 
       @{$sections} > 0) {
       unless(grep(/^\Q$usec\E$/,@{$sections})) {
    next;
       }
                   }
                 if ($uname ne '' && $udom ne '') {                  if ($uname ne '' && $udom ne '') {
                     my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);                      my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);
                     foreach my $type (keys %{$types}) {                       foreach my $type (keys(%{$types})) { 
                         if ($status eq $type) {                          if ($status eq $type) {
                             $$users{$role}{$user} = $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);
       }
                 }                  }
             }              }
         }          }
Line 3124  sub get_course_users { Line 3633  sub get_course_users {
     return;      return;
 }  }
   
   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;
   }
   
 ###############################################  ###############################################
   
Line 3192  sub get_posted_cgi { Line 3708  sub get_posted_cgi {
     }      }
  }   }
     }      }
   #
   # Digested POSTed values
   #
   # Remember the way this was originally done (GET or POST)
   #
     $env{'request.method'}=$ENV{'REQUEST_METHOD'};      $env{'request.method'}=$ENV{'REQUEST_METHOD'};
     $r->method_number(M_GET);  #
   # There may also be stuff in the query string
   # Tell subsequent handlers that this was GET, not POST, so they can access query string.
   # Also, unset POSTed content length to cover all tracks.
   #
   
   # This does not work, because M_GET is not defined (if it's defined, it is just 0). 
   # Commenting out for now ... not sure if harm is done.
   #    $r->method_number(M_GET);
   
     $r->method('GET');      $r->method('GET');
     $r->headers_in->unset('Content-length');      $r->headers_in->unset('Content-length');
 }  }
Line 3264  sub no_cache { Line 3794  sub no_cache {
   
 sub content_type {  sub content_type {
     my ($r,$type,$charset) = @_;      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'; }      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 3498  sub upfile_select_html { Line 4032  sub upfile_select_html {
     return $Str;      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 3515  Apache Request ref, $records is an array Line 4065  Apache Request ref, $records is an array
 ######################################################  ######################################################
 sub csv_print_samples {  sub csv_print_samples {
     my ($r,$records) = @_;      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>');      $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('<th>'.&mt('Column&nbsp;[_1]',($_+1)).'</th>'); }
     $r->print('</tr>');      $r->print('</tr>');
     foreach my $hash (\%sone,\%stwo,\%sthree) {      foreach my $hash (@$samples) {
  $r->print('<tr>');   $r->print('<tr>');
  foreach (sort({$a <=> $b} keys(%sone))) {   foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
     $r->print('<td>');      $r->print('<td>');
     if (defined($$hash{$_})) { $r->print($$hash{$_}); }      if (defined($$hash{$_})) { $r->print($$hash{$_}); }
     $r->print('</td>');      $r->print('</td>');
Line 3555  $d is an array of 2 element arrays (inte Line 4102  $d is an array of 2 element arrays (inte
 ######################################################  ######################################################
 sub csv_print_select_table {  sub csv_print_select_table {
     my ($r,$records,$d) = @_;      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".      $r->print(&mt('Associate columns with student attributes.')."\n".
      '<table border="2"><tr>'.       '<table border="2"><tr>'.
               '<th>'.&mt('Attribute').'</th>'.                '<th>'.&mt('Attribute').'</th>'.
Line 3568  sub csv_print_select_table { Line 4115  sub csv_print_select_table {
  $r->print('<td><select name=f'.$i.   $r->print('<td><select name=f'.$i.
   ' onchange="javascript:flip(this.form,'.$i.');">');    ' onchange="javascript:flip(this.form,'.$i.');">');
  $r->print('<option value="none"></option>');   $r->print('<option value="none"></option>');
  foreach (sort({$a <=> $b} keys(%sone))) {   foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
     $r->print('<option value="'.$_.'"'.      $r->print('<option value="'.$_.'"'.
                       ($_ eq $defaultcol ? ' selected="selected" ' : '').                        ($_ eq $defaultcol ? ' selected="selected" ' : '').
                       '>Column '.($_+1).'</option>');                        '>Column '.($_+1).'</option>');
Line 3599  $d is an array of 2 element arrays (inte Line 4146  $d is an array of 2 element arrays (inte
 ######################################################  ######################################################
 sub csv_samples_select_table {  sub csv_samples_select_table {
     my ($r,$records,$d) = @_;      my ($r,$records,$d) = @_;
     my %sone; my %stwo; my %sthree;  
     my $i=0;      my $i=0;
     #      #
       my $samples = &get_samples($records,3);
     $r->print('<table border=2><tr><th>'.      $r->print('<table border=2><tr><th>'.
               &mt('Field').'</th><th>'.&mt('Samples').'</th></tr>');                &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.'"'.   $r->print('<tr><td><select name="f'.$i.'"'.
   ' onchange="javascript:flip(this.form,'.$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.'"'.      $r->print('<option value="'.$value.'"'.
                       ($i eq $defaultcol ? ' selected="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"); }   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>');   $r->print('</td></tr>');
  $i++;   $i++;
     }      }
Line 3709  the routine &Apache::lonnet::transfer_pr Line 4255  the routine &Apache::lonnet::transfer_pr
 my $uniq=0;  my $uniq=0;
 sub get_cgi_id {  sub get_cgi_id {
     $uniq=($uniq+1)%100000;      $uniq=($uniq+1)%100000;
     return (time.'_'.$uniq);      return (time.'_'.$$.'_'.$uniq);
 }  }
   
 ############################################################  ############################################################
Line 4129  sub store_course_settings { Line 4675  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 $udom  = $env{'user.domain'};
       my $uname = $env{'user.name'};
     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 = 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              # Save this value away
             if ($type eq 'scalar' &&              if ($type eq 'scalar' &&
Line 4163  sub store_course_settings { Line 4710  sub store_course_settings {
         }          }
     }      }
     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,      my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
                                           $coursedom,                                            $udom,$uname);
                                           $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 4179  sub restore_course_settings { Line 4725  sub restore_course_settings {
     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 = 'environment.internal.'.$courseid.'.'.$prefix.
             '.'.$setting;              '.'.$setting;
         if (exists($env{$envname})) {          if (exists($env{$envname})) {
             if ($type eq 'scalar') {              if ($type eq 'scalar') {
Removed from v.1.275  
changed lines
  Added in v.1.329

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