File:  [LON-CAPA] / loncom / homework / structuretags.pm
Revision 1.48: download - view: text, annotated - select for diffs
Wed Jul 18 20:08:34 2001 UTC (22 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- added support for .library and <library>

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

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