1: # The LON-CAPA input tags
2: #
3: # Input definitions.
4: #
5: # YEAR=2000
6: # 7/25,9/11,9/19,10/2,10/11,11/21,11/28,12/1,12/4,12/8,12/11 Guy Albertelli
7: # 12/12 Guy Albertelli
8: # 12/12 Gerd Kortemeyer
9: # 12/12,12/15,12/21 Guy Albertelli
10: # YEAR=2001
11: # 1/4,1/5,1/6,1/10,1/15,1/24,2/19 Guy Albertelli
12:
13: package Apache::inputtags;
14: use strict;
15:
16: # ======================================================================= BEGIN
17: sub BEGIN {
18: &Apache::lonxml::register('Apache::inputtags',
19: ('textarea','textline','datasubmission'));
20: }
21:
22: # ======================================================= Initialize input tags
23: sub initialize_inputtags {
24: # list of current input ids
25: @Apache::inputtags::input = ();
26: # list of all input ids seen in this problem
27: @Apache::inputtags::inputlist = ();
28: # list of all current response ids
29: @Apache::inputtags::response = ();
30: # list of all response ids seen in this problem
31: @Apache::inputtags::responselist = ();
32: # list of whether or not a specific response was previously used
33: @Apache::inputtags::previous = ();
34: # id of current part, 0 means no part is current (inside <problem> only
35: $Apache::inputtags::part = '';
36: # list of problem date statuses, the first element is for <problem>
37: #if there is a second element it is for the current <part>
38: @Apache::inputtags::status = ();
39: #hash of defined params for the current response
40: %Apache::inputtags::params = ();
41: }
42:
43: # ========================================== Start input (return scalar string)
44: sub start_input {
45: my ($parstack,$safeeval) = @_;
46: my $id = &Apache::lonxml::get_param('id',$parstack,$safeeval);
47: if ($id eq '') { $id = $Apache::lonxml::curdepth; }
48: push (@Apache::inputtags::input,$id);
49: push (@Apache::inputtags::inputlist,$id);
50: return $id;
51: }
52:
53: # =================================================================== End input
54: sub end_input {
55: pop @Apache::inputtags::input;
56: return '';
57: }
58:
59: # ====================================== Start text area (return scalar string)
60: sub start_textarea {
61: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
62: my $result = "";
63: my $id = &start_input($parstack,$safeeval);
64: if ($target eq 'web') {
65: my $oldresponse = $Apache::lonhomework::history{'resource.'.
66: $Apache::inputtags::part.'.'.
67: $Apache::inputtags::response['-1'].'.submission'};
68: my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
69: if ( $cols eq '') { $cols = 80; }
70: my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
71: if ( $rows eq '') { $rows = 10; }
72: $result= '<textarea name="HWVAL'.$Apache::inputtags::response['-1'].
73: '" '."rows=\"$rows\" cols=\"$cols\">".$oldresponse;
74: if ($oldresponse ne '') {
75: #get rid of any startup text if the user has already responded
76: &Apache::lonxml::get_all_text("/textarea",$$parser[$#$parser]);
77: }
78: }
79: return $result;
80: }
81:
82: # ======================================== End text area (return scalar string)
83: sub end_textarea {
84: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
85: if ($target eq 'web') {
86: return "</textarea>";
87: }
88: &end_input;
89: return '';
90: }
91:
92: # ====================================== Start text line (return scalar string)
93: sub start_textline {
94: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
95: my $result = "";
96: if ($target eq 'web') {
97: my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
98: if ($size eq '') { $size=20; }
99: my $oldresponse = $Apache::lonhomework::history{'resource.'.
100: $Apache::inputtags::part.'.'.
101: $Apache::inputtags::response['-1'].'.submission'};
102: $result = '<input type="text" name="HWVAL'.
103: $Apache::inputtags::response['-1'].
104: '" value="'.$oldresponse.'" size="'.$size.'" />';
105: }
106: if ($target eq 'edit') {
107: $result .= &Apache::edit::tag_start($target,$token,
108: &Apache::lonxml::description($token));
109: $result .= &Apache::edit::text_arg('Size:','size',$token,'5').
110: '</td></tr>';
111: $result .= &Apache::edit::end_table;
112: }
113: if ($target eq 'modified') {
114: my $constructtag = &Apache::edit::get_new_args($token,$parstack,
115: $safeeval,'size');
116: if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
117: }
118: return $result;
119: }
120:
121: # =============================================================== End text line
122: sub end_textline {
123: my ($target,$token,$tagstack,$parstack,$parser,$safeeval) = @_;
124: if ($target eq 'edit') { return ('','no'); }
125: return "";
126: }
127:
128: # ======================================================= Start data submission
129: sub start_datasubmission {
130: return '';
131: }
132:
133: # ========================================================= End data submission
134: sub end_datasubmission {
135: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
136: if ( $target == 'web' ) {
137: return '<input type="submit" name="submit" value="Submit All Data" />';
138: }
139: return '';
140: }
141:
142: # ============================================================= Finalize awards
143: sub finalizeawards {
144: my $result='';
145: my $award;
146: if ($#_ == '-1') { $result = "NO_RESPONSE"; }
147: if ($result eq '' ) {
148: foreach $award (@_) { if ($award eq '') {$result='MISSING_ANSWER';
149: last;}}
150: }
151: if ($result eq '' ) {
152: foreach $award (@_) { if ($award eq 'ERROR') {$result='ERROR'; last;}}
153: }
154: if ($result eq '' ) {
155: foreach $award (@_) { if ($award eq 'NO_RESPONSE') {
156: $result='NO_RESPONSE'; last;} }
157: }
158: if ($result eq '' ) {
159: foreach $award (@_) {
160: if ($award eq 'UNIT_FAIL' ||
161: $award eq 'NO_UNIT' ||
162: $award eq 'UNIT_NOTNEEDED') {
163: $result=$award; last;
164: }
165: }
166: }
167: if ($result eq '' ) {
168: foreach $award (@_) {
169: if ($award eq 'WANTED_NUMERIC' ||
170: $award eq 'BAD_FORMULA') {$result=$award; last;}
171: }
172: }
173: if ($result eq '' ) {
174: foreach $award (@_) { if ($award eq 'SIG_FAIL') {
175: $result=$award; last;} }
176: }
177: if ($result eq '' ) {
178: foreach $award (@_) { if ($award eq 'INCORRECT') {$result=$award;
179: last;} }
180: }
181: if ($result eq '' ) {
182: foreach $award (@_) { if ($award eq 'SUBMITTED') {$result=$award;
183: last;} }
184: }
185: if ($result eq '' ) {
186: foreach $award (@_) { if ($award eq 'APPROX_ANS') {$result=$award;
187: last;} }
188: }
189: if ($result eq '' ) { $result='EXACT_ANS'; }
190: return $result;
191: }
192:
193: # ====================================== Decide output (return 3 element array)
194: sub decideoutput {
195: my ($award,$solved,$previous)=@_;
196: my $message='';
197: my $button=0;
198: my $previousmsg;
199:
200: if ($previous) { $previousmsg='You have entered that answer before'; }
201:
202: if ($solved =~ /^correct/) {
203: $message = "<b>You are correct.</b> Your receipt is ".
204: &Apache::lonnet::receipt;
205: $button=0;
206: $previousmsg='';
207: } elsif ($solved =~ /^excused/) {
208: $message = "<b>You are excused from the problem.</b>";
209: $button=0;
210: $previousmsg='';
211: } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) {
212: if ($solved =~ /^incorrect/ || $solved eq '') {
213: $message = "Incorrect";
214: $button=1;
215: } else {
216: $message = "<b>You are correct.</b> Your receipt is ".
217: &Apache::lonnet::receipt;
218: $button=0;
219: $previousmsg='';
220: }
221: } elsif ($award eq 'NO_RESPONSE') {
222: $message = '';
223: $button=1;
224: } elsif ($award eq 'MISSING_ANSWER') {
225: $message = 'Some parts were not submitted';
226: $button = 1;
227: } elsif ($award eq 'WANTED_NUMERIC') {
228: $message = "This question expects a numeric answer";
229: $button=1;
230: } elsif ($award eq 'SIG_FAIL') {
231: $message = "Please adjust significant figures.";# you provided %s significant figures";
232: $button=1;
233: } elsif ($award eq 'UNIT_FAIL') {
234: $message = "Units incorrect."; #Computer reads units as %s";
235: $button=1;
236: } elsif ($award eq 'UNIT_NOTNEEDED') {
237: $message = "Only a number required.";# Computer reads units of %s";
238: $button=1;
239: } elsif ($award eq 'NO_UNIT') {
240: $message = "Units required";
241: $button=1;
242: } elsif ($award eq 'BAD_FORMULA') {
243: $message = "Unable to understand formula";
244: $button=1;
245: } elsif ($award eq 'INCORRECT') {
246: $message = "Incorrect";
247: $button=1;
248: } elsif ($award eq 'SUBMITTED') {
249: $message = "Your submission has been recorded.";
250: $button=1;
251: } else {
252: $message = "Unknown message: $award";
253: $button=1;
254: }
255: return ($button,$message,$previousmsg);
256: }
257:
258: # ============================================================== Set grade data
259: sub setgradedata {
260: my ($award,$id,$previously_used) = @_;
261: # if the student already has it correct, don't modify the status
262: if ( $Apache::lonhomework::history{"resource.$id.solved"} !~ /^correct/ ) {
263: #handle assignment of tries and solved status
264: if ( $award eq 'APPROX_ANS' || $award eq 'EXACT_ANS' ) {
265: $Apache::lonhomework::results{"resource.$id.tries"} =
266: $Apache::lonhomework::history{"resource.$id.tries"} + 1;
267: $Apache::lonhomework::results{"resource.$id.solved"} =
268: 'correct_by_student';
269: $Apache::lonhomework::results{"resource.$id.awarded"} = '1';
270: } elsif ( $award eq 'INCORRECT' ) {
271: $Apache::lonhomework::results{"resource.$id.tries"} =
272: $Apache::lonhomework::history{"resource.$id.tries"} + 1;
273: $Apache::lonhomework::results{"resource.$id.solved"} =
274: 'incorrect_attempted';
275: } elsif ( $award eq 'SUBMITTED' ) {
276: $Apache::lonhomework::results{"resource.$id.tries"} =
277: $Apache::lonhomework::history{"resource.$id.tries"} + 1;
278: $Apache::lonhomework::results{"resource.$id.solved"} =
279: 'ungraded_attempted';
280: } elsif ( $award eq 'NO_RESPONSE' ) {
281: return '';
282: } else {
283: $Apache::lonhomework::results{"resource.$id.solved"} =
284: 'incorrect_attempted';
285: }
286:
287: # check if this was a previous submission if it was delete the
288: # unneeded data and update the previously_used attribute
289: if ( $previously_used eq 'PREVIOUSLY_USED') {
290: delete($Apache::lonhomework::results{"resource.$id.tries"});
291: $Apache::lonhomework::results{"resource.$id.previous"} = '1';
292: } elsif ( $previously_used eq 'PREVIOUSLY_LAST') {
293: #delete all data as they student didn't do anything
294: foreach my $key (keys(%Apache::lonhomework::results)) {
295: if ($key =~ /^resource\.$id\./) {
296: &Apache::lonxml::debug("Removing $key");
297: delete($Apache::lonhomework::results{$key});
298: }
299: }
300: #and since they didn't do anything we were never here
301: return '';
302: } else {
303: $Apache::lonhomework::results{"resource.$id.previous"} = '0';
304: }
305: }
306: $Apache::lonhomework::results{"resource.$id.award"} = $award;
307: }
308:
309: # ======================================================================= Grade
310: sub grade {
311: my ($target) = @_;
312: my $id = $Apache::inputtags::part;
313: my $response = '';
314: if ( defined $ENV{'form.submitted'}) {
315: my @awards = ();
316: foreach $response (@Apache::inputtags::responselist) {
317: &Apache::lonxml::debug("looking for response.$id.$response.".
318: "awarddetail");
319: my $value=$Apache::lonhomework::results{"resource.$id.$response.".
320: "awarddetail"};
321: if ( $value ne '' ) {
322: &Apache::lonxml::debug("keeping $value from $response for".
323: " $id");
324: push (@awards,$value);
325: } else {
326: &Apache::lonxml::debug("skipping $value from $response for".
327: " $id");
328: }
329: }
330: my $finalaward = &finalizeawards(@awards);
331: my $previously_used;
332: if ( $#Apache::inputtags::previous eq $#awards ) {
333: $previously_used = 'PREVIOUSLY_LAST';
334: foreach my $value (@Apache::inputtags::previous) {
335: if ($value eq 'PREVIOUSLY_USED' ) {
336: $previously_used = $value;
337: last;
338: }
339: }
340: }
341: &Apache::lonxml::debug("final award $finalaward, $previously_used");
342: &setgradedata($finalaward,$id,$previously_used);
343: }
344: return '';
345: }
346:
347: # ========================================= Grade status (return scalar string)
348: sub gradestatus {
349: my ($id) = @_;
350: my $showbutton = 1;
351: my $message = '';
352: my $trystr = '';
353: my $button = '';
354: my $previousmsg = '';
355:
356: my $status = $Apache::inputtags::status['-1'];
357: &Apache::lonxml::debug("gradestatus has :$status:");
358: if ( $status ne 'CLOSED' ) {
359: my $award = $Apache::lonhomework::history{"resource.$id.award"};
360: my $solved = $Apache::lonhomework::history{"resource.$id.solved"};
361: my $previous = $Apache::lonhomework::history{"resource.$id.previous"};
362: &Apache::lonxml::debug("Found Award |$award|$solved|");
363: if ( $award ne '' ) {
364: &Apache::lonxml::debug('Getting message');
365: ($showbutton,$message,$previousmsg) =
366: &decideoutput($award,$solved,$previous);
367: $message = "<td bgcolor=\"#aaffaa\">$message</td>";
368: if ($previousmsg) {
369: $previousmsg = "<td bgcolor=\"#ffaaaa\">$previousmsg</td>";
370: }
371: }
372: my $tries = $Apache::lonhomework::history{"resource.$id.tries"};
373: my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");
374: &Apache::lonxml::debug("got maxtries of :$maxtries:");
375: if ( $tries eq '' ) { $tries = '0'; }
376: if ( $maxtries eq '' ) { $maxtries = '2'; }
377: if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; }
378: if ( $showbutton ) {
379: $trystr = "<td>Tries $tries/$maxtries</td>";
380: }
381: if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {
382: $showbutton = 0;}
383: if ( $showbutton ) {
384: $button = '<br /><input type="submit" name="submit" value='.
385: '"Submit All Answers" />';
386: }
387: }
388: my $output= $previousmsg.$message.$trystr;
389: if ($output =~ /^\s*$/) {
390: return $button;
391: } else {
392: return $button.'<table><tr>'.$previousmsg.$message.$trystr.
393: '</tr></table>';
394: }
395: }
396:
397: 1;
398:
399: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to inputtags.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework