File:  [LON-CAPA] / loncom / homework / structuretags.pm
Revision 1.49: download - view: text, annotated - select for diffs
Thu Jul 19 21:26:22 2001 UTC (22 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- added submit button at top
- fixed strinfresponse to use selcet_arg
- fixed passing of strings to capa checker.

    1: # The LearningOnline Network with CAPA 
    2: # definition of tags that give a structure to a document
    3: # 2/19 Guy
    4: # 6/26/2001 fixed extra web display at end of <web></web> tags
    5: package Apache::structuretags; 
    6: 
    7: use strict;
    8: use Apache::lonnet;
    9: 
   10: sub BEGIN {
   11:   &Apache::lonxml::register('Apache::structuretags',('block','while','randomlist','problem','library','web','tex','part','preduedate','postanswerdate','solved','notsolved','startouttext','endouttext'));
   12: #  &Apache::lonxml::register_insert('problem','',('part','postanswerdate','preduedate'))
   13: }
   14: 
   15: sub start_web {
   16:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   17:   my $bodytext=&Apache::lonxml::get_all_text("/web",$$parser[$#$parser]);
   18:   if ($target eq 'web') {
   19:     return $bodytext;
   20:   } 
   21:   return '';
   22: }
   23: 
   24: sub end_web {
   25:     return '';
   26: }
   27: 
   28: sub start_tex {
   29:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   30:   my $bodytext=&Apache::lonxml::get_all_text("/tex",$$parser[$#$parser]);
   31:   if ($target eq 'tex') {
   32:     return $bodytext
   33:   }
   34:   return '';
   35: }
   36: 
   37: sub end_tex {
   38:     return '';
   39: }
   40: 
   41: sub page_start {
   42:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   43:   my $result=&Apache::londefdef::start_html($target,$token,$tagstack,$parstack,$parser,$safeeval);
   44:   my $head_tag_start='<head>'.&Apache::lonxml::registerurl();
   45:   my $body_tag_start='<body onLoad="'.&Apache::lonxml::loadevents().'" '.
   46: 	  'onUnload="'.&Apache::lonxml::unloadevents().'" '.
   47: 	    'bgcolor="#FFFFFF">';
   48:   return ($result,$head_tag_start,$body_tag_start);
   49: }
   50: 
   51: sub start_problem {
   52:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   53: 
   54: #intialize globals
   55:   $Apache::inputtags::part='0';
   56:   @Apache::inputtags::responselist = ();
   57:   $Apache::lonhomework::type=&Apache::lonnet::EXT('resource.0.type');
   58:   &Apache::lonxml::debug("Found this to be of type :$Apache::lonhomework::type:");
   59:   if ($Apache::lonhomework::type eq '') {
   60:     $Apache::lonhomework::type='homework';
   61:   }
   62: #adeed vars to the scripting enviroment
   63:   my $expression='$external::part='.$Apache::inputtags::part.';';
   64:   &Apache::run::run($expression,$safeeval);
   65:   my $status;
   66:   my $datemsg;
   67: 
   68:   #should get back a <html> or the neccesary stuff to start XML/MathML
   69:   my ($result,$head_tag_start,$body_tag_start)=
   70:     &page_start($target,$token,$tagstack,$parstack,$parser,$safeeval);
   71: 
   72:   if ($target eq 'web' || $target eq 'grade') {
   73:     ($status,$datemsg) = &Apache::lonhomework::check_date('0');
   74:     push (@Apache::inputtags::status,$status);
   75:     my $expression='$external::datestatus="'.$status.'";';
   76:     $expression.='$external::gradestatus="'.$Apache::lonhomework::history{"resource.0.solved"}.'";';
   77:     &Apache::run::run($expression,$safeeval);
   78:     if ( $status eq 'CLOSED' ) {
   79:       my $bodytext=&Apache::lonxml::get_all_text("/problem",$$parser[$#$parser]);
   80:       if ( $target eq "web" ) {
   81: 	$result.= $head_tag_start.'</head>';
   82: 	return $result . $body_tag_start .
   83: 	  " <br />Problem is not open to be viewed. The problem $datemsg<br />";
   84:       }
   85:     }
   86:   }
   87:   if ($target eq 'web') {
   88:     my $name= &Apache::lonxml::get_param('name',$parstack,$safeeval);
   89:     if ($name eq '') { 
   90:       $name=&Apache::lonnet::EXT('resource.title');
   91:       if ($name eq 'con_lost') { $name = ''; }
   92:     }
   93:     $Apache::lonhomework::name=$name;
   94:     if ($status eq 'CAN_ANSWER') {
   95:       # create a page header and exit
   96:       $result.="$head_tag_start<title>$name</title></head>\n
   97:               $body_tag_start\n
   98:               <form name=\"lonhomework\" method=\"POST\" action=\"".$ENV{'request.uri'}."\">".
   99: 		'<input type="hidden" name="submitted" value="yes" />';
  100:       if ($ENV{'request.state'} eq "construct") {
  101: 	$result.='<input type="hidden" name="problemmode" value="View" />
  102:                  <input type="submit" name="problemmode" value="Edit" /><hr />';
  103:       }
  104:       return $result;
  105:     } elsif ($status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER' || $status eq 'CLOSED') {
  106:       return $result.$head_tag_start."<title>$name</title></head>\n$body_tag_start\n";
  107:     }
  108:   }
  109:   if ($target eq 'edit') {
  110:     $result.=$head_tag_start."</head>".$body_tag_start.
  111:       '<form name="lonhomework" method="POST" action="'.$ENV{'request.uri'}.'">
  112:        <input type="hidden" name="submitted" value="edit" />
  113:        <input type="hidden" name="problemmode" value="Edit" />
  114:        <input type="submit" name="problemmode" value="View" />
  115:        <input type="submit" name="Undo" value="undo" /> <hr />
  116:        <input type="submit" name="submit" value="Submit Changes" /><br />
  117:       ';
  118:     my $temp=&Apache::edit::insertlist($target,$token);
  119:     $result.=$temp;
  120:     return $result;
  121:   }
  122:   if ($target eq 'modified') {
  123:     $result=$token->[4];
  124:     $result.=&Apache::edit::handle_insert();
  125:     return $result;
  126:   }
  127:   return '';
  128: }
  129: 
  130: sub end_problem {
  131:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  132:   my $result='';
  133:   my $status=$Apache::inputtags::status['-1'];
  134:   if ($target eq 'grade' || $target eq 'web' ) {
  135:     if ( $target eq 'grade' && $Apache::inputtags::part eq '0' &&
  136:        $status eq 'CAN_ANSWER') {
  137:       # if part is zero, no <part>s existed, so we need to the grading
  138:       &Apache::inputtags::grade;
  139:     } elsif ($Apache::inputtags::part eq '0') {
  140:       # if part is zero, no <part>s existed, so we need show the current 
  141:       # grading status
  142:       $result.= &Apache::inputtags::gradestatus($Apache::inputtags::part);
  143:     }
  144:     if ($target eq 'web') { 
  145:       if ($status eq 'CAN_ANSWER') {
  146: 	$result.="</form></body>\n"; 
  147:       } elsif ($status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {
  148: 	$result.="</body>\n";
  149:       }
  150:     }
  151:   }
  152:   if ($target eq 'meta') {
  153:     if ($Apache::inputtags::part eq '0') {
  154:       $result=&Apache::response::mandatory_part_meta;
  155:     }
  156:   }
  157:   if ($target eq 'edit') {
  158:     &Apache::lonxml::debug("in end_problem with $target, edit");
  159:     $result='<br /><input type="submit" name="submit" value="Submit Changes" />';
  160:   }
  161:   return $result;
  162: }
  163: 
  164: sub start_library {
  165:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  166:   my ($result,$head_tag_start,$body_tag_start)=
  167:     &page_start($target,$token,$tagstack,$parstack,$parser,$safeeval);
  168:   if ($target eq 'edit') {
  169:     $result.=$head_tag_start."</head>".$body_tag_start.
  170:       '<form name="lonhomework" method="POST" action="'.$ENV{'request.uri'}.'">
  171:        <input type="hidden" name="submitted" value="edit" />
  172:        <input type="hidden" name="problemmode" value="Edit" />
  173:        <input type="submit" name="problemmode" value="View" />
  174:        <input type="submit" name="Undo" value="undo" /> <hr />
  175:       ';
  176:     my $temp=&Apache::edit::insertlist($target,$token);
  177:     $result.=$temp;
  178:     return $result;
  179:   }
  180:   if ($target eq 'modified') {
  181:     $result=$token->[4];
  182:     $result.=&Apache::edit::handle_insert();
  183:     return $result;
  184:   }
  185:   return '';
  186: }
  187: 
  188: sub end_library {
  189:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  190:   my $result='';
  191:   if ($target eq 'edit') {
  192:     $result='<br /><input type="submit" name="submit" value="Submit Changes" />';
  193:   }
  194:   return $result;
  195: }
  196: 
  197: sub start_block {
  198:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  199: 
  200:   if ($target eq 'web' || $target eq 'grade') {
  201:     my $code = @$parstack[$#$parstack];
  202:     $code =~ s/\"//g;
  203:     $code .=';return $condition;';
  204:     #  print "<br />$code<br />";
  205:     my $result = &Apache::run::run($code,$safeeval);
  206:     &Apache::lonxml::debug("block :$code: returned :$result:");
  207:     if ( ! $result ) { 
  208:       my $skip=&Apache::lonxml::get_all_text("/block",$$parser[$#$parser]);
  209:       &Apache::lonxml::debug("skipping ahead :$skip: $$parser[$#$parser]");
  210:     }
  211:   }
  212:   return "";
  213: }
  214: 
  215: sub end_block {
  216:   return '';
  217: }
  218: 
  219: sub start_while {
  220:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  221: 
  222:   my $code = @$parstack[$#$parstack];
  223:   $code =~ s/\"//g;
  224:   $code .=';return $condition;';
  225: 
  226:   push( @Apache::structuretags::whileconds, $code); 
  227:   my $result = &Apache::run::run($code,$safeeval);
  228:   my $bodytext=$$parser[$#$parser]->get_text("/while");
  229:   push( @Apache::structuretags::whilebody, $bodytext);
  230:   if ( $result ) { 
  231:     &Apache::lonxml::newparser($parser,\$bodytext);
  232:   }
  233:   return "";
  234: }
  235: 
  236: sub end_while {
  237:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  238:   my $code = pop @Apache::structuretags::whileconds;
  239:   my $bodytext = pop @Apache::structuretags::whilebody;
  240:   my $result = &Apache::run::run($code,$safeeval);
  241:   if ( $result ) { 
  242:     &Apache::lonxml::newparser($parser,\$bodytext);
  243:   } 
  244:   return "";
  245: }
  246: 
  247: # <randomlist> 
  248: #  <tag1>..</tag1>
  249: #  <tag2>..</tag2>
  250: #  <tag3>..</tag3>
  251: #  ... 
  252: # </randomlist>
  253: sub start_randomlist {
  254:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  255:   my $body= &Apache::lonxml::get_all_text("/randomlist",$$parser[$#$parser]);
  256:   my $b_parser= HTML::TokeParser->new(\$body);
  257:   my $b_tok;
  258:   my @randomlist;
  259:   my $list_item;
  260: 
  261:   while($b_tok = $b_parser->get_token() ) {
  262:     if($b_tok->[0] eq 'S') { # start tag
  263:     # get content of the tag until matching end tag
  264:     # get all text upto the matching tag
  265:     # and push the content into @randomlist
  266:       $list_item = &Apache::lonxml::get_all_text('/'.$b_tok->[1],$b_parser);
  267:       $list_item = "$b_tok->[4]"."$list_item"."</$b_tok->[1]>";
  268:       push(@randomlist,$list_item);
  269:    #  print "<br /><b>START-TAG $b_tok->[1], $b_tok->[4], $list_item</b>";
  270:     }
  271:     if($b_tok->[0] eq 'T') { # text
  272:     # what to do with text in between tags?
  273:       #  print "<b>TEXT $b_tok->[1]</b><br />";
  274:     }
  275:     # if($b_tok->[0] eq 'E') { # end tag, should not happen
  276:       #  print "<b>END-TAG $b_tok->[1]</b><br />";
  277:     # }
  278:   }
  279:   my @idx_arr = (0 .. $#randomlist);
  280:   &Apache::structuretags::shuffle(\@idx_arr);
  281:   my $bodytext = '';
  282:   for(0 .. $#randomlist) {
  283:     $bodytext .= "$randomlist[ $idx_arr[$_] ]";
  284:   }
  285: 
  286:   &Apache::lonxml::newparser($parser,\$bodytext);
  287:   return "";
  288: }
  289: 
  290: sub shuffle {
  291:     my $a=shift;
  292:     my $i;
  293:     for($i=@$a;--$i;) {
  294:       my $j=int rand($i+1);
  295:       next if $i == $j;
  296:       @$a[$i,$j] = @$a[$j,$i];
  297:     }
  298: }
  299: 
  300: sub end_randomlist {
  301:   return '';
  302: }
  303: 
  304: sub start_part {
  305:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  306:   my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
  307:   if ($id eq '') { $id = $Apache::lonxml::curdepth; }
  308:   $Apache::inputtags::part=$id;
  309:   @Apache::inputtags::responselist = ();
  310:   if ($target eq 'meta') {
  311:     return &Apache::response::mandatory_part_meta;
  312:   } elsif ($target eq 'web' || $target eq 'grade') {
  313:     my ($status,$datemsg) = &Apache::lonhomework::check_date($id);
  314:     push (@Apache::inputtags::status,$status);
  315:     my $expression='$external::datestatus="'.$status.'";';
  316:     $expression.='$external::gradestatus="'.$Apache::lonhomework::history{"resource.$id.solved"}.'";';
  317:     &Apache::run::run($expression,$safeeval);
  318:     if ( $status eq 'CLOSED' ) {
  319:       my $bodytext=&Apache::lonxml::get_all_text("/part",$$parser[$#$parser]);
  320:       if ( $target eq "web" ) {
  321: 	return "<br />Part is not open to be viewed. It $datemsg<br />";
  322:       }
  323:     }
  324:   }
  325:   return '';
  326: }
  327: 
  328: sub end_part {
  329:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  330:   &Apache::lonxml::debug("in end_part $target ");
  331:   my $status=$Apache::inputtags::status['-1'];
  332:   pop @Apache::inputtags::status;
  333:   if ( $target eq 'meta' ) { return ''; }
  334:   if ( $target eq 'grade' && $status eq 'CAN_ANSWER') {
  335:     return &Apache::inputtags::grade;
  336:   }
  337:   if ($target eq 'web') {
  338:     return &Apache::inputtags::gradestatus($Apache::inputtags::part);
  339:   }
  340:   return '';
  341: }
  342: 
  343: sub start_preduedate {
  344:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  345:   if ($target eq 'web' || $target eq 'grade') {
  346:     if ($Apache::inputtags::status['-1'] ne 'CAN_ANSWER' &&
  347: 	$Apache::inputtags::status['-1'] ne 'CANNOT_ANSWER' ) {
  348:       &Apache::lonxml::get_all_text("/preduedate",$$parser[$#$parser]);
  349:     }
  350:   }
  351:   return '';
  352: }
  353: 
  354: sub end_preduedate {
  355:   return '';
  356: }
  357: 
  358: sub start_postanswerdate {
  359:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  360:   if ($target eq 'web' || $target eq 'grade') {
  361:     if ($Apache::inputtags::status['-1'] ne 'SHOW_ANSWER') {
  362:       &Apache::lonxml::get_all_text("/postanswerdate",$$parser[$#$parser]);
  363:     }
  364:   }
  365:   return '';
  366: }
  367: 
  368: sub end_postanswerdate {
  369:   return '';
  370: }
  371: 
  372: sub start_notsolved {
  373:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  374:   if ($target eq 'web' || $target eq 'grade') {
  375:     my $gradestatus=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
  376:     &Apache::lonxml::debug("not solved has :$gradestatus:");
  377:     if ($gradestatus =~ /^correct/) {
  378:       &Apache::lonxml::debug("skipping");
  379:       &Apache::lonxml::get_all_text("/notsolved",$$parser[$#$parser]);
  380:     }
  381:   }
  382:   return '';
  383: }
  384: 
  385: sub end_notsolved {
  386:   return '';
  387: }
  388: 
  389: sub start_solved {
  390:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  391:   if ($target eq 'web' || $target eq 'grade') {
  392:     my $gradestatus=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
  393:     if ($gradestatus !~ /^correct/) {
  394:       &Apache::lonxml::get_all_text("/solved",$$parser[$#$parser]);
  395:     }
  396:   }
  397:   return '';
  398: }
  399: 
  400: sub end_solved {
  401:   return '';
  402: }
  403: 
  404: sub start_startouttext {
  405:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  406:   my @result=(''.'');
  407:   if ($target eq 'edit' || $target eq 'modified' ) { @result=('','no'); }
  408:   return (@result);
  409: }
  410: sub end_startouttext {
  411:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  412:   my $result='';
  413:   my $text='';
  414: 
  415:   if ($target eq 'edit') {
  416:     $text=&Apache::lonxml::get_all_text("endouttext",$$parser[$#$parser]);
  417:     $result.=&Apache::edit::start_table($token)."<tr><td>Text Block</td>
  418: <td>Delete:".
  419:   &Apache::edit::deletelist($target,$token)
  420:   ."</td>
  421: <td>".
  422:   &Apache::edit::insertlist($target,$token).
  423:     "</td>
  424: </tr><tr><td colspan=\"3\">\n".
  425: 	&Apache::edit::editfield($token->[1],$text,"",50,4);
  426:   }
  427:   if ($target eq 'modified') {
  428:     $text=&Apache::lonxml::get_all_text("endouttext",$$parser['-1']);
  429:     $result='<startouttext />'.&Apache::edit::modifiedfield();
  430:   }
  431:   return $result;
  432: }
  433: sub start_endouttext {
  434:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  435:   my $result='';
  436:   if ($target eq "edit" ) { $result="</td></tr>".&Apache::edit::end_table()."\n"; }
  437:   if ($target eq "modified") { $result='<endouttext />'; }
  438:   return $result;
  439: }
  440: sub end_endouttext {
  441:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  442:   my @result=('','');
  443:   if ($target eq "edit" || $target eq 'modified') { @result=('','no'); }
  444:   return (@result);
  445: }
  446: sub delete_startouttext {
  447:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
  448: #  my $text=&Apache::lonxml::get_all_text("endouttext",$$parser['-1']);
  449:   my $text=$$parser['-1']->get_text("/endouttext");
  450:   my $token=$$parser['-1']->get_token();
  451:   &Apache::lonxml::debug("Deleting :$text: and :$token->[0]:$token->[1]:$token->[2]: for startouttext");
  452:   &Apache::lonxml::end_tag($tagstack,$parstack,$token);
  453:   # Deleting 2 parallel tag pairs, but we need the numbers later to look like 
  454:   # they did the last time round
  455:   &Apache::lonxml::increasedepth($token);
  456:   &Apache::lonxml::decreasedepth($token);
  457:   return 1;
  458: }
  459: 
  460: 1;
  461: __END__

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