File:  [LON-CAPA] / loncom / homework / structuretags.pm
Revision 1.55: download - view: text, annotated - select for diffs
Fri Aug 17 14:24:29 2001 UTC (22 years, 8 months ago) by www
Branches: MAIN
CVS tags: HEAD
check_date became check_access for more general functionality

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

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