File:  [LON-CAPA] / loncom / homework / structuretags.pm
Revision 1.50: download - view: text, annotated - select for diffs
Fri Aug 3 17:48:24 2001 UTC (22 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
-support background= and bgcolor= in <problem>
-call xmlend to end the page

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

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