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

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

version 1.258, 2005/04/07 06:56:22 version 1.275, 2005/10/04 16:34:40
Line 152  BEGIN { Line 152  BEGIN {
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';      my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
     opendir(DIR,$designdir);      opendir(DIR,$designdir);
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
    if ($filename!~/\.tab$/) { next; }
  my ($domain)=($filename=~/^(\w+)\./);   my ($domain)=($filename=~/^(\w+)\./);
     {   {
         my $designfile = $designdir.'/'.$filename;      my $designfile = $designdir.'/'.$filename;
         if ( open (my $fh,"<$designfile") ) {      if ( open (my $fh,"<$designfile") ) {
             while (<$fh>) {   while (<$fh>) {
                 next if /^\#/;      next if /^\#/;
                 chomp;      chomp;
                 my ($key,$val)=(split(/\=/,$_));      my ($key,$val)=(split(/\=/,$_));
                 if ($val) { $designhash{$domain.'.'.$key}=$val; }      if ($val) { $designhash{$domain.'.'.$key}=$val; }
             }   }
             close($fh);   close($fh);
         }      }
     }   }
   
     }      }
     closedir(DIR);      closedir(DIR);
Line 418  sub selectcourse_link { Line 419  sub selectcourse_link {
         '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>";          '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>";
 }  }
   
   sub check_uncheck_jscript {
       my $jscript = <<"ENDSCRT";
   function checkAll(field) {
       if (field.length > 0) {
           for (i = 0; i < field.length; i++) {
               field[i].checked = true ;
           }
       } else {
           field.checked = true
       }
   }
    
   function uncheckAll(field) {
       if (field.length > 0) {
           for (i = 0; i < field.length; i++) {
               field[i].checked = false ;
           }     } else {
           field.checked = false ;
       }
   }
   ENDSCRT
       return $jscript;
   }
   
   
 =pod  =pod
   
 =item * linked_select_forms(...)  =item * linked_select_forms(...)
