Return to lonparmset.pm CVS log

Up to [LON-CAPA] / loncom / interface

Continuing work, not functional yet

    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 @srcp;
   27: my @typep;
   28: my @resp;
   29: my @mapp;
   30: my @symbp;
   31: 
   32: my $uname;
   33: my $udom;
   34: my $uhome;
   35: 
   36: my $csec;
   37: 
   38: # -------------------------------------------- Figure out a cascading parameter
   39: 
   40: sub parmval {
   41:     my ($what,$idx)=@_;
   42: # ----------------------------------------------------- Cascading lookup scheme
   43:        my $symbparm=$symbp[$idx].'.'.$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 ($useropt{$reslevel}) { return $useropt{$reslevel}; }
   55:        if ($useropt{$seclevel}) { return $useropt{$seclevel}; }
   56:        if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
   57: 
   58: # -------------------------------------------------------- second, check course
   59: 
   60:        if ($courseopt{$reslevel}) { return $courseopt{$reslevel}; }
   61:        if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }  
   62:        if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
   63: 
   64: # ------------------------------------------------------ third, check map parms
   65: 
   66:        my $thisparm=$parmhash{$symbparm};
   67:        if ($thisparm) { return $thisparm; }
   68: 
   69:      
   70: # --------------------------------------------- last, look in resource metadata
   71: 
   72:         my $filename='/home/httpd/res/'.$srcp[$idx].'.meta';
   73:         if (-e $filename) {
   74:             my @content;
   75:             {
   76:              my $fh=Apache::File->new($filename);
   77:              @content=<$fh>;
   78:             }
   79:             if (join('',@content)=~
   80:                  /\<$what[^\>]*\>([^\<]*)\<\/$what\>/) {
   81: 	        return $1;
   82:  	    }
   83:         }
   84:     return '';
   85: }
   86: 
   87: # ================================================================ Main Handler
   88: 
   89: sub handler {
   90:    my $r=shift;
   91: 
   92:    if ($r->header_only) {
   93:       $r->content_type('text/html');
   94:       $r->send_http_header;
   95:       return OK;
   96:    }
   97: 
   98: # ----------------------------------------------------- Needs to be in a course
   99: 
  100:    if (($ENV{'request.course.fn'}) && 
  101:        (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
  102: # -------------------------------------------------------- Variable declaration
  103: 
  104:       %courseopt=();
  105:       %useropt=();
  106:       %bighash=();
  107: 
  108:       @srcp=();
  109:       @typep=();
  110:       @resp=();
  111:       @mapp=();
  112:       @symbp=();
  113: 
  114:       $uname=$ENV{'form.uname'};
  115:       $udom=$ENV{'form.udom'};
  116:       unless ($udom) { $uname=''; }
  117:       $uhome='';
  118:       if ($uname) {
  119: 	  $uhome=&Apache::lonnet::homeserver($uname,$udom);
  120:       }
  121: 
  122:       $csec=$ENV{'form.csec'};
  123: 
  124: # ------------------------------------------------------------------- Tie hashs
  125:       if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
  126:                        &GDBM_READER,0640)) &&
  127:           (tie(%parmhash,'GDBM_File',
  128:            $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
  129: 
  130: # -------------------------------------------------------------- Get coursedata
  131:         my $reply=&Apache::lonnet::reply('dump:'.
  132:               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
  133:               $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
  134:               $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
  135:         if ($reply!~/^error\:/) {
  136:            map {
  137:              my ($name,$value)=split(/\=/,$_);
  138:              $courseopt{unescape($name)}=unescape($value);  
  139:            } split(/\&/,$reply);
  140:         }
  141: # --------------------------------------------------- Get userdata (if present)
  142:         if ($uname) {
  143:            my $reply=
  144:        &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
  145:            if ($reply!~/^error\:/) {
  146:               map {
  147:                 my ($name,$value)=split(/\=/,$_);
  148:                 $useropt{unescape($name)}=unescape($value);  
  149:               } split(/\&/,$reply);
  150:            }
  151:         }
  152: # --------------------------------------------------------- Get all assessments
  153:         map {
  154: 	    if ($_=~/^src\_(\d+)\.(\d+)$/) {
  155: 	       my $mapid=$1;
  156:                my $resid=$2;
  157:                if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
  158:                   $typep[$#typep+1]=$1;
  159:                   $mapp[$#mapp+1]=$mapid;
  160:                   $resp[$#resp+1]=$resid;
  161:                   $srcp[$#srcp+1]=&Apache::lonnet::declutter($bighash{$_});
  162:                   $symbp[$#symbp+1]=
  163: 		    &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
  164: 			'___'.$resid.'___'.$srcp[$#srcp];
  165: 	       }
  166:             }
  167:         } keys %bighash;
  168: # ------------------------------------------------------------------- Sort this
  169: 
  170: # ------------------------------------------------------------------ Start page
  171:          $r->content_type('text/html');
  172:          $r->send_http_header;
  173: 	 $r->print('<html><body bgcolor="#FFFFFF">');
  174: 
  175:          $r->print('</body></html>');
  176:          untie(%bighash);
  177: 	 untie(%parmhash);
  178:       }
  179:    } else {
  180: # ----------------------------- Not in a course, or not allowed to modify parms
  181:       $ENV{'user.error.msg'}=
  182:         "/adm/flip:opa:0:0:Cannot modify assessment parameters";
  183:       return HTTP_NOT_ACCEPTABLE; 
  184:    }
  185:    return OK;
  186: }
  187: 
  188: 1;
  189: __END__
  190: 
  191: 
  192: 
  193: 
  194: 
  195: 
  196: