Return to lonparmset.pm CVS log

Up to [LON-CAPA] / loncom / interface

Now sort of sorts ...

    1: # The LearningOnline Network with CAPA
    2: # Handler to set parameters for assessments
    3: #
    4: # (Handler to resolve ambiguous file locations
    5: #
    6: # (TeX Content Handler
    7: #
    8: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
    9: #
   10: # 10/11,10/12,10/16 Gerd Kortemeyer)
   11: #
   12: # 11/20,11/21 Gerd Kortemeyer
   13: 
   14: package Apache::lonparmset;
   15: 
   16: use strict;
   17: use Apache::lonnet;
   18: use Apache::Constants qw(:common :http REDIRECT);
   19: use GDBM_File;
   20: 
   21: my %courseopt;
   22: my %useropt;
   23: my %bighash;
   24: my %parmhash;
   25: 
   26: my @ids;
   27: my %symbp;
   28: my %typep;
   29: 
   30: my $uname;
   31: my $udom;
   32: my $uhome;
   33: 
   34: my $csec;
   35: 
   36: my $fcat;
   37: 
   38: # -------------------------------------------- Figure out a cascading parameter
   39: 
   40: sub parmval {
   41:     my ($what,$id)=@_;
   42: # ----------------------------------------------------- Cascading lookup scheme
   43:        my $symbparm=$symbp{$id}.'.'.$what;
   44:        my $reslevel=
   45: 	    $ENV{'request.course.id'}.'.'.$symbparm;
   46:        my $seclevel=
   47:             $ENV{'request.course.id'}.'.'.
   48: 		$ENV{'request.course.sec'}.'.'.$what;
   49:        my $courselevel=
   50:             $ENV{'request.course.id'}.'.'.$what;
   51: 
   52: # ----------------------------------------------------------- first, check user
   53: 
   54:       if ($uname) {
   55:        if ($useropt{$reslevel}) { return $useropt{$reslevel}; }
   56:        if ($useropt{$seclevel}) { return $useropt{$seclevel}; }
   57:        if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
   58:       }
   59: 
   60: # -------------------------------------------------------- second, check course
   61: 
   62:        if ($courseopt{$reslevel}) { return $courseopt{$reslevel}; }
   63:        if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }  
   64:        if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
   65: 
   66: # ------------------------------------------------------ third, check map parms
   67: 
   68:        my $thisparm=$parmhash{$symbparm};
   69:        if ($thisparm) { return $thisparm; }
   70:      
   71: # --------------------------------------------- last, look in resource metadata
   72: 
   73:         my $filename='/home/httpd/res/'.$bighash{'src_'.$id}.'.meta';
   74:         if (-e $filename) {
   75:             my @content;
   76:             {
   77:              my $fh=Apache::File->new($filename);
   78:              @content=<$fh>;
   79:             }
   80:             if (join('',@content)=~
   81:                  /\<$what[^\>]*\>([^\<]*)\<\/$what\>/) {
   82: 	        return $1;
   83:  	    }
   84:         }
   85:     return '';
   86: }
   87: 
   88: # ---------------------------------------------------------------- Sort routine
   89: 
   90: sub bycat {
   91:     if ($fcat eq '') {
   92:         $a<=>$b;
   93:     } else {
   94:         &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b);
   95:     }
   96: }
   97: 
   98: # ================================================================ Main Handler
   99: 
  100: sub handler {
  101:    my $r=shift;
  102: 
  103:    if ($r->header_only) {
  104:       $r->content_type('text/html');
  105:       $r->send_http_header;
  106:       return OK;
  107:    }
  108: 
  109: # ----------------------------------------------------- Needs to be in a course
  110: 
  111:    if (($ENV{'request.course.fn'}) && 
  112:        (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
  113: # -------------------------------------------------------- Variable declaration
  114: 
  115:       %courseopt=();
  116:       %useropt=();
  117:       %bighash=();
  118: 
  119:       @ids=();
  120:       %symbp=();
  121:       %typep=();
  122: 
  123:       $uname=$ENV{'form.uname'};
  124:       $udom=$ENV{'form.udom'};
  125:       unless ($udom) { $uname=''; }
  126:       $uhome='';
  127:       my $message='';
  128:       if ($uname) {
  129: 	  $uhome=&Apache::lonnet::homeserver($uname,$udom);
  130:       }
  131:       if ($uhome eq 'no_host') { 
  132:           $message=
  133:          "<h3><font color=red>Unknown User $uname at Domain $udom</font></h3>";
  134:           $uname=''; 
  135:       }
  136: 
  137:       $csec=$ENV{'form.csec'};
  138:       unless ($csec) { $csec=''; }
  139:       $fcat=$ENV{'form.fcat'};
  140:       unless ($fcat) { $fcat=''; }
  141: 
  142: # ------------------------------------------------------------------- Tie hashs
  143:       if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
  144:                        &GDBM_READER,0640)) &&
  145:           (tie(%parmhash,'GDBM_File',
  146:            $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
  147: 
  148: # -------------------------------------------------------------- Get coursedata
  149:         my $reply=&Apache::lonnet::reply('dump:'.
  150:               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
  151:               $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
  152:               $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
  153:         if ($reply!~/^error\:/) {
  154:            map {
  155:              my ($name,$value)=split(/\=/,$_);
  156:              $courseopt{unescape($name)}=unescape($value);  
  157:            } split(/\&/,$reply);
  158:         }
  159: # --------------------------------------------------- Get userdata (if present)
  160:         if ($uname) {
  161:            my $reply=
  162:        &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
  163:            if ($reply!~/^error\:/) {
  164:               map {
  165:                 my ($name,$value)=split(/\=/,$_);
  166:                 $useropt{unescape($name)}=unescape($value);  
  167:               } split(/\&/,$reply);
  168:            }
  169:         }
  170: # --------------------------------------------------------- Get all assessments
  171:         map {
  172: 	    if ($_=~/^src\_(\d+)\.(\d+)$/) {
  173: 	       my $mapid=$1;
  174:                my $resid=$2;
  175:                my $id=$mapid.'.'.$resid;
  176:                if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
  177: 		   $ids[$#ids+1]=$id;
  178:                    $typep{$id}=$1;
  179:                    $symbp{$id}=
  180: 		    &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
  181: 			'___'.$resid.'___'.
  182: 			    &Apache::lonnet::declutter($bighash{$_});
  183: 	       }
  184:             }
  185:         } keys %bighash;
  186: # ------------------------------------------------------------------- Sort this
  187:          @ids=sort bycat @ids;
  188: # ------------------------------------------------------------------ Start page
  189:          $r->content_type('text/html');
  190:          $r->send_http_header;
  191: 	 $r->print(
  192:   '<html><body bgcolor="#FFFFFF"><h1>Set Assessment Parameters</h1>');
  193: 	$r->print("<h2>Course: $ENV{'course.'.
  194:                    $ENV{'request.course.id'}.'.description'}</h2>");
  195: 	 if ($csec) {
  196:             $r->print("<h3>Section/Group: $csec</h3>");
  197: 	 }
  198: 	 if ($uname) {
  199:             $r->print("<h3>For User $uname at Domain $udom");
  200: 	 }
  201: 	 if ($uhome eq 'no_host') {
  202:             $r->print($message);
  203:          }
  204:  	 map {
  205: 	     $r->print($_.'<br>');
  206: 	 } @ids;
  207:          $r->print('</body></html>');
  208:          untie(%bighash);
  209: 	 untie(%parmhash);
  210:       }
  211:    } else {
  212: # ----------------------------- Not in a course, or not allowed to modify parms
  213:       $ENV{'user.error.msg'}=
  214:         "/adm/flip:opa:0:0:Cannot modify assessment parameters";
  215:       return HTTP_NOT_ACCEPTABLE; 
  216:    }
  217:    return OK;
  218: }
  219: 
  220: 1;
  221: __END__
  222: 
  223: 
  224: 
  225: 
  226: 
  227: 
  228: