Annotation of loncom/publisher/testbankimport.pm, revision 1.32
1.3 albertel 1: # Handler for parsing text upload problem descriptions into .problems
1.32 ! raeburn 2: # $Id: testbankimport.pm,v 1.31 2011/10/23 01:27:34 www 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.30 raeburn 1333: my $output = '<problem>';
1334: if ($qtype eq 'MC') {
1335: $output .= "\n".'<parameter name="maxtries" type="int_pos" default="2" description="Maximum Number of Tries" />';
1336: }
1337: $output .= '
1.15 raeburn 1338: <startouttext />';
1339: if ($res eq 'application/rtf' || $res eq 'text/html') {
1340: if ($header ne '') {
1341: $output .= &HTML::Entities::decode($header);
1342: }
1343: if ($js ne '') {
1344: $output .= &HTML::Entities::decode($js);
1345: }
1346: if ($css ne '') {
1347: $output .= &HTML::Entities::decode($css);
1348: }
1349: $qstn = &HTML::Entities::decode($qstn);
1350: }
1351: $output .= $qstn.'<endouttext />'."\n";
1.1 raeburn 1352: if ($qtype eq "MA") {
1353: $output .= qq|
1354: <optionresponse max="$numfoils" randomize="yes">
1355: <foilgroup options="('True','False')">
1356: |;
1357: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1358: $output .= " <foil name=\"foil".$k."\" value=\"";
1359: if (grep/^$k$/,@{$answerref}) {
1360: $output .= "True\" location=\"random\"";
1361: } else {
1362: $output .= "False\" location=\"random\"";
1363: }
1.15 raeburn 1364: my $showfoil = ${$qstnref}[$k+1];
1365: if ($res eq 'application/rtf' || $res eq 'text/html') {
1366: $showfoil = &HTML::Entities::decode($showfoil);
1367: }
1368: $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1369: }
1370: chomp($output);
1371: $output .= qq|
1372: </foilgroup>
1.15 raeburn 1373: </optionresponse>|;
1.1 raeburn 1374: }
1375: if ($qtype eq "MC") {
1376: $output .= qq|
1377: <radiobuttonresponse max="$numfoils" randomize="yes">
1378: <foilgroup>
1379: |;
1380: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1381: $output .= " <foil name=\"foil".$k."\" value=\"";
1382: if (grep/^$k$/,@{$answerref}) {
1383: $output .= "true\" location=\"";
1384: } else {
1385: $output .= "false\" location=\"";
1386: }
1387: if (lc (${$qstnref}[$k+1]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {
1388: $output .= "bottom\"";
1389: } else {
1390: $output .= "random\"";
1391: }
1.15 raeburn 1392: my $showfoil = ${$qstnref}[$k+1];
1393: if ($res eq 'application/rtf' || $res eq 'text/html') {
1394: $showfoil = &HTML::Entities::decode($showfoil);
1395: }
1396: $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1397: }
1398: chomp($output);
1399: $output .= qq|
1400: </foilgroup>
1.15 raeburn 1401: </radiobuttonresponse>|;
1.1 raeburn 1402: }
1403: if ($qtype eq "Ord") {
1404: $output .= qq|
1405: <rankresponse max="$numfoils" randomize="yes">
1406: <foilgroup>
1407: |;
1408: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1.14 raeburn 1409: my $ansval;
1410: my $num = 0;
1411: for (my $i=0; $i<@{$answerref}; $i++) {
1412: if ($$answerref[$i] =~ /=/) {
1413: my @tied = split(/=/,$$answerref[$i]);
1414: foreach my $tie (@tied) {
1415: if ($k == $tie) {
1416: $ansval = $num + 1;
1417: last;
1418: }
1419: }
1420: $num += scalar(@tied);
1421: } elsif ($k == $$answerref[$i]) {
1422: $ansval = $num + 1;
1423: last;
1424: } else {
1425: $num ++;
1426: }
1427: }
1.15 raeburn 1428: my $showfoil = ${$qstnref}[$k+1];
1429: if ($res eq 'application/rtf' || $res eq 'text/html') {
1430: $showfoil = &HTML::Entities::decode($showfoil);
1431: }
1432: $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$ansval."\"><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1433: }
1434: chomp($output);
1435: $output .= qq|
1436: </foilgroup>
1.15 raeburn 1437: </rankresponse>|;
1.1 raeburn 1438: }
1439: if ($qtype eq "FIB") {
1440: my $numerical = 1;
1441: for (my $i=0; $i<@{$answerref}; $i++) {
1442: if (${$answerref}[$i] =~ m/([^\d\.]|\.\.)/) {
1443: $numerical = 0;
1444: }
1445: }
1446: if ($numerical) {
1447: my $numans;
1448: my $tol;
1449: if (@{$answerref} == 1) {
1450: $tol = 5;
1451: $numans = $$answerref[0];
1452: } else {
1.2 raeburn 1453: my $min = $$answerref[0];
1454: my $max = $$answerref[0];
1455: for (my $i=1; $i<@{$answerref}; $i++) {
1456: if ($$answerref[$i]<=$min) {
1.1 raeburn 1457: $min = $$answerref[$i];
1.2 raeburn 1458: } elsif ($$answerref[$i] >= $max) {
1.1 raeburn 1459: $max = $$answerref[$i];
1460: }
1461: }
1462: $numans = ($max + $min)/2;
1463: $tol = 100*($max - $min)/($numans*2);
1464: }
1465: $output .= qq|
1466: <numericalresponse answer="$numans">
1467: <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
1468: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures" />
1469: <textline />
1.15 raeburn 1470: </numericalresponse>|;
1.1 raeburn 1471: } else {
1472: if (@{$answerref} == 1) {
1473: $output .= qq|
1474: <stringresponse answer="$$answerref[0]" type="ci">
1475: <textline>
1476: </textline>
1.15 raeburn 1477: </stringresponse>|;
1.1 raeburn 1478: } else {
1479: for (my $i=0; $i<@{$answerref}; $i++) {
1480: ${$answerref}[$i] =~ s/\|/\|/g;
1481: }
1482: my $regexpans = join('|',@{$answerref});
1483: $regexpans = '/('.$regexpans.')/';
1484: $output .= qq|
1485: <stringresponse answer="$regexpans" type="re">
1486: <textline>
1487: </textline>
1.15 raeburn 1488: </stringresponse>|;
1.1 raeburn 1489: }
1490: }
1491: }
1.15 raeburn 1492: if ($footer ne '') {
1493: $output .= '<startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
1494: }
1495: $output .= qq|
1496: </problem>
1497: |;
1498: my $result;
1499: if (-e $destdir.$libfile) {
1500: $result = 'exists';
1501: } else {
1502: if (open(PROB,">$destdir$libfile")) {
1503: print PROB $output;
1504: close(PROB);
1505: $result = 'ok';
1506: } else {
1507: $result = 'failed';
1508: }
1509: }
1510: return ($result,$subdir.$libfile);
1.1 raeburn 1511: }
1512:
1513: # create_ess builds an essay or True/False question
1514:
1515: sub create_ess {
1.15 raeburn 1516: my ($destdir,$subdir,$answer_id,$qstn,$answertxt,$qtype,$libfile,$res,$header,
1517: $footer,$js,$css) = @_;
1518: my $output = '<problem>
1519: <startouttext />';
1520: if ($res eq 'application/rtf' || $res eq 'text/html') {
1521: if ($header ne '') {
1522: $output .= &HTML::Entities::decode($header);
1523: }
1524: if ($js ne '') {
1525: $output .= &HTML::Entities::decode($js);
1526: }
1527: if ($css ne '') {
1528: $output .= &HTML::Entities::decode($css);
1529: }
1530: $qstn = &HTML::Entities::decode($qstn);
1531: $answertxt = &HTML::Entities::decode($answertxt);
1532: }
1533: $output .= $qstn.'<endouttext />';
1.1 raeburn 1534: my $answer = '';
1535: my $answerlog = '';
1536: if ($qtype eq "Ess") {
1.15 raeburn 1537: $output .= '
1.1 raeburn 1538: <essayresponse>
1539: <textfield></textfield>
1540: </essayresponse>
1541: <postanswerdate>
1.13 raeburn 1542: <startouttext />
1.15 raeburn 1543: '.$answertxt
1544: .'<endouttext />
1545: </postanswerdate>';
1.1 raeburn 1546: } elsif ($qtype eq "TF") {
1547: $answer = $answer_id;
1548: $output .= qq|
1549: <radiobuttonresponse max="2" randomize="yes">
1550: <foilgroup>
1551: |;
1552: $output .= " <foil name=\"foil0\" value=\"true\" location=\"random\"><startouttext />";
1553: if ($answer_id) {
1554: $output .= "False";
1555: } else {
1556: $output .= "True";
1557: }
1558: $output .= "<endouttext /></foil>\n";
1559: $output .= " <foil name=\"foil1\" value=\"false\" location=\"random\"><startouttext />";
1560: if ($answer_id) {
1561: $output .= "True";
1562: } else {
1563: $output .= "False";
1564: }
1.15 raeburn 1565: $output .= '<endouttext /></foil>
1.1 raeburn 1566: </foilgroup>
1.15 raeburn 1567: </radiobuttonresponse>';
1.1 raeburn 1568: }
1.15 raeburn 1569: if ($footer ne '') {
1570: $output .= '
1571: <startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
1572: }
1573: $output .= '
1574: </problem>
1575: ';
1576: my $result;
1577: if (-e $destdir.$libfile) {
1578: $result = 'exists';
1579: } else {
1580: if (open(PROB,">$destdir$libfile")) {
1581: print PROB $output;
1582: close(PROB);
1583: } else {
1584: $result = 'failed';
1585: }
1586: }
1587: return ($result,$subdir.$libfile);
1588: }
1589:
1590: sub probfile_name {
1591: my ($j) = @_;
1592: my $libfile = &HTML::Entities::decode($env{'form.probfile_'.$j});
1593: my $qnum = $j + 1;
1594: if ($libfile eq '') {
1595: if (length($qnum) == 1) {
1596: $qnum = "00".$qnum;
1597: } elsif (length($qnum) == 2) {
1598: $qnum = "0".$qnum;
1599: }
1600: $libfile = 'testbank_question_'.$qnum;
1601: $libfile .= '.problem';
1602: }
1603: return $libfile;
1.1 raeburn 1604: }
1605:
1606: sub file_error {
1.17 raeburn 1607: my ($r,$uname,$fn,$current_page,$webpath,$res) = @_;
1608: $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.').
1609: '</p><p>'.&mt('Extraction of questions is only possible for the following file types:').
1610: '<ul><li>'.&mt('plain text').'</li><li>RTF</li><li>HTML</li></ul>'.
1611: &mt('The file type identified for the file you uploaded is [_1].','<b>'.$res.'</b>').'</p>');
1612: $r->print(&page_footer($env{'form.newdir'},$uname,$fn,$current_page,$webpath,undef,'badfile').
1613: '</form>');
1614: return;
1.15 raeburn 1615: }
1616:
1617: sub parse_datafile {
1.18 raeburn 1618: my ($r,$uname,$filename,$pathname,$dirpath,$urlpath,$page_name,$subdir,$timestamp) = @_;
1.15 raeburn 1619: my ($badfile,$res,%allfiles,%codebase);
1620: my $mm = new File::MMagic;
1621: my ($text,$header,$css,$js);
1622: if (-e "$dirpath") {
1623: $res = $mm->checktype_filename($dirpath.$filename);
1624: if ($env{'form.phase'} eq 'three') {
1625: if ($res eq 'text/plain') {
1626: open(TESTBANK,"<$dirpath$filename");
1627: @{$text} = <TESTBANK>;
1628: close(TESTBANK);
1629: } elsif ($res eq 'application/rtf') {
1630: my $html = '';
1.18 raeburn 1631: my $image_uri = $timestamp;
1.15 raeburn 1632: if ($page_name eq 'Target') {
1.18 raeburn 1633: $image_uri = $urlpath.'/'.$timestamp;
1.15 raeburn 1634: }
1635: my $image_dir;
1636: if ($page_name eq 'Blocks') {
1637: $image_dir = $dirpath;
1638: $image_dir =~ s/\/$//;
1.18 raeburn 1639: $image_dir .= '/'.$timestamp;
1640: if (!-e $image_dir) {
1641: mkdir($image_dir,0755);
1642: }
1.15 raeburn 1643: } else {
1644: $image_dir = $r->dir_config('lonDaemons').'/tmp/'.
1645: $env{'user.name'}.'_'.$env{'user.domain'}.
1646: '_rtfupload_'.$filename.'_'.time.'_'.$$;
1647: if (!-e $image_dir) {
1648: mkdir($image_dir,0755);
1649: }
1650: }
1651: my $parser = RTF::HTMLConverter->new (
1652: in => $dirpath.$filename,
1653: out => \$html,
1654: DOMImplementation => 'XML::DOM',
1655: image_uri => $image_uri,
1656: image_dir => $image_dir,
1657: );
1658: $parser->parse();
1659: utf8::decode($html);
1660: ($text,$header,$css,$js) =
1.18 raeburn 1661: &parse_htmlcontent($res,$subdir,$html,undef,$page_name);
1.15 raeburn 1662: } elsif ($res eq 'text/html') {
1663: ($text,$header,$css,$js) =
1.18 raeburn 1664: &parse_htmlcontent($res,$subdir,undef,$dirpath.$filename,$page_name);
1.15 raeburn 1665: } else {
1666: $badfile = 1;
1667: }
1668: }
1669: }
1670: return ($res,$badfile,$text,$header,$css,$js,\%allfiles,\%codebase);
1671: }
1672:
1673: sub parse_htmlcontent {
1.18 raeburn 1674: my ($res,$subdir,$html,$fullpath,$page_name) = @_;
1.15 raeburn 1675: my ($p,$fh);
1676: if ($res eq 'application/rtf') {
1677: $p = HTML::TokeParser->new( \$html );
1678: } elsif ($res eq 'text/html') {
1679: open($fh, "<:utf8", $fullpath);
1680: $p = HTML::TokeParser->new( $fh );
1681: }
1682: my ($current_tag,$line,@text,$header,$css,$js,$have_header,$delayed);
1683: while (my $token = $p->get_token) {
1684: if (ref($token) eq 'ARRAY') {
1685: if ($token->[0] eq 'S') {
1686: if ($delayed ne '') {
1687: $line.= $delayed;
1688: $delayed = '';
1689: }
1690: $current_tag = $token->[1];
1691: next if ($token->[1] eq 'html' || $token->[1] eq 'head' || $token->[1] eq 'body' || $token->[1] eq 'meta' || $token->[1] eq 'title');
1692: if ($token->[1] eq 'p') {
1693: $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
1694: if (!$have_header) {
1695: $header = $line;
1696: if ($header ne '') {
1697: $header =~ s/\s*[\n\r\f]+/\n/gs;
1698: }
1699: $have_header = 1;
1700: } else {
1701: push(@text,$line);
1702: }
1703: $line = '';
1704: } elsif ($current_tag eq 'style') {
1705: $css .= $token->[4];
1706: } elsif ($current_tag eq 'script') {
1707: $js .= $token->[4];
1708: } else {
1709: my $contents = $token->[4];
1710: if ($subdir ne '') {
1711: if (($token->[1] eq 'img') && ($token->[2]->{'src'} ne '')) {
1.18 raeburn 1712: if (($res eq 'text/html') ||
1713: ($res eq 'application/rtf') && ($page_name ne 'Target')) {
1714: $contents =~ s/(src=\s*["']?)/$1..\//i;
1715: }
1.15 raeburn 1716: }
1717: }
1718: if (($line eq '') && ($current_tag eq 'font')) {
1719: $delayed = &HTML::Entities::encode($contents,'<>&"');
1720: } else {
1721: $line .= &HTML::Entities::encode($contents,'<>&"');
1722: }
1723: }
1724: } elsif ($token->[0] eq 'T') {
1725: if ($current_tag ne 'html' && $current_tag ne 'head' && $current_tag ne 'body' && $current_tag ne 'meta' && $current_tag ne 'title') {
1726: if ($current_tag eq 'style') {
1727: $css .= $token->[1];
1728: } elsif ($current_tag eq 'script') {
1729: $js .= $token->[1];
1730: } else {
1731: if ($delayed ne '') {
1732: my ($id,$rest) = ($token->[1] =~ /^(\s*\(*[A-Za-z0-9]+\)*\.*\s+)(.+)$/s);
1733: if ($id ne '') {
1734: $line .= $id.$delayed.$rest;
1735: } else {
1736: $line .= $token->[1].$delayed;
1737: }
1738: $delayed = '';
1739: } else {
1740: $line .= $token->[1];
1741: }
1742: }
1743: }
1744: } elsif ($token->[0] eq 'E') {
1745: 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');
1746: if ($token->[1] eq 'style') {
1747: $css .= $token->[2];
1748: } elsif ($token->[1] eq 'script') {
1749: $js .= $token->[2];
1750: } else {
1751: $line .= &HTML::Entities::encode($token->[2],'<>&"');
1752: }
1753: $current_tag = '';
1754: }
1755: }
1756: }
1757: if ($line ne '') {
1758: if ($line ne '') {
1759: $line =~ s/\s*[\n\r\f]+/\n/gs;
1760: }
1761: $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
1762: push(@text,$line);
1763: }
1764: if ($res eq 'text/html') {
1765: close($fh);
1766: }
1767: return (\@text,$header,$css,$js);
1768: }
1769:
1770: sub build_image_url {
1771: my ($urlpath,$item) = @_;
1772: $item =~ s/(<img[^>]+src=["']?\s*)(\.?\.?\/?)/$1$urlpath/gsi;
1773: return $item;
1774: }
1775:
1776: sub print_header {
1.26 raeburn 1777: my ($uname,$udom,$javascript,$loadentries,$title,$current_page,$pagesref,
1778: $namesref) = @_;
1779: my $brcrum = [{'href' => &Apache::loncommon::authorspace(),
1780: 'text' => 'Construction Space'}];
1781: if ($env{'form.phase'} eq 'three') {
1782: if (ref($pagesref) eq 'ARRAY') {
1783: for (my $i=0; $i<$current_page; $i++) {
1784: my $goback = 1 + $i - $current_page;
1785: if (ref($namesref) eq 'HASH') {
1786: if ($namesref->{$pagesref->[$i]} ne '') {
1787: if (ref($brcrum) eq 'ARRAY') {
1788: my $text = $namesref->{$pagesref->[$i]};
1789: my $href;
1790: if ($goback == -1) {
1791: $href = 'javascript:backPage();';
1792: } else {
1793: $href = 'javascript:history.go('.$goback.')';
1794: }
1795: push(@{$brcrum}, {'href' => $href,
1796: 'text' => $text});
1797: }
1798: }
1799: }
1800: }
1801: }
1802: }
1.15 raeburn 1803: my $output = &Apache::loncommon::start_page($title,$javascript,
1.26 raeburn 1804: {'bread_crumbs' => $brcrum,
1805: 'add_entries' => $loadentries});
1.15 raeburn 1806: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.28 www 1807: $output .= '<p class="LC_info">'
1.24 bisitz 1808: .&mt('Co-Author [_1]',$uname.':'.$udom)
1.20 bisitz 1809: .'</p>';
1.15 raeburn 1810: }
1811: return $output;
1812: }
1813:
1.1 raeburn 1814: # ---------------------------------------------------------------- Main Handler
1815: sub handler {
1816: my $r=shift;
1817: my $uname;
1818: my $udom;
1819: my $javascript = '';
1820: my $page_name = '';
1821: my $current_page = '';
1822: my $qcount = '';
1.15 raeburn 1823: my $title = 'Upload testbank questions to Construction Space';
1824:
1.6 albertel 1825: if ($env{'form.uploaduname'}) {
1826: $env{'form.filename'}='/priv/'.$env{'form.uploaduname'}.'/'.
1827: $env{'form.filename'};
1.1 raeburn 1828: }
1829: ($uname,$udom)=
1.32 ! raeburn 1830: &Apache::loncacc::constructaccess($env{'form.filename'});
! 1831: unless (($uname ne '') && ($udom ne '')) {
1.15 raeburn 1832: $r->log_reason($uname.':'.$udom.' trying to convert testbank file '.
1833: $env{'form.filename'}.' - not authorized',$r->filename);
1.1 raeburn 1834: return HTTP_NOT_ACCEPTABLE;
1835: }
1.15 raeburn 1836:
1837: my ($fn,$filename);
1.6 albertel 1838: if ($env{'form.filename'}) {
1839: $fn=$env{'form.filename'};
1.19 raeburn 1840: $fn=~s/^https?\:\/\/[^\/]+\///;
1.1 raeburn 1841: $fn=~s/^\///;
1.11 albertel 1842: $fn=~s{(~|priv/)($LONCAPA::username_re)}{};
1.1 raeburn 1843: $fn=~s/\/+/\//g;
1844: } else {
1.6 albertel 1845: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.1 raeburn 1846: ' unspecified filename for upload', $r->filename);
1847: return HTTP_NOT_FOUND;
1848: }
1849:
1850: # ----------------------------------------------------------- Start page output
1851: &Apache::loncommon::content_type($r,'text/html');
1852: $r->send_http_header;
1853:
1.15 raeburn 1854: my ($filename,$pathname) = &File::Basename::fileparse($fn);
1.31 www 1855: my $webpath = '/priv/'.$udom.'/'.$uname.$pathname;
1856: my $dirpath = $r->dir_config('lonDocRoot').$webpath;
1.26 raeburn 1857: my ($res,$subdir,$badfile,$textref,$header,$css,$js,%loadentries,@pages,%names);
1.15 raeburn 1858:
1.6 albertel 1859: if ($env{'form.phase'} eq 'three') {
1.1 raeburn 1860: $current_page = &display_control();
1.26 raeburn 1861: @pages = ('Welcome','Blocks','Format','Target','Confirmation');
1862: %names = (
1863: Welcome => 'Testbank Format',
1864: Blocks => 'Classification',
1865: Format => 'Selection',
1866: Target => 'Result'
1867: );
1.15 raeburn 1868: $page_name = $pages[$current_page];
1.18 raeburn 1869: if ($env{'form.timestamp'} eq '') {
1870: $env{'form.timestamp'} = time;
1871: }
1.15 raeburn 1872: if ($env{'form.newdir'} ne '') {
1873: if ($env{'form.newdir'} =~ /^\Q$dirpath\E(.+)$/) {
1874: $subdir = $1;
1875: }
1876: }
1877: ($res,$badfile,$textref,$header,$css,$js) =
1.31 www 1878: &parse_datafile($r,$uname,$filename,$pathname,$dirpath,$webpath,
1.18 raeburn 1879: $page_name,$subdir,$env{'form.timestamp'});
1.15 raeburn 1880: if ($page_name eq 'Welcome') {
1881: &jscript_zero($webpath,\$javascript);
1882: } elsif ($page_name eq 'Blocks') {
1883: if ($env{'form.go'} eq "PreviousPage") {
1884: $loadentries{'onload'} = "setElements()";
1885: }
1.1 raeburn 1886: &jscript_one(\$javascript);
1.15 raeburn 1887: } elsif ($page_name eq 'Format') {
1888: if ($env{'form.go'} eq "PreviousPage") {
1889: $loadentries{'onload'} = "setElements()";
1890: }
1891: $qcount = question_count($env{'form.qnumformat'},$textref);
1.1 raeburn 1892: &jscript_two(\$javascript,$qcount);
1.15 raeburn 1893: } elsif ($page_name eq 'Target') {
1.6 albertel 1894: if ($env{'form.go'} eq "PreviousPage") {
1.10 albertel 1895: $loadentries{'onload'} = "setElements()";
1.1 raeburn 1896: }
1.15 raeburn 1897: &jscript_three($webpath,\$javascript);
1.1 raeburn 1898: } elsif ($page_name eq 'Confirmation') {
1.15 raeburn 1899: &jscript_four(\$javascript,$webpath);
1900: }
1901: $javascript = "<script type=\"text/javascript\">\n//<!--\n".
1902: $javascript."\n// --></script>\n";
1903: if ($res eq 'application/rtf' || $res eq 'text/html') {
1904: if ($page_name eq 'Target') {
1905: $javascript .= $js.$css;
1906: }
1.1 raeburn 1907: }
1.8 albertel 1908: }
1909:
1.26 raeburn 1910: $r->print(&print_header($uname,$udom,$javascript,\%loadentries,$title,
1.27 raeburn 1911: $current_page,\@pages,\%names));
1.1 raeburn 1912:
1.27 raeburn 1913: if (($env{'form.phase'} eq 'four') || ($env{'form.phase'} eq 'three')) {
1914: if ($env{'form.phase'} eq 'four') {
1915: $r->print(&Apache::lonupload::phasefour($r,$fn,$uname,$udom,'testbank'));
1916: my $current_page = 0;
1917: my $js;
1918: &jscript_zero($webpath,\$js);
1919: $js = '<script type="text/javascript">'."\n$js\n".'</script>';
1920: $r->print($js);
1921: &display_zero($r,$uname,$fn,$current_page,$webpath);
1922: } elsif ($env{'form.phase'} eq 'three') {
1923: if ($env{'form.action'} eq 'upload_embedded') {
1924: my ($result,$flag) =
1925: &Apache::lonupload::phasethree($r,$fn,$uname,$udom,'testbank');
1926: $r->print($result);
1927: if ($flag eq 'modify_orightml') {
1928: undef($page_name);
1929: $r->print('<form name="testbankForm" method="post" action="/adm/testbank">'.
1930: &page_footer('',$uname,$fn).'</form>');
1931: }
1932: }
1.15 raeburn 1933: }
1.1 raeburn 1934: if ($badfile) {
1.17 raeburn 1935: &file_error($r,$uname,$fn,$current_page,$webpath,$res);
1.27 raeburn 1936: } else {
1.15 raeburn 1937: &display_zero ($r,$uname,$fn,$current_page,$webpath) if $page_name eq 'Welcome';
1938: &display_one ($r,$uname,$fn,$current_page,$textref,$header) if $page_name eq 'Blocks';
1939: &display_two ($r,$uname,$fn,$current_page,$textref,$header,$qcount) if $page_name eq 'Format';
1.31 www 1940: &display_three ($r,$uname,$fn,$current_page,$textref,$res,$header,$webpath,$qcount) if $page_name eq 'Target';
1.15 raeburn 1941: &final_display ($r,$uname,$fn,$current_page,$textref,$res,$header,$css,$js,$webpath,$dirpath,$subdir) if $page_name eq 'Confirmation';
1.1 raeburn 1942: }
1.6 albertel 1943: } elsif ($env{'form.phase'} eq 'two') {
1.15 raeburn 1944: my ($result,$flag) = &Apache::lonupload::phasetwo($r,$fn,$uname,$udom,'testbank');
1945: $r->print($result);
1.1 raeburn 1946: if ($flag eq 'ok') {
1.29 raeburn 1947: my $current_page = 0;
1.15 raeburn 1948: my $js;
1949: &jscript_zero($webpath,\$js);
1950: $js = '<script type="text/javascript">'."\n$js\n".'</script>';
1951: $r->print($js);
1952: &display_zero($r,$uname,$fn,$current_page,$webpath);
1953: } elsif ($flag eq 'embedded') {
1954: $r->print($js.'<form name="testbankForm" method="post" action="/adm/testbank">'.
1955: &page_footer('',$uname,$fn).'</form>');
1.1 raeburn 1956: }
1957: } else {
1958: &Apache::lonupload::phaseone($r,$fn,$uname,$udom,'testbank');
1959: }
1.8 albertel 1960: $r->print(&Apache::loncommon::end_page());
1.1 raeburn 1961: return OK;
1962: }
1.15 raeburn 1963:
1.1 raeburn 1964: 1;
1965: __END__
1966:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>