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

Diff for /loncom/interface/loncommon.pm between versions 1.257 and 1.258

version 1.257, 2005/03/22 15:32:07 version 1.258, 2005/04/07 06:56:22
Line 55  redundancy from other modules and increa Line 55  redundancy from other modules and increa
 package Apache::loncommon;  package Apache::loncommon;
   
 use strict;  use strict;
 use Apache::lonnet();  use Apache::lonnet;
 use GDBM_File;  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
Line 311  END Line 311  END
 }  }
   
 sub lastresurl {  sub lastresurl {
     if ($ENV{'environment.lastresurl'}) {      if ($env{'environment.lastresurl'}) {
  return $ENV{'environment.lastresurl'}   return $env{'environment.lastresurl'}
     } else {      } else {
  return '/res';   return '/res';
     }      }
Line 329  sub storeresurl { Line 329  sub storeresurl {
   
 sub studentbrowser_javascript {  sub studentbrowser_javascript {
    unless (     unless (
             (($ENV{'request.course.id'}) &&               (($env{'request.course.id'}) && 
              (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})))               (&Apache::lonnet::allowed('srm',$env{'request.course.id'})))
          || ($ENV{'request.role'}=~/^(au|dc|su)/)           || ($env{'request.role'}=~/^(au|dc|su)/)
           ) { return ''; }              ) { return ''; }  
    return (<<'ENDSTDBRW');     return (<<'ENDSTDBRW');
 <script type="text/javascript" language="Javascript" >  <script type="text/javascript" language="Javascript" >
Line 360  ENDSTDBRW Line 360  ENDSTDBRW
   
 sub selectstudent_link {  sub selectstudent_link {
    my ($form,$unameele,$udomele)=@_;     my ($form,$unameele,$udomele)=@_;
    if ($ENV{'request.course.id'}) {       if ($env{'request.course.id'}) {  
        unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {         unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
    return '';     return '';
        }         }
        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.         return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'");'."'>".&mt('Select User')."</a>";          '","'.$udomele.'");'."'>".&mt('Select User')."</a>";
    }     }
    if ($ENV{'request.role'}=~/^(au|dc|su)/) {     if ($env{'request.role'}=~/^(au|dc|su)/) {
        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.         return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";          '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
    }     }
Line 593  sub help_open_topic { Line 593  sub help_open_topic {
     my ($topic, $text, $stayOnPage, $width, $height) = @_;      my ($topic, $text, $stayOnPage, $width, $height) = @_;
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     if ($ENV{'browser.interface'} eq 'textual' ||      if ($env{'browser.interface'} eq 'textual' ||
  $ENV{'environment.remote'} eq 'off' ) {   $env{'environment.remote'} eq 'off' ) {
  $stayOnPage=1;   $stayOnPage=1;
     }      }
     $width = 350 if (not defined $width);      $width = 350 if (not defined $width);
Line 659  sub help_open_menu { Line 659  sub help_open_menu {
     my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;      my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     if ($ENV{'browser.interface'} eq 'textual' ||      if ($env{'browser.interface'} eq 'textual' ||
         $ENV{'environment.remote'} eq 'off' ) {          $env{'environment.remote'} eq 'off' ) {
         $stayOnPage=1;          $stayOnPage=1;
     }      }
     $width = 620 if (not defined $width);      $width = 620 if (not defined $width);
Line 742  ENDTEMPLATE Line 742  ENDTEMPLATE
   
 sub help_open_bug {  sub help_open_bug {
     my ($topic, $text, $stayOnPage, $width, $height) = @_;      my ($topic, $text, $stayOnPage, $width, $height) = @_;
     unless ($ENV{'user.adv'}) { return ''; }      unless ($env{'user.adv'}) { return ''; }
     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }      unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     if ($ENV{'browser.interface'} eq 'textual' ||      if ($env{'browser.interface'} eq 'textual' ||
  $ENV{'environment.remote'} eq 'off' ) {   $env{'environment.remote'} eq 'off' ) {
  $stayOnPage=1;   $stayOnPage=1;
     }      }
     $width = 600 if (not defined $width);      $width = 600 if (not defined $width);
Line 787  ENDTEMPLATE Line 787  ENDTEMPLATE
   
 sub help_open_faq {  sub help_open_faq {
     my ($topic, $text, $stayOnPage, $width, $height) = @_;      my ($topic, $text, $stayOnPage, $width, $height) = @_;
     unless ($ENV{'user.adv'}) { return ''; }      unless ($env{'user.adv'}) { return ''; }
     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }      unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     if ($ENV{'browser.interface'} eq 'textual' ||      if ($env{'browser.interface'} eq 'textual' ||
  $ENV{'environment.remote'} eq 'off' ) {   $env{'environment.remote'} eq 'off' ) {
  $stayOnPage=1;   $stayOnPage=1;
     }      }
     $width = 350 if (not defined $width);      $width = 350 if (not defined $width);
Line 865  pretty much any HTML. Line 865  pretty much any HTML.
   
 sub change_content_javascript {  sub change_content_javascript {
     # If we're on Netscape 4, we need to use Layer-based code      # If we're on Netscape 4, we need to use Layer-based code
     if ($ENV{'browser.type'} eq 'netscape' &&      if ($env{'browser.type'} eq 'netscape' &&
  $ENV{'browser.version'} =~ /^4\./) {   $env{'browser.version'} =~ /^4\./) {
  return (<<NETSCAPE4);   return (<<NETSCAPE4);
  function change(name, content) {   function change(name, content) {
     doc = document.layers[name+"___escape"].layers[0].document;      doc = document.layers[name+"___escape"].layers[0].document;
Line 903  the area will originally contain, which Line 903  the area will originally contain, which
 sub changable_area {  sub changable_area {
     my ($name, $origContent) = @_;      my ($name, $origContent) = @_;
   
     if ($ENV{'browser.type'} eq 'netscape' &&      if ($env{'browser.type'} eq 'netscape' &&
  $ENV{'browser.version'} =~ /^4\./) {   $env{'browser.version'} =~ /^4\./) {
  # If this is netscape 4, we need to use the Layer tag   # 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>";   return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
     } else {      } else {
Line 1024  sub create_workbook { Line 1024  sub create_workbook {
         #          #
     # Create the excel spreadsheet      # Create the excel spreadsheet
     my $filename = '/prtspool/'.      my $filename = '/prtspool/'.
         $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.          $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
         time.'_'.rand(1000000000).'.xls';          time.'_'.rand(1000000000).'.xls';
     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);      my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
     if (! defined($workbook)) {      if (! defined($workbook)) {
Line 1067  sub create_text_file { Line 1067  sub create_text_file {
     if (! defined($suffix)) { $suffix = 'txt'; };      if (! defined($suffix)) { $suffix = 'txt'; };
     my $fh;      my $fh;
     my $filename = '/prtspool/'.      my $filename = '/prtspool/'.
         $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.          $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
         time.'_'.rand(1000000000).'.'.$suffix;          time.'_'.rand(1000000000).'.'.$suffix;
     $fh = Apache::File->new('>/home/httpd'.$filename);      $fh = Apache::File->new('>/home/httpd'.$filename);
     if (! defined($fh)) {      if (! defined($fh)) {
Line 1904  if the user does not Line 1904  if the user does not
 sub nickname {  sub nickname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     my %names;      my %names;
     if ($uname eq $ENV{'user.name'} &&      if ($uname eq $env{'user.name'} &&
  $udom eq $ENV{'user.domain'}) {   $udom eq $env{'user.domain'}) {
  %names=('nickname'   => $ENV{'environment.nickname'}  ,   %names=('nickname'   => $env{'environment.nickname'}  ,
  'firstname'  => $ENV{'environment.firstname'} ,   'firstname'  => $env{'environment.firstname'} ,
  'middlename' => $ENV{'environment.middlename'},   'middlename' => $env{'environment.middlename'},
  'lastname'   => $ENV{'environment.lastname'}  ,   'lastname'   => $env{'environment.lastname'}  ,
  'generation' => $ENV{'environment.generation'});   'generation' => $env{'environment.generation'});
     } else {      } else {
  %names=&Apache::lonnet::get('environment',   %names=&Apache::lonnet::get('environment',
     ['nickname','firstname','middlename',      ['nickname','firstname','middlename',
Line 1941  Gets a users screenname and returns it a Line 1941  Gets a users screenname and returns it a
   
 sub screenname {  sub screenname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     if ($uname eq $ENV{'user.name'} &&      if ($uname eq $env{'user.name'} &&
  $udom eq $ENV{'user.domain'}) {return $ENV{'environment.screenname'};}   $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);      my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
     return $names{'screenname'};      return $names{'screenname'};
 }  }
Line 2190  sub display_languages { Line 2190  sub display_languages {
  $languages{$_}=1;   $languages{$_}=1;
     }      }
     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);      &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
     if ($ENV{'form.displaylanguage'}) {      if ($env{'form.displaylanguage'}) {
  foreach (split(/\s*(\,|\;|\:)\s*/,$ENV{'form.displaylanguage'})) {   foreach (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
     $languages{$_}=1;      $languages{$_}=1;
         }          }
     }      }
Line 2200  sub display_languages { Line 2200  sub display_languages {
   
 sub preferred_languages {  sub preferred_languages {
     my @languages=();      my @languages=();
     if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {      if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
  @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,   @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
          $ENV{'course.'.$ENV{'request.course.id'}.'.languages'}));           $env{'course.'.$env{'request.course.id'}.'.languages'}));
     }      }
     if ($ENV{'environment.languages'}) {      if ($env{'environment.languages'}) {
  @languages=split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'});   @languages=split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'});
     }      }
     my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];      my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];
     if ($browser) {      if ($browser) {
  @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));   @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));
     }      }
     if ($Apache::lonnet::domain_lang_def{$ENV{'user.domain'}}) {      if ($Apache::lonnet::domain_lang_def{$env{'user.domain'}}) {
  @languages=(@languages,   @languages=(@languages,
  $Apache::lonnet::domain_lang_def{$ENV{'user.domain'}});   $Apache::lonnet::domain_lang_def{$env{'user.domain'}});
     }      }
     if ($Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}}) {      if ($Apache::lonnet::domain_lang_def{$env{'request.role.domain'}}) {
  @languages=(@languages,   @languages=(@languages,
  $Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}});   $Apache::lonnet::domain_lang_def{$env{'request.role.domain'}});
     }      }
     if ($Apache::lonnet::domain_lang_def{      if ($Apache::lonnet::domain_lang_def{
                           $Apache::lonnet::perlvar{'lonDefDomain'}}) {                            $Apache::lonnet::perlvar{'lonDefDomain'}}) {
Line 2539  sub maketime { Line 2539  sub maketime {
 sub findallcourses {  sub findallcourses {
     my %courses=();      my %courses=();
     my $now=time;      my $now=time;
     foreach (keys %ENV) {      foreach (keys %env) {
  if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {   if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {
     my ($starttime,$endtime)=$ENV{$_};      my ($starttime,$endtime)=$env{$_};
             my $active=1;              my $active=1;
             if ($starttime) {              if ($starttime) {
  if ($now<$starttime) { $active=0; }   if ($now<$starttime) { $active=0; }
Line 2578  sub determinedomain { Line 2578  sub determinedomain {
    if (! $domain) {     if (! $domain) {
         # Determine domain if we have not been given one          # Determine domain if we have not been given one
         $domain = $Apache::lonnet::perlvar{'lonDefDomain'};          $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
         if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; }          if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
         if ($ENV{'request.role.domain'}) {           if ($env{'request.role.domain'}) { 
             $domain=$ENV{'request.role.domain'};               $domain=$env{'request.role.domain'}; 
         }          }
     }      }
     return $domain;      return $domain;
Line 2625  Returns: value of designparamter $which Line 2625  Returns: value of designparamter $which
 ##############################################  ##############################################
 sub designparm {  sub designparm {
     my ($which,$domain)=@_;      my ($which,$domain)=@_;
     if ($ENV{'browser.blackwhite'} eq 'on') {      if ($env{'browser.blackwhite'} eq 'on') {
  if ($which=~/\.(font|alink|vlink|link)$/) {   if ($which=~/\.(font|alink|vlink|link)$/) {
     return '#000000';      return '#000000';
  }   }
Line 2636  sub designparm { Line 2636  sub designparm {
     return '#CCCCCC';      return '#CCCCCC';
  }   }
     }      }
     if ($ENV{'environment.color.'.$which}) {      if ($env{'environment.color.'.$which}) {
  return $ENV{'environment.color.'.$which};   return $env{'environment.color.'.$which};
     }      }
     $domain=&determinedomain($domain);      $domain=&determinedomain($domain);
     if ($designhash{$domain.'.'.$which}) {      if ($designhash{$domain.'.'.$which}) {
Line 2703  sub bodytag { Line 2703  sub bodytag {
 # Accessibility font enhance  # Accessibility font enhance
     unless ($addentries) { $addentries=''; }      unless ($addentries) { $addentries=''; }
     my $addstyle='';      my $addstyle='';
     if ($ENV{'browser.fontenhance'} eq 'on') {      if ($env{'browser.fontenhance'} eq 'on') {
  $addstyle=' font-size: x-large;';   $addstyle=' font-size: x-large;';
     }      }
  # role and realm   # role and realm
     my ($role,$realm)      my ($role,$realm)
        =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);         =&Apache::lonnet::plaintext((split(/\./,$env{'request.role'}))[0]);
 # realm  # realm
     if ($ENV{'request.course.id'}) {      if ($env{'request.course.id'}) {
  $realm=   $realm=
          $ENV{'course.'.$ENV{'request.course.id'}.'.description'};           $env{'course.'.$env{'request.course.id'}.'.description'};
     }      }
     unless ($realm) { $realm='&nbsp;'; }      unless ($realm) { $realm='&nbsp;'; }
 # Set messages  # Set messages
Line 2729  a:focus { color: red; background: yellow Line 2729  a:focus { color: red; background: yellow
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"  <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
 style="margin-top: 0px;$addstyle" $addentries>  style="margin-top: 0px;$addstyle" $addentries>
 END  END
     if ($ENV{'environment.texengine'} eq 'jsMath') {      if ($env{'environment.texengine'} eq 'jsMath') {
  $bodytag.='<script type="text/javascript">   $bodytag.='<script type="text/javascript">
                      function NoFontMessage () {}                       function NoFontMessage () {}
                    </script>'."\n".                     </script>'."\n".
Line 2740  END Line 2740  END
                    $lonhttpdPort.$img.'" alt="'.$function.'" />';                     $lonhttpdPort.$img.'" alt="'.$function.'" />';
     if ($bodyonly) {      if ($bodyonly) {
         return $bodytag;          return $bodytag;
     } elsif ($ENV{'browser.interface'} eq 'textual') {      } elsif ($env{'browser.interface'} eq 'textual') {
 # Accessibility  # Accessibility
                       
         return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',          return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
                                                       $forcereg).                                                        $forcereg).
                '<h1>LON-CAPA: '.$title.'</h1>';                 '<h1>LON-CAPA: '.$title.'</h1>';
     } elsif ($ENV{'environment.remote'} eq 'off') {      } elsif ($env{'environment.remote'} eq 'off') {
 # No Remote  # No Remote
  my $roleinfo=(<<ENDROLE);   my $roleinfo=(<<ENDROLE);
 <td bgcolor="$tabbg" align="right">  <td bgcolor="$tabbg" align="right">
 <font size="2" face="Arial, Helvetica, sans-serif">  <font size="2" face="Arial, Helvetica, sans-serif">
     $ENV{'environment.firstname'}      $env{'environment.firstname'}
     $ENV{'environment.middlename'}      $env{'environment.middlename'}
     $ENV{'environment.lastname'}      $env{'environment.lastname'}
     $ENV{'environment.generation'}      $env{'environment.generation'}
     </font>&nbsp;      </font>&nbsp;
 <br />  <br />
 <font size="2" face="Arial, Helvetica, sans-serif">$role</font>&nbsp;  <font size="2" face="Arial, Helvetica, sans-serif">$role</font>&nbsp;
Line 2768  ENDROLE Line 2768  ENDROLE
             $titleinfo = $customtitle;              $titleinfo = $customtitle;
         }          }
   
  if ($ENV{'request.state'} eq 'construct') {   if ($env{'request.state'} eq 'construct') {
     my ($uname,$thisdisfn)=      my ($uname,$thisdisfn)=
  ($ENV{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);   ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
     my $formaction='/priv/'.$uname.'/'.$thisdisfn;      my $formaction='/priv/'.$uname.'/'.$thisdisfn;
     $formaction=~s/\/+/\//g;      $formaction=~s/\/+/\//g;
             unless ($customtitle) {  #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm                unless ($customtitle) {  #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm  
Line 2798  ENDROLE Line 2798  ENDROLE
                          'cellspacing="3" cellpadding="3">'.                           'cellspacing="3" cellpadding="3">'.
                          '<tr><td rowspan="3" bgcolor="'.$tabbg.'">'.                           '<tr><td rowspan="3" bgcolor="'.$tabbg.'">'.
                          $titleinfo.'</td>'.$roleinfo.'</tr></table>';                           $titleinfo.'</td>'.$roleinfo.'</tr></table>';
         if ($ENV{'request.state'} eq 'construct') {          if ($env{'request.state'} eq 'construct') {
             $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);              $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);
  } else {   } else {
             $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).              $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).
Line 2817  ENDROLE Line 2817  ENDROLE
     #      #
     # Extra info if you are the DC      # Extra info if you are the DC
     my $dc_info = '';      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'}.'/'})) {                                   '.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.')';          $dc_info = '('.$dc_info.')';
     }      }
     #      #
Line 2837  $upperleft</td> Line 2837  $upperleft</td>
 $titleinfo $dc_info  $titleinfo $dc_info
 </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'}
     $ENV{'environment.middlename'}      $env{'environment.middlename'}
     $ENV{'environment.lastname'}      $env{'environment.lastname'}
     $ENV{'environment.generation'}      $env{'environment.generation'}
     </font>&nbsp;      </font>&nbsp;
 </td>  </td>
 </tr>  </tr>
Line 2880  Returns: A uniform footer for LON-CAPA w Line 2880  Returns: A uniform footer for LON-CAPA w
   
 sub endbodytag {  sub endbodytag {
     my $endbodytag='</body>';      my $endbodytag='</body>';
     if ($ENV{'environment.texengine'} eq 'jsMath') {      if ($env{'environment.texengine'} eq 'jsMath') {
  $endbodytag='<script type="text/javascript">jsMath.Process()</script>'.   $endbodytag='<script type="text/javascript">jsMath.Process()</script>'.
     "\n".$endbodytag;      "\n".$endbodytag;
     }      }
Line 2901  Returns either 'student','coordinator',' Line 2901  Returns either 'student','coordinator','
 ###############################################  ###############################################
 sub get_users_function {  sub get_users_function {
     my $function = 'student';      my $function = 'student';
     if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {      if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
         $function='coordinator';          $function='coordinator';
     }      }
     if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {      if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
         $function='admin';          $function='admin';
     }      }
     if (($ENV{'request.role'}=~/^(au|ca)/) ||      if (($env{'request.role'}=~/^(au|ca)/) ||
         ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {          ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
         $function='author';          $function='author';
     }      }
Line 3001  sub get_posted_cgi { Line 3001  sub get_posted_cgi {
  if ($name) {   if ($name) {
     chomp($value);      chomp($value);
     if ($fname) {      if ($fname) {
  $ENV{"form.$name.filename"}=$fname;   $env{"form.$name.filename"}=$fname;
  $ENV{"form.$name.mimetype"}=$fmime;   $env{"form.$name.mimetype"}=$fmime;
     } else {      } else {
  $value=~s/\s+$//s;   $value=~s/\s+$//s;
     }      }
Line 3034  sub get_posted_cgi { Line 3034  sub get_posted_cgi {
     }      }
  }   }
     }      }
     $ENV{'request.method'}=$ENV{'REQUEST_METHOD'};      $env{'request.method'}=$ENV{'REQUEST_METHOD'};
     $r->method_number(M_GET);      $r->method_number(M_GET);
     $r->method('GET');      $r->method('GET');
     $r->headers_in->unset('Content-length');      $r->headers_in->unset('Content-length');
Line 3044  sub get_posted_cgi { Line 3044  sub get_posted_cgi {
   
 =item * get_unprocessed_cgi($query,$possible_names)  =item * get_unprocessed_cgi($query,$possible_names)
   
 Modify the %ENV hash to contain unprocessed CGI form parameters held in  Modify the %env hash to contain unprocessed CGI form parameters held in
 $query.  The parameters listed in $possible_names (an array reference),  $query.  The parameters listed in $possible_names (an array reference),
 will be set in $ENV{'form.name'} if they do not already exist.  will be set in $env{'form.name'} if they do not already exist.
   
 Typically called with $ENV{'QUERY_STRING'} as the first parameter.    Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
 $possible_names is an ref to an array of form element names.  As an example:  $possible_names is an ref to an array of form element names.  As an example:
 get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);  get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
 will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.  will result in $env{'form.uname'} and $env{'form.udom'} being set.
   
 =cut  =cut
   
Line 3065  sub get_unprocessed_cgi { Line 3065  sub get_unprocessed_cgi {
       $value =~ tr/+/ /;        $value =~ tr/+/ /;
       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
       &Apache::lonxml::debug("Seting :$name: to :$value:");        &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 3079  returns cache-controlling header code Line 3079  returns cache-controlling header code
 =cut  =cut
   
 sub cacheheader {  sub cacheheader {
     unless ($ENV{'request.method'} eq 'GET') { return ''; }      unless ($env{'request.method'} eq 'GET') { return ''; }
     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);      my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />      my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />                  <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
Line 3098  specifies header code to not have cache Line 3098  specifies header code to not have cache
 sub no_cache {  sub no_cache {
     my ($r) = @_;      my ($r) = @_;
     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&      if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
  $ENV{'request.method'} ne 'GET') { return ''; }   $env{'request.method'} ne 'GET') { return ''; }
     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));      my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
     $r->no_cache(1);      $r->no_cache(1);
     $r->header_out("Expires" => $date);      $r->header_out("Expires" => $date);
Line 3107  sub no_cache { Line 3107  sub no_cache {
   
 sub content_type {  sub content_type {
     my ($r,$type,$charset) = @_;      my ($r,$type,$charset) = @_;
     if ($ENV{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }      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 3123  sub content_type { Line 3123  sub content_type {
   
 =item * add_to_env($name,$value)   =item * add_to_env($name,$value) 
   
 adds $name to the %ENV hash with value  adds $name to the %env hash with value
 $value, if $name already exists, the entry is converted to an array  $value, if $name already exists, the entry is converted to an array
 reference and $value is added to the array.  reference and $value is added to the array.
   
Line 3131  reference and $value is added to the arr Line 3131  reference and $value is added to the arr
   
 sub add_to_env {  sub add_to_env {
   my ($name,$value)=@_;    my ($name,$value)=@_;
   if (defined($ENV{$name})) {    if (defined($env{$name})) {
     if (ref($ENV{$name})) {      if (ref($env{$name})) {
       #already have multiple values        #already have multiple values
         push(@{ $env{$name} },$value);
       push(@{ $ENV{$name} },$value);        push(@{ $ENV{$name} },$value);
     } else {      } else {
       #first time seeing multiple values, convert hash entry to an arrayref        #first time seeing multiple values, convert hash entry to an arrayref
       my $first=$ENV{$name};        my $first=$env{$name};
         undef($env{$name});
       undef($ENV{$name});        undef($ENV{$name});
         push(@{ $env{$name} },$first,$value);
       push(@{ $ENV{$name} },$first,$value);        push(@{ $ENV{$name} },$first,$value);
     }      }
   } else {    } else {
       $env{$name}=$value;
     $ENV{$name}=$value;      $ENV{$name}=$value;
   }    }
 }  }
Line 3150  sub add_to_env { Line 3154  sub add_to_env {
   
 =item * get_env_multiple($name)   =item * get_env_multiple($name) 
   
 gets $name from the %ENV hash, it seemlessly handles the cases where multiple  gets $name from the %env hash, it seemlessly handles the cases where multiple
 values may be defined and end up as an array ref.  values may be defined and end up as an array ref.
   
 returns an array of values  returns an array of values
Line 3160  returns an array of values Line 3164  returns an array of values
 sub get_env_multiple {  sub get_env_multiple {
     my ($name) = @_;      my ($name) = @_;
     my @values;      my @values;
     if (defined($ENV{$name})) {      if (defined($env{$name})) {
         # exists is it an array          # exists is it an array
         if (ref($ENV{$name})) {          if (ref($env{$name})) {
             @values=@{ $ENV{$name} };              @values=@{ $env{$name} };
         } else {          } else {
             $values[0]=$ENV{$name};              $values[0]=$env{$name};
         }          }
     }      }
     return(@values);      return(@values);
Line 3183  sub get_env_multiple { Line 3187  sub get_env_multiple {
 =item * upfile_store($r)  =item * upfile_store($r)
   
 Store uploaded file, $r should be the HTTP Request object,  Store uploaded file, $r should be the HTTP Request object,
 needs $ENV{'form.upfile'}  needs $env{'form.upfile'}
 returns $datatoken to be put into hidden field  returns $datatoken to be put into hidden field
   
 =cut  =cut
   
 sub upfile_store {  sub upfile_store {
     my $r=shift;      my $r=shift;
     $ENV{'form.upfile'}=~s/\r/\n/gs;      $env{'form.upfile'}=~s/\r/\n/gs;
     $ENV{'form.upfile'}=~s/\f/\n/gs;      $env{'form.upfile'}=~s/\f/\n/gs;
     $ENV{'form.upfile'}=~s/\n+/\n/gs;      $env{'form.upfile'}=~s/\n+/\n/gs;
     $ENV{'form.upfile'}=~s/\n+$//gs;      $env{'form.upfile'}=~s/\n+$//gs;
   
     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.      my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
  '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;   '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
     {      {
         my $datafile = $r->dir_config('lonDaemons').          my $datafile = $r->dir_config('lonDaemons').
                            '/tmp/'.$datatoken.'.tmp';                             '/tmp/'.$datatoken.'.tmp';
         if ( open(my $fh,">$datafile") ) {          if ( open(my $fh,">$datafile") ) {
             print $fh $ENV{'form.upfile'};              print $fh $env{'form.upfile'};
             close($fh);              close($fh);
         }          }
     }      }
Line 3213  sub upfile_store { Line 3217  sub upfile_store {
 =item * load_tmp_file($r)  =item * load_tmp_file($r)
   
 Load uploaded file from tmp, $r should be the HTTP Request object,  Load uploaded file from tmp, $r should be the HTTP Request object,
 needs $ENV{'form.datatoken'},  needs $env{'form.datatoken'},
 sets $ENV{'form.upfile'} to the contents of the file  sets $env{'form.upfile'} to the contents of the file
   
 =cut  =cut
   
Line 3223  sub load_tmp_file { Line 3227  sub load_tmp_file {
     my @studentdata=();      my @studentdata=();
     {      {
         my $studentfile = $r->dir_config('lonDaemons').          my $studentfile = $r->dir_config('lonDaemons').
                               '/tmp/'.$ENV{'form.datatoken'}.'.tmp';                                '/tmp/'.$env{'form.datatoken'}.'.tmp';
         if ( open(my $fh,"<$studentfile") ) {          if ( open(my $fh,"<$studentfile") ) {
             @studentdata=<$fh>;              @studentdata=<$fh>;
             close($fh);              close($fh);
         }          }
     }      }
     $ENV{'form.upfile'}=join('',@studentdata);      $env{'form.upfile'}=join('',@studentdata);
 }  }
   
 =pod  =pod
Line 3238  sub load_tmp_file { Line 3242  sub load_tmp_file {
   
 Separate uploaded file into records  Separate uploaded file into records
 returns array of records,  returns array of records,
 needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}  needs $env{'form.upfile'} and $env{'form.upfiletype'}
   
 =cut  =cut
   
 sub upfile_record_sep {  sub upfile_record_sep {
     if ($ENV{'form.upfiletype'} eq 'xml') {      if ($env{'form.upfiletype'} eq 'xml') {
     } else {      } else {
  my @records;   my @records;
  foreach my $line (split(/\n/,$ENV{'form.upfile'})) {   foreach my $line (split(/\n/,$env{'form.upfile'})) {
     if ($line=~/^\s*$/) { next; }      if ($line=~/^\s*$/) { next; }
     push(@records,$line);      push(@records,$line);
  }   }
Line 3258  sub upfile_record_sep { Line 3262  sub upfile_record_sep {
   
 =item * record_sep($record)  =item * record_sep($record)
   
 Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}  Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
   
 =cut  =cut
   
 sub record_sep {  sub record_sep {
     my $record=shift;      my $record=shift;
     my %components=();      my %components=();
     if ($ENV{'form.upfiletype'} eq 'xml') {      if ($env{'form.upfiletype'} eq 'xml') {
     } elsif ($ENV{'form.upfiletype'} eq 'space') {      } elsif ($env{'form.upfiletype'} eq 'space') {
         my $i=0;          my $i=0;
         foreach (split(/\s+/,$record)) {          foreach (split(/\s+/,$record)) {
             my $field=$_;              my $field=$_;
Line 3275  sub record_sep { Line 3279  sub record_sep {
             $components{$i}=$field;              $components{$i}=$field;
             $i++;              $i++;
         }          }
     } elsif ($ENV{'form.upfiletype'} eq 'tab') {      } elsif ($env{'form.upfiletype'} eq 'tab') {
         my $i=0;          my $i=0;
         foreach (split(/\t/,$record)) {          foreach (split(/\t/,$record)) {
             my $field=$_;              my $field=$_;
Line 3966  Returns: both routines return nothing Line 3970  Returns: both routines return nothing
 sub store_course_settings {  sub store_course_settings {
     # save to the environment      # save to the environment
     # appenv the same items, just to be safe      # appenv the same items, just to be safe
     my $courseid = $ENV{'request.course.id'};      my $courseid = $env{'request.course.id'};
     my $coursedom = $ENV{'course.'.$courseid.'.domain'};      my $coursedom = $env{'course.'.$courseid.'.domain'};
     my ($prefix,$Settings) = @_;      my ($prefix,$Settings) = @_;
     my %SaveHash;      my %SaveHash;
     my %AppHash;      my %AppHash;
     while (my ($setting,$type) = each(%$Settings)) {      while (my ($setting,$type) = each(%$Settings)) {
         my $basename = 'internal.'.$prefix.'.'.$setting;          my $basename = 'internal.'.$prefix.'.'.$setting;
         my $envname = 'course.'.$courseid.'.'.$basename;          my $envname = 'course.'.$courseid.'.'.$basename;
         if (exists($ENV{'form.'.$setting})) {          if (exists($env{'form.'.$setting})) {
             # Save this value away              # Save this value away
             if ($type eq 'scalar' &&              if ($type eq 'scalar' &&
                 (! exists($ENV{$envname}) ||                   (! exists($env{$envname}) || 
                  $ENV{$envname} ne $ENV{'form.'.$setting})) {                   $env{$envname} ne $env{'form.'.$setting})) {
                 $SaveHash{$basename} = $ENV{'form.'.$setting};                  $SaveHash{$basename} = $env{'form.'.$setting};
                 $AppHash{$envname}   = $ENV{'form.'.$setting};                  $AppHash{$envname}   = $env{'form.'.$setting};
             } elsif ($type eq 'array') {              } elsif ($type eq 'array') {
                 my $stored_form;                  my $stored_form;
                 if (ref($ENV{'form.'.$setting})) {                  if (ref($env{'form.'.$setting})) {
                     $stored_form = join(',',                      $stored_form = join(',',
                                         map {                                          map {
                                             &Apache::lonnet::escape($_);                                              &Apache::lonnet::escape($_);
                                         } sort(@{$ENV{'form.'.$setting}}));                                          } sort(@{$env{'form.'.$setting}}));
                 } else {                  } else {
                     $stored_form =                       $stored_form = 
                         &Apache::lonnet::escape($ENV{'form.'.$setting});                          &Apache::lonnet::escape($env{'form.'.$setting});
                 }                  }
                 # Determine if the array contents are the same.                  # Determine if the array contents are the same.
                 if ($stored_form ne $ENV{$envname}) {                  if ($stored_form ne $env{$envname}) {
                     $SaveHash{$basename} = $stored_form;                      $SaveHash{$basename} = $stored_form;
                     $AppHash{$envname}   = $stored_form;                      $AppHash{$envname}   = $stored_form;
                 }                  }
Line 4002  sub store_course_settings { Line 4006  sub store_course_settings {
     }      }
     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,      my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
                                           $coursedom,                                            $coursedom,
                                           $ENV{'course.'.$courseid.'.num'});                                            $env{'course.'.$courseid.'.num'});
     if ($put_result !~ /^(ok|delayed)/) {      if ($put_result !~ /^(ok|delayed)/) {
         &Apache::lonnet::logthis('unable to save form parameters, '.          &Apache::lonnet::logthis('unable to save form parameters, '.
                                  'got error:'.$put_result);                                   'got error:'.$put_result);
Line 4013  sub store_course_settings { Line 4017  sub store_course_settings {
 }  }
   
 sub restore_course_settings {  sub restore_course_settings {
     my $courseid = $ENV{'request.course.id'};      my $courseid = $env{'request.course.id'};
     my ($prefix,$Settings) = @_;      my ($prefix,$Settings) = @_;
     while (my ($setting,$type) = each(%$Settings)) {      while (my ($setting,$type) = each(%$Settings)) {
         next if (exists($ENV{'form.'.$setting}));          next if (exists($env{'form.'.$setting}));
         my $envname = 'course.'.$courseid.'.internal.'.$prefix.          my $envname = 'course.'.$courseid.'.internal.'.$prefix.
             '.'.$setting;              '.'.$setting;
         if (exists($ENV{$envname})) {          if (exists($env{$envname})) {
             if ($type eq 'scalar') {              if ($type eq 'scalar') {
                 $ENV{'form.'.$setting} = $ENV{$envname};                  $env{'form.'.$setting} = $env{$envname};
             } elsif ($type eq 'array') {              } elsif ($type eq 'array') {
                 $ENV{'form.'.$setting} = [                   $env{'form.'.$setting} = [ 
                                            map {                                              map { 
                                                &Apache::lonnet::unescape($_);                                                  &Apache::lonnet::unescape($_); 
                                            } split(',',$ENV{$envname})                                             } split(',',$env{$envname})
                                            ];                                             ];
             }              }
         }          }
Removed from v.1.257  
changed lines
  Added in v.1.258

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