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

Diff for /loncom/interface/loncommon.pm between versions 1.289 and 1.301

version 1.289, 2005/11/15 15:40:58 version 1.301, 2005/12/15 22:10:49
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 2886  ENDROLE Line 2890  ENDROLE
     #      #
     return(<<ENDBODY);      return(<<ENDBODY);
 $bodytag  $bodytag
 <table class="thinborder" width="100%" cellspacing="0" border="0" cellpadding="0">  <table width="100%" cellspacing="0" border="0" cellpadding="0">
 <tr><td bgcolor="$sidebg">  <tr><td bgcolor="$sidebg">
 $upperleft</td>  $upperleft</td>
 <td bgcolor="$sidebg" align="right">$messages&nbsp;</td>  <td bgcolor="$sidebg" align="right">$messages&nbsp;</td>
Line 3080  sub get_sections { Line 3084  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
   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  =pod
                                                                                                                                                                   
Line 3123  sub get_course_users { Line 3259  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 3299  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 3315  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 3213  sub get_user_info { Line 3343  sub get_user_info {
     my ($udom,$uname,$idx,$userdata) = @_;      my ($udom,$uname,$idx,$userdata) = @_;
     $$userdata{$uname.':'.$udom}[$$idx{fullname}] =       $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
  &plainname($uname,$udom,'lastname');   &plainname($uname,$udom,'lastname');
     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname      $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $udom      $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
     return;      return;
 }  }
   
Line 3356  sub no_cache { Line 3486  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 3590  sub upfile_select_html { Line 3724  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 3607  Apache Request ref, $records is an array Line 3757  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 3647  $d is an array of 2 element arrays (inte Line 3794  $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 3660  sub csv_print_select_table { Line 3807  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 3691  $d is an array of 2 element arrays (inte Line 3838  $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 4221  sub store_course_settings { Line 4367  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 4255  sub store_course_settings { Line 4402  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 4271  sub restore_course_settings { Line 4417  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.289  
changed lines
  Added in v.1.301

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