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

Diff for /loncom/interface/loncommon.pm between versions 1.288 and 1.295

version 1.288, 2005/11/15 15:14:17 version 1.295, 2005/11/17 16:57:54
Line 380  sub coursebrowser_javascript { Line 380  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 403  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 417  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 1917  if $first is set to 'lastname' then it r Line 1920  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 1953  if the user does not Line 1955  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 1978  sub nickname { Line 1968  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 2775  sub bodytag { Line 2779  sub bodytag {
 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 { border-collapse: collapse; }
 table.thinborder tr th { border-style: solid; border-width: 1px}  table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}
 table.thinborder tr td { border-style: solid; border-width: 1px}  form, .inline { display: inline; }
 .center { text-align: center; }  .center { text-align: center; }
 </style>  </style>
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"  <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
Line 3082  sub get_sections { Line 3086  sub get_sections {
 ###############################################  ###############################################
   
 =pod  =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 &lonnet::get_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
   whther 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 %content=();
       while ($token=$parser->get_token) {
           if ($token->[0] eq 'S')  {
               my $entry=$token->[1];
               if ($entry eq 'functions') {
                   %{$content{$entry}} = ();
                   $tool = $entry;
               } 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);
                   } else {
                       $content{$entry}=$value;
                   }
               }
           } elsif ($token->[0] eq 'E') {
               if ($token->[1] eq 'functions') {
                   $tool = '';
               }
           }
       }
       return %content;
   }
   
   sub check_group_access {
       my ($group) = @_;
       my $access = 1;
       my $now = time;
       my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
       if (($end!=0) && ($end<$now)) { $access = 0; }
       if (($start!=0) && ($start>$now)) { $access=0; }
       return $access;
   }
   
   ###############################################
   
   =pod
                                                                                                                                                                   
 =item get_course_users  =item get_course_users
                                                                                                                                                                   
Line 3123  sub get_course_users { Line 3204  sub get_course_users {
     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();      $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
     $idx{status} = &Apache::loncoursedata::CL_STATUS();      $idx{status} = &Apache::loncoursedata::CL_STATUS();
   
     if (grep/^st$/,@{$roles}) {      if (grep(/^st$/,@{$roles})) {
         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);          my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
         my $now = time;          my $now = time;
         foreach my $student (keys(%{$classlist})) {          foreach my $student (keys(%{$classlist})) {
             my $match = 0;              my $match = 0;
             if (defined($sections) && (ref($sections) eq 'ARRAY')) {              if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
                 if (@{$sections} > 0) {   unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/,
                     unless(grep/^$$classlist{$student}[$idx{section}]$/,@{$sections}) {      @{$sections})) {
                         next;      next;
                     }   }
                 }  
             }               } 
             if (defined($$types{'active'})) {              if (defined($$types{'active'})) {
                 if ($$classlist{$student}[$idx{status}] eq 'Active') {                  if ($$classlist{$student}[$idx{status}] eq 'Active') {
Line 3164  sub get_course_users { Line 3244  sub get_course_users {
             my $match = 0;              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,$usec) = split(/:/,$user);                  my ($uname,$udom,$usec) = split(/:/,$user);
                 unless ($usec eq '') {                  if ($usec ne '' && (ref($sections) eq 'ARRAY') && 
                     if (defined($sections) && (ref($sections) eq 'ARRAY')) {      @{$sections} > 0) {
                         if (@{$sections} > 0) {      unless(grep(/^\Q$usec\E$/,@{$sections})) {
                             unless(grep/^$usec$/,@{$sections}) {   next;
                                 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);
Line 3183  sub get_course_users { Line 3260  sub get_course_users {
                             $match = 1;                              $match = 1;
                         }                          }
                     }                      }
                     if ($match && defined($userdata)) {                      if ($match && defined($userdata) &&
                         unless(exists($$userdata{$uname.':'.$udom})) {                          !exists($$userdata{$uname.':'.$udom})) {
                             &get_user_info($udom,$uname,\%idx,$userdata);   &get_user_info($udom,$uname,\%idx,$userdata);
                         }  
                     }                      }
                 }                  }
             }              }
         }          }
         if (grep/^ow$/,@{$roles}) {          if (grep(/^ow$/,@{$roles})) {
             if ((defined($cdom)) && (defined($cnum))) {              if ((defined($cdom)) && (defined($cnum))) {
                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);                  my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                 if ( defined($csettings{'internal.courseowner'}) ) {                  if ( defined($csettings{'internal.courseowner'}) ) {
                     my $owner = $csettings{'internal.courseowner'};                      my $owner = $csettings{'internal.courseowner'};
                     @{$$users{'ow'}{$owner.':'.$cdom}} = 'any';                      @{$$users{'ow'}{$owner.':'.$cdom}} = 'any';
                     if (defined($userdata)) {                      if (defined($userdata) && 
                         unless(exists($$userdata{$owner.':'.$cdom})) {   !exists($$userdata{$owner.':'.$cdom})) {
                             &get_user_info($cdom,$owner,\%idx,$userdata);   &get_user_info($cdom,$owner,\%idx,$userdata);
                         }      }
                     }  
                 }                  }
             }              }
         }          }
Line 3211  sub get_course_users { Line 3286  sub get_course_users {
   
 sub get_user_info {  sub get_user_info {
     my ($udom,$uname,$idx,$userdata) = @_;      my ($udom,$uname,$idx,$userdata) = @_;
     my %userinfo = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id'],$udom,$uname);      $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
     if (grep/^(con_lost|error|no_such_host)/,keys(%userinfo)) {   &plainname($uname,$udom,'lastname');
         &Apache::lonnet::logthis('get_user_info error for '.$uname.':'.$udom);      $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
         $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;      $$userdata{$uname.':'.$udom}[$$idx{uname}] = $udom;
         $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;   
     } else {  
         $userinfo{fullname} = &Apache::lonnet::format_name(@userinfo{qw/firstname middlename lastname generation/},'lastname');  
         $userinfo{uname} = $uname;  
         $userinfo{udom} = $udom;  
         foreach my $item (qw/uname udom id fullname/) {  
             $$userdata{$uname.':'.$udom}[$$idx{$item}] = $userinfo{$item};  
         }  
     }  
     return;      return;
 }  }
   
Line 3365  sub no_cache { Line 3431  sub no_cache {
   
 sub content_type {  sub content_type {
     my ($r,$type,$charset) = @_;      my ($r,$type,$charset) = @_;
       &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;
Removed from v.1.288  
changed lines
  Added in v.1.295

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