Annotation of loncom/homework/structuretags.pm, revision 1.44

1.34      albertel    1: # The LearningOnline Network with CAPA 
                      2: # definition of tags that give a structure to a document
1.33      albertel    3: # 2/19 Guy
1.44    ! ng          4: # 6/26/2001 fixed extra web display at end of <web></web> tags
1.1       albertel    5: package Apache::structuretags; 
                      6: 
                      7: use strict;
                      8: use Apache::lonnet;
                      9: 
                     10: sub BEGIN {
1.34      albertel   11:   &Apache::lonxml::register('Apache::structuretags',('block','while','randomlist','problem','web','tex','part','preduedate','postanswerdate','solved','notsolved','startouttext','endouttext'));
1.37      albertel   12: #  &Apache::lonxml::register_insert('problem','',('part','postanswerdate','preduedate'))
1.10      albertel   13: }
                     14: 
                     15: sub start_web {
1.40      albertel   16:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.10      albertel   17:   my $bodytext=&Apache::lonxml::get_all_text("/web",$$parser[$#$parser]);
1.19      albertel   18:   if ($target eq 'web') {
                     19:     return $bodytext;
                     20:   } 
                     21:   return '';
1.10      albertel   22: }
                     23: 
                     24: sub end_web {
1.44    ! ng         25:     return '';
1.10      albertel   26: }
                     27: 
                     28: sub start_tex {
1.40      albertel   29:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.10      albertel   30:   my $bodytext=&Apache::lonxml::get_all_text("/tex",$$parser[$#$parser]);
1.19      albertel   31:   if ($target eq 'tex') {
                     32:     return $bodytext
                     33:   }
1.10      albertel   34:   return '';
                     35: }
                     36: 
                     37: sub end_tex {
1.44    ! ng         38:     return '';
1.9       albertel   39: }
                     40: 
                     41: sub start_problem {
1.40      albertel   42:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.19      albertel   43: 
                     44: #intialize globals
                     45:   $Apache::inputtags::part='0';
                     46:   @Apache::inputtags::responselist = ();
1.42      albertel   47:   $Apache::lonhomework::type=&Apache::lonnet::EXT('resource.0.type');
                     48:   &Apache::lonxml::debug("Found this to be of type :$Apache::lonhomework::type:");
                     49:   if ($Apache::lonhomework::type eq '') {
                     50:     $Apache::lonhomework::type='homework';
                     51:   }
1.19      albertel   52: #adeed vars to the scripting enviroment
                     53:   my $expression='$external::part='.$Apache::inputtags::part.';';
                     54:   &Apache::run::run($expression,$safeeval);
1.22      albertel   55:   my $status;
                     56:   my $datemsg;
1.36      albertel   57: 
1.41      albertel   58:   #should get back a <html> or the neccesary stuff to start XML/MathML
1.40      albertel   59:   my $result=&Apache::londefdef::start_html($target,$token,$tagstack,$parstack,$parser,$safeeval);
1.36      albertel   60: 
1.41      albertel   61:   my $head_tag_start='<head>'.&Apache::lonxml::registerurl();
                     62:   my $body_tag_start='<body onLoad="'.&Apache::lonxml::loadevents().'" '.
                     63: 	  'onUnload="'.&Apache::lonxml::unloadevents().'" '.
                     64: 	    'bgcolor="#FFFFFF">';
1.34      albertel   65:   if ($target eq 'web' || $target eq 'grade') {
1.22      albertel   66:     ($status,$datemsg) = &Apache::lonhomework::check_date('0');
                     67:     push (@Apache::inputtags::status,$status);
1.24      albertel   68:     my $expression='$external::datestatus="'.$status.'";';
                     69:     $expression.='$external::gradestatus="'.$Apache::lonhomework::history{"resource.0.solved"}.'";';
                     70:     &Apache::run::run($expression,$safeeval);
1.22      albertel   71:     if ( $status eq 'CLOSED' ) {
1.21      albertel   72:       my $bodytext=&Apache::lonxml::get_all_text("/problem",$$parser[$#$parser]);
                     73:       if ( $target eq "web" ) {
1.41      albertel   74: 	$result.= $head_tag_start.'</head>';
                     75: 	return $result . $body_tag_start .
                     76: 	  " <br />Problem is not open to be viewed. The problem $datemsg<br />";
1.21      albertel   77:       }
1.41      albertel   78:     }
1.21      albertel   79:   }
1.19      albertel   80:   if ($target eq 'web') {
1.39      albertel   81:     my $name= &Apache::lonxml::get_param('name',$parstack,$safeeval);
1.30      albertel   82:     if ($name eq '') { 
                     83:       $name=&Apache::lonnet::EXT('resource.title');
                     84:       if ($name eq 'con_lost') { $name = ''; }
                     85:     }
                     86:     $Apache::lonhomework::name=$name;
1.22      albertel   87:     if ($status eq 'CAN_ANSWER') {
                     88:       # create a page header and exit
1.41      albertel   89:       $result.="$head_tag_start<title>$name</title></head>\n
                     90:               $body_tag_start\n
1.36      albertel   91:               <form name=\"lonhomework\" method=\"POST\" action=\"".$ENV{'request.uri'}."\">".
                     92: 		'<input type="hidden" name="submitted" value="yes" />';
                     93:       if ($ENV{'request.state'} eq "construct") {
                     94: 	$result.='<input type="hidden" name="problemmode" value="View" />
                     95:                  <input type="submit" name="problemmode" value="Edit" /><hr />';
                     96:       }
                     97:       return $result;
1.29      albertel   98:     } elsif ($status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER' || $status eq 'CLOSED') {
1.41      albertel   99:       return $result.$head_tag_start."<title>$name</title></head>\n$body_tag_start\n";
1.22      albertel  100:     }
                    101:   }
1.34      albertel  102:   if ($target eq 'edit') {
1.41      albertel  103:     $result.=$head_tag_start."</head>".$body_tag_start.
                    104:       '<form name="lonhomework" method="POST" action="'.$ENV{'request.uri'}.'">
                    105:        <input type="hidden" name="submitted" value="edit" />
                    106:        <input type="hidden" name="problemmode" value="Edit" />
                    107:        <input type="submit" name="problemmode" value="View" />
                    108:        <input type="submit" name="Undo" value="undo" /> <hr />
                    109:       ';
1.39      albertel  110:     my $temp=&Apache::edit::insertlist($target,$token);
1.36      albertel  111:     $result.=$temp;
                    112:     return $result;
1.34      albertel  113:   }
1.37      albertel  114:   if ($target eq 'modified') {
                    115:     $result=$token->[4];
                    116:     $result.=&Apache::edit::handle_insert();
                    117:     return $result;
                    118:   }
1.19      albertel  119:   return '';
1.9       albertel  120: }
                    121: 
                    122: sub end_problem {
1.40      albertel  123:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.16      albertel  124:   my $result='';
1.24      albertel  125:   my $status=$Apache::inputtags::status['-1'];
1.40      albertel  126:   if ($target eq 'grade' || $target eq 'web' ) {
1.28      albertel  127:     if ( $target eq 'grade' && $Apache::inputtags::part eq '0' &&
                    128:        $status eq 'CAN_ANSWER') {
1.19      albertel  129:       # if part is zero, no <part>s existed, so we need to the grading
                    130:       &Apache::inputtags::grade;
                    131:     } elsif ($Apache::inputtags::part eq '0') {
                    132:       # if part is zero, no <part>s existed, so we need show the current 
                    133:       # grading status
1.20      albertel  134:       $result.= &Apache::inputtags::gradestatus($Apache::inputtags::part);
1.41      albertel  135:     }
1.22      albertel  136:     if ($target eq 'web') { 
                    137:       if ($status eq 'CAN_ANSWER') {
                    138: 	$result.="</form></body>\n"; 
1.28      albertel  139:       } elsif ($status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {
1.41      albertel  140: 	$result.="</body>\n";
                    141:       }
1.22      albertel  142:     }
1.41      albertel  143:   }
1.34      albertel  144:   if ($target eq 'meta') {
1.18      albertel  145:     if ($Apache::inputtags::part eq '0') {
1.16      albertel  146:       $result=&Apache::response::mandatory_part_meta;
                    147:     }
                    148:   }
1.34      albertel  149:   if ($target eq 'edit') {
                    150:     &Apache::lonxml::debug("in end_problem with $target, edit");
                    151:     $result='<br /><input type="submit" name="submit" value="Submit Changes" />';
                    152:   }
1.16      albertel  153:   return $result;
1.1       albertel  154: }
                    155: 
                    156: sub start_block {
1.40      albertel  157:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.1       albertel  158: 
1.38      albertel  159:   if ($target eq 'web' || $target eq 'grade') {
                    160:     my $code = @$parstack[$#$parstack];
                    161:     $code =~ s/\"//g;
                    162:     $code .=';return $condition;';
                    163:     #  print "<br />$code<br />";
                    164:     my $result = &Apache::run::run($code,$safeeval);
                    165:     &Apache::lonxml::debug("block :$code: returned :$result:");
                    166:     if ( ! $result ) { 
                    167:       my $skip=&Apache::lonxml::get_all_text("/block",$$parser[$#$parser]);
                    168:       &Apache::lonxml::debug("skipping ahead :$skip: $$parser[$#$parser]");
                    169:     }
1.1       albertel  170:   }
                    171:   return "";
                    172: }
                    173: 
                    174: sub end_block {
1.38      albertel  175:   return '';
1.4       tsai      176: }
                    177: 
                    178: sub start_while {
1.40      albertel  179:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.4       tsai      180: 
                    181:   my $code = @$parstack[$#$parstack];
                    182:   $code =~ s/\"//g;
                    183:   $code .=';return $condition;';
                    184: 
1.5       tsai      185:   push( @Apache::structuretags::whileconds, $code); 
1.4       tsai      186:   my $result = &Apache::run::run($code,$safeeval);
                    187:   my $bodytext=$$parser[$#$parser]->get_text("/while");
1.5       tsai      188:   push( @Apache::structuretags::whilebody, $bodytext);
                    189:   if ( $result ) { 
1.8       albertel  190:     &Apache::lonxml::newparser($parser,\$bodytext);
1.4       tsai      191:   }
                    192:   return "";
                    193: }
                    194: 
                    195: sub end_while {
1.40      albertel  196:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.5       tsai      197:   my $code = pop @Apache::structuretags::whileconds;
                    198:   my $bodytext = pop @Apache::structuretags::whilebody;
                    199:   my $result = &Apache::run::run($code,$safeeval);
                    200:   if ( $result ) { 
1.8       albertel  201:     &Apache::lonxml::newparser($parser,\$bodytext);
1.5       tsai      202:   } 
                    203:   return "";
1.1       albertel  204: }
1.6       tsai      205: 
                    206: # <randomlist> 
                    207: #  <tag1>..</tag1>
                    208: #  <tag2>..</tag2>
                    209: #  <tag3>..</tag3>
                    210: #  ... 
                    211: # </randomlist>
                    212: sub start_randomlist {
1.40      albertel  213:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.9       albertel  214:   my $body= &Apache::lonxml::get_all_text("/randomlist",$$parser[$#$parser]);
1.6       tsai      215:   my $b_parser= HTML::TokeParser->new(\$body);
                    216:   my $b_tok;
                    217:   my @randomlist;
                    218:   my $list_item;
                    219: 
                    220:   while($b_tok = $b_parser->get_token() ) {
                    221:     if($b_tok->[0] eq 'S') { # start tag
                    222:     # get content of the tag until matching end tag
                    223:     # get all text upto the matching tag
                    224:     # and push the content into @randomlist
1.9       albertel  225:       $list_item = &Apache::lonxml::get_all_text('/'.$b_tok->[1],$b_parser);
1.7       tsai      226:       $list_item = "$b_tok->[4]"."$list_item"."</$b_tok->[1]>";
1.6       tsai      227:       push(@randomlist,$list_item);
1.32      albertel  228:    #  print "<br /><b>START-TAG $b_tok->[1], $b_tok->[4], $list_item</b>";
1.6       tsai      229:     }
                    230:     if($b_tok->[0] eq 'T') { # text
                    231:     # what to do with text in between tags?
1.32      albertel  232:       #  print "<b>TEXT $b_tok->[1]</b><br />";
1.6       tsai      233:     }
                    234:     # if($b_tok->[0] eq 'E') { # end tag, should not happen
1.32      albertel  235:       #  print "<b>END-TAG $b_tok->[1]</b><br />";
1.6       tsai      236:     # }
                    237:   }
1.7       tsai      238:   my @idx_arr = (0 .. $#randomlist);
                    239:   &Apache::structuretags::shuffle(\@idx_arr);
                    240:   my $bodytext = '';
                    241:   for(0 .. $#randomlist) {
                    242:     $bodytext .= "$randomlist[ $idx_arr[$_] ]";
                    243:   }
1.8       albertel  244: 
                    245:   &Apache::lonxml::newparser($parser,\$bodytext);
1.6       tsai      246:   return "";
1.7       tsai      247: }
                    248: 
                    249: sub shuffle {
                    250:     my $a=shift;
                    251:     my $i;
                    252:     for($i=@$a;--$i;) {
                    253:       my $j=int rand($i+1);
                    254:       next if $i == $j;
                    255:       @$a[$i,$j] = @$a[$j,$i];
                    256:     }
1.6       tsai      257: }
                    258: 
                    259: sub end_randomlist {
                    260: }
                    261: 
1.11      albertel  262: sub start_part {
1.40      albertel  263:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.39      albertel  264:   my $id= &Apache::lonxml::get_param('id',$parstack,$safeeval);
1.14      albertel  265:   $Apache::inputtags::part=$id;
1.18      albertel  266:   @Apache::inputtags::responselist = ();
1.15      www       267:   if ($target eq 'meta') {
1.16      albertel  268:     return &Apache::response::mandatory_part_meta;
1.37      albertel  269:   } elsif ($target eq 'web' || $target eq 'grade') {
1.23      albertel  270:     my ($status,$datemsg) = &Apache::lonhomework::check_date("OPEN_DATE",$id);
                    271:     push (@Apache::inputtags::status,$status);
                    272:     my $expression='$external::datestatus="'.$status.'";';
                    273:     $expression.='$external::gradestatus="'.$Apache::lonhomework::history{"resource.$id.solved"}.'";';
                    274:     &Apache::run::run($expression,$safeeval);
                    275:     if ( $status eq 'CLOSED' ) {
1.21      albertel  276:       my $bodytext=&Apache::lonxml::get_all_text("/part",$$parser[$#$parser]);
                    277:       if ( $target eq "web" ) {
1.32      albertel  278: 	return "<br />Part is not open to be viewed. It $datemsg<br />";
1.21      albertel  279:       }
                    280:     }
1.15      www       281:   }
1.19      albertel  282:   return '';
1.11      albertel  283: }
                    284: 
                    285: sub end_part {
1.40      albertel  286:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.18      albertel  287:   &Apache::lonxml::debug("in end_part $target ");
1.28      albertel  288:   my $status=$Apache::inputtags::status['-1'];
1.23      albertel  289:   pop @Apache::inputtags::status;
1.19      albertel  290:   if ( $target eq 'meta' ) { return ''; }
1.37      albertel  291:   if ( $target eq 'grade' && $status eq 'CAN_ANSWER') {
                    292:     return &Apache::inputtags::grade;
1.28      albertel  293:   }
1.37      albertel  294:   if ($target eq 'web') {
                    295:     return &Apache::inputtags::gradestatus($Apache::inputtags::part);
                    296:   }
                    297:   return '';
1.11      albertel  298: }
1.1       albertel  299: 
1.25      albertel  300: sub start_preduedate {
1.40      albertel  301:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.34      albertel  302:   if ($target eq 'web' || $target eq 'grade') {
1.29      albertel  303:     if ($Apache::inputtags::status['-1'] ne 'CAN_ANSWER' &&
                    304: 	$Apache::inputtags::status['-1'] ne 'CANNOT_ANSWER' ) {
1.26      albertel  305:       &Apache::lonxml::get_all_text("/preduedate",$$parser[$#$parser]);
1.24      albertel  306:     }
                    307:   }
                    308:   return '';
                    309: }
                    310: 
1.25      albertel  311: sub end_preduedate {
1.24      albertel  312:   return '';
                    313: }
                    314: 
1.25      albertel  315: sub start_postanswerdate {
1.40      albertel  316:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.34      albertel  317:   if ($target eq 'web' || $target eq 'grade') {
1.24      albertel  318:     if ($Apache::inputtags::status['-1'] ne 'SHOW_ANSWER') {
1.26      albertel  319:       &Apache::lonxml::get_all_text("/postanswerdate",$$parser[$#$parser]);
1.24      albertel  320:     }
                    321:   }
                    322:   return '';
                    323: }
                    324: 
1.25      albertel  325: sub end_postanswerdate {
1.24      albertel  326:   return '';
                    327: }
                    328: 
1.25      albertel  329: sub start_notsolved {
1.40      albertel  330:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.34      albertel  331:   if ($target eq 'web' || $target eq 'grade') {
1.24      albertel  332:     my $gradestatus=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
                    333:     &Apache::lonxml::debug("not solved has :$gradestatus:");
                    334:     if ($gradestatus =~ /^correct/) {
                    335:       &Apache::lonxml::debug("skipping");
1.26      albertel  336:       &Apache::lonxml::get_all_text("/notsolved",$$parser[$#$parser]);
1.24      albertel  337:     }
                    338:   }
                    339:   return '';
                    340: }
                    341: 
1.25      albertel  342: sub end_notsolved {
1.24      albertel  343:   return '';
                    344: }
                    345: 
                    346: sub start_solved {
1.40      albertel  347:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.34      albertel  348:   if ($target eq 'web' || $target eq 'grade') {
1.24      albertel  349:     my $gradestatus=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
                    350:     if ($gradestatus !~ /^correct/) {
                    351:       &Apache::lonxml::get_all_text("/solved",$$parser[$#$parser]);
                    352:     }
                    353:   }
                    354:   return '';
                    355: }
                    356: 
                    357: sub end_solved {
                    358:   return '';
                    359: }
1.34      albertel  360: 
                    361: sub start_startouttext {
1.40      albertel  362:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.35      albertel  363:   my @result=(''.'');
                    364:   if ($target eq 'edit' || $target eq 'modified' ) { @result=('','no'); }
                    365:   return (@result);
1.34      albertel  366: }
                    367: sub end_startouttext {
1.40      albertel  368:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.34      albertel  369:   my $result='';
1.35      albertel  370:   my $text='';
                    371: 
1.34      albertel  372:   if ($target eq 'edit') {
1.35      albertel  373:     $text=&Apache::lonxml::get_all_text("endouttext",$$parser[$#$parser]);
1.43      albertel  374:     $result.=&Apache::edit::start_table($token)."<tr><td>Text Block</td>
1.42      albertel  375: <td>Delete:".
                    376:   &Apache::edit::deletelist($target,$token)
                    377:   ."</td>
                    378: <td>".
                    379:   &Apache::edit::insertlist($target,$token).
                    380:     "</td>
                    381: </tr><tr><td colspan=\"3\">\n".
                    382: 	&Apache::edit::editfield($token->[1],$text,"",50,5);
1.35      albertel  383:   }
                    384:   if ($target eq 'modified') {
                    385:     $text=&Apache::lonxml::get_all_text("endouttext",$$parser['-1']);
                    386:     $result='<startouttext />'.&Apache::edit::modifiedfield();
1.34      albertel  387:   }
                    388:   return $result;
                    389: }
                    390: sub start_endouttext {
1.40      albertel  391:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.34      albertel  392:   my $result='';
1.43      albertel  393:   if ($target eq "edit" ) { $result="</td></tr>".&Apache::edit::end_table()."\n"; }
1.35      albertel  394:   if ($target eq "modified") { $result='<endouttext />'; }
1.34      albertel  395:   return $result;
                    396: }
                    397: sub end_endouttext {
1.40      albertel  398:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
1.35      albertel  399:   my @result=('','');
                    400:   if ($target eq "edit" || $target eq 'modified') { @result=('','no'); }
                    401:   return (@result);
1.34      albertel  402: }
                    403: 
                    404: 
1.1       albertel  405: 1;
                    406: __END__

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