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

Diff for /loncom/interface/lonparmset.pm between versions 1.15 and 1.21

version 1.15, 2000/11/27 16:08:55 version 1.21, 2001/01/16 15:52:09
Line 9 Line 9
 #  #
 # 10/11,10/12,10/16 Gerd Kortemeyer)  # 10/11,10/12,10/16 Gerd Kortemeyer)
 #  #
 # 11/20,11/21,11/22,11/23,11/24,11/25,11/27 Gerd Kortemeyer  # 11/20,11/21,11/22,11/23,11/24,11/25,11/27,11/28,
   # 12/08,12/12,
   # 16/01/01 Gerd Kortemeyer
   
 package Apache::lonparmset;  package Apache::lonparmset;
   
Line 17  use strict; Line 19  use strict;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::Constants qw(:common :http REDIRECT);  use Apache::Constants qw(:common :http REDIRECT);
 use GDBM_File;  use GDBM_File;
 use Apache::lonmeta;  
   
   
 my %courseopt;  my %courseopt;
Line 31  my @ids; Line 32  my @ids;
 my %symbp;  my %symbp;
 my %mapp;  my %mapp;
 my %typep;  my %typep;
   my %keyp;
   my %defp;
   
   my %allkeys;
   
 my $uname;  my $uname;
 my $udom;  my $udom;
Line 121  sub parmval { Line 126  sub parmval {
     return $result;      return $result;
 }  }
   
 # ---------------------------------------------------------------- Sort routine  
   
 sub bycat {  
     if ($fcat eq '') {  
         $a<=>$b;  
     } else {  
         &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b);  
     }  
 }  
   
 # ------------------------------------------------------------ Output for value  # ------------------------------------------------------------ Output for value
   
 sub valout {  sub valout {
Line 177  sub handler { Line 172  sub handler {
   
       $csec=$ENV{'form.csec'};        $csec=$ENV{'form.csec'};
       $udom=$ENV{'form.udom'};        $udom=$ENV{'form.udom'};
         unless ($udom) { $udom=$r->dir_config('lonDefDomain'); }
   
       my $id=$ENV{'form.id'};        my $id=$ENV{'form.id'};
       if (($id) && ($udom)) {        if (($id) && ($udom)) {
           $uname=(&Apache::lonnet::idget($udom,$id))[1];            $uname=(&Apache::lonnet::idget($udom,$id))[1];
Line 184  sub handler { Line 181  sub handler {
       $id='';        $id='';
           } else {            } else {
               $message=                $message=
      "<h3><font color=red>Unknown ID '$id' at domain '$udom'</font></h3>";       "<font color=red>Unknown ID '$id' at domain '$udom'</font>";
           }            }
       } else {        } else {
           $uname=$ENV{'form.uname'};            $uname=$ENV{'form.uname'};
Line 196  sub handler { Line 193  sub handler {
               
         if ($uhome eq 'no_host') {           if ($uhome eq 'no_host') { 
           $message=            $message=
      "<h3><font color=red>Unknown user '$uname' at domain '$udom'</font></h3>";       "<font color=red>Unknown user '$uname' at domain '$udom'</font>";
           $uname='';             $uname=''; 
         } else {          } else {
           $csec=&Apache::lonnet::usection(            $csec=&Apache::lonnet::usection(
        $udom,$uname,$ENV{'request.course.id'});         $udom,$uname,$ENV{'request.course.id'});
           if ($csec eq '-1') {            if ($csec eq '-1') {
              $message="<h3><font color=red>".               $message="<font color=red>".
               "User '$uname' at domain '$udom' not in this course</font></h3>";                "User '$uname' at domain '$udom' not in this course</font>";
               $uname='';                $uname='';
               $csec=$ENV{'form.csec'};                $csec=$ENV{'form.csec'};
  } else {   } else {
Line 229  sub handler { Line 226  sub handler {
            $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {             $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
   
 # --------------------------------------------------------- Get all assessments  # --------------------------------------------------------- Get all assessments
    %allkeys=();
           %defp=();
         map {          map {
     if ($_=~/^src\_(\d+)\.(\d+)$/) {      if ($_=~/^src\_(\d+)\.(\d+)$/) {
        my $mapid=$1;         my $mapid=$1;
                my $resid=$2;                 my $resid=$2;
                my $id=$mapid.'.'.$resid;                 my $id=$mapid.'.'.$resid;
                if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {                 my $srcf=$bighash{$_};
                  if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
    $ids[$#ids+1]=$id;     $ids[$#ids+1]=$id;
                    $typep{$id}=$1;                     $typep{$id}=$1;
                      $keyp{$id}='';
                      map {
                          if ($_=~/^parameter\_(.*)/) {
     my $key=$_;
                             my $allkey=$1;
                             $allkey=~s/\_/\./;
                             my $display=
         &Apache::lonnet::metadata($srcf,$key.'.display');
                             unless ($display) {
                                 $display=
            &Apache::lonnet::metadata($srcf,$key.'.name');
                             }
                             $allkeys{$allkey}=$display;
                             if ($allkey eq $fcat) {
                                $defp{$id}=
                                 &Apache::lonnet::metadata($srcf,$key);
     }
                             if ($keyp{$id}) {
         $keyp{$id}.=','.$key;
                             } else {
                                 $keyp{$id}=$key;
             }
          }
                      } split(/\,/,
                         &Apache::lonnet::metadata($srcf,'keys'));
                    $mapp{$id}=                     $mapp{$id}=
        &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});         &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});
                    $symbp{$id}=$mapp{$id}.                     $symbp{$id}=$mapp{$id}.
  '___'.$resid.'___'.   '___'.$resid.'___'.
     &Apache::lonnet::declutter($bighash{$_});      &Apache::lonnet::declutter($srcf);
        }         }
             }              }
         } keys %bighash;          } keys %bighash;
Line 300  sub handler { Line 325  sub handler {
            }             }
   
          if ($reply=~/^error\:(.*)/) {           if ($reply=~/^error\:(.*)/) {
      $message.="<h3><font color=red>Write Error: $1</font></h3>";       $message.="<font color=red>Write Error: $1</font>";
  }   }
 # ---------------------------------------------------------------- Done storing  # ---------------------------------------------------------------- Done storing
    }     }
Line 330  sub handler { Line 355  sub handler {
         }          }
   
 # ------------------------------------------------------------------- Sort this  # ------------------------------------------------------------------- Sort this
          @ids=sort bycat @ids;  
           @ids=sort  {  
              if ($fcat eq '') {
                 $a<=>$b;
              } else {
                 $outpar[&parmval($fcat,$a,$defp{$a})]<=>
                 $outpar[&parmval($fcat,$b,$defp{$b})];
              } 
           } @ids;
 # ------------------------------------------------------------------ Start page  # ------------------------------------------------------------------ Start page
          $r->content_type('text/html');           $r->content_type('text/html');
          $r->send_http_header;           $r->send_http_header;
Line 358  sub handler { Line 391  sub handler {
   
     function psub() {      function psub() {
         pclose();          pclose();
         if ((document.parmform.pres_value.value!='') &&           if (document.parmform.pres_marker.value!='') {
             (document.parmform.pres_marker.value!='')) {  
             document.parmform.submit();              document.parmform.submit();
         } else {          } else {
             document.parmform.pres_value.value='';              document.parmform.pres_value.value='';
Line 389  at Domain Line 421  at Domain
 <input type="hidden" value='' name="pres_type">  <input type="hidden" value='' name="pres_type">
 <input type="hidden" value='' name="pres_marker">  <input type="hidden" value='' name="pres_marker">
 ENDHEAD  ENDHEAD
   
         $r->print($message.'<p>Sort list by ');          $r->print('<h2>'.$message.'</h2><p>Sort list by ');
  $r->print('<select name="fcat" onChange="this.form.submit();">');   $r->print('<select name="fcat" onChange="this.form.submit();">');
         my $k;          $r->print('<option value="">Enclosing Map</option>');
         my @sopt=('map','Map','name','Problem Name','deadline','Deadline');          map {
         for ($k=0;$k<$#sopt;$k=$k+2) {      $r->print('<option value="'.$_.'"');
     $r->print('<option value="'.$sopt[$k].'"');              if ($fcat eq $_) { $r->print(' selected'); }
             if ($fcat eq $sopt[$k]) { $r->print(' selected'); }              $r->print('>'.$allkeys{$_}.'</option>');
             $r->print('>'.$sopt[$k+1].'</option>');          } keys %allkeys;
         }  
         $r->print('</select>');          $r->print('</select>');
 # ----------------------------------------------------------------- Start Table  # ----------------------------------------------------------------- Start Table
         my $coursespan=$csec?8:5;          my $coursespan=$csec?8:5;
Line 431  ENDTABLEHEADFOUR Line 462  ENDTABLEHEADFOUR
   $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');    $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
     }      }
  $r->print('</tr><tr>');   $r->print('</tr><tr>');
            my $defbgone='';
            my $defbgtwo='';
   map {    map {
 # ------------------------------------------------------ Entry for one resource  # ------------------------------------------------------ Entry for one resource
        if ($defbgone eq '"E0E099"') {
    $defbgone='"E0E0DD"';
                } else {
                    $defbgone='"E0E099"';
        }
        if ($defbgtwo eq '"FFFF99"') {
    $defbgtwo='"FFFFDD"';
                } else {
                    $defbgtwo='"FFFF99"';
        }
     @outpar=();      @outpar=();
             my $rid=$_;              my $rid=$_;
             my $thistitle='';              my $thistitle='';
             my %name=   ('0_deadline' => 'deadline');              my %name=   ();
             my %part=   ('0_deadline' => '0');              my %part=   ();
     my %display=('0_deadline' => 'Deadline');      my %display=();
     my %type=   ('0_deadline' => 'date_end');      my %type=   ();
             my %default=('0_deadline' => time);              my %default=();
             my %metadata=&Apache::lonmeta::unpackagemeta(              my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
 &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1);  
             map {              map {
                 if ($_=~/^parameter\_(\d+)\_(\w+)$/) {   $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
                     my $hashid=$1.'_'.$2;                  $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
     $part{$hashid}=$1;                  $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
                     $name{$hashid}=$2;                  unless ($display{$_}) { $display{$_}=''; }
                     my $tdef;                  $display{$_}.=' ('.$name{$_}.')';
                     ($tdef,$display{$hashid})=                  $default{$_}=&Apache::lonnet::metadata($uri,$_);
  split(/\_\_dis\_\_/,$metadata{$_});                  $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
     ($type{$hashid},$default{$hashid})=split(/\:/,$tdef);                  $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
                     unless ($display{$hashid}) {              } split(/\,/,$keyp{$rid});
                         $display{$hashid}=$name{$hashid};  
                     }  
                 }  
                 if ($_ eq 'title') {  
     $thistitle=$metadata{$_};  
                 }  
             } keys %metadata;  
     my $totalparms=scalar keys %name;      my $totalparms=scalar keys %name;
             $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.      my $isdef=1;
   join(' / ',split(/\//,&Apache::lonnet::declutter($bighash{'src_'.$rid}))).      unless ($totalparms) { $totalparms=1; $isdef=0; }
            '</font></tt><p><b>'.              $r->print('<td bgcolor='.$defbgone.
                   ' rowspan='.$totalparms.'><tt><font size=-1>'.
                   join(' / ',split(/\//,$uri)).
                   '</font></tt><p><b>'.
                       $bighash{'title_'.$rid});                        $bighash{'title_'.$rid});
             if ($thistitle) {              if ($thistitle) {
  $r->print(' ('.$thistitle.')');   $r->print(' ('.$thistitle.')');
             }              }
             $r->print('</b></td>');              $r->print('</b></td>');
             $r->print('<td rowspan='.$totalparms.'>'.$typep{$rid}.'</td>');              $r->print('<td bgcolor='.$defbgtwo.
             $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.                      ' rowspan='.$totalparms.'>'.$typep{$rid}.'</td>');
               $r->print('<td bgcolor='.$defbgone.
                       ' rowspan='.$totalparms.'><tt><font size=-1>'.
       join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>');        join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>');
     if ($isdef) {
             map {              map {
   
        my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_});         my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_});
   
                $r->print("<td>$part{$_}</td><td>$display{$_}</td>");                  $r->print("<td bgcolor=".$defbgtwo.
                my $mprefix=$rid.'&'.$_.'&';                    ">$part{$_}</td><td bgcolor=".$defbgone.
                     ">$display{$_}</td>");
                  my $thismarker=$_;
                  $thismarker=~s/^parameter\_//; 
                  my $mprefix=$rid.'&'.$thismarker.'&';
   
                $r->print('<td'.(($result==11)?' bgcolor="#AAFFAA"':'').'>'.                 $r->print('<td bgcolor='.
                   (($result==11)?'"#AAFFAA"':'#FFDDDD').'>'.
              &valout($outpar[11],$type{$_}).'</td>');               &valout($outpar[11],$type{$_}).'</td>');
                $r->print('<td'.(($result==10)?' bgcolor="#AAFFAA"':'').'>'.                 $r->print('<td bgcolor='.
                   (($result==10)?'"#AAFFAA"':'#FFDDDD').'>'.
              &valout($outpar[10],$type{$_}).'</td>');               &valout($outpar[10],$type{$_}).'</td>');
   
                $r->print('<td'.(($result==9)?' bgcolor="#AAFFAA"':'').'>'.                 $r->print('<td bgcolor='.
                   (($result==9)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9',               &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                $r->print('<td'.(($result==8)?' bgcolor="#AAFFAA"':'').'>'.                 $r->print('<td bgcolor='.
                   (($result==8)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8',               &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                $r->print('<td'.(($result==7)?' bgcolor="#AAFFAA"':'').'>'.                 $r->print('<td bgcolor='.
                   (($result==7)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7',               &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
   
                if ($csec) {                 if ($csec) {
                  $r->print('<td'.(($result==6)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                      (($result==6)?'"#AAFFAA"':$defbgtwo).'>'.
              &plink($type{$_},$display{$_},$outpar[6],$mprefix.'6',               &plink($type{$_},$display{$_},$outpar[6],$mprefix.'6',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                  $r->print('<td'.(($result==5)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                      (($result==5)?'"#AAFFAA"':$defbgtwo).'>'.
              &plink($type{$_},$display{$_},$outpar[5],$mprefix.'5',               &plink($type{$_},$display{$_},$outpar[5],$mprefix.'5',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                  $r->print('<td'.(($result==4)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                       (($result==4)?'"#AAFFAA"':$defbgtwo).'>'.
              &plink($type{$_},$display{$_},$outpar[4],$mprefix.'4',               &plink($type{$_},$display{$_},$outpar[4],$mprefix.'4',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                }                 }
   
                if ($uname) {                 if ($uname) {
                  $r->print('<td'.(($result==3)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                       (($result==3)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[3],$mprefix.'3',               &plink($type{$_},$display{$_},$outpar[3],$mprefix.'3',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                  $r->print('<td'.(($result==2)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                       (($result==2)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[2],$mprefix.'2',               &plink($type{$_},$display{$_},$outpar[2],$mprefix.'2',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                  $r->print('<td'.(($result==1)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                      (($result==1)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[1],$mprefix.'1',               &plink($type{$_},$display{$_},$outpar[1],$mprefix.'1',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                }                 }
   
                $r->print('<td>'.&valout($outpar[$result],$type{$_}).'</td>');                 $r->print(
           '<td bgcolor=#CCCCFF>'.&valout($outpar[$result],$type{$_}).'</td>');
                $r->print("</tr>\n<tr>");                 $r->print("</tr>\n<tr>");
    } sort keys %name;     } sort keys %name;
    } else {
       $r->print("</tr>\n<tr>");
           }
 # -------------------------------------------------- End entry for one resource  # -------------------------------------------------- End entry for one resource
  } @ids;   } @ids;
          $r->print('</table></form></body></html>');           $r->print('</table></form></body></html>');
Removed from v.1.15  
changed lines
  Added in v.1.21

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