Annotation of loncom/publisher/testbankimport.pm, revision 1.28
1.3 albertel 1: # Handler for parsing text upload problem descriptions into .problems
1.28 ! www 2: # $Id: testbankimport.pm,v 1.27 2010/11/28 00:04:10 raeburn Exp $
1.3 albertel 3: #
4: # Copyright Michigan State University Board of Trustees
5: #
6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
7: #
8: # LON-CAPA is free software; you can redistribute it and/or modify
9: # it under the terms of the GNU General Public License as published by
10: # the Free Software Foundation; either version 2 of the License, or
11: # (at your option) any later version.
12: #
13: # LON-CAPA is distributed in the hope that it will be useful,
14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16: # GNU General Public License for more details.
17: #
18: # You should have received a copy of the GNU General Public License
19: # along with LON-CAPA; if not, write to the Free Software
20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21: #
22: # /home/httpd/html/adm/gpl.txt
23: #
24: # http://www.lon-capa.org/
25: #
26:
1.1 raeburn 27: package Apache::testbankimport;
28:
1.3 albertel 29: use strict;
30: use Apache::Constants qw(:common :http :methods);
31: use Apache::loncacc;
32: use Apache::loncommon();
33: use Apache::lonnet;
34: use HTML::Entities();
35: use Apache::lonlocal;
36: use Apache::lonupload;
1.15 raeburn 37: use Apache::londocs;
1.3 albertel 38: use File::Basename();
1.11 albertel 39: use LONCAPA();
1.15 raeburn 40: use File::MMagic;
41: use XML::DOM;
42: use RTF::HTMLConverter;
43: use HTML::TokeParser;
1.1 raeburn 44:
45: # ---------------------------------------------------------------- Display Control
46: sub display_control {
47: # figure out what page we're on and where we're heading.
1.6 albertel 48: my $page = $env{'form.page'};
49: my $command = $env{'form.go'};
1.1 raeburn 50: my $current_page = &calculate_page($page,$command);
51: return $current_page;
52: }
53:
54: # CALCULATE THE CURRENT PAGE
55: sub calculate_page($$) {
56: my ($prev,$dir) = @_;
57: return 0 if $prev eq ''; # start with first page
58: return $prev + 1 if $dir eq 'NextPage';
59: return $prev - 1 if $dir eq 'PreviousPage';
60: return $prev if $dir eq 'ExitPage';
61: return 0 if $dir eq 'BackToStart';
62: }
63:
1.15 raeburn 64: sub jscript_zero {
65: my ($webpath,$jsref) = @_;
66: my $start_page =
67: &Apache::loncommon::start_page('Create Testbank directory',undef,
68: {'only_body' => 1,
69: 'js_ready' => 1,});
70: my $end_page =
71: &Apache::loncommon::end_page({'js_ready' => 1,});
72: my %lt = &Apache::lonlocal::texthash(
73: loca => 'Location',
74: newd => 'New Directory',
75: ente => 'Enter the name of the new directory where you will save the converted testbank questions',
76: go => 'Go',
77: );
78: $$jsref = <<"END_SCRIPT";
79: function createWin() {
80: document.info.newdir.value = "";
81: newWindow = window.open("","CreateDir","HEIGHT=400,WIDTH=750,scrollbars=yes")
82: newWindow.document.open()
83: newWindow.document.write('$start_page')
1.22 bisitz 84: newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]' />\\n")
1.15 raeburn 85: newWindow.document.write("<h3>$lt{'loca'}: <tt>$webpath</tt></h3><h3>$lt{'newd'}</h3>\\n")
86: newWindow.document.write("<form name='fileaction' action='/adm/cfile' method='post'>\\n")
87: newWindow.document.write("$lt{'ente'}.<br /><br />")
1.21 bisitz 88: newWindow.document.write("<input type='hidden' name='filename' value='$webpath' />")
1.22 bisitz 89: newWindow.document.write("<input type='hidden' name='action' value='newdir' />")
1.21 bisitz 90: newWindow.document.write("<input type='hidden' name='callingmode' value='testbank' />")
1.26 raeburn 91: newWindow.document.write("<input type='hidden' name='inhibitmenu' value='yes' />")
1.21 bisitz 92: newWindow.document.write("$webpath<input type='text' name='newfilename' value='' />")
1.15 raeburn 93: newWindow.document.write("<input type='button' value='$lt{'go'}' onClick='document.fileaction.submit();' /></form>")
94: newWindow.document.write('$end_page')
95: newWindow.document.close()
96: newWindow.focus()
97: }
98:
99: END_SCRIPT
100: return;
101: }
102:
103:
1.1 raeburn 104: # ---------------------------------------------------------------- Jscript One
105:
106: sub jscript_one {
107: my $jsref = shift;
108: $$jsref = <<"END_SCRIPT";
109: function verify() {
110: if ((document.forms.display.blocks.value == "") || (!document.forms.display.blocks.value) || (document.forms.display.blocks.value == "0")) {
111: alert("You must enter the number of blocks of questions of a given question type. This number must be 1 or more.")
112: return false
113: }
114: if (document.forms.display.qnumformat.options[document.forms.display.qnumformat.selectedIndex].value == "-1") {
115: alert("You must select the format used for the question number, e.g., (1), 1., (1, or 1).")
116: return false
117: }
118: return true
119: }
120: function nextPage() {
121: if (verify()) {
122: document.forms.display.go.value="NextPage"
123: document.forms.display.submit()
124: }
125: }
126: function backPage() {
127: document.forms.display.go.value="PreviousPage"
128: document.forms.display.submit()
129: }
130: function setElements() {
131: var iter = 0
132: var selParam = 0
133: END_SCRIPT
1.6 albertel 134: if (exists($env{'form.blocks'}) ) {
1.1 raeburn 135: $$jsref .= qq|
1.6 albertel 136: document.forms.display.blocks.value = $env{'form.blocks'}\n|;
1.15 raeburn 137: }
138: if (exists($env{'form.qnumformat'}) ) {
1.1 raeburn 139: $$jsref .= <<"TO_HERE";
140: for (iter=0; iter<document.forms.display.qnumformat.length; iter++) {
1.6 albertel 141: if(document.forms.display.qnumformat.options[iter].value == "$env{'form.qnumformat'}") {
1.1 raeburn 142: selParam = iter
143: }
144: }
145: document.forms.display.qnumformat.selectedIndex = selParam
146: TO_HERE
147: }
148: $$jsref .= qq|
149: }
150: |;
151: }
152:
153: # ---------------------------------------------------------------- Jscript Two
154: sub jscript_two {
155: my ($jsref,$qcount) = @_;
156: my $blocks = 0;
1.6 albertel 157: if ( exists( $env{'form.blocks'}) ) {
158: $blocks = $env{'form.blocks'};
1.1 raeburn 159: }
160: $$jsref = <<"END_SCRIPT";
161: function verify() {
162: var poolForm = document.forms.display
163: var curmax = 0
164: var curmin = 0
165: for (var i=0; i<$blocks; i++) {
166: var iter = i+1
167: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "MC") {
168: if (poolForm.elements[5*i+4].selectedIndex == 0) {
169: alert ("You must choose the foil labelling format in Multiple Choice questions")
170: return false
171: }
172: }
173: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "MA") {
174: if (poolForm.elements[5*i+4].selectedIndex == 0) {
175: alert ("You must choose the foil labelling format in Multiple Answer questions")
176: return false
177: }
178: if (poolForm.elements[5*i+5].selectedIndex == 0) {
179: alert ("You must choose the answer format in Multiple Answer questions")
180: return false
181: }
182: }
183: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "FIB") {
184: if (poolForm.elements[5*i+5].selectedIndex == 0) {
185: alert ("You must choose the answer format in Fill-in-the-blank questions")
186: return false
187: }
188: }
189: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "TF") {
190: if (poolForm.elements[5*i+5].selectedIndex == 0) {
191: alert ("You must choose the answer format in True/False questions")
192: return false
193: }
194: }
195: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "Ord") {
196: if (poolForm.elements[5*i+4].selectedIndex == 0) {
197: alert ("You must choose the foil labelling format in Ranking/ordering questions")
198: return false
199: }
200: if (poolForm.elements[5*i+5].selectedIndex == 0) {
201: alert ("You must choose the answer format in Ranking/ordering questions")
202: return false
203: }
204: }
205: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "-1") {
206: alert ("You must choose the question type for block "+iter)
207: return false
208: }
209: if ((poolForm.elements[5*i+1].value == "") || !(poolForm.elements[5*i+1].value)) {
210: alert ("You must choose the start number for block "+iter)
211: return false
212: }
213: if ((poolForm.elements[5*i+2].value == "") || !(poolForm.elements[5*i+2].value)) {
214: alert ("You must choose the end number for block "+iter)
215: return false
216: }
217: if (poolForm.elements[5*i+2].value - poolForm.elements[5*i+1].value < 0) {
218: alert ("In block: "+iter+" the end number must be the same or greater than the start number")
219: return false
220: }
221: if (i == 0) {
222: curmin = parseInt(poolForm.elements[5*i+1].value)
223: curmax = parseInt(poolForm.elements[5*i+2].value)
224: }
225: else {
226: if (parseInt(poolForm.elements[5*i+1].value) < curmin) {
227: if (parseInt(poolForm.elements[5*i+2].value) >= curmin ) {
228: alert("The question number range for block "+iter+" overlaps with the question number range for one of the previous blocks - this is not permitted.")
229: return false
230: }
231: }
232: else {
233: if (parseInt(poolForm.elements[5*i+1].value) <= curmax) {
234: for (var j=parseInt(poolForm.elements[5*i+1].value); j<=parseInt(poolForm.elements[5*i+2].value); j++) {
235: for (var k=0; k<i; k++) {
236: if ((j >= parseInt(poolForm.elements[5*k+1].value)) && (j <= parseInt(poolForm.elements[5*k+2].value))) {
237: var overlap = k+1
238: alert("The question number range for block "+iter+" overlaps with the question number range for block "+overlap+" - this is not permitted.")
239: return false
240: }
241: }
242: }
243: }
244: }
245: if (parseInt(poolForm.elements[5*i+1].value) < curmin) {
246: curmin = parseInt(poolForm.elements[5*i+1].value)
247: }
248: if (parseInt(poolForm.elements[5*i+2].value) > curmax) {
249: curmax = parseInt(poolForm.elements[5*i+2].value)
250: }
251: }
252: }
253: if (curmax >$qcount+curmin) {
254: alert("The last # for one or more of the blocks is too large - the last number of the last block can not be greater than $qcount: the total number of questions in the uploaded file.")
255: return false
256: }
257: var endpt = $qcount + curmin
258: for (var n=curmin; n<endpt; n++) {
259: var warnFlag = true
260: for (var m=0; m<$blocks; m++) {
261: if ((n >= parseInt(poolForm.elements[5*m+1].value)) && (n <= parseInt(poolForm.elements[5*m+2].value))) {
262: warnFlag = false
263: }
264: }
265: if (warnFlag) {
266: alert("The question type for question "+n+" could not be identified because it does not fall within the number ranges you have provided for any of the $blocks block(s)")
267: return false
268: }
269: }
270: return true
271: }
272:
273: function nextPage() {
274: if (verify()) {
275: document.forms.display.go.value="NextPage"
276: document.forms.display.submit()
277: }
278: }
279: function backPage() {
280: document.forms.display.go.value="PreviousPage"
281: document.forms.display.submit()
282: }
283: function colSet(caller) {
284: var poolForm = document.forms.display
285: var curVal = poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value
286: poolForm.elements[caller*5+4].length = 0
287: if (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "-1") {
288: poolForm.elements[caller*5+4].options[0] = new Option("<--- Set type ","-1",true,true)
289: }
290: else {
291: if ((poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "MC") || (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "MA") || (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "Ord")) {
1.15 raeburn 292: poolForm.elements[caller*5+4].options[0] = new Option("Select","-1",true,true)
1.1 raeburn 293: poolForm.elements[caller*5+4].options[1] = new Option("a.","lcperiod",false,false)
294: poolForm.elements[caller*5+4].options[2] = new Option("A.","ucperiod",false,false)
295: poolForm.elements[caller*5+4].options[3] = new Option("(a)","lcparen",false,false)
296: poolForm.elements[caller*5+4].options[4] = new Option("(A)","ucparen",false,false)
1.5 raeburn 297: poolForm.elements[caller*5+4].options[5] = new Option("a)","lconeparen",false,false)
298: poolForm.elements[caller*5+4].options[6] = new Option("A)","uconeparen",false,false)
299: poolForm.elements[caller*5+4].options[7] = new Option("a.)","lcdotparen",false,false)
300: poolForm.elements[caller*5+4].options[8] = new Option("A.)","ucdotparen",false,false)
301: poolForm.elements[caller*5+4].options[9] = new Option("(i)","romparen",false,false)
302: poolForm.elements[caller*5+4].options[10] = new Option("i)","romoneparen",false,false)
303: poolForm.elements[caller*5+4].options[11] = new Option("i.)","romdotparen",false,false)
304: poolForm.elements[caller*5+4].options[12] = new Option("i.","romperiod",false,false)
1.1 raeburn 305: poolForm.elements[caller*5+4].selectedIndex = 0
306: }
307: else {
308: poolForm.elements[caller*5+4].options[0] = new Option("Not required","0",true,true)
309: }
310: }
311: poolForm.elements[caller*5+5].length = 0
312: if (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "-1") {
313: poolForm.elements[caller*5+5].options[0] = new Option("<--- Set type ","-1",true,true)
314: }
315: else {
316: if ((poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "MA") || (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "FIB")) {
1.15 raeburn 317: poolForm.elements[caller*5+5].options[0] = new Option("Select","-1",true,true)
1.1 raeburn 318: poolForm.elements[caller*5+5].options[1] = new Option("single answer","single",false,false)
319: poolForm.elements[caller*5+5].options[2] = new Option("comma","comma",false,false)
320: poolForm.elements[caller*5+5].options[3] = new Option("space","space",false,false)
321: poolForm.elements[caller*5+5].options[4] = new Option("new line","line",false,false)
322: poolForm.elements[caller*5+5].options[5] = new Option("tab","tab",false,false)
323: }
324: else {
325: if (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "Ord") {
1.15 raeburn 326: poolForm.elements[caller*5+5].options[0] = new Option("Select","-1",true,true)
1.1 raeburn 327: poolForm.elements[caller*5+5].options[1] = new Option("comma","comma",false,false)
328: poolForm.elements[caller*5+5].options[2] = new Option("space","space",false,false)
329: poolForm.elements[caller*5+5].options[3] = new Option("new line","line",false,false)
330: poolForm.elements[caller*5+5].options[4] = new Option("tab","tab",false,false)
331: }
332: else {
333: if (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "TF") {
1.15 raeburn 334: poolForm.elements[caller*5+5].options[0] = new Option("Select","-1",true,true)
1.1 raeburn 335: poolForm.elements[caller*5+5].options[1] = new Option("True or False","word",false,false)
1.5 raeburn 336: poolForm.elements[caller*5+5].options[2] = new Option("true or false","word",false,false)
337: poolForm.elements[caller*5+5].options[3] = new Option("TRUE or FALSE","word",false,false)
338: poolForm.elements[caller*5+5].options[4] = new Option("T or F","lett",false,false)
339: poolForm.elements[caller*5+5].options[5] = new Option("t or f","lett",false,false)
1.1 raeburn 340: }
341: else {
342: poolForm.elements[caller*5+5].options[0] = new Option("Not required","0",true,true)
343: }
344: }
345: }
346: }
347: }
348:
349: function setElements() {
350: var iter = 0
351: var selParam = 0
352: END_SCRIPT
353: my @names = ("start_","end_","qtype_","foilformat_","ansr_");
354: for (my $x=0; $x<$blocks; $x++) {
355: foreach my $name (@names) {
356: my $parname = $name.$x;
1.6 albertel 357: my $value = $env{"form.$parname"};
1.1 raeburn 358: if ($value ne "") {
359: if (($name eq "start_") || ($name eq "end_")) {
360: $$jsref .= qq|
361: document.forms.display.$parname.value = $value\n|;
362: } elsif ($name eq "qtype_") {
363: $$jsref .= qq|
364: for (iter=0; iter<document.forms.display.$parname.length; iter++) {
365: if (document.forms.display.$parname.options[iter].value == "$value") {
366: selParam = iter
367: }
368: }
369: document.forms.display.$parname.selectedIndex = selParam
370: colSet($x)
371: |;
372: } elsif (($name eq "foilformat_") || ($name eq "ansr_")) {
373: $$jsref .= <<"TO_HERE";
374: for (iter=0; iter<document.forms.display.$parname.length; iter++) {
375: if (document.forms.display.$parname.options[iter].value == "$value") {
376: selParam = iter
377: }
378: }
379: document.forms.display.$parname.selectedIndex = selParam
380: TO_HERE
381: }
382: }
383: }
384: }
385: $$jsref .= qq|
386: }
387: |;
388: }
389: # ---------------------------------------------------------------- Jscript Three
390:
391: sub jscript_three {
1.15 raeburn 392: my ($webpath,$jsref) = @_;
1.1 raeburn 393: my $source = '';
1.6 albertel 394: if (exists($env{'form.go'}) ) {
395: $source = $env{'form.go'};
1.1 raeburn 396: }
1.8 albertel 397:
1.1 raeburn 398: $$jsref = <<"END_OF_ONE";
399: function nextPage() {
400: if (verify()) {
401: document.forms.dataForm.go.value="NextPage"
1.15 raeburn 402: document.forms.dataForm.submit();
1.1 raeburn 403: }
404: }
1.15 raeburn 405:
1.1 raeburn 406: function backPage() {
407: document.forms.dataForm.go.value="PreviousPage"
408: document.forms.dataForm.submit()
409: }
410:
411: END_OF_ONE
412: if ($source eq "PreviousPage") {
413: $$jsref .= qq|
414: function setElements() {
415: var iter = 0
416: var selParam = 0
417: |;
1.15 raeburn 418: foreach my $item (keys(%env)) {
419: if ($item =~ m/^form\.(probfile_\d+)$/) {
1.1 raeburn 420: my $name = $1;
1.6 albertel 421: my $value = $env{"form.$name"};
1.15 raeburn 422: if ($value ne '') {
423: $$jsref .= qq( document.dataForm.$name.value = "$value"\n);
1.1 raeburn 424: }
425: }
426: }
427: $$jsref .= "}";
428: }
1.15 raeburn 429: $$jsref .= '
430:
431: function verify() {
432: ';
433: my $blocks = 0;
434: if ( exists( $env{'form.blocks'}) ) {
435: $blocks = $env{'form.blocks'};
436: }
437: my $numitems = 0;
438: for (my $i=0; $i<$blocks; $i++) {
439: my $count = 0;
440: if (($env{"form.start_$i"} ne '') && ($env{"form.end_$i"} ne '')) {
441: $count = $env{"form.end_$i"} - $env{"form.start_$i"} +1;
442: }
443: $numitems += $count;
444: }
445: if ($numitems > 0) {
446: my $maxnum = $numitems - 1;
447: my %lt = &Apache::lonlocal::texthash(
448: fnmb => 'File names must be unique',
449: isum => 'is used more than once',
450: );
451: $$jsref .= qq|
452: for (var j=$maxnum; j>0; j--) {
453: var currname = document.dataForm.elements['probfile_'+j].value;
454: for (var k=j-1; k>=0; k--) {
455: var comparename = document.dataForm.elements['probfile_'+k].value;
456: if (currname == comparename) {
457: alert("$lt{fnmb} - "+currname+" $lt{isum}");
458: return false;
459: }
460: }
461: }
462: |;
463: }
464: $$jsref .= '
465: return true;
466: }
467: ';
468: $$jsref .= &Apache::loncommon::check_uncheck_jscript();
469: return;
1.1 raeburn 470: }
471:
472: # ---------------------------------------------------------------- Jscript Four
473: sub jscript_four {
1.15 raeburn 474: my ($jsref,$webpath) = @_;
1.1 raeburn 475: $$jsref = qq|
476: function backtoStart() {
1.15 raeburn 477: document.location.href="$webpath"
1.1 raeburn 478: }
1.15 raeburn 479: function backPage() {
1.1 raeburn 480: document.forms.verify.go.value="PreviousPage"
1.15 raeburn 481: document.forms.verify.submit();
1.1 raeburn 482: }
483: |;
484: }
485:
486: # ---------------------------------------------------------------- Display Zero
487: sub display_zero {
1.15 raeburn 488: my ($r,$uname,$fn,$page,$webpath) = @_;
489: my $go_default = 'NextPage';
490: if ($fn eq '') {
491: $r->print('<b>'.&mt('Incomplete file upload').'</b> '.&mt('Return to the [_1]construction space menu[_2] to upload a file','<a href="'.$webpath.'">','</a>'));
492: }
493: $r->print(&mt('The <b>Testbank Upload</b> utility can be used by LON-CAPA authors to generate LON-CAPA problem files from a testbank file of questions/answers.').'<br />'.
494: &mt('The following question types can be converted:').'
495: <ul>
496: <li>'.&mt('multiple choice').'</li>
497: <li>'.&mt('multiple answer correct').'</li>
498: <li>'.&mt('fill-in-the-blank').'</li>
499: <li>'.&mt('ordering/ranking').'</li>
500: <li>'.&mt('true/false').'</li>
501: <li>'.&mt('essay').'</li>
502: </ul>
503: '.&mt('The file of questions (in plain text, RTF or HTML format) must meet certain requirements for the conversion process to generate functioning LON-CAPA problems.').&Apache::loncommon::help_open_topic('Testbank_Formatting').'<br />'.
504: &mt('Five steps are involved in the conversion process.').'
1.1 raeburn 505: <ol>
1.15 raeburn 506: <li>'.&mt('Optionally create a new sub-directory where the converted testbank questions will be saved.').'</li>
507: <li>'.&mt('Provide information about the question format - i.e., question numbering style, and the number of blocks of questions of each question type.').'</li>
508: <li>'.&mt('Provide information about the questions in each block, including question type, start and end question numbers for each block, and foil labelling style and answer format where required.').'</li>
509: <li>'.&mt('Review the identified questions, choose which to convert, and (optionally) override the default filename to be used for each problem file.').'</li>
510: <li>'.&mt('Complete the import of questions.').'</li>
511: </ol><form name="info" method="post" action="/adm/testbank">'.
1.25 bisitz 512: &Apache::lonhtmlcommon::topic_bar(1,&mt('Optional: create a sub-directory in which the testbank questions will be saved')).
1.15 raeburn 513: &mt('By default, LON-CAPA problems generated from the testbank file will be stored in the current directory.').' '.&mt('To store them in a new sub-directory:').
1.21 bisitz 514: ' <input type="button" name="createdir" value="'.&mt('Create sub-directory').'" onClick="javascript:createWin()" />'.
1.15 raeburn 515: &page_footer($env{'form.newdir'},$uname,$fn,$page,$webpath).'
516: </form>');
1.1 raeburn 517: }
518:
519: # ---------------------------------------------------------------- Display One
520:
521: sub display_one {
1.15 raeburn 522: my ($r,$uname,$fn,$page,$textref,$header) = @_;
523: my %topics;
524: $topics{2} = &mt('Select the format of the question number - e.g., 1, 1., 1), (1 or (1) - ').'
525: <select name="qnumformat">
1.23 bisitz 526: <option value="-1" selected="selected">'.&mt('Select').'</option>
1.15 raeburn 527: <option value="number">1</option>
528: <option value="period">1.</option>
529: <option value="paren">(1)</option>
530: <option value="leadparen">(1</option>
531: <option value="trailparen">1)</option>
532: </select>'."\n";
533: $topics{3} = &mt('Indicate the number of blocks of different question types in the testbank file.').' <input type="text" name="blocks" value="" size="5" />';
534: $r->print('<h3>'.&mt('Identification of blocks of questions').'</h3>'."\n".
535: '<form method="post" name="display" action="/adm/testbank">'."\n".
536: &show_uploaded_data($textref,$header)."\n".
1.25 bisitz 537: &Apache::lonhtmlcommon::topic_bar(2,$topics{2}).'<p>'.
1.15 raeburn 538: &mt('A number in the specified format should appear at the start of each question.').'<br />'.
539: &mt('For multiple choice questions, the question number must begin the line that contains the question text; foils (starting (a), (i) etc.) should occur on subsequent lines.').'<br />'."\n".
540: &mt('Correct answers should be numbered in the same way as the questions and should appear after <b>all</b> the questions (including question text and possible foils for all questions).').'<br />'."\n".
541: &mt('Each numbered question must have a corresponding numbered answer, although the answer itself may be blank for essay questions.').'<br /><br />'."\n".
542: &mt('For example, you would select <b>1.</b> if your testbank file contained the following questions:').'<br /><blockquote>'.
543: '<pre>
544: 1. '.&mt('The capital of the USA is ...').'
545: (a) Washington D.C.
546: (b) New York
547: (c) Los Angeles
548:
549: 2. '.&mt('The capital of Canada is ...').'
550: (a) Toronto
551: (b) Vancouver
552: (c) Ottawa
553:
554: 3. '.&mt('Describe an experiment you could conduct to measure c, the speed of light in a vacuum.').'
555: 1. (a)
556: 2. (c)
557: 3.
558: </pre>'.
559: '</blockquote></p>'.
1.25 bisitz 560: &Apache::lonhtmlcommon::topic_bar(3,$topics{3}).'<p>'.
1.15 raeburn 561: &mt('For example, you would enter <b>6</b> if your testbank file contained the following sequence of questions:').'</p><blockquote>'.
562: &mt('10 multiple choice questions').'<br />'.
563: &mt('5 essay questions').'<br />'.
564: &mt('5 fill-in-the-blank questions').'<br />'.
565: &mt('5 multiple answer questions').'<br />'.
566: &mt('4 multiple choice questions').'<br />'.
567: &mt('3 essay questions').'</blockquote></p><p>'.
568: &mt('You will indicate the question type and the question number range for each of the blocks on the next page.').'</p><br />'.
569: &page_footer($env{'form.newdir'},$uname,$fn,$page).'
570: </form>');
571: return;
1.1 raeburn 572: }
573:
574: # ---------------------------------------------------------------- Display Two
575:
576: sub display_two {
1.15 raeburn 577: my ($r,$uname,$fn,$page,$textref,$header,$qcount) = @_;
1.6 albertel 578: my $blocks = $env{'form.blocks'};
579: my $qnumformat = $env{'form.qnumformat'};
1.1 raeburn 580: my @types = ("MC","MA","TF","Ess","FIB","Ord");
581: my %typenames = (
582: MC => "Multiple Choice",
583: TF => "True/False",
584: MA => "Multiple Answer",
585: Ess => "Essay",
586: FIB => "Fill-in-the-blank",
587: Ord => "Ranking/ordering",
588: );
589: my %qnumtypes = (
590: number => "1",
591: period => "1.",
592: paren => "(1)",
593: leadparen => "(1",
594: trailparen => "1)",
595: );
596: my $bl1st = '';
597: my $bl1end = '';
598: if ($blocks == 1) {
599: $bl1st = '1';
600: $bl1end = $qcount;
601: }
1.15 raeburn 602: my $steptitle = &mt('Information about question types and formats in each block.');
603: $r->print('<h3>'.&mt('Classification of blocks').'</h3>'.
604: '<form method="post" name="display" action="/adm/testbank"><p>'.
605: &mt('You indicated that <b>all</b> questions (and the corresponding answer(s) for each question) begin with a number in the following format: [_1].','<b>'.$qnumtypes{$qnumformat}.'</b>').'</p><p>'.
606: &mt('A total of <b>[quant,_1,question]</b> and <b>[quant,_2,answer]</b> were found in the file you uploaded.',$qcount,$qcount).' '.
607: &mt('If this total does not match the number you expect, examine your original testbank file to verify that each question <i>and</i> each answer begins with a number in the specified format.').' '.
608: &mt('If necessary use an editor to edit your testbank file of questions, and click "Previous Page" on this page and the "Exit Now" on the preceding page, so you can upload your file again.').'</p><p>'.
609: &mt('You also indicated that the <b>[quant,_1,question]</b> can be divided into <b>[quant,_2,block]</b> of questions of a particular question type.',$qcount,$blocks).'</p><p>'.
610: &mt('Provide additional information below, about the types of questions you have uploaded, and, if applicable, the format of answers and "foils" for specific types of questions.').'</p>'.
611: &show_uploaded_data($textref,$header).
1.25 bisitz 612: &Apache::lonhtmlcommon::topic_bar(4,$steptitle).'<p>'.
1.15 raeburn 613: &mt('For <i>each</i> of the [_1] question blocks, specify the question numbers of the first and last questions in the block (e.g., 1 and 10), and the question type of the questions in the block.','<b>'.$blocks.'</b>').' '.
614: &mt('If required, provide additional information about foil formats and answer formats for the question types you select.').'</p><p>'.
615: &Apache::loncommon::start_data_table().
616: &Apache::loncommon::start_data_table_header_row().
617: '<th>'.&mt('Block').'</th>'."\n".
618: '<th>'.&mt('First number').'</th>'."\n".
619: '<th>'.&mt('Last number').'</th>'."\n".
620: '<th>'.&mt('Question type').'</th>'."\n".
621: '<th>'.&mt('Foil format').'</th>'."\n".
622: '<th>'.&mt('Answer format').'</th>'."\n".
623: &Apache::loncommon::end_data_table_header_row());
1.1 raeburn 624: for (my $i=0; $i<$blocks; $i++) {
625: my $iter = $i+1;
1.15 raeburn 626: $r->print(&Apache::loncommon::start_data_table_row().
627: '<td valign="top"> '.$iter.' </td>'."\n".
628: '<td valign="top"> <input type="text" name="start_'.$i.'" value="'.$bl1st.'" size="5" /> </td>'."\n".
1.21 bisitz 629: '<td valign="top"> <input type="text" name="end_'.$i.'" value="'.$bl1end.'" size="5" /> </td>'."\n".
1.15 raeburn 630: '<td valign="top">
631: <select name="qtype_'.$i.'" onChange="colSet('.$i.')">
1.23 bisitz 632: <option value="-1" selected="selected">'.&mt('Select').'</option>'."\n");
1.1 raeburn 633: foreach my $qtype (@types) {
1.15 raeburn 634: $r->print('<option value="'.$qtype.'">'.$typenames{$qtype}.'</option>'."\n");
1.1 raeburn 635: }
1.15 raeburn 636: $r->print(' </select>
1.1 raeburn 637: </td>
1.15 raeburn 638: <td align="left" valign="top">
639: <select name="foilformat_'.$i.'">
1.1 raeburn 640: <option value="-1"><--- Set type
641: </select>
642: </td>
1.15 raeburn 643: <td align="left" valign="top">
644: <select name="ansr_'.$i.'">
1.1 raeburn 645: <option value="-1"><--- Set type
646: </select>
1.15 raeburn 647: </td>'.
648: &Apache::loncommon::end_data_table_row());
1.1 raeburn 649: }
1.15 raeburn 650: $r->print(&Apache::loncommon::end_data_table().'</p><ul><li>'.
651: &mt('For <i>multiple choice</i>, <i>multiple correct answer</i> and <i>ranking</i> type questions, you must use the <b>Foil format</b> column to choose the format of the identifier used for each of the possible answers (e.g., (a), a, a., i, (i) etc.) provided for a given question stem.').'</li><li>'.
652: &mt('For <i>multiple correct answer</i> and <i>fill-in-the-blank</i> questions with more than one correct answer you must use the <b>Answer format</b> column to choose the separator used between the answers, e.g., if the correct answers for question 28. were listed as:[_1] you would choose "comma", or if they were listed as:[_2] you would choose "new line".','<blockquote><pre>28. (a),(d),(e)</pre></blockquote>','<blockquote><pre>
653: 28. (a)
654: (d)
655: (e)
656: </pre></blockquote>').'</li><li>'.
657: &mt('For <i>true/false</i> questions you must use the <b>Answer format</b> column to choose how the correct answer - True or False, is displayed in the text file (e.g., T or F, true or false etc.).').'</li><li>'.
658: &mt('For <i>ranking</i> questions you must use the <b>Answer format</b> column to choose the separator used between the (ranked) answers.').'</li></ul>
659: <input type="hidden" name="blocks" value="'.$blocks.'" />
660: <input type="hidden" name="qnumformat" value="'.$qnumformat.'" />'.
661: &page_footer($env{'form.newdir'},$uname,$fn,$page).'
662: </form>');
663: return;
664: }
665:
1.1 raeburn 666: # ---------------------------------------------------------------- Display Three
1.15 raeburn 667: sub display_three {
668: my ($r,$uname,$fn,$page,$textref,$res,$header,$urlpath,$qcount) = @_;
1.6 albertel 669: my $qnumformat = $env{'form.qnumformat'};
670: my $filename = $env{'form.filename'};
671: my $source = $env{'form.go'};
672: my $blocks = $env{'form.blocks'};
1.15 raeburn 673: my ($alphabet,$romans) = &get_constants();
1.1 raeburn 674: my @start = ();
675: my @end = ();
676: my @nums = ();
677: my @qtype = ();
678: my @foilformats = ();
679: my @ansrtypes = ();
680: my %multparts = ();
681: my $numitems = 0;
1.15 raeburn 682: my %lt = &Apache::lonlocal::texthash (
683: crt => 'Create?',
684: typ => 'Type',
685: fnam => 'File Name',
686: ques => 'Question',
687: answ => 'Answer',
688: chka => 'check all',
689: unch => 'uncheck all',
690: );
1.1 raeburn 691: for (my $i=0; $i<$blocks; $i++) {
1.6 albertel 692: if (($env{"form.start_$i"} ne '') && ($env{"form.end_$i"} ne '')) {
693: $start[$i] = $env{"form.start_$i"};
694: $end[$i] = $env{"form.end_$i"};
1.1 raeburn 695: $nums[$i] = $end[$i]-$start[$i] +1;
1.6 albertel 696: $qtype[$i] = $env{"form.qtype_$i"};
1.1 raeburn 697: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
1.6 albertel 698: $foilformats[$i] = $env{"form.foilformat_$i"};
1.1 raeburn 699: } else {
700: $foilformats[$i] = '';
701: }
702: if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) {
1.6 albertel 703: $ansrtypes[$i] = $env{"form.ansr_$i"};
1.1 raeburn 704: } else {
705: $ansrtypes[$i] = '';
706: }
707: } else {
708: $nums[$i] = 0;
709: }
710: $numitems += $nums[$i];
711: }
1.15 raeburn 712: my ($items,$ids,$footer) = &file_split(\@start,\@end,\@nums,$qnumformat,\@foilformats,$textref,\%multparts,$numitems,\@qtype,$blocks);
713: my ($showheader,$showcss);
714: if ($res eq 'application/rtf' || $res eq 'text/html') {
715: if ($header ne '') {
716: $showheader = &HTML::Entities::decode($header);
717: if ($res eq 'text/html') {
718: $showheader = &build_image_url($urlpath,$showheader);
719: }
720: }
721: }
722: $r->print('<h3>'.&mt('Review and selection of problems to convert').'</h3>'."\n".
723: '<form name="dataForm" method="post" action="/adm/testbank">'."\n".
724: &mt('Based on your previous responses your data have been split into a total of [quant,_1,question].',$numitems).
1.25 bisitz 725: &Apache::lonhtmlcommon::topic_bar(5,&mt('Choose which problems to convert and names to use for individual problem files')));
1.15 raeburn 726: if ($showheader) {
727: $r->print($showheader.'<br />');
728: }
729: $r->print('<input type="button" value="'.$lt{'chka'}.'" onclick="javascript:checkAll(document.dataForm.createprob)" />
730: <input type="button" value="'.$lt{'unch'}.'" onclick="javascript:uncheckAll(document.dataForm.createprob)" /><br /><br />'.
731: &Apache::loncommon::start_data_table().
732: &Apache::loncommon::start_data_table_header_row().
733: '<th>'.#'.</th>'.
734: '<th>'.$lt{'crt'}.'</th>'.
735: '<th>'.$lt{'typ'}.'</th>'.
736: '<th>'.$lt{'fnam'}.'</th>'.
737: '<th>'.$lt{'ques'}.'</th>'.
738: '<th>'.$lt{'answ'}.'</th>'.
739: &Apache::loncommon::end_data_table_header_row());
740: my $idx;
741: if ($numitems =~ /^\d+$/ && $numitems > 0) {
742: $idx = int(log($numitems)/log(10));
743: $idx ++;
744: }
745: if ($idx<3) {
746: $idx = 3;
747: }
1.1 raeburn 748: for (my $j=0; $j<$numitems; $j++) {
1.15 raeburn 749: my $qnum = $ids->[$j];
750: my $libfile = 'question_';
751: my $leading = 0;
752: while (($idx - length($qnum) - $leading) > 0) {
753: $libfile .= '0';
754: $leading ++;
755: }
756: $libfile .= $qnum.'.problem';
1.1 raeburn 757: for (my $i=0; $i<$blocks; $i++) {
758: if ($nums[$i] > 0) {
759: if (($j+1 >= $start[$i]) && ($j+1 <= $end[$i])) {
760: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA")) {
761: for (my $k=0; $k<@{$multparts{$j}}; $k++) {
762: if ($k == 0) {
1.15 raeburn 763: my $showqn = $multparts{$j}[$k];
764: if (($res eq 'application/rtf') || ($res eq 'text/html')) {
765: $showqn = &HTML::Entities::decode($showqn);
766: if ($res eq 'text/html') {
767: $showqn = &build_image_url($urlpath,$showqn);
768: }
769: }
770: $r->print(&Apache::loncommon::start_data_table_row().
771: '<td valign="top">'.$qnum.'.</td>'."\n".
1.23 bisitz 772: '<td valign="top"><input name="createprob" type="checkbox" checked="checked" value="'.$j.'" /></td>'."\n".
1.15 raeburn 773: '<td valign="top"><b>'.$qtype[$i].'</b></td>'."\n".
774: '<td valign="top"><input type="textbox" name="probfile_'.$j.'" value="'.$libfile.'" size="20" /></td>'.
775: '<td valign="top">'.$showqn.'<br /><br />'."\n");
776: } else {
1.1 raeburn 777: my $foiltag = '';
778: if ($foilformats[$i] eq "lcperiod") {
1.15 raeburn 779: $foiltag = $alphabet->[$k-1].'.';
1.1 raeburn 780: } elsif ($foilformats[$i] eq "lcparen") {
1.15 raeburn 781: $foiltag = '('.$alphabet->[$k-1].')';
1.5 raeburn 782: } elsif ($foilformats[$i] eq "lconeparen") {
1.15 raeburn 783: $foiltag = $alphabet->[$k-1].')';
1.5 raeburn 784: } elsif ($foilformats[$i] eq "lcdotparen") {
1.15 raeburn 785: $foiltag = $alphabet->[$k-1].'.)';
1.1 raeburn 786: } elsif ($foilformats[$i] eq "ucperiod") {
1.15 raeburn 787: $foiltag = $alphabet->[$k-1].'.';
1.1 raeburn 788: $foiltag =~ tr/a-z/A-Z/;
789: } elsif ($foilformats[$i] eq "ucparen") {
1.15 raeburn 790: $foiltag = '('.$alphabet->[$k-1].')';
1.1 raeburn 791: $foiltag =~ tr/a-z/A-Z/;
1.5 raeburn 792: } elsif ($foilformats[$i] eq "uconeparen") {
1.15 raeburn 793: $foiltag = $alphabet->[$k-1].')';
1.5 raeburn 794: $foiltag =~ tr/a-z/A-Z/;
795: } elsif ($foilformats[$i] eq "ucdotparen") {
1.15 raeburn 796: $foiltag = $alphabet->[$k-1].'.)';
1.5 raeburn 797: $foiltag =~ tr/a-z/A-Z/;
1.1 raeburn 798: } elsif ($foilformats[$i] eq "romperiod") {
1.15 raeburn 799: $foiltag = $romans->[$k-1].'.';
1.1 raeburn 800: } elsif ($foilformats[$i] eq "romparen") {
1.15 raeburn 801: $foiltag = '('.$romans->[$k-1].')';
1.5 raeburn 802: } elsif ($foilformats[$i] eq "romoneparen") {
1.15 raeburn 803: $foiltag = $romans->[$k-1].')';
1.5 raeburn 804: } elsif ($foilformats[$i] eq "romdotparen") {
1.15 raeburn 805: $foiltag = $romans->[$k-1].'.)';
806: }
807: my $showfoil = $multparts{$j}[$k];
808: if ($res eq 'application/rtf' || $res eq 'text/html') {
809: $showfoil = &HTML::Entities::decode($showfoil);
810: if ($res eq 'text/html') {
811: $showfoil = &build_image_url($urlpath,$showfoil);
812: }
1.5 raeburn 813: }
1.15 raeburn 814: $r->print("$foiltag $showfoil<br />\n");
1.1 raeburn 815: }
816: }
1.15 raeburn 817: my $showfoil = $items->[$j+$numitems];
818: if ($res eq 'application/rtf' || $res eq 'text/html') {
819: $showfoil = &HTML::Entities::decode($showfoil);
820: $showfoil =~ s/<\/?[^>]+>//g;
821: }
822:
823: $r->print('<br /></td><td valign="top">'.$showfoil.'</td>'.
824: &Apache::loncommon::end_data_table_row());
1.1 raeburn 825: } else {
1.15 raeburn 826: my $showfoil = $items->[$j+$numitems];
827: if ($res eq 'application/rtf' || $res eq 'text/html') {
828: $showfoil = &HTML::Entities::decode($showfoil);
829: $showfoil =~ s/<\/?[^>]+>//g;
830: }
831: $r->print(&Apache::loncommon::start_data_table_row().
832: '<td valign="top">'.$qnum.'</td>'."\n".
1.23 bisitz 833: '<td valign="top"><input name="createprob" type="checkbox" checked="checked" value="'.$j.'" /></td>'."\n".
1.15 raeburn 834: '<td valign="top"><b>'.$qtype[$i].'</b></td>'."\n".
835: '<td valign="top"><input type="textbox" name="probfile_'.$j.'" value="'.$libfile.'" size="20" /></td>'."\n".
836: '<td valign="top">'.$items->[$j].'</td>'."\n".
837: '<td valign="top">'.$showfoil.'</td>'."\n".
838: &Apache::loncommon::end_data_table_row());
1.1 raeburn 839: }
840: last;
841: }
842: }
843: }
844: }
1.15 raeburn 845: $r->print(&Apache::loncommon::end_data_table().'</p><p>'."\n".
846: '<input type="hidden" name="qnumformat" value="'.$qnumformat.'" />'."\n".
847: '<input type="hidden" name="blocks" value="'.$blocks.'" />');
1.1 raeburn 848: for (my $i=0; $i<$blocks; $i++) {
1.15 raeburn 849: $r->print('
850: <input type="hidden" name="start_'.$i.'" value="'.$start[$i].'" />
851: <input type="hidden" name="end_'.$i.'" value="'.$end[$i].'" />
852: <input type="hidden" name="qtype_'.$i.'" value="'.$qtype[$i].'" />');
1.1 raeburn 853: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
1.15 raeburn 854: $r->print('
855: <input type="hidden" name="foilformat_'.$i.'" value="'.$foilformats[$i].'" />');
1.1 raeburn 856: }
857: if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) {
1.15 raeburn 858: $r->print('
859: <input type="hidden" name="ansr_'.$i.'" value="'.$ansrtypes[$i].'" />');
860: }
861: }
862: $r->print('</p>'.&page_footer($env{'form.newdir'},$uname,$fn,$page).'
863: </form>');
1.1 raeburn 864: }
865:
866: # ---------------------------------------------------------------- Final Display
867: sub final_display {
1.15 raeburn 868: my ($r,$uname,$fn,$page,$textref,$res,$header,$css,$js,$webpath,$dirpath,$subdir) = @_;
1.6 albertel 869: my $qnumformat = $env{'form.qnumformat'};
870: my $blocks = $env{'form.blocks'};
1.1 raeburn 871: my $question_id = '';
872: my @question_title = ();
873: my @question_status = ();
874: my @qtype = ();
875: my @start = ();
876: my @nums = ();
877: my @end = ();
878: my @foilformats = ();
879: my @ansrtypes = ();
880: my %multparts = ();
881: my $numitems = 0;
1.15 raeburn 882: my @createprobs = &Apache::loncommon::get_env_multiple('form.createprob');
1.1 raeburn 883: for (my $i=0; $i<$blocks; $i++) {
1.6 albertel 884: $start[$i] = $env{"form.start_$i"};
885: $end[$i] = $env{"form.end_$i"};
1.1 raeburn 886: if (($end[$i] - $start[$i]) >= 0) {
887: $nums[$i] = $end[$i] - $start[$i]+1;
888: } else {
889: $nums[$i] = 0;
890: }
1.6 albertel 891: $qtype[$i] = $env{"form.qtype_$i"};
1.1 raeburn 892: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
1.6 albertel 893: $foilformats[$i] = $env{"form.foilformat_$i"};
1.1 raeburn 894: } else {
895: $foilformats[$i] = '';
896: }
897: if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) {
1.6 albertel 898: $ansrtypes[$i] = $env{"form.ansr_$i"};
1.1 raeburn 899: }
900: $numitems += $nums[$i];
901: }
902:
1.15 raeburn 903: my %answers;
904: my ($items,$ids,$footer) = &file_split(\@start,\@end,\@nums,$qnumformat,\@foilformats,$textref,\%multparts,$numitems,\@qtype,$blocks);
1.1 raeburn 905:
906: # Converting MC and MA answer to number, and splitting answers for FIB, and ordering for Ord.
1.15 raeburn 907: my ($alphabet,$romans) = &get_constants();
1.1 raeburn 908: my %patterns = (
909: comma => ',',
910: space => '\s+',
911: line => '[\r\n\f]+',
912: tab => '\t+',
913: );
914: for (my $i=0; $i<$blocks; $i++) {
915: if ($nums[$i] > 0) {
916: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "Ord")) {
917: for (my $k=$numitems+$start[$i]-1; $k<$numitems+$end[$i]; $k++) {
1.15 raeburn 918: my $qnum = $k - $numitems;
919: next if (!grep(/^$qnum$/,@createprobs));
920: if (($res eq 'application/rtf') || ($res eq 'text/html')) {
921: $items->[$k] = &HTML::Entities::decode($items->[$k]);
922: }
923: @{$answers{$qnum}} = ();
1.1 raeburn 924: if ($qtype[$i] eq "MC") {
1.15 raeburn 925: $items->[$k] =~ tr/A-Z/a-z/;
926: $items->[$k] =~ s/<\/?[^>]+>//g;
927: $items->[$k] =~ s/\W//g;
1.5 raeburn 928: if ($foilformats[$i] eq "lcperiod" || $foilformats[$i] eq "lcparen" || $foilformats[$i] eq "lconeparen" || $foilformats[$i] eq "lcdotparen" || $foilformats[$i] eq "ucparen" || $foilformats[$i] eq "ucperiod" || $foilformats[$i] eq "uconeparen" || $foilformats[$i] eq "ucdotparen") {
1.15 raeburn 929: for (my $j=0; $j<@{$alphabet}; $j++) {
930: if ($alphabet->[$j] eq $items->[$k]) {
931: push @{$answers{$qnum}}, $j;
1.1 raeburn 932: last;
933: }
934: }
1.5 raeburn 935: } elsif (($foilformats[$i] eq "romparen") || ($foilformats[$i] eq "romperiod") || ($foilformats[$i] eq "romoneparen") || ($foilformats[$i] eq "romdotparen")) {
1.15 raeburn 936: for (my $j=0; $j<@{$romans}; $j++) {
937: if ($romans->[$j] eq $items->[$k]) {
938: push @{$answers{$qnum}}, $j;
1.1 raeburn 939: last;
940: }
941: }
942: }
943: } elsif (($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
1.15 raeburn 944: $items->[$k] =~ tr/A-Z/a-z/;
945: $items->[$k] =~ s/<\/?[^>]+>//g;
946: my @corrects = split/$patterns{$ansrtypes[$i]}/,$items->[$k];
1.1 raeburn 947: foreach my $correct (@corrects) {
1.14 raeburn 948: my @tied;
949: if ($qtype[$i] eq "Ord") {
950: if ($correct =~ /=/) {
951: @tied = split(/=/,$correct);
952: for (my $j=0; $j<@tied; $j++) {
953: $tied[$j] =~ s/\W//g;
954: }
955: } else {
956: $correct =~s/\W//g;
957: }
958: } else {
959: $correct =~s/\W//g;
960: }
1.1 raeburn 961: if ($foilformats[$i] eq "lcperiod" || $foilformats[$i] eq "lcparen" || $foilformats[$i] eq "ucparen" || $foilformats[$i] eq "ucperiod") {
1.15 raeburn 962: if (($qtype[$i] eq "Ord") && (@tied > 0)) {
1.14 raeburn 963: my @ties;
964: foreach my $tie (@tied) {
1.15 raeburn 965: for (my $j=0; $j<@{$alphabet}; $j++) {
966: if ($alphabet->[$j] eq $tie) {
1.14 raeburn 967: push(@ties,$j);
968: last;
969: }
970: }
971: }
972: my $ans = join('=',@ties);
1.15 raeburn 973: push(@{$answers{$qnum}},$ans);
1.14 raeburn 974: } else {
1.15 raeburn 975: for (my $j=0; $j<@{$alphabet}; $j++) {
976: if ($alphabet->[$j] eq $correct) {
977: push @{$answers{$qnum}}, $j;
1.14 raeburn 978: last;
979: }
1.1 raeburn 980: }
981: }
1.5 raeburn 982: } elsif (($foilformats[$i] eq "romparen") || ($foilformats[$i] eq "romperiod") || ($foilformats[$i] eq "romoneparen") || ($foilformats[$i] eq "romdotparen")) {
1.14 raeburn 983: if (($qtype[$i] eq "Ord") && (@tied > 0)) {
984: my @ties;
985: foreach my $tie (@tied) {
1.15 raeburn 986: for (my $j=0; $j<@{$romans}; $j++) {
987: if ($romans->[$j] eq $tie) {
1.14 raeburn 988: push(@ties,$j);
989: last;
990: }
991: }
992: }
1.15 raeburn 993: push(@{$answers{$qnum}},join('=',@ties));
1.14 raeburn 994: } else {
1.15 raeburn 995: for (my $j=0; $j<@{$romans}; $j++) {
996: if ($romans->[$j] eq $correct) {
997: push @{$answers{$qnum}}, $j;
1.14 raeburn 998: last;
999: }
1.1 raeburn 1000: }
1001: }
1002: }
1003: }
1004: } elsif ($qtype[$i] eq "FIB") {
1.15 raeburn 1005: $items->[$k] =~ s/<\/?[^>]+>//g;
1006: @{$answers{$qnum}} = split/$patterns{$ansrtypes[$i]}/,$items->[$k];
1007: for (my $j=0; $j<@{$answers{$qnum}}; $j++) {
1008: $answers{$qnum}[$j] =~ s/^\s+//;
1009: $answers{$qnum}[$j] =~ s/\s+$//;
1010: if ($j==0) {
1011: $answers{$qnum}[$j] =~ s/^<[^>]+>//;
1012: } elsif ($j == @{$answers{$qnum}}-1) {
1013: $answers{$qnum}[$j] =~ s/<\/[^>]+>$//;
1014: }
1.1 raeburn 1015: }
1016: }
1017: }
1018: }
1019: }
1020: }
1.15 raeburn 1021: my $state;
1022:
1023: $r->print('<form name="verify" method="post" action="/adm/testbank">'."\n".
1024: '<input type="hidden" name="blocks" value="'.$blocks.'" />'."\n".
1025: '<input type="hidden" name="qnumformat" value="'.$qnumformat.'" />'."\n");
1026: for (my $i=0; $i<$blocks; $i++) {
1027: $r->print('<input type="hidden" name="start_'.$i.'" value="'.$start[$i].'" />
1028: <input type="hidden" name="end_'.$i.'" value="'.$end[$i].'" />
1029: <input type="hidden" name="qtype_'.$i.'" value="'.$qtype[$i].'" />
1030: <input type="hidden" name="foilformat_'.$i.'" value="'.$foilformats[$i].'" />
1031: <input type="hidden" name="ansr_'.$i.'" value="'.$ansrtypes[$i].'" />'."\n");
1032: }
1033: for (my $i=0; $i<$numitems; $i++) {
1034: $r->print('<input type="hidden" name="probfile_'.$i.'" value="'.$env{'form.probfile_'.$i}.'" />'."\n");
1035: }
1.25 bisitz 1036: $r->print(&Apache::lonhtmlcommon::topic_bar(6,&mt('Result of conversion of testbank questions to LON-CAPA problems')));
1.15 raeburn 1037: my $destdir = $dirpath;
1038: if ($destdir ne '' && $subdir ne '') {
1039: $subdir .= '/';
1040: $destdir .= $subdir;
1041: }
1042: if (@createprobs == 0) {
1043: $state = 'unchecked';
1044: $r->print('<p>'.&mt('No questions were selected for conversion.').'</p>'.
1045: &page_footer($env{'form.newdir'},$uname,$fn,$page,$webpath,$subdir,$state).'</form>');
1046: } elsif (($destdir ne '') && (-e $destdir)) {
1047: my (@qn_file,@result,@numid);
1.1 raeburn 1048: my $qcount = 0;
1.15 raeburn 1049: my $itemcount = 0;
1.1 raeburn 1050: for (my $i=0; $i<$blocks; $i++) {
1051: if ($nums[$i] > 0) {
1052: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "Ord")) {
1053: for (my $j=$start[$i]-1; $j<$end[$i]; $j++) {
1.15 raeburn 1054: $numid[$qcount] = $ids->[$itemcount];
1055: $itemcount ++;
1056: next if (!grep(/^$qcount$/,@createprobs));
1057: my $libfile = &probfile_name($j);
1.1 raeburn 1058: my $answer = $j + $numitems;
1.15 raeburn 1059: my $numans = scalar(@{$answers{$qcount}});
1.1 raeburn 1060: my $foilcount = 0;
1061: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
1062: $foilcount = @{$multparts{$j}};
1063: $foilcount --;
1064: }
1.15 raeburn 1065: ($result[$qcount],$qn_file[$qcount]) = &create_mcq($destdir,$subdir,\@{$multparts{$j}},\@{$answers{$qcount}},$qtype[$i],$libfile,$res,$header,$footer,$js,$css);
1.1 raeburn 1066: $qcount ++;
1067: }
1068: } elsif ($qtype[$i] eq "TF") {
1069: for (my $j=$start[$i]-1; $j<$end[$i]; $j++) {
1.15 raeburn 1070: $numid[$qcount] = $ids->[$itemcount];
1071: $itemcount ++;
1072: next if (!grep(/^$qcount$/,@createprobs));
1073: my $libfile = &probfile_name($j);
1.1 raeburn 1074: my $answer = $j + $numitems;
1.15 raeburn 1075: $items->[$answer] =~ s/^\s+//;
1076: $items->[$answer] =~ s/\s+$//;
1077: $items->[$answer] =~ s/\W//g;
1078: $items->[$answer] =~ tr/A-Z/a-z/;
1.1 raeburn 1079: my $answer_id = '';
1080: if ($ansrtypes[$i] eq 'word' ) {
1.15 raeburn 1081: if ($items->[$answer] =~ m/true/) {
1.1 raeburn 1082: $answer_id = 0;
1083: } else {
1084: $answer_id = 1;
1085: }
1086: } elsif ($ansrtypes[$i] eq 'lett') {
1.15 raeburn 1087: if ($items->[$answer] =~ m/^t/) {
1.1 raeburn 1088: $answer_id = 0;
1089: } else {
1090: $answer_id = 1;
1091: }
1092: }
1.15 raeburn 1093: ($result[$qcount],$qn_file[$qcount]) = &create_ess($destdir,$subdir,$answer_id,$items->[$j],$items->[$answer],$qtype[$i],$libfile,$res,$header,$footer,$js,$css);
1.1 raeburn 1094: $qcount ++;
1095: }
1096: } elsif ($qtype[$i] eq "Ess") {
1097: for (my $j=$start[$i]-1; $j<$end[$i]; $j++) {
1.15 raeburn 1098: $numid[$qcount] = $ids->[$itemcount];
1099: $itemcount ++;
1100: next if (!grep(/^$qcount$/,@createprobs));
1101: my $libfile = &probfile_name($j);
1.1 raeburn 1102: my $answer = $j + $numitems;
1103: my $answer_id = '';
1.15 raeburn 1104: ($result[$qcount],$qn_file[$qcount]) = &create_ess($destdir,$subdir,$answer_id,$items->[$j],$items->[$answer],$qtype[$i],$libfile,$res,$header,$footer,$js,$css);
1.1 raeburn 1105: $qcount ++;
1106: }
1107: }
1108: }
1109: }
1.15 raeburn 1110: my ($successes,$failures,$existing);
1.1 raeburn 1111: for (my $i=0; $i<@qn_file; $i++) {
1.15 raeburn 1112: if ($result[$i] eq 'ok') {
1113: $successes .= '<b>'.$numid[$i].': <a href="'.$webpath.$qn_file[$i].'">'.
1114: $qn_file[$i].'</a></b><br />'."\n";
1115: } elsif ($result[$i] eq 'failed') {
1116: $failures .= $numid[$i].': '.$qn_file[$i].'<br />'."\n";
1117: } elsif ($result[$i] eq 'exists') {
1118: $existing .= '<b>'.$numid[$i].': <a href="'.$webpath.$qn_file[$i].'">'.
1119: $qn_file[$i].'</a></b><br />'."\n";
1120: }
1121: }
1122: if ($successes) {
1123: $r->print('<p>'.&mt('Individual problem files have been created from the following problems included in the testbank file:').'<br />'.$successes.'</p><p>'.
1124: &mt('The problems must be published before they can be used in a course').'</p>');
1125: }
1126: if ($failures) {
1127: $r->print('<p>'.&mt('An error occurred when opening files for the following problems, so they have not been created:').'<br />'.$failures.'</p>');
1128: }
1129: if ($existing) {
1130: $r->print('<p>'.&mt('The following files already existed, and were not overwritten so these problems generated from the testbank have not been saved:').'<br />'.$existing.'</p>');
1131: $state = 'existing';
1132: }
1133: $r->print(&page_footer($env{'form.newdir'},$uname,$fn,$page,$webpath,$subdir,$state).'</form>');
1.1 raeburn 1134: } else {
1.15 raeburn 1135: $state = 'nodir';
1136: $r->print('<p>'.&mt('No destination directory was available so import of questions could not proceed.').'</p>'.
1137: &page_footer($env{'form.newdir'},$uname,$fn,$page,$webpath,$subdir,$state).'</form>');
1138: }
1.1 raeburn 1139: return;
1.15 raeburn 1140: }
1141:
1142: sub show_uploaded_data {
1143: my ($textref,$header) = @_;
1144: my $output = '<p><b>'.&mt('Testbank data uploaded to the server').'</b></p><p>'."\n".
1.16 raeburn 1145: '<textarea name="rawdata" cols="70" rows="6" wrap="virtual" align="center" readonly>'."\n";
1.15 raeburn 1146: if ($header ne '') {
1147: $output .= $header."\n";
1148: }
1149: if (ref($textref) eq 'ARRAY') {
1150: foreach my $line (@{$textref}) {
1151: $line =~ s/\n//g;
1152: if ($line ne '') {
1153: $output .= $line."\n";
1154: }
1155: }
1156: }
1157: $output .= '</textarea></p>';
1158: return $output;
1159: }
1160:
1161: sub page_footer {
1162: my ($newdir,$uname,$fn,$page,$webpath,$subdir,$state) = @_;
1163: my $prevval = &mt('Previous Page');
1164: my $nextval = &mt('Next Page');
1165: my $prevclick = 'javascript:backPage();';
1166: my $nextclick = 'javascript:nextPage();';
1.17 raeburn 1167: my $go = '';
1168: if (($page == 0) || ($state eq 'badfile')) {
1.15 raeburn 1169: $go = 'NextPage';
1170: $prevval = &mt('Exit Now');
1171: $prevclick = 'javascript:location.href='."'$webpath';";
1172: $nextclick = 'javascript:submit();'
1173: } elsif ($page == 3) {
1174: $nextval = &mt('Complete Testbank Conversion');
1175: } elsif ($page == 4) {
1176: if (($state ne 'existing') && ($state ne 'unchecked')) {
1177: my $destdir = $webpath;
1178: if ($subdir ne '') {
1179: $destdir = $webpath.$subdir;
1180: }
1181: $prevval = &mt('Back to Directory');
1182: $prevclick = 'javascript:location.href='."'$destdir';";
1183: }
1184: }
1185: my $output = '
1186: <input type="hidden" name="newdir" value="'.&HTML::Entities::encode($newdir,'<>&"').'" />
1187: <input type="hidden" name="uploaduname" value="'.$uname.'" />
1188: <input type="hidden" name="filename" value="'.$fn.'" />
1189: <input type="hidden" name="page" value="'.$page.'" />
1190: <input type="hidden" name="phase" value="three" />
1.18 raeburn 1191: <input type="hidden" name="go" value="'.$go.'" />
1192: <input type="hidden" name="timestamp" value="'.$env{'form.timestamp'}.'" />';
1.15 raeburn 1193: if ($page ne '') {
1194: $output .= '
1195: <table border="0">
1196: <tr>
1197: <td>
1198: <input type="button" name="backpage" value="'.$prevval.'" onclick="'.$prevclick.'" />
1199: </td>';
1.17 raeburn 1200: if (($page < 4) && ($state ne 'badfile')) {
1.15 raeburn 1201: $output .= '
1202: <td> </td>
1203: <td>
1.21 bisitz 1204: <input type="button" name="nextpage" value="'.$nextval.'" onclick="'.$nextclick.'" />
1.15 raeburn 1205: </td>';
1206: }
1207: $output .= ' </tr>
1208: </table>
1209: ';
1210: }
1211: return $output;
1.1 raeburn 1212: }
1213:
1214: sub question_count {
1215: my ($qnumformat,$textref) = @_;
1216: my $text_in = join "\n", @{$textref};
1217: $text_in = "\n ".$text_in;
1218: my $qpattern ='';
1219: if ($qnumformat eq "period") {
1220: $qpattern = '\d{1,}\.';
1221: } elsif ($qnumformat eq "paren") {
1222: $qpattern = '\(\d{1,}\)';
1223: } elsif ($qnumformat eq "number") {
1224: $qpattern = '\d{1,}';
1225: } elsif ($qnumformat eq "leadparen") {
1226: $qpattern = '\(\d{1,}';
1227: } elsif ($qnumformat eq "trailparen") {
1228: $qpattern = '\d{1,}\)';
1229: }
1230: my @questions = split/[\r\n\f]+\s?$qpattern\s?/,$text_in;
1231: my $qcount = scalar(@questions);
1232: $qcount = $qcount/2;
1233: $qcount = int($qcount);
1234: return $qcount;
1235: }
1236:
1.15 raeburn 1237: sub get_constants {
1238: my @alphabet = ("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z");
1239: my @romans = ("i","ii","iii","iv","v","vi","vii","viii","ix","x","xi","xii","xiii","xiv","xv","xvi","xvii","xviii","xix","xx","xxi","xxii","xxiii","xxiv","xxv","xxvi");
1240: return (\@alphabet,\@romans);
1241: }
1242:
1.1 raeburn 1243: sub file_split {
1244: my ($startsref,$endsref,$numsref,$qnumformat,$foilsref,$textref,$multpartsref,$numitems,$qtyperef,$blocks) = @_;
1245: my $text_in = join "\n", @{$textref};
1246: $text_in = "\n ".$text_in;
1247: my $dignum = length($numitems);
1.15 raeburn 1248: my ($qpatst,$qpatend,$numpat,@questions,@qids);
1249: my $numpat = '\d{1';
1.1 raeburn 1250: if ($dignum > 1) {
1.15 raeburn 1251: $numpat .= ','.$dignum.'}';
1.1 raeburn 1252: } else {
1.15 raeburn 1253: $numpat .= '}';
1.1 raeburn 1254: }
1255: if ($qnumformat eq "period") {
1.15 raeburn 1256: $qpatend = '\.';
1.1 raeburn 1257: } elsif ($qnumformat eq "paren") {
1.15 raeburn 1258: $qpatst = '\(';
1259: $qpatend = '\)';
1.1 raeburn 1260: } elsif ($qnumformat eq "leadparen") {
1.15 raeburn 1261: $qpatst = '\(';
1.1 raeburn 1262: } elsif ($qnumformat eq "trailparen") {
1.15 raeburn 1263: $qpatend = '\)';
1.1 raeburn 1264: }
1.15 raeburn 1265: my @lines = split/[\r\n\f]+\s*$qpatst($numpat)$qpatend\s*/,$text_in;
1.1 raeburn 1266: # my @questions = split/\n\s\d{1,3}\.\s/,$text_in;
1.15 raeburn 1267: shift(@lines);
1268: for (my $i=0; $i<@lines; $i++) {
1269: if ($i%2) {
1270: push(@questions,$lines[$i]);
1271: } else {
1272: push(@qids,$lines[$i]);
1273: }
1274: }
1.1 raeburn 1275: my %multparts = ();
1276: for (my $i=0; $i<$blocks; $i++) {
1277: if (${$numsref}[$i] > 0) {
1.14 raeburn 1278: if ((${$qtyperef}[$i] eq "MC") || (${$qtyperef}[$i] eq "MA") || (${$qtyperef}[$i] eq "Ord")) {
1.1 raeburn 1279: my $splitstr = '';
1280: if (${$foilsref}[$i] eq "lcperiod") {
1281: $splitstr = '[a-z]\.';
1282: } elsif (${$foilsref}[$i] eq "lcparen") {
1283: $splitstr = '\([a-z]\)';
1.5 raeburn 1284: } elsif (${$foilsref}[$i] eq "lconeparen") {
1285: $splitstr = '[a-z]\)';
1286: } elsif (${$foilsref}[$i] eq "lcdotparen") {
1287: $splitstr = '[a-z]\.\)';
1.1 raeburn 1288: } elsif (${$foilsref}[$i] eq "ucperiod") {
1289: $splitstr = '[A-Z]\.';
1290: } elsif (${$foilsref}[$i] eq "ucparen") {
1291: $splitstr = '\([A-Z]\)';
1.5 raeburn 1292: } elsif (${$foilsref}[$i] eq "uconeparen") {
1293: $splitstr = '[A-Z]\)';
1294: } elsif (${$foilsref}[$i] eq "ucdotparen") {
1295: $splitstr = '[A-Z]\.\)';
1.1 raeburn 1296: } elsif (${$foilsref}[$i] eq "romperiod") {
1297: $splitstr = '[ivx]+\.';
1298: } elsif (${$foilsref}[$i] eq "romparen") {
1299: $splitstr = '\([ivx]+\)';
1.5 raeburn 1300: } elsif (${$foilsref}[$i] eq "romoneparen") {
1301: $splitstr = '[ivx]+\)';
1302: } elsif (${$foilsref}[$i] eq "romdotparen") {
1303: $splitstr = '[ivx]+\.\)';
1.1 raeburn 1304: }
1305: for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
1.5 raeburn 1306: @{$multparts{$j}} = split/[\r\n\f]+\s*$splitstr\s*/,$questions[$j];
1.1 raeburn 1307: chomp(@{$multparts{$j}});
1308: }
1309: } elsif (${$qtyperef}[$i] eq "FIB") {
1310: for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
1311: @{$multparts{$j}} = ("$questions[$j]");
1312: }
1313: }
1314: }
1.15 raeburn 1315: }
1316: my ($lastanswer,$footer) = ($questions[-1] =~ /^([,\r\n\f\t\s().A-Za-z]+)(.+)$/);
1317: if ($footer ne '') {
1318: $questions[-1] = $lastanswer;
1319: }
1.1 raeburn 1320: %{$multpartsref} = %multparts;
1.15 raeburn 1321: return (\@questions,\@qids,$footer);
1.1 raeburn 1322: }
1323:
1324: # create_mcq builds an MC, MA, Ord or FIB question
1325:
1326: sub create_mcq {
1.15 raeburn 1327: my ($destdir,$subdir,$qstnref,$answerref,$qtype,$libfile,$res,$header,$footer,$js,$css) = @_;
1328:
1.1 raeburn 1329: my $qstn = ${$qstnref}[0];
1330: my $numfoils = scalar(@{$qstnref}) - 1;
1331: my $datestamp = localtime;
1332: my $numansrs = scalar(@{$answerref});
1.15 raeburn 1333: my $output = '<problem>
1334: <startouttext />';
1335: if ($res eq 'application/rtf' || $res eq 'text/html') {
1336: if ($header ne '') {
1337: $output .= &HTML::Entities::decode($header);
1338: }
1339: if ($js ne '') {
1340: $output .= &HTML::Entities::decode($js);
1341: }
1342: if ($css ne '') {
1343: $output .= &HTML::Entities::decode($css);
1344: }
1345: $qstn = &HTML::Entities::decode($qstn);
1346: }
1347: $output .= $qstn.'<endouttext />'."\n";
1.1 raeburn 1348: if ($qtype eq "MA") {
1349: $output .= qq|
1350: <optionresponse max="$numfoils" randomize="yes">
1351: <foilgroup options="('True','False')">
1352: |;
1353: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1354: $output .= " <foil name=\"foil".$k."\" value=\"";
1355: if (grep/^$k$/,@{$answerref}) {
1356: $output .= "True\" location=\"random\"";
1357: } else {
1358: $output .= "False\" location=\"random\"";
1359: }
1.15 raeburn 1360: my $showfoil = ${$qstnref}[$k+1];
1361: if ($res eq 'application/rtf' || $res eq 'text/html') {
1362: $showfoil = &HTML::Entities::decode($showfoil);
1363: }
1364: $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1365: }
1366: chomp($output);
1367: $output .= qq|
1368: </foilgroup>
1.15 raeburn 1369: </optionresponse>|;
1.1 raeburn 1370: }
1371: if ($qtype eq "MC") {
1372: $output .= qq|
1373: <radiobuttonresponse max="$numfoils" randomize="yes">
1374: <foilgroup>
1375: |;
1376: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1377: $output .= " <foil name=\"foil".$k."\" value=\"";
1378: if (grep/^$k$/,@{$answerref}) {
1379: $output .= "true\" location=\"";
1380: } else {
1381: $output .= "false\" location=\"";
1382: }
1383: if (lc (${$qstnref}[$k+1]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {
1384: $output .= "bottom\"";
1385: } else {
1386: $output .= "random\"";
1387: }
1.15 raeburn 1388: my $showfoil = ${$qstnref}[$k+1];
1389: if ($res eq 'application/rtf' || $res eq 'text/html') {
1390: $showfoil = &HTML::Entities::decode($showfoil);
1391: }
1392: $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1393: }
1394: chomp($output);
1395: $output .= qq|
1396: </foilgroup>
1.15 raeburn 1397: </radiobuttonresponse>|;
1.1 raeburn 1398: }
1399: if ($qtype eq "Ord") {
1400: $output .= qq|
1401: <rankresponse max="$numfoils" randomize="yes">
1402: <foilgroup>
1403: |;
1404: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1.14 raeburn 1405: my $ansval;
1406: my $num = 0;
1407: for (my $i=0; $i<@{$answerref}; $i++) {
1408: if ($$answerref[$i] =~ /=/) {
1409: my @tied = split(/=/,$$answerref[$i]);
1410: foreach my $tie (@tied) {
1411: if ($k == $tie) {
1412: $ansval = $num + 1;
1413: last;
1414: }
1415: }
1416: $num += scalar(@tied);
1417: } elsif ($k == $$answerref[$i]) {
1418: $ansval = $num + 1;
1419: last;
1420: } else {
1421: $num ++;
1422: }
1423: }
1.15 raeburn 1424: my $showfoil = ${$qstnref}[$k+1];
1425: if ($res eq 'application/rtf' || $res eq 'text/html') {
1426: $showfoil = &HTML::Entities::decode($showfoil);
1427: }
1428: $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$ansval."\"><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1429: }
1430: chomp($output);
1431: $output .= qq|
1432: </foilgroup>
1.15 raeburn 1433: </rankresponse>|;
1.1 raeburn 1434: }
1435: if ($qtype eq "FIB") {
1436: my $numerical = 1;
1437: for (my $i=0; $i<@{$answerref}; $i++) {
1438: if (${$answerref}[$i] =~ m/([^\d\.]|\.\.)/) {
1439: $numerical = 0;
1440: }
1441: }
1442: if ($numerical) {
1443: my $numans;
1444: my $tol;
1445: if (@{$answerref} == 1) {
1446: $tol = 5;
1447: $numans = $$answerref[0];
1448: } else {
1.2 raeburn 1449: my $min = $$answerref[0];
1450: my $max = $$answerref[0];
1451: for (my $i=1; $i<@{$answerref}; $i++) {
1452: if ($$answerref[$i]<=$min) {
1.1 raeburn 1453: $min = $$answerref[$i];
1.2 raeburn 1454: } elsif ($$answerref[$i] >= $max) {
1.1 raeburn 1455: $max = $$answerref[$i];
1456: }
1457: }
1458: $numans = ($max + $min)/2;
1459: $tol = 100*($max - $min)/($numans*2);
1460: }
1461: $output .= qq|
1462: <numericalresponse answer="$numans">
1463: <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
1464: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures" />
1465: <textline />
1.15 raeburn 1466: </numericalresponse>|;
1.1 raeburn 1467: } else {
1468: if (@{$answerref} == 1) {
1469: $output .= qq|
1470: <stringresponse answer="$$answerref[0]" type="ci">
1471: <textline>
1472: </textline>
1.15 raeburn 1473: </stringresponse>|;
1.1 raeburn 1474: } else {
1475: for (my $i=0; $i<@{$answerref}; $i++) {
1476: ${$answerref}[$i] =~ s/\|/\|/g;
1477: }
1478: my $regexpans = join('|',@{$answerref});
1479: $regexpans = '/('.$regexpans.')/';
1480: $output .= qq|
1481: <stringresponse answer="$regexpans" type="re">
1482: <textline>
1483: </textline>
1.15 raeburn 1484: </stringresponse>|;
1.1 raeburn 1485: }
1486: }
1487: }
1.15 raeburn 1488: if ($footer ne '') {
1489: $output .= '<startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
1490: }
1491: $output .= qq|
1492: </problem>
1493: |;
1494: my $result;
1495: if (-e $destdir.$libfile) {
1496: $result = 'exists';
1497: } else {
1498: if (open(PROB,">$destdir$libfile")) {
1499: print PROB $output;
1500: close(PROB);
1501: $result = 'ok';
1502: } else {
1503: $result = 'failed';
1504: }
1505: }
1506: return ($result,$subdir.$libfile);
1.1 raeburn 1507: }
1508:
1509: # create_ess builds an essay or True/False question
1510:
1511: sub create_ess {
1.15 raeburn 1512: my ($destdir,$subdir,$answer_id,$qstn,$answertxt,$qtype,$libfile,$res,$header,
1513: $footer,$js,$css) = @_;
1514: my $output = '<problem>
1515: <startouttext />';
1516: if ($res eq 'application/rtf' || $res eq 'text/html') {
1517: if ($header ne '') {
1518: $output .= &HTML::Entities::decode($header);
1519: }
1520: if ($js ne '') {
1521: $output .= &HTML::Entities::decode($js);
1522: }
1523: if ($css ne '') {
1524: $output .= &HTML::Entities::decode($css);
1525: }
1526: $qstn = &HTML::Entities::decode($qstn);
1527: $answertxt = &HTML::Entities::decode($answertxt);
1528: }
1529: $output .= $qstn.'<endouttext />';
1.1 raeburn 1530: my $answer = '';
1531: my $answerlog = '';
1532: if ($qtype eq "Ess") {
1.15 raeburn 1533: $output .= '
1.1 raeburn 1534: <essayresponse>
1535: <textfield></textfield>
1536: </essayresponse>
1537: <postanswerdate>
1.13 raeburn 1538: <startouttext />
1.15 raeburn 1539: '.$answertxt
1540: .'<endouttext />
1541: </postanswerdate>';
1.1 raeburn 1542: } elsif ($qtype eq "TF") {
1543: $answer = $answer_id;
1544: $output .= qq|
1545: <radiobuttonresponse max="2" randomize="yes">
1546: <foilgroup>
1547: |;
1548: $output .= " <foil name=\"foil0\" value=\"true\" location=\"random\"><startouttext />";
1549: if ($answer_id) {
1550: $output .= "False";
1551: } else {
1552: $output .= "True";
1553: }
1554: $output .= "<endouttext /></foil>\n";
1555: $output .= " <foil name=\"foil1\" value=\"false\" location=\"random\"><startouttext />";
1556: if ($answer_id) {
1557: $output .= "True";
1558: } else {
1559: $output .= "False";
1560: }
1.15 raeburn 1561: $output .= '<endouttext /></foil>
1.1 raeburn 1562: </foilgroup>
1.15 raeburn 1563: </radiobuttonresponse>';
1.1 raeburn 1564: }
1.15 raeburn 1565: if ($footer ne '') {
1566: $output .= '
1567: <startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
1568: }
1569: $output .= '
1570: </problem>
1571: ';
1572: my $result;
1573: if (-e $destdir.$libfile) {
1574: $result = 'exists';
1575: } else {
1576: if (open(PROB,">$destdir$libfile")) {
1577: print PROB $output;
1578: close(PROB);
1579: } else {
1580: $result = 'failed';
1581: }
1582: }
1583: return ($result,$subdir.$libfile);
1584: }
1585:
1586: sub probfile_name {
1587: my ($j) = @_;
1588: my $libfile = &HTML::Entities::decode($env{'form.probfile_'.$j});
1589: my $qnum = $j + 1;
1590: if ($libfile eq '') {
1591: if (length($qnum) == 1) {
1592: $qnum = "00".$qnum;
1593: } elsif (length($qnum) == 2) {
1594: $qnum = "0".$qnum;
1595: }
1596: $libfile = 'testbank_question_'.$qnum;
1597: $libfile .= '.problem';
1598: }
1599: return $libfile;
1.1 raeburn 1600: }
1601:
1602: sub file_error {
1.17 raeburn 1603: my ($r,$uname,$fn,$current_page,$webpath,$res) = @_;
1604: $r->print('<p><form name="display" method="post" action="/adm/testbank">'.&mt('The file you uploaded does not appear to be in the correct format.').
1605: '</p><p>'.&mt('Extraction of questions is only possible for the following file types:').
1606: '<ul><li>'.&mt('plain text').'</li><li>RTF</li><li>HTML</li></ul>'.
1607: &mt('The file type identified for the file you uploaded is [_1].','<b>'.$res.'</b>').'</p>');
1608: $r->print(&page_footer($env{'form.newdir'},$uname,$fn,$current_page,$webpath,undef,'badfile').
1609: '</form>');
1610: return;
1.15 raeburn 1611: }
1612:
1613: sub parse_datafile {
1.18 raeburn 1614: my ($r,$uname,$filename,$pathname,$dirpath,$urlpath,$page_name,$subdir,$timestamp) = @_;
1.15 raeburn 1615: my ($badfile,$res,%allfiles,%codebase);
1616: my $mm = new File::MMagic;
1617: my ($text,$header,$css,$js);
1618: if (-e "$dirpath") {
1619: $res = $mm->checktype_filename($dirpath.$filename);
1620: if ($env{'form.phase'} eq 'three') {
1621: if ($res eq 'text/plain') {
1622: open(TESTBANK,"<$dirpath$filename");
1623: @{$text} = <TESTBANK>;
1624: close(TESTBANK);
1625: } elsif ($res eq 'application/rtf') {
1626: my $html = '';
1.18 raeburn 1627: my $image_uri = $timestamp;
1.15 raeburn 1628: if ($page_name eq 'Target') {
1.18 raeburn 1629: $image_uri = $urlpath.'/'.$timestamp;
1.15 raeburn 1630: }
1631: my $image_dir;
1632: if ($page_name eq 'Blocks') {
1633: $image_dir = $dirpath;
1634: $image_dir =~ s/\/$//;
1.18 raeburn 1635: $image_dir .= '/'.$timestamp;
1636: if (!-e $image_dir) {
1637: mkdir($image_dir,0755);
1638: }
1.15 raeburn 1639: } else {
1640: $image_dir = $r->dir_config('lonDaemons').'/tmp/'.
1641: $env{'user.name'}.'_'.$env{'user.domain'}.
1642: '_rtfupload_'.$filename.'_'.time.'_'.$$;
1643: if (!-e $image_dir) {
1644: mkdir($image_dir,0755);
1645: }
1646: }
1647: my $parser = RTF::HTMLConverter->new (
1648: in => $dirpath.$filename,
1649: out => \$html,
1650: DOMImplementation => 'XML::DOM',
1651: image_uri => $image_uri,
1652: image_dir => $image_dir,
1653: );
1654: $parser->parse();
1655: utf8::decode($html);
1656: ($text,$header,$css,$js) =
1.18 raeburn 1657: &parse_htmlcontent($res,$subdir,$html,undef,$page_name);
1.15 raeburn 1658: } elsif ($res eq 'text/html') {
1659: ($text,$header,$css,$js) =
1.18 raeburn 1660: &parse_htmlcontent($res,$subdir,undef,$dirpath.$filename,$page_name);
1.15 raeburn 1661: } else {
1662: $badfile = 1;
1663: }
1664: }
1665: }
1666: return ($res,$badfile,$text,$header,$css,$js,\%allfiles,\%codebase);
1667: }
1668:
1669: sub parse_htmlcontent {
1.18 raeburn 1670: my ($res,$subdir,$html,$fullpath,$page_name) = @_;
1.15 raeburn 1671: my ($p,$fh);
1672: if ($res eq 'application/rtf') {
1673: $p = HTML::TokeParser->new( \$html );
1674: } elsif ($res eq 'text/html') {
1675: open($fh, "<:utf8", $fullpath);
1676: $p = HTML::TokeParser->new( $fh );
1677: }
1678: my ($current_tag,$line,@text,$header,$css,$js,$have_header,$delayed);
1679: while (my $token = $p->get_token) {
1680: if (ref($token) eq 'ARRAY') {
1681: if ($token->[0] eq 'S') {
1682: if ($delayed ne '') {
1683: $line.= $delayed;
1684: $delayed = '';
1685: }
1686: $current_tag = $token->[1];
1687: next if ($token->[1] eq 'html' || $token->[1] eq 'head' || $token->[1] eq 'body' || $token->[1] eq 'meta' || $token->[1] eq 'title');
1688: if ($token->[1] eq 'p') {
1689: $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
1690: if (!$have_header) {
1691: $header = $line;
1692: if ($header ne '') {
1693: $header =~ s/\s*[\n\r\f]+/\n/gs;
1694: }
1695: $have_header = 1;
1696: } else {
1697: push(@text,$line);
1698: }
1699: $line = '';
1700: } elsif ($current_tag eq 'style') {
1701: $css .= $token->[4];
1702: } elsif ($current_tag eq 'script') {
1703: $js .= $token->[4];
1704: } else {
1705: my $contents = $token->[4];
1706: if ($subdir ne '') {
1707: if (($token->[1] eq 'img') && ($token->[2]->{'src'} ne '')) {
1.18 raeburn 1708: if (($res eq 'text/html') ||
1709: ($res eq 'application/rtf') && ($page_name ne 'Target')) {
1710: $contents =~ s/(src=\s*["']?)/$1..\//i;
1711: }
1.15 raeburn 1712: }
1713: }
1714: if (($line eq '') && ($current_tag eq 'font')) {
1715: $delayed = &HTML::Entities::encode($contents,'<>&"');
1716: } else {
1717: $line .= &HTML::Entities::encode($contents,'<>&"');
1718: }
1719: }
1720: } elsif ($token->[0] eq 'T') {
1721: if ($current_tag ne 'html' && $current_tag ne 'head' && $current_tag ne 'body' && $current_tag ne 'meta' && $current_tag ne 'title') {
1722: if ($current_tag eq 'style') {
1723: $css .= $token->[1];
1724: } elsif ($current_tag eq 'script') {
1725: $js .= $token->[1];
1726: } else {
1727: if ($delayed ne '') {
1728: my ($id,$rest) = ($token->[1] =~ /^(\s*\(*[A-Za-z0-9]+\)*\.*\s+)(.+)$/s);
1729: if ($id ne '') {
1730: $line .= $id.$delayed.$rest;
1731: } else {
1732: $line .= $token->[1].$delayed;
1733: }
1734: $delayed = '';
1735: } else {
1736: $line .= $token->[1];
1737: }
1738: }
1739: }
1740: } elsif ($token->[0] eq 'E') {
1741: next if ($token->[1] eq 'html' || $token->[1] eq 'head' || $token->[1] eq 'body' || $token->[1] eq 'meta' || $token->[1] eq 'title' || $token->[1] eq 'p');
1742: if ($token->[1] eq 'style') {
1743: $css .= $token->[2];
1744: } elsif ($token->[1] eq 'script') {
1745: $js .= $token->[2];
1746: } else {
1747: $line .= &HTML::Entities::encode($token->[2],'<>&"');
1748: }
1749: $current_tag = '';
1750: }
1751: }
1752: }
1753: if ($line ne '') {
1754: if ($line ne '') {
1755: $line =~ s/\s*[\n\r\f]+/\n/gs;
1756: }
1757: $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
1758: push(@text,$line);
1759: }
1760: if ($res eq 'text/html') {
1761: close($fh);
1762: }
1763: return (\@text,$header,$css,$js);
1764: }
1765:
1766: sub build_image_url {
1767: my ($urlpath,$item) = @_;
1768: $item =~ s/(<img[^>]+src=["']?\s*)(\.?\.?\/?)/$1$urlpath/gsi;
1769: return $item;
1770: }
1771:
1772: sub print_header {
1.26 raeburn 1773: my ($uname,$udom,$javascript,$loadentries,$title,$current_page,$pagesref,
1774: $namesref) = @_;
1775: my $brcrum = [{'href' => &Apache::loncommon::authorspace(),
1776: 'text' => 'Construction Space'}];
1777: if ($env{'form.phase'} eq 'three') {
1778: if (ref($pagesref) eq 'ARRAY') {
1779: for (my $i=0; $i<$current_page; $i++) {
1780: my $goback = 1 + $i - $current_page;
1781: if (ref($namesref) eq 'HASH') {
1782: if ($namesref->{$pagesref->[$i]} ne '') {
1783: if (ref($brcrum) eq 'ARRAY') {
1784: my $text = $namesref->{$pagesref->[$i]};
1785: my $href;
1786: if ($goback == -1) {
1787: $href = 'javascript:backPage();';
1788: } else {
1789: $href = 'javascript:history.go('.$goback.')';
1790: }
1791: push(@{$brcrum}, {'href' => $href,
1792: 'text' => $text});
1793: }
1794: }
1795: }
1796: }
1797: }
1798: }
1.15 raeburn 1799: my $output = &Apache::loncommon::start_page($title,$javascript,
1.26 raeburn 1800: {'bread_crumbs' => $brcrum,
1801: 'add_entries' => $loadentries});
1.15 raeburn 1802: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.28 ! www 1803: $output .= '<p class="LC_info">'
1.24 bisitz 1804: .&mt('Co-Author [_1]',$uname.':'.$udom)
1.20 bisitz 1805: .'</p>';
1.15 raeburn 1806: }
1807: return $output;
1808: }
1809:
1.1 raeburn 1810: # ---------------------------------------------------------------- Main Handler
1811: sub handler {
1812: my $r=shift;
1813: my $uname;
1814: my $udom;
1815: my $javascript = '';
1816: my $page_name = '';
1817: my $current_page = '';
1818: my $qcount = '';
1.15 raeburn 1819: my $title = 'Upload testbank questions to Construction Space';
1820:
1.6 albertel 1821: if ($env{'form.uploaduname'}) {
1822: $env{'form.filename'}='/priv/'.$env{'form.uploaduname'}.'/'.
1823: $env{'form.filename'};
1.1 raeburn 1824: }
1825: ($uname,$udom)=
1.6 albertel 1826: &Apache::loncacc::constructaccess($env{'form.filename'},
1.1 raeburn 1827: $r->dir_config('lonDefDomain'));
1828: unless (($uname) && ($udom)) {
1.15 raeburn 1829: $r->log_reason($uname.':'.$udom.' trying to convert testbank file '.
1830: $env{'form.filename'}.' - not authorized',$r->filename);
1.1 raeburn 1831: return HTTP_NOT_ACCEPTABLE;
1832: }
1.15 raeburn 1833:
1834: my ($fn,$filename);
1.6 albertel 1835: if ($env{'form.filename'}) {
1836: $fn=$env{'form.filename'};
1.19 raeburn 1837: $fn=~s/^https?\:\/\/[^\/]+\///;
1.1 raeburn 1838: $fn=~s/^\///;
1.11 albertel 1839: $fn=~s{(~|priv/)($LONCAPA::username_re)}{};
1.1 raeburn 1840: $fn=~s/\/+/\//g;
1841: } else {
1.6 albertel 1842: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.1 raeburn 1843: ' unspecified filename for upload', $r->filename);
1844: return HTTP_NOT_FOUND;
1845: }
1846:
1847: # ----------------------------------------------------------- Start page output
1848: &Apache::loncommon::content_type($r,'text/html');
1849: $r->send_http_header;
1850:
1.15 raeburn 1851: my ($filename,$pathname) = &File::Basename::fileparse($fn);
1852: my $webpath = '/priv/'.$uname.$pathname;
1853: my $urlpath = '/~'.$uname.$pathname;
1854: my $dirpath = '/home/'.$uname.'/public_html'.$pathname;
1.26 raeburn 1855: my ($res,$subdir,$badfile,$textref,$header,$css,$js,%loadentries,@pages,%names);
1.15 raeburn 1856:
1.6 albertel 1857: if ($env{'form.phase'} eq 'three') {
1.1 raeburn 1858: $current_page = &display_control();
1.26 raeburn 1859: @pages = ('Welcome','Blocks','Format','Target','Confirmation');
1860: %names = (
1861: Welcome => 'Testbank Format',
1862: Blocks => 'Classification',
1863: Format => 'Selection',
1864: Target => 'Result'
1865: );
1.15 raeburn 1866: $page_name = $pages[$current_page];
1.18 raeburn 1867: if ($env{'form.timestamp'} eq '') {
1868: $env{'form.timestamp'} = time;
1869: }
1.15 raeburn 1870: if ($env{'form.newdir'} ne '') {
1871: if ($env{'form.newdir'} =~ /^\Q$dirpath\E(.+)$/) {
1872: $subdir = $1;
1873: }
1874: }
1875: ($res,$badfile,$textref,$header,$css,$js) =
1876: &parse_datafile($r,$uname,$filename,$pathname,$dirpath,$urlpath,
1.18 raeburn 1877: $page_name,$subdir,$env{'form.timestamp'});
1.15 raeburn 1878: if ($page_name eq 'Welcome') {
1879: &jscript_zero($webpath,\$javascript);
1880: } elsif ($page_name eq 'Blocks') {
1881: if ($env{'form.go'} eq "PreviousPage") {
1882: $loadentries{'onload'} = "setElements()";
1883: }
1.1 raeburn 1884: &jscript_one(\$javascript);
1.15 raeburn 1885: } elsif ($page_name eq 'Format') {
1886: if ($env{'form.go'} eq "PreviousPage") {
1887: $loadentries{'onload'} = "setElements()";
1888: }
1889: $qcount = question_count($env{'form.qnumformat'},$textref);
1.1 raeburn 1890: &jscript_two(\$javascript,$qcount);
1.15 raeburn 1891: } elsif ($page_name eq 'Target') {
1.6 albertel 1892: if ($env{'form.go'} eq "PreviousPage") {
1.10 albertel 1893: $loadentries{'onload'} = "setElements()";
1.1 raeburn 1894: }
1.15 raeburn 1895: &jscript_three($webpath,\$javascript);
1.1 raeburn 1896: } elsif ($page_name eq 'Confirmation') {
1.15 raeburn 1897: &jscript_four(\$javascript,$webpath);
1898: }
1899: $javascript = "<script type=\"text/javascript\">\n//<!--\n".
1900: $javascript."\n// --></script>\n";
1901: if ($res eq 'application/rtf' || $res eq 'text/html') {
1902: if ($page_name eq 'Target') {
1903: $javascript .= $js.$css;
1904: }
1.1 raeburn 1905: }
1.8 albertel 1906: }
1907:
1.26 raeburn 1908: $r->print(&print_header($uname,$udom,$javascript,\%loadentries,$title,
1.27 raeburn 1909: $current_page,\@pages,\%names));
1.1 raeburn 1910:
1.27 raeburn 1911: if (($env{'form.phase'} eq 'four') || ($env{'form.phase'} eq 'three')) {
1912: if ($env{'form.phase'} eq 'four') {
1913: $r->print(&Apache::lonupload::phasefour($r,$fn,$uname,$udom,'testbank'));
1914: my $current_page = 0;
1915: my $js;
1916: &jscript_zero($webpath,\$js);
1917: $js = '<script type="text/javascript">'."\n$js\n".'</script>';
1918: $r->print($js);
1919: &display_zero($r,$uname,$fn,$current_page,$webpath);
1920: } elsif ($env{'form.phase'} eq 'three') {
1921: if ($env{'form.action'} eq 'upload_embedded') {
1922: my ($result,$flag) =
1923: &Apache::lonupload::phasethree($r,$fn,$uname,$udom,'testbank');
1924: $r->print($result);
1925: if ($flag eq 'modify_orightml') {
1926: undef($page_name);
1927: $r->print('<form name="testbankForm" method="post" action="/adm/testbank">'.
1928: &page_footer('',$uname,$fn).'</form>');
1929: }
1930: }
1.15 raeburn 1931: }
1.1 raeburn 1932: if ($badfile) {
1.17 raeburn 1933: &file_error($r,$uname,$fn,$current_page,$webpath,$res);
1.27 raeburn 1934: } else {
1.15 raeburn 1935: &display_zero ($r,$uname,$fn,$current_page,$webpath) if $page_name eq 'Welcome';
1936: &display_one ($r,$uname,$fn,$current_page,$textref,$header) if $page_name eq 'Blocks';
1937: &display_two ($r,$uname,$fn,$current_page,$textref,$header,$qcount) if $page_name eq 'Format';
1938: &display_three ($r,$uname,$fn,$current_page,$textref,$res,$header,$urlpath,$qcount) if $page_name eq 'Target';
1939: &final_display ($r,$uname,$fn,$current_page,$textref,$res,$header,$css,$js,$webpath,$dirpath,$subdir) if $page_name eq 'Confirmation';
1.1 raeburn 1940: }
1.6 albertel 1941: } elsif ($env{'form.phase'} eq 'two') {
1.15 raeburn 1942: my ($result,$flag) = &Apache::lonupload::phasetwo($r,$fn,$uname,$udom,'testbank');
1943: $r->print($result);
1.1 raeburn 1944: if ($flag eq 'ok') {
1.15 raeburn 1945: my $js;
1946: &jscript_zero($webpath,\$js);
1947: $js = '<script type="text/javascript">'."\n$js\n".'</script>';
1948: $r->print($js);
1949: &display_zero($r,$uname,$fn,$current_page,$webpath);
1950: } elsif ($flag eq 'embedded') {
1951: $r->print($js.'<form name="testbankForm" method="post" action="/adm/testbank">'.
1952: &page_footer('',$uname,$fn).'</form>');
1.1 raeburn 1953: }
1954: } else {
1955: &Apache::lonupload::phaseone($r,$fn,$uname,$udom,'testbank');
1956: }
1.8 albertel 1957: $r->print(&Apache::loncommon::end_page());
1.1 raeburn 1958: return OK;
1959: }
1.15 raeburn 1960:
1.1 raeburn 1961: 1;
1962: __END__
1963:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>