Annotation of loncom/homework/structuretags.pm, revision 1.32
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.32 ! albertel 57: return "<body bgcolor=\"#FFFFFF\"> <br />Problem is not open to be viewed. The problem $datemsg<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.30 albertel 65: if ($name eq '') {
66: $name=&Apache::lonnet::EXT('resource.title');
67: if ($name eq 'con_lost') { $name = ''; }
68: }
69: $Apache::lonhomework::name=$name;
1.22 albertel 70: if ($status eq 'CAN_ANSWER') {
71: # create a page header and exit
1.31 albertel 72: 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 73: } elsif ($status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER' || $status eq 'CLOSED') {
1.22 albertel 74: return "<title>$name</title>\n<body bgcolor=#FFFFFF>\n";
75: }
76: }
1.19 albertel 77: return '';
1.9 albertel 78: }
79:
80: sub end_problem {
1.16 albertel 81: my ($target,$token,$parstack,$parser,$safeeval)=@_;
82: my $result='';
1.24 albertel 83: my $status=$Apache::inputtags::status['-1'];
1.16 albertel 84: unless ($target eq 'meta') {
1.28 albertel 85: if ( $target eq 'grade' && $Apache::inputtags::part eq '0' &&
86: $status eq 'CAN_ANSWER') {
1.19 albertel 87: # if part is zero, no <part>s existed, so we need to the grading
88: &Apache::inputtags::grade;
89: } elsif ($Apache::inputtags::part eq '0') {
90: # if part is zero, no <part>s existed, so we need show the current
91: # grading status
1.20 albertel 92: $result.= &Apache::inputtags::gradestatus($Apache::inputtags::part);
1.19 albertel 93: }
1.22 albertel 94: if ($target eq 'web') {
95: if ($status eq 'CAN_ANSWER') {
96: $result.="</form></body>\n";
1.28 albertel 97: } elsif ($status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {
1.22 albertel 98: $result.="</body>\n";
99: }
100: }
1.16 albertel 101: } else {
1.18 albertel 102: if ($Apache::inputtags::part eq '0') {
1.16 albertel 103: $result=&Apache::response::mandatory_part_meta;
104: }
105: }
106: return $result;
1.1 albertel 107: }
108:
109: sub start_block {
110: my ($target,$token,$parstack,$parser,$safeeval)=@_;
111:
112: my $code = @$parstack[$#$parstack];
113: $code =~ s/\"//g;
114: $code .=';return $condition;';
1.32 ! albertel 115: # print "<br />$code<br />";
1.1 albertel 116: my $result = &Apache::run::run($code,$safeeval);
1.24 albertel 117: &Apache::lonxml::debug("block :$code: returned :$result:");
1.1 albertel 118: if ( ! $result ) {
1.9 albertel 119: my $skip=&Apache::lonxml::get_all_text("/block",$$parser[$#$parser]);
1.24 albertel 120: &Apache::lonxml::debug("skipping ahead :$skip: $$parser[$#$parser]");
1.1 albertel 121: }
122: return "";
123: }
124:
125: sub end_block {
1.4 tsai 126: }
127:
128: sub start_while {
129: my ($target,$token,$parstack,$parser,$safeeval)=@_;
130:
131: my $code = @$parstack[$#$parstack];
132: $code =~ s/\"//g;
133: $code .=';return $condition;';
134:
1.5 tsai 135: push( @Apache::structuretags::whileconds, $code);
1.4 tsai 136: my $result = &Apache::run::run($code,$safeeval);
137: my $bodytext=$$parser[$#$parser]->get_text("/while");
1.5 tsai 138: push( @Apache::structuretags::whilebody, $bodytext);
139: if ( $result ) {
1.8 albertel 140: &Apache::lonxml::newparser($parser,\$bodytext);
1.4 tsai 141: }
142: return "";
143: }
144:
145: sub end_while {
1.5 tsai 146: my ($target,$token,$parstack,$parser,$safeeval)=@_;
147: my $code = pop @Apache::structuretags::whileconds;
148: my $bodytext = pop @Apache::structuretags::whilebody;
149: my $result = &Apache::run::run($code,$safeeval);
150: if ( $result ) {
1.8 albertel 151: &Apache::lonxml::newparser($parser,\$bodytext);
1.5 tsai 152: }
153: return "";
1.1 albertel 154: }
1.6 tsai 155:
156: # <randomlist>
157: # <tag1>..</tag1>
158: # <tag2>..</tag2>
159: # <tag3>..</tag3>
160: # ...
161: # </randomlist>
162: sub start_randomlist {
163: my ($target,$token,$parstack,$parser,$safeeval)=@_;
1.9 albertel 164: my $body= &Apache::lonxml::get_all_text("/randomlist",$$parser[$#$parser]);
1.6 tsai 165: my $b_parser= HTML::TokeParser->new(\$body);
166: my $b_tok;
167: my @randomlist;
168: my $list_item;
169:
170: while($b_tok = $b_parser->get_token() ) {
171: if($b_tok->[0] eq 'S') { # start tag
172: # get content of the tag until matching end tag
173: # get all text upto the matching tag
174: # and push the content into @randomlist
1.9 albertel 175: $list_item = &Apache::lonxml::get_all_text('/'.$b_tok->[1],$b_parser);
1.7 tsai 176: $list_item = "$b_tok->[4]"."$list_item"."</$b_tok->[1]>";
1.6 tsai 177: push(@randomlist,$list_item);
1.32 ! albertel 178: # print "<br /><b>START-TAG $b_tok->[1], $b_tok->[4], $list_item</b>";
1.6 tsai 179: }
180: if($b_tok->[0] eq 'T') { # text
181: # what to do with text in between tags?
1.32 ! albertel 182: # print "<b>TEXT $b_tok->[1]</b><br />";
1.6 tsai 183: }
184: # if($b_tok->[0] eq 'E') { # end tag, should not happen
1.32 ! albertel 185: # print "<b>END-TAG $b_tok->[1]</b><br />";
1.6 tsai 186: # }
187: }
1.7 tsai 188: my @idx_arr = (0 .. $#randomlist);
189: &Apache::structuretags::shuffle(\@idx_arr);
190: my $bodytext = '';
191: for(0 .. $#randomlist) {
192: $bodytext .= "$randomlist[ $idx_arr[$_] ]";
193: }
1.8 albertel 194:
195: &Apache::lonxml::newparser($parser,\$bodytext);
1.6 tsai 196: return "";
1.7 tsai 197: }
198:
199: sub shuffle {
200: my $a=shift;
201: my $i;
202: for($i=@$a;--$i;) {
203: my $j=int rand($i+1);
204: next if $i == $j;
205: @$a[$i,$j] = @$a[$j,$i];
206: }
1.6 tsai 207: }
208:
209: sub end_randomlist {
210: }
211:
1.11 albertel 212: sub start_part {
213: my ($target,$token,$parstack,$parser,$safeeval)=@_;
214: my $args ='';
215: if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; }
216: my $id = &Apache::run::run("{$args;".'return $id}',$safeeval);
1.14 albertel 217: $Apache::inputtags::part=$id;
1.18 albertel 218: @Apache::inputtags::responselist = ();
1.15 www 219: if ($target eq 'meta') {
1.16 albertel 220: return &Apache::response::mandatory_part_meta;
1.21 albertel 221: } else {
1.23 albertel 222: my ($status,$datemsg) = &Apache::lonhomework::check_date("OPEN_DATE",$id);
223: push (@Apache::inputtags::status,$status);
224: my $expression='$external::datestatus="'.$status.'";';
225: $expression.='$external::gradestatus="'.$Apache::lonhomework::history{"resource.$id.solved"}.'";';
226: &Apache::run::run($expression,$safeeval);
227: if ( $status eq 'CLOSED' ) {
1.21 albertel 228: my $bodytext=&Apache::lonxml::get_all_text("/part",$$parser[$#$parser]);
229: if ( $target eq "web" ) {
1.32 ! albertel 230: return "<br />Part is not open to be viewed. It $datemsg<br />";
1.21 albertel 231: }
232: }
1.15 www 233: }
1.19 albertel 234: return '';
1.11 albertel 235: }
236:
237: sub end_part {
238: my ($target,$token,$parstack,$parser,$safeeval)=@_;
1.18 albertel 239: &Apache::lonxml::debug("in end_part $target ");
1.28 albertel 240: my $status=$Apache::inputtags::status['-1'];
1.23 albertel 241: pop @Apache::inputtags::status;
1.19 albertel 242: if ( $target eq 'meta' ) { return ''; }
1.28 albertel 243: if ( $target eq 'grade' && $status eq 'CAN_ANSWER') {
244: return &Apache::inputtags::grade;
245: }
1.20 albertel 246: return &Apache::inputtags::gradestatus($Apache::inputtags::part);
1.11 albertel 247: }
1.1 albertel 248:
1.25 albertel 249: sub start_preduedate {
1.24 albertel 250: my ($target,$token,$parstack,$parser,$safeeval)=@_;
251: if ($target ne 'meta') {
1.29 albertel 252: if ($Apache::inputtags::status['-1'] ne 'CAN_ANSWER' &&
253: $Apache::inputtags::status['-1'] ne 'CANNOT_ANSWER' ) {
1.26 albertel 254: &Apache::lonxml::get_all_text("/preduedate",$$parser[$#$parser]);
1.24 albertel 255: }
256: }
257: return '';
258: }
259:
1.25 albertel 260: sub end_preduedate {
1.24 albertel 261: return '';
262: }
263:
1.25 albertel 264: sub start_postanswerdate {
1.24 albertel 265: my ($target,$token,$parstack,$parser,$safeeval)=@_;
266: if ($target ne 'meta') {
267: if ($Apache::inputtags::status['-1'] ne 'SHOW_ANSWER') {
1.26 albertel 268: &Apache::lonxml::get_all_text("/postanswerdate",$$parser[$#$parser]);
1.24 albertel 269: }
270: }
271: return '';
272: }
273:
1.25 albertel 274: sub end_postanswerdate {
1.24 albertel 275: return '';
276: }
277:
1.25 albertel 278: sub start_notsolved {
1.24 albertel 279: my ($target,$token,$parstack,$parser,$safeeval)=@_;
280: if ($target ne 'meta') {
281: my $gradestatus=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
282: &Apache::lonxml::debug("not solved has :$gradestatus:");
283: if ($gradestatus =~ /^correct/) {
284: &Apache::lonxml::debug("skipping");
1.26 albertel 285: &Apache::lonxml::get_all_text("/notsolved",$$parser[$#$parser]);
1.24 albertel 286: }
287: }
288: return '';
289: }
290:
1.25 albertel 291: sub end_notsolved {
1.24 albertel 292: return '';
293: }
294:
295: sub start_solved {
296: my ($target,$token,$parstack,$parser,$safeeval)=@_;
297: if ($target ne 'meta') {
298: my $gradestatus=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"};
299: if ($gradestatus !~ /^correct/) {
300: &Apache::lonxml::get_all_text("/solved",$$parser[$#$parser]);
301: }
302: }
303: return '';
304: }
305:
306: sub end_solved {
307: return '';
308: }
1.1 albertel 309: 1;
310: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to structuretags.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework