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

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

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