File:  [LON-CAPA] / loncom / homework / structuretags.pm
Revision 1.53: download - view: text, annotated - select for diffs
Thu Aug 16 21:06:22 2001 UTC (22 years, 8 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- sets $Apaceh::lonhomework::type off of
   - &EXT('resource.0.type')
   - extension on URI
   - default value of 'problem'

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

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