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

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

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