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

1.6       tsai        1: # The LearningOnline Network with CAPA # <script> definiton
1.1       albertel    2: 
                      3: package Apache::structuretags; 
                      4: 
                      5: use strict;
                      6: use Apache::lonnet;
                      7: 
                      8: sub BEGIN {
1.25      albertel    9:   &Apache::lonxml::register('Apache::structuretags',('block','while','randomlist','problem','web','tex','part','preduedate','postanswerdate','solved','notsolved'));
1.10      albertel   10: }
                     11: 
                     12: sub start_web {
                     13:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
                     14:   my $bodytext=&Apache::lonxml::get_all_text("/web",$$parser[$#$parser]);
1.19      albertel   15:   if ($target eq 'web') {
                     16:     return $bodytext;
                     17:   } 
                     18:   return '';
1.10      albertel   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]);
1.19      albertel   27:   if ($target eq 'tex') {
                     28:     return $bodytext
                     29:   }
1.10      albertel   30:   return '';
                     31: }
                     32: 
                     33: sub end_tex {
1.9       albertel   34: }
                     35: 
                     36: sub start_problem {
                     37:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
1.19      albertel   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);
1.22      albertel   46:   my $status;
                     47:   my $datemsg;
1.21      albertel   48:   if ($target ne 'meta') {
1.22      albertel   49:     ($status,$datemsg) = &Apache::lonhomework::check_date('0');
                     50:     push (@Apache::inputtags::status,$status);
1.24      albertel   51:     my $expression='$external::datestatus="'.$status.'";';
                     52:     $expression.='$external::gradestatus="'.$Apache::lonhomework::history{"resource.0.solved"}.'";';
                     53:     &Apache::run::run($expression,$safeeval);
1.22      albertel   54:     if ( $status eq 'CLOSED' ) {
1.21      albertel   55:       my $bodytext=&Apache::lonxml::get_all_text("/problem",$$parser[$#$parser]);
                     56:       if ( $target eq "web" ) {
1.23      albertel   57: 	return "<br></br>Problem is not open to be viewed. The problem $datemsg<br></br>";
1.21      albertel   58:       }
1.22      albertel   59:     } 
1.21      albertel   60:   }
1.19      albertel   61:   if ($target eq 'web') {
1.16      albertel   62:     my $args ='';
1.19      albertel   63:     if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; }
1.16      albertel   64:     my $name = &Apache::run::run("{$args;".'return $name}',$safeeval);
1.22      albertel   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:   }
1.19      albertel   72:   return '';
1.9       albertel   73: }
                     74: 
                     75: sub end_problem {
1.16      albertel   76:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
                     77:   my $result='';
1.24      albertel   78:   my $status=$Apache::inputtags::status['-1'];
1.16      albertel   79:   unless ($target eq 'meta') {
1.19      albertel   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
1.20      albertel   86:       $result.= &Apache::inputtags::gradestatus($Apache::inputtags::part);
1.19      albertel   87:     } 
1.22      albertel   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:     }
1.16      albertel   95:   } else {
1.18      albertel   96:     if ($Apache::inputtags::part eq '0') {
1.16      albertel   97:       $result=&Apache::response::mandatory_part_meta;
                     98:     }
                     99:   }
                    100:   return $result;
1.1       albertel  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;';
1.3       albertel  109: #  print "<br>$code<br>";
1.1       albertel  110:   my $result = &Apache::run::run($code,$safeeval);
1.24      albertel  111:   &Apache::lonxml::debug("block :$code: returned :$result:");
1.1       albertel  112:   if ( ! $result ) { 
1.9       albertel  113:     my $skip=&Apache::lonxml::get_all_text("/block",$$parser[$#$parser]);
1.24      albertel  114:     &Apache::lonxml::debug("skipping ahead :$skip: $$parser[$#$parser]");
1.1       albertel  115:   }
                    116:   return "";
                    117: }
                    118: 
                    119: sub end_block {
1.4       tsai      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: 
1.5       tsai      129:   push( @Apache::structuretags::whileconds, $code); 
1.4       tsai      130:   my $result = &Apache::run::run($code,$safeeval);
                    131:   my $bodytext=$$parser[$#$parser]->get_text("/while");
1.5       tsai      132:   push( @Apache::structuretags::whilebody, $bodytext);
                    133:   if ( $result ) { 
1.8       albertel  134:     &Apache::lonxml::newparser($parser,\$bodytext);
1.4       tsai      135:   }
                    136:   return "";
                    137: }
                    138: 
                    139: sub end_while {
1.5       tsai      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 ) { 
1.8       albertel  145:     &Apache::lonxml::newparser($parser,\$bodytext);
1.5       tsai      146:   } 
                    147:   return "";
1.1       albertel  148: }
1.6       tsai      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)=@_;
1.9       albertel  158:   my $body= &Apache::lonxml::get_all_text("/randomlist",$$parser[$#$parser]);
1.6       tsai      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
1.9       albertel  169:       $list_item = &Apache::lonxml::get_all_text('/'.$b_tok->[1],$b_parser);
1.7       tsai      170:       $list_item = "$b_tok->[4]"."$list_item"."</$b_tok->[1]>";
1.6       tsai      171:       push(@randomlist,$list_item);
1.7       tsai      172:    #  print "<BR><B>START-TAG $b_tok->[1], $b_tok->[4], $list_item</B>";
1.6       tsai      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:   }
1.7       tsai      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:   }
1.8       albertel  188: 
                    189:   &Apache::lonxml::newparser($parser,\$bodytext);
1.6       tsai      190:   return "";
1.7       tsai      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:     }
1.6       tsai      201: }
                    202: 
                    203: sub end_randomlist {
                    204: }
                    205: 
1.11      albertel  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);
1.14      albertel  211:   $Apache::inputtags::part=$id;
1.18      albertel  212:   @Apache::inputtags::responselist = ();
1.15      www       213:   if ($target eq 'meta') {
1.16      albertel  214:     return &Apache::response::mandatory_part_meta;
1.21      albertel  215:   } else {
1.23      albertel  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' ) {
1.21      albertel  222:       my $bodytext=&Apache::lonxml::get_all_text("/part",$$parser[$#$parser]);
                    223:       if ( $target eq "web" ) {
1.23      albertel  224: 	return "<br></br>Part is not open to be viewed. It $datemsg<br></br>";
1.21      albertel  225:       }
                    226:     }
1.15      www       227:   }
1.19      albertel  228:   return '';
1.11      albertel  229: }
                    230: 
                    231: sub end_part {
                    232:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
1.18      albertel  233:   &Apache::lonxml::debug("in end_part $target ");
1.23      albertel  234:   pop @Apache::inputtags::status;
1.19      albertel  235:   if ( $target eq 'meta' ) { return ''; }
1.24      albertel  236:   if ( $target eq 'grade' ) { return &Apache::inputtags::grade; }
1.20      albertel  237:   return &Apache::inputtags::gradestatus($Apache::inputtags::part);
1.11      albertel  238: }
1.1       albertel  239: 
1.25      albertel  240: sub start_preduedate {
1.24      albertel  241:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
                    242:   if ($target ne 'meta') {
                    243:     if ($Apache::inputtags::status['-1'] ne 'CAN_ANSWER') {
1.26    ! albertel  244:       &Apache::lonxml::get_all_text("/preduedate",$$parser[$#$parser]);
1.24      albertel  245:     }
                    246:   }
                    247:   return '';
                    248: }
                    249: 
1.25      albertel  250: sub end_preduedate {
1.24      albertel  251:   return '';
                    252: }
                    253: 
1.25      albertel  254: sub start_postanswerdate {
1.24      albertel  255:   my ($target,$token,$parstack,$parser,$safeeval)=@_;
                    256:   if ($target ne 'meta') {
                    257:     if ($Apache::inputtags::status['-1'] ne 'SHOW_ANSWER') {
1.26    ! albertel  258:       &Apache::lonxml::get_all_text("/postanswerdate",$$parser[$#$parser]);
1.24      albertel  259:     }
                    260:   }
                    261:   return '';
                    262: }
                    263: 
1.25      albertel  264: sub end_postanswerdate {
1.24      albertel  265:   return '';
                    266: }
                    267: 
1.25      albertel  268: sub start_notsolved {
1.24      albertel  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");
1.26    ! albertel  275:       &Apache::lonxml::get_all_text("/notsolved",$$parser[$#$parser]);
1.24      albertel  276:     }
                    277:   }
                    278:   return '';
                    279: }
                    280: 
1.25      albertel  281: sub end_notsolved {
1.24      albertel  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: }
1.1       albertel  299: 1;
                    300: __END__

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