File:  [LON-CAPA] / loncom / homework / structuretags.pm
Revision 1.60: download - view: text, annotated - select for diffs
Mon Aug 20 14:24:12 2001 UTC (22 years, 8 months ago) by www
Branches: MAIN
CVS tags: HEAD
Confirmation of Check Out

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

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