Line 673  sub help_open_menu { Line 699  sub help_open_menu {
     foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {      foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
         $$_ = &Apache::lonnet::escape($$_);          $$_ = &Apache::lonnet::escape($$_);
     }      }
   
     if (!$stayOnPage) {      if (!$stayOnPage) {
          $link = "javascript:helpMenu('open')";           $link = "javascript:helpMenu('open')";
     } else {      } else {
Line 684  sub help_open_menu { Line 709  sub help_open_menu {
     my $template;      my $template;
     if ($text ne "") {      if ($text ne "") {
  $template .=    $template .= 
   "<table bgcolor='#773311' cellspacing='1' cellpadding='1' border='0'><tr>".    "<table bgcolor='#CC3300' cellspacing='1' cellpadding='1' border='0'><tr>".
   "<td bgcolor='#886622'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";    "<td bgcolor='#CC6600'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
     }      }
       my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
     my $html=&Apache::lonxml::xmlbegin();      my $html=&Apache::lonxml::xmlbegin();
     my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");      my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
Line 698  function helpMenu(target) { Line 724  function helpMenu(target) {
     if (target == 'open') {      if (target == 'open') {
         var newWindow = null;          var newWindow = null;
         try {          try {
             newWindow =  window.open("/adm/rat/empty.html","helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )              newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
         }          }
         catch(error) {          catch(error) {
             writeHelp(caller);              writeHelp(caller);
Line 712  function helpMenu(target) { Line 738  function helpMenu(target) {
     return;      return;
 }  }
 function writeHelp(caller) {  function writeHelp(caller) {
     caller.document.write('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>')      caller.document.writeln('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>')
     caller.document.write("<frameset rows='105,*' border='0'><frame name='bannerframe'  src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")      caller.document.writeln("<frameset rows='105,*' border='0'><frame name='bannerframe'  src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
     caller.document.write("</html>")      caller.document.writeln("</html>")
     caller.document.close()      caller.document.close()
     caller.focus()      caller.focus()
 }  }
Line 1984  sub syllabuswrapper { Line 2010  sub syllabuswrapper {
 }  }
   
 sub track_student_link {  sub track_student_link {
     my ($linktext,$sname,$sdom,$target) = @_;      my ($linktext,$sname,$sdom,$target,$start) = @_;
     my $link ="/adm/trackstudent";      my $link ="/adm/trackstudent?";
     my $title = 'View recent activity';      my $title = 'View recent activity';
     if (defined($sname) && $sname !~ /^\s*$/ &&      if (defined($sname) && $sname !~ /^\s*$/ &&
         defined($sdom)  && $sdom  !~ /^\s*$/) {          defined($sdom)  && $sdom  !~ /^\s*$/) {
         $link .= "?selected_student=$sname:$sdom";          $link .= "selected_student=$sname:$sdom";
         $title .= ' of this student';          $title .= ' of this student';
     }      } 
     if (defined($target) && $target !~ /^\s*$/) {      if (defined($target) && $target !~ /^\s*$/) {
         $target = qq{target="$target"};          $target = qq{target="$target"};
     } else {      } else {
         $target = '';          $target = '';
     }      }
       if ($start) { $link.='&amp;start='.$start; }
     return qq{<a href="$link" title="$title" $target>$linktext</a>};      return qq{<a href="$link" title="$title" $target>$linktext</a>};
 }  }
   
   
   
 =pod  =pod
   
 =back  =back
Line 2689  other decorations will be returned. Line 2714  other decorations will be returned.
 =cut  =cut
   
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle)=@_;      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,$notopbar)=@_;
     $title=&mt($title);      $title=&mt($title);
     $function = &get_users_function() if (!$function);      $function = &get_users_function() if (!$function);
     my $img=&designparm($function.'.img',$domain);      my $img=&designparm($function.'.img',$domain);
Line 2729  a:focus { color: red; background: yellow Line 2754  a:focus { color: red; background: yellow
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"  <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
 style="margin-top: 0px;$addstyle" $addentries>  style="margin-top: 0px;$addstyle" $addentries>
 END  END
       &Apache::lontexconvert::jsMath_reset();
     if ($env{'environment.texengine'} eq 'jsMath') {      if ($env{'environment.texengine'} eq 'jsMath') {
  $bodytag.='<script type="text/javascript">   $bodytag.=&Apache::lontexconvert::jsMath_header();
                      function NoFontMessage () {}  
                    </script>'."\n".  
     '<script src="/adm/jsMath/jsMath.js"></script>'."\n";  
     }      }
   
     my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.      my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
Line 2796  ENDROLE Line 2819  ENDROLE
         }          }
         my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.          my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.
                          'cellspacing="3" cellpadding="3">'.                           'cellspacing="3" cellpadding="3">'.
                          '<tr><td rowspan="3" bgcolor="'.$tabbg.'">'.                           '<tr><td bgcolor="'.$tabbg.'">'.
                          $titleinfo.'</td>'.$roleinfo.'</tr></table>';                           $titleinfo.'</td>'.$roleinfo.'</tr></table>';
         if ($env{'request.state'} eq 'construct') {          if ($env{'request.state'} eq 'construct') {
             $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);              if ($notopbar) {
                   $bodytag .= $titletable;
               } else {
                   $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);
               }
  } else {   } else {
             $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).              if ($notopbar) {
                   $bodytag .= $titletable;
               } else {
                   $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).
                         $titletable;                          $titletable;
               }
         }          }
         return $bodytag;          return $bodytag;
     }      }
Line 2880  Returns: A uniform footer for LON-CAPA w Line 2911  Returns: A uniform footer for LON-CAPA w
   
 sub endbodytag {  sub endbodytag {
     my $endbodytag='</body>';      my $endbodytag='</body>';
     if ($env{'environment.texengine'} eq 'jsMath') {      $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
  $endbodytag='<script type="text/javascript">jsMath.Process()</script>'.  
     "\n".$endbodytag;  
     }  
     return $endbodytag;      return $endbodytag;
 }  }
   
Line 2918  sub get_users_function { Line 2946  sub get_users_function {
   
 =pod  =pod
   
   =item check_user_status
   
   Determines current status of supplied role for a
   specific user. Roles can be active, previous or future.
   
   Inputs: 
   user's domain, user's username, course's domain,
   course's number, optional section/group.
   
   Outputs:
   role status: active, previous or future. 
   
   =cut
   
   sub check_user_status {
       my ($udom,$uname,$cdom,$crs,$role,$secgrp) = @_;
       my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
       my @uroles = keys %userinfo;
       my $srchstr;
       my $active_chk = 'none';
       if (@uroles > 0) {
           if (($role eq 'cc') || ($secgrp eq '') || (!defined($secgrp))) {
               $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
           } else {
               $srchstr = '/'.$cdom.'/'.$crs.'/'.$secgrp.'_'.$role;         }
           if (grep/^$srchstr$/,@uroles) {
               my $role_end = 0;
               my $role_start = 0;
               $active_chk = 'active';
               if ($userinfo{$srchstr} =~ m/^($role)_(\d+)/) {
                   $role_end = $2;
                   if ($userinfo{$srchstr} =~ m/^($role)_($role_end)_(\d+)$/) {
                       $role_start = $3;
                   }
               }
               if ($role_start > 0) {
                   if (time < $role_start) {
                       $active_chk = 'future';
                   }
               }
               if ($role_end > 0) {
                   if (time > $role_end) {
                       $active_chk = 'previous';
                   }
               }
           }
       }
       return $active_chk;
   }
   
   ###############################################
   
   =pod
   
 =item get_sections  =item get_sections
   
 Determines all the sections for a course including  Determines all the sections for a course including
Line 2970  sub get_sections { Line 3052  sub get_sections {
     return $numsections;      return $numsections;
 }  }
   
   ###############################################
   
   =pod
                                                                                   
   =item get_course_users
                                                                                   
   Retrieves usernames:domains for users in the specified course
   with specific role(s), and access status. 
   
   Incoming parameters:
   1. course_id
   2. course domain
   3. course number
   4. access status: users must have - either active, 
   previous, future, or all.
   5. reference to array of permissible roles
   6. reference to results object (hash of hashes).
   Keys of top level hash are roles.
   Keys of inner hashes are username:domain, with 
   values set to access type.
                                                                                   
   =cut
                                                                                   
   ###############################################
                                                                                   
   sub get_course_users {
       my ($course_id,$cdom,$cnum,$types,$roles,$users) = @_;
       if (grep/^st$/,@{$roles}) {
           my $statusidx = &Apache::loncoursedata::CL_STATUS;
           my $startidx = &Apache::loncoursedata::CL_START;
           my $endidx = &Apache::loncoursedata::CL_END;
           my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($course_id,$cdom,$cnum);
           foreach my $student (keys (%{$classlist})) {
               if (defined($$types{'active'})) {
                   if ($$classlist{$student}[$statusidx] eq 'Active') {
                       push(@{$$users{st}{$student}},'active');
                   }
               }
               if (defined($$types{'previous'})) {
                   if ($$classlist{$student}[$endidx] <= time) {
                       push(@{$$users{st}{$student}},'previous');
                   }
               }
               if (defined($$types{'future'})) {
                   if (($$classlist{$student}[$startidx] > 0) && ($$classlist{$student}[$endidx] > time) || ($$classlist{$student}[$endidx] == 0) || ($$classlist{$student}[$endidx] eq '')) {
                       push(@{$$users{st}{$student}},'future');
                   }
               }
           }
       }
       if ((@{$roles} > 0) && (@{$roles} ne "st")) {
           my ($cdom,$cnum) = split/_/,$course_id;
           my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);
           foreach my $person (@coursepersonnel) {
               my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);
               $user =~ s/:$//;
               if (($role) && (grep/^$role$/,@{$roles})) {
                   my ($uname,$udom) = split/:/,$user;
                   if ($uname ne '' && $udom ne '') {
                       my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);
                       foreach my $type (keys %{$types}) { 
                           if ($status eq $type) {
                               $$users{$role}{$user} = $type;
                           }
                       }
                   }
               }
           }
       }
       return;
   }
   
   
   
   ###############################################
   
 sub get_posted_cgi {  sub get_posted_cgi {
     my $r=shift;      my $r=shift;
   
     my $buffer;      my $buffer;
           if ($r->header_in('Content-length')) {
     $r->read($buffer,$r->header_in('Content-length'),0);   $r->read($buffer,$r->header_in('Content-length'),0);
       }
     unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {      unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
  my @pairs=split(/&/,$buffer);   my @pairs=split(/&/,$buffer);
  my $pair;   my $pair;
Line 3064  sub get_unprocessed_cgi { Line 3222  sub get_unprocessed_cgi {
     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {      if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
       $value =~ tr/+/ /;        $value =~ tr/+/ /;
       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
       &Apache::lonxml::debug("Seting :$name: to :$value:");  
       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };        unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
     }      }
   }    }
Line 3135  sub add_to_env { Line 3292  sub add_to_env {
     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 3266  Separate a record into fields $record sh Line 3419  Separate a record into fields $record sh
   
 =cut  =cut
   
   sub takeleft {
       my $index=shift;
       return substr('0000'.$index,-4,4);
   }
   
 sub record_sep {  sub record_sep {
     my $record=shift;      my $record=shift;
     my %components=();      my %components=();
Line 3276  sub record_sep { Line 3434  sub record_sep {
             my $field=$_;              my $field=$_;
             $field=~s/^(\"|\')//;              $field=~s/^(\"|\')//;
             $field=~s/(\"|\')$//;              $field=~s/(\"|\')$//;
             $components{$i}=$field;              $components{&takeleft($i)}=$field;
             $i++;              $i++;
         }          }
     } elsif ($env{'form.upfiletype'} eq 'tab') {      } elsif ($env{'form.upfiletype'} eq 'tab') {
Line 3285  sub record_sep { Line 3443  sub record_sep {
             my $field=$_;              my $field=$_;
             $field=~s/^(\"|\')//;              $field=~s/^(\"|\')//;
             $field=~s/(\"|\')$//;              $field=~s/(\"|\')$//;
             $components{$i}=$field;              $components{&takeleft($i)}=$field;
             $i++;              $i++;
         }          }
     } else {      } else {
Line 3303  sub record_sep { Line 3461  sub record_sep {
                 $field=~s/^\s*$delimiter//;                  $field=~s/^\s*$delimiter//;
                 $field=~s/$delimiter\s*$//;                  $field=~s/$delimiter\s*$//;
             }              }
             $components{$i}=$field;              $components{&takeleft($i)}=$field;
     $i++;      $i++;
         }          }
     }      }
Line 3460  sub csv_samples_select_table { Line 3618  sub csv_samples_select_table {
                       $display.'</option>');                        $display.'</option>');
  }   }
  $r->print('</select></td><td>');   $r->print('</select></td><td>');
  if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }   if (defined($sone{$_})) { $r->print($sone{$_}."<br />\n"); }
  if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }   if (defined($stwo{$_})) { $r->print($stwo{$_}."<br />\n"); }
  if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }   if (defined($sthree{$_})) { $r->print($sthree{$_}."<br />\n"); }
  $r->print('</td></tr>');   $r->print('</td></tr>');
  $i++;   $i++;
     }      }
Removed from v.1.258  
changed lines
  Added in v.1.275

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