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>