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

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.24    ! albertel    9:   &Apache::lonxml::register('Apache::structuretags',('block','while','randomlist','problem','web','tex','part','pre_duedate','post_answerdate','solved','not_solved'));
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.24    ! albertel  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: }
1.1       albertel  299: 1;
                    300: __END__

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