File:  [LON-CAPA] / loncom / homework / structuretags.pm
Revision 1.52: download - view: text, annotated - select for diffs
Mon Aug 6 18:33:58 2001 UTC (22 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- stabilized <randomlist> randomness

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

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