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

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

version 1.295, 2005/11/17 16:57:54 version 1.305, 2006/03/04 21:32:30
Line 331  sub storeresurl { Line 331  sub storeresurl {
 sub studentbrowser_javascript {  sub studentbrowser_javascript {
    unless (     unless (
             (($env{'request.course.id'}) &&               (($env{'request.course.id'}) && 
              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})))               (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
         || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
     '/'.$env{'request.course.sec'})
         ))
          || ($env{'request.role'}=~/^(au|dc|su)/)           || ($env{'request.role'}=~/^(au|dc|su)/)
           ) { return ''; }              ) { return ''; }  
    return (<<'ENDSTDBRW');     return (<<'ENDSTDBRW');
Line 362  ENDSTDBRW Line 365  ENDSTDBRW
 sub selectstudent_link {  sub selectstudent_link {
    my ($form,$unameele,$udomele)=@_;     my ($form,$unameele,$udomele)=@_;
    if ($env{'request.course.id'}) {       if ($env{'request.course.id'}) {  
        unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {         if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
      && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
    '/'.$env{'request.course.sec'})) {
    return '';     return '';
        }         }
        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.         return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
Line 2782  table.thinborder { border-collapse: coll Line 2787  table.thinborder { border-collapse: coll
 table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}  table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}
 form, .inline { display: inline; }  form, .inline { display: inline; }
 .center { text-align: center; }  .center { text-align: center; }
   .filename {font-family: monospace;}
 </style>  </style>
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"  <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
 style="margin-top: 0px;$addstyle" $addentries>  style="margin-top: 0px;$addstyle" $addentries>
Line 2887  ENDROLE Line 2893  ENDROLE
         $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};          $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
         $dc_info = '('.$dc_info.')';          $dc_info = '('.$dc_info.')';
     }      }
       # Explicit link to get inline menu
       my $menu='<br /><font size="2" face="Arial, Helvetica, sans-serif">&nbsp;<a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a></font>';
     #      #
     return(<<ENDBODY);      return(<<ENDBODY);
 $bodytag  $bodytag
 <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>
 </tr>  </tr>
 <tr>  <tr>
 <td rowspan="3" bgcolor="$tabbg">  <td rowspan="3" bgcolor="$tabbg">
 $titleinfo $dc_info  $titleinfo $dc_info $menu
 </td><td bgcolor="$tabbg" align="right">  </td><td bgcolor="$tabbg" align="right">
 <font size="2" face="Arial, Helvetica, sans-serif">  <font size="2" face="Arial, Helvetica, sans-serif">
     $env{'environment.firstname'}      $env{'environment.firstname'}
Line 3084  sub get_sections { Line 3092  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  =pod
   
Line 3093  Uses TokeParser to extract group informa Line 3156  Uses TokeParser to extract group informa
 XML used to describe course groups.  XML used to describe course groups.
   
 Input:  Input:
 Scalar containing XML (as retrieved from &lonnet::get_coursegroups).  Scalar containing XML  - as retrieved from &coursegroups().
   
 Output:  Output:
 Hash containing group information as key=values for (a), and  Hash containing group information as key=values for (a), and
Line 3110  times for group members. Line 3173  times for group members.
 Outer hash key is functions.  Outer hash key is functions.
 Inner hash keys are chat,discussion,email,files,homepage,roster.  Inner hash keys are chat,discussion,email,files,homepage,roster.
 Corresponding values are either on or off, depending on  Corresponding values are either on or off, depending on
 whther this type of functionality is available for the group.  whether this type of functionality is available for the group.
   
 =cut  =cut
                                                                                                                                                                     
Line 3121  sub get_group_settings { Line 3184  sub get_group_settings {
     my $parser=HTML::TokeParser->new(\$groupinfo);      my $parser=HTML::TokeParser->new(\$groupinfo);
     my $token;      my $token;
     my $tool = '';      my $tool = '';
       my $role = '';
     my %content=();      my %content=();
     while ($token=$parser->get_token) {      while ($token=$parser->get_token) {
         if ($token->[0] eq 'S')  {          if ($token->[0] eq 'S')  {
             my $entry=$token->[1];              my $entry=$token->[1];
             if ($entry eq 'functions') {              if ($entry eq 'functions' || $entry eq 'autosec') {
                 %{$content{$entry}} = ();                  %{$content{$entry}} = ();
                 $tool = $entry;                  $tool = $entry;
               } elsif ($entry eq 'role') {
                   if ($tool eq 'autosec') {
                       $role = $token->[2]{id};
                   }
             } else {              } else {
                 my $value=$parser->get_text('/'.$entry);                  my $value=$parser->get_text('/'.$entry);
                 if ($entry eq 'name') {                  if ($entry eq 'name') {
Line 3137  sub get_group_settings { Line 3205  sub get_group_settings {
                     }                      }
                 } elsif ($entry eq 'groupname') {                  } elsif ($entry eq 'groupname') {
                     $content{$entry}=&Apache::lonnet::unescape($value);                      $content{$entry}=&Apache::lonnet::unescape($value);
                   } elsif (($entry eq 'roles') || ($entry eq 'types') ||
                            ($entry eq 'sectionpick') || ($entry eq 'defpriv')) {
                       push(@{$content{$entry}},$value);
                   } elsif ($entry eq 'section') {
                       if ($tool eq 'autosec'  && $role ne '') {
                           push(@{$content{$tool}{$role}},$value);
                       }
                 } else {                  } else {
                     $content{$entry}=$value;                      $content{$entry}=$value;
                 }                  }
             }              }
         } elsif ($token->[0] eq 'E') {          } elsif ($token->[0] eq 'E') {
             if ($token->[1] eq 'functions') {              if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') {
                 $tool = '';                  $tool = '';
               } elsif ($token->[1] eq 'role') {
                   $role = '';
             }              }
   
         }          }
     }      }
     return %content;      return %content;
Line 3289  sub get_user_info { Line 3367  sub get_user_info {
     $$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 3431  sub no_cache { Line 3509  sub no_cache {
   
 sub content_type {  sub content_type {
     my ($r,$type,$charset) = @_;      my ($r,$type,$charset) = @_;
     &no_cache($r);      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 3666  sub upfile_select_html { Line 3747  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 3683  Apache Request ref, $records is an array Line 3780  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 3723  $d is an array of 2 element arrays (inte Line 3817  $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 3736  sub csv_print_select_table { Line 3830  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 3767  $d is an array of 2 element arrays (inte Line 3861  $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 4297  sub store_course_settings { Line 4390  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 4331  sub store_course_settings { Line 4425  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 4347  sub restore_course_settings { Line 4440  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.295  
changed lines
  Added in v.1.305

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