File:  [LON-CAPA] / loncom / homework / structuretags.pm
Revision 1.24: download - view: text, annotated - select for diffs
Thu Dec 21 18:13:33 2000 UTC (23 years, 4 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- most lectureonline tags work now, except for <hintpart> and <numericalresponse>

    1: # The LearningOnline Network with CAPA # <script> definiton
    2: 
    3: package Apache::structuretags; 
    4: 
    5: use strict;
    6: use Apache::lonnet;
    7: 
    8: sub BEGIN {
    9:   &Apache::lonxml::register('Apache::structuretags',('block','while','randomlist','problem','web','tex','part','pre_duedate','post_answerdate','solved','not_solved'));
   10: }
   11: 
   12: sub start_web {
   13:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
   14:   my $bodytext=&Apache::lonxml::get_all_text("/web",$$parser[$#$parser]);
   15:   if ($target eq 'web') {
   16:     return $bodytext;
   17:   } 
   18:   return '';
   19: }
   20: 
   21: sub end_web {
   22: }
   23: 
   24: sub start_tex {
   25:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
   26:   my $bodytext=&Apache::lonxml::get_all_text("/tex",$$parser[$#$parser]);
   27:   if ($target eq 'tex') {
   28:     return $bodytext
   29:   }
   30:   return '';
   31: }
   32: 
   33: sub end_tex {
   34: }
   35: 
   36: sub start_problem {
   37:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
   38: 
   39: #intialize globals
   40:   $Apache::inputtags::part='0';
   41:   @Apache::inputtags::responselist = ();
   42: 
   43: #adeed vars to the scripting enviroment
   44:   my $expression='$external::part='.$Apache::inputtags::part.';';
   45:   &Apache::run::run($expression,$safeeval);
   46:   my $status;
   47:   my $datemsg;
   48:   if ($target ne 'meta') {
   49:     ($status,$datemsg) = &Apache::lonhomework::check_date('0');
   50:     push (@Apache::inputtags::status,$status);
   51:     my $expression='$external::datestatus="'.$status.'";';
   52:     $expression.='$external::gradestatus="'.$Apache::lonhomework::history{"resource.0.solved"}.'";';
   53:     &Apache::run::run($expression,$safeeval);
   54:     if ( $status eq 'CLOSED' ) {
   55:       my $bodytext=&Apache::lonxml::get_all_text("/problem",$$parser[$#$parser]);
   56:       if ( $target eq "web" ) {
   57: 	return "<br></br>Problem is not open to be viewed. The problem $datemsg<br></br>";
   58:       }
   59:     } 
   60:   }
   61:   if ($target eq 'web') {
   62:     my $args ='';
   63:     if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; }
   64:     my $name = &Apache::run::run("{$args;".'return $name}',$safeeval);
   65:     if ($status eq 'CAN_ANSWER') {
   66:       # create a page header and exit
   67:       return "<title>$name</title>\n<body bgcolor=#FFFFFF>\n<form name=\"lonhomework\" method=\"POST\" action=\"".$ENV{'request.uri'}."\">";
   68:     } elsif ($status eq 'SHOW_ANSWER') {
   69:       return "<title>$name</title>\n<body bgcolor=#FFFFFF>\n";
   70:     }
   71:   }
   72:   return '';
   73: }
   74: 
   75: sub end_problem {
   76:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
   77:   my $result='';
   78:   my $status=$Apache::inputtags::status['-1'];
   79:   unless ($target eq 'meta') {
   80:     if ( $target eq 'grade' && $Apache::inputtags::part eq '0') {
   81:       # if part is zero, no <part>s existed, so we need to the grading
   82:       &Apache::inputtags::grade;
   83:     } elsif ($Apache::inputtags::part eq '0') {
   84:       # if part is zero, no <part>s existed, so we need show the current 
   85:       # grading status
   86:       $result.= &Apache::inputtags::gradestatus($Apache::inputtags::part);
   87:     } 
   88:     if ($target eq 'web') { 
   89:       if ($status eq 'CAN_ANSWER') {
   90: 	$result.="</form></body>\n"; 
   91:       } elsif ($status eq 'SHOW_ANSWER') {
   92: 	$result.="</body>\n"; 
   93:       } 
   94:     }
   95:   } else {
   96:     if ($Apache::inputtags::part eq '0') {
   97:       $result=&Apache::response::mandatory_part_meta;
   98:     }
   99:   }
  100:   return $result;
  101: }
  102: 
  103: sub start_block {
  104:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
  105: 
  106:   my $code = @$parstack[$#$parstack];
  107:   $code =~ s/\"//g;
  108:   $code .=';return $condition;';
  109: #  print "<br>$code<br>";
  110:   my $result = &Apache::run::run($code,$safeeval);
  111:   &Apache::lonxml::debug("block :$code: returned :$result:");
  112:   if ( ! $result ) { 
  113:     my $skip=&Apache::lonxml::get_all_text("/block",$$parser[$#$parser]);
  114:     &Apache::lonxml::debug("skipping ahead :$skip: $$parser[$#$parser]");
  115:   }
  116:   return "";
  117: }
  118: 
  119: sub end_block {
  120: }
  121: 
  122: sub start_while {
  123:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
  124: 
  125:   my $code = @$parstack[$#$parstack];
  126:   $code =~ s/\"//g;
  127:   $code .=';return $condition;';
  128: 
  129:   push( @Apache::structuretags::whileconds, $code); 
  130:   my $result = &Apache::run::run($code,$safeeval);
  131:   my $bodytext=$$parser[$#$parser]->get_text("/while");
  132:   push( @Apache::structuretags::whilebody, $bodytext);
  133:   if ( $result ) { 
  134:     &Apache::lonxml::newparser($parser,\$bodytext);
  135:   }
  136:   return "";
  137: }
  138: 
  139: sub end_while {
  140:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
  141:   my $code = pop @Apache::structuretags::whileconds;
  142:   my $bodytext = pop @Apache::structuretags::whilebody;
  143:   my $result = &Apache::run::run($code,$safeeval);
  144:   if ( $result ) { 
  145:     &Apache::lonxml::newparser($parser,\$bodytext);
  146:   } 
  147:   return "";
  148: }
  149: 
  150: # <randomlist> 
  151: #  <tag1>..</tag1>
  152: #  <tag2>..</tag2>
  153: #  <tag3>..</tag3>
  154: #  ... 
  155: # </randomlist>
  156: sub start_randomlist {
  157:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
  158:   my $body= &Apache::lonxml::get_all_text("/randomlist",$$parser[$#$parser]);
  159:   my $b_parser= HTML::TokeParser->new(\$body);
  160:   my $b_tok;
  161:   my @randomlist;
  162:   my $list_item;
  163: 
  164:   while($b_tok = $b_parser->get_token() ) {
  165:     if($b_tok->[0] eq 'S') { # start tag
  166:     # get content of the tag until matching end tag
  167:     # get all text upto the matching tag
  168:     # and push the content into @randomlist
  169:       $list_item = &Apache::lonxml::get_all_text('/'.$b_tok->[1],$b_parser);
  170:       $list_item = "$b_tok->[4]"."$list_item"."</$b_tok->[1]>";
  171:       push(@randomlist,$list_item);
  172:    #  print "<BR><B>START-TAG $b_tok->[1], $b_tok->[4], $list_item</B>";
  173:     }
  174:     if($b_tok->[0] eq 'T') { # text
  175:     # what to do with text in between tags?
  176:       #  print "<B>TEXT $b_tok->[1]</B><BR>";
  177:     }
  178:     # if($b_tok->[0] eq 'E') { # end tag, should not happen
  179:       #  print "<B>END-TAG $b_tok->[1]</B><BR>";
  180:     # }
  181:   }
  182:   my @idx_arr = (0 .. $#randomlist);
  183:   &Apache::structuretags::shuffle(\@idx_arr);
  184:   my $bodytext = '';
  185:   for(0 .. $#randomlist) {
  186:     $bodytext .= "$randomlist[ $idx_arr[$_] ]";
  187:   }
  188: 
  189:   &Apache::lonxml::newparser($parser,\$bodytext);
  190:   return "";
  191: }
  192: 
  193: sub shuffle {
  194:     my $a=shift;
  195:     my $i;
  196:     for($i=@$a;--$i;) {
  197:       my $j=int rand($i+1);
  198:       next if $i == $j;
  199:       @$a[$i,$j] = @$a[$j,$i];
  200:     }
  201: }
  202: 
  203: sub end_randomlist {
  204: }
  205: 
  206: sub start_part {
  207:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
  208:   my $args ='';
  209:   if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; }
  210:   my $id = &Apache::run::run("{$args;".'return $id}',$safeeval);
  211:   $Apache::inputtags::part=$id;
  212:   @Apache::inputtags::responselist = ();
  213:   if ($target eq 'meta') {
  214:     return &Apache::response::mandatory_part_meta;
  215:   } else {
  216:     my ($status,$datemsg) = &Apache::lonhomework::check_date("OPEN_DATE",$id);
  217:     push (@Apache::inputtags::status,$status);
  218:     my $expression='$external::datestatus="'.$status.'";';
  219:     $expression.='$external::gradestatus="'.$Apache::lonhomework::history{"resource.$id.solved"}.'";';
  220:     &Apache::run::run($expression,$safeeval);
  221:     if ( $status eq 'CLOSED' ) {
  222:       my $bodytext=&Apache::lonxml::get_all_text("/part",$$parser[$#$parser]);
  223:       if ( $target eq "web" ) {
  224: 	return "<br></br>Part is not open to be viewed. It $datemsg<br></br>";
  225:       }
  226:     }
  227:   }
  228:   return '';
  229: }
  230: 
  231: sub end_part {
  232:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
  233:   &Apache::lonxml::debug("in end_part $target ");
  234:   pop @Apache::inputtags::status;
  235:   if ( $target eq 'meta' ) { return ''; }
  236:   if ( $target eq 'grade' ) { return &Apache::inputtags::grade; }
  237:   return &Apache::inputtags::gradestatus($Apache::inputtags::part);
  238: }
  239: 
  240: sub start_pre_duedate {
  241:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
  242:   if ($target ne 'meta') {
  243:     if ($Apache::inputtags::status['-1'] ne 'CAN_ANSWER') {
  244:       &Apache::lonxml::get_all_text("/pre_duedate",$$parser[$#$parser]);
  245:     }
  246:   }
  247:   return '';
  248: }
  249: 
  250: sub end_pre_duedate {
  251:   return '';
  252: }
  253: 
  254: sub start_post_answerdate {
  255:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
  256:   if ($target ne 'meta') {
  257:     if ($Apache::inputtags::status['-1'] ne 'SHOW_ANSWER') {
  258:       &Apache::lonxml::get_all_text("/post_answerdate",$$parser[$#$parser]);
  259:     }
  260:   }
  261:   return '';
  262: }
  263: 
  264: sub end_post_answerdate {
  265:   return '';
  266: }
  267: 
  268: sub start_not_solved {
  269:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
  270:   if ($target ne 'meta') {
  271:     my $gradestatus=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
  272:     &Apache::lonxml::debug("not solved has :$gradestatus:");
  273:     if ($gradestatus =~ /^correct/) {
  274:       &Apache::lonxml::debug("skipping");
  275:       &Apache::lonxml::get_all_text("/not_solved",$$parser[$#$parser]);
  276:     }
  277:   }
  278:   return '';
  279: }
  280: 
  281: sub end_not_solved {
  282:   return '';
  283: }
  284: 
  285: sub start_solved {
  286:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
  287:   if ($target ne 'meta') {
  288:     my $gradestatus=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
  289:     if ($gradestatus !~ /^correct/) {
  290:       &Apache::lonxml::get_all_text("/solved",$$parser[$#$parser]);
  291:     }
  292:   }
  293:   return '';
  294: }
  295: 
  296: sub end_solved {
  297:   return '';
  298: }
  299: 1;
  300: __END__

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