Annotation of loncom/publisher/testbankimport.pm, revision 1.33
1.3 albertel 1: # Handler for parsing text upload problem descriptions into .problems
1.33 ! raeburn 2: # $Id: testbankimport.pm,v 1.32 2011/10/31 01:25:32 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.33 ! raeburn 488: my ($r,$fn,$page,$webpath) = @_;
1.15 raeburn 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.33 ! raeburn 515: &page_footer($env{'form.newdir'},$fn,$page,$webpath).'
1.15 raeburn 516: </form>');
1.1 raeburn 517: }
518:
519: # ---------------------------------------------------------------- Display One
520:
521: sub display_one {
1.33 ! raeburn 522: my ($r,$fn,$page,$textref,$header) = @_;
1.15 raeburn 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 />'.
1.33 ! raeburn 569: &page_footer($env{'form.newdir'},$fn,$page).'
1.15 raeburn 570: </form>');
571: return;
1.1 raeburn 572: }
573:
574: # ---------------------------------------------------------------- Display Two
575:
576: sub display_two {
1.33 ! raeburn 577: my ($r,$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.'" />'.
1.33 ! raeburn 661: &page_footer($env{'form.newdir'},$fn,$page).'
1.15 raeburn 662: </form>');
663: return;
664: }
665:
1.1 raeburn 666: # ---------------------------------------------------------------- Display Three
1.15 raeburn 667: sub display_three {
1.33 ! raeburn 668: my ($r,$fn,$page,$textref,$res,$header,$webpath,$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') {
1.33 ! raeburn 718: $showheader = &build_image_url($webpath,$showheader);
1.15 raeburn 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') {
1.33 ! raeburn 767: $showqn = &build_image_url($webpath,$showqn);
1.15 raeburn 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') {
1.33 ! raeburn 811: $showfoil = &build_image_url($webpath,$showfoil);
1.15 raeburn 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: }
1.33 ! raeburn 862: $r->print('</p>'.&page_footer($env{'form.newdir'},$fn,$page).'
1.15 raeburn 863: </form>');
1.1 raeburn 864: }
865:
866: # ---------------------------------------------------------------- Final Display
867: sub final_display {
1.33 ! raeburn 868: my ($r,$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>'.
1.33 ! raeburn 1045: &page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).'</form>');
1.15 raeburn 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: }
1.33 ! raeburn 1133: $r->print(&page_footer($env{'form.newdir'},$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>'.
1.33 ! raeburn 1137: &page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).'</form>');
1.15 raeburn 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 {
1.33 ! raeburn 1162: my ($newdir,$fn,$page,$webpath,$subdir,$state) = @_;
1.15 raeburn 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="filename" value="'.$fn.'" />
1188: <input type="hidden" name="page" value="'.$page.'" />
1189: <input type="hidden" name="phase" value="three" />
1.18 raeburn 1190: <input type="hidden" name="go" value="'.$go.'" />
1191: <input type="hidden" name="timestamp" value="'.$env{'form.timestamp'}.'" />';
1.15 raeburn 1192: if ($page ne '') {
1193: $output .= '
1194: <table border="0">
1195: <tr>
1196: <td>
1197: <input type="button" name="backpage" value="'.$prevval.'" onclick="'.$prevclick.'" />
1198: </td>';
1.17 raeburn 1199: if (($page < 4) && ($state ne 'badfile')) {
1.15 raeburn 1200: $output .= '
1201: <td> </td>
1202: <td>
1.21 bisitz 1203: <input type="button" name="nextpage" value="'.$nextval.'" onclick="'.$nextclick.'" />
1.15 raeburn 1204: </td>';
1205: }
1206: $output .= ' </tr>
1207: </table>
1208: ';
1209: }
1210: return $output;
1.1 raeburn 1211: }
1212:
1213: sub question_count {
1214: my ($qnumformat,$textref) = @_;
1215: my $text_in = join "\n", @{$textref};
1216: $text_in = "\n ".$text_in;
1217: my $qpattern ='';
1218: if ($qnumformat eq "period") {
1219: $qpattern = '\d{1,}\.';
1220: } elsif ($qnumformat eq "paren") {
1221: $qpattern = '\(\d{1,}\)';
1222: } elsif ($qnumformat eq "number") {
1223: $qpattern = '\d{1,}';
1224: } elsif ($qnumformat eq "leadparen") {
1225: $qpattern = '\(\d{1,}';
1226: } elsif ($qnumformat eq "trailparen") {
1227: $qpattern = '\d{1,}\)';
1228: }
1229: my @questions = split/[\r\n\f]+\s?$qpattern\s?/,$text_in;
1230: my $qcount = scalar(@questions);
1231: $qcount = $qcount/2;
1232: $qcount = int($qcount);
1233: return $qcount;
1234: }
1235:
1.15 raeburn 1236: sub get_constants {
1237: 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");
1238: 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");
1239: return (\@alphabet,\@romans);
1240: }
1241:
1.1 raeburn 1242: sub file_split {
1243: my ($startsref,$endsref,$numsref,$qnumformat,$foilsref,$textref,$multpartsref,$numitems,$qtyperef,$blocks) = @_;
1244: my $text_in = join "\n", @{$textref};
1245: $text_in = "\n ".$text_in;
1246: my $dignum = length($numitems);
1.15 raeburn 1247: my ($qpatst,$qpatend,$numpat,@questions,@qids);
1248: my $numpat = '\d{1';
1.1 raeburn 1249: if ($dignum > 1) {
1.15 raeburn 1250: $numpat .= ','.$dignum.'}';
1.1 raeburn 1251: } else {
1.15 raeburn 1252: $numpat .= '}';
1.1 raeburn 1253: }
1254: if ($qnumformat eq "period") {
1.15 raeburn 1255: $qpatend = '\.';
1.1 raeburn 1256: } elsif ($qnumformat eq "paren") {
1.15 raeburn 1257: $qpatst = '\(';
1258: $qpatend = '\)';
1.1 raeburn 1259: } elsif ($qnumformat eq "leadparen") {
1.15 raeburn 1260: $qpatst = '\(';
1.1 raeburn 1261: } elsif ($qnumformat eq "trailparen") {
1.15 raeburn 1262: $qpatend = '\)';
1.1 raeburn 1263: }
1.15 raeburn 1264: my @lines = split/[\r\n\f]+\s*$qpatst($numpat)$qpatend\s*/,$text_in;
1.1 raeburn 1265: # my @questions = split/\n\s\d{1,3}\.\s/,$text_in;
1.15 raeburn 1266: shift(@lines);
1267: for (my $i=0; $i<@lines; $i++) {
1268: if ($i%2) {
1269: push(@questions,$lines[$i]);
1270: } else {
1271: push(@qids,$lines[$i]);
1272: }
1273: }
1.1 raeburn 1274: my %multparts = ();
1275: for (my $i=0; $i<$blocks; $i++) {
1276: if (${$numsref}[$i] > 0) {
1.14 raeburn 1277: if ((${$qtyperef}[$i] eq "MC") || (${$qtyperef}[$i] eq "MA") || (${$qtyperef}[$i] eq "Ord")) {
1.1 raeburn 1278: my $splitstr = '';
1279: if (${$foilsref}[$i] eq "lcperiod") {
1280: $splitstr = '[a-z]\.';
1281: } elsif (${$foilsref}[$i] eq "lcparen") {
1282: $splitstr = '\([a-z]\)';
1.5 raeburn 1283: } elsif (${$foilsref}[$i] eq "lconeparen") {
1284: $splitstr = '[a-z]\)';
1285: } elsif (${$foilsref}[$i] eq "lcdotparen") {
1286: $splitstr = '[a-z]\.\)';
1.1 raeburn 1287: } elsif (${$foilsref}[$i] eq "ucperiod") {
1288: $splitstr = '[A-Z]\.';
1289: } elsif (${$foilsref}[$i] eq "ucparen") {
1290: $splitstr = '\([A-Z]\)';
1.5 raeburn 1291: } elsif (${$foilsref}[$i] eq "uconeparen") {
1292: $splitstr = '[A-Z]\)';
1293: } elsif (${$foilsref}[$i] eq "ucdotparen") {
1294: $splitstr = '[A-Z]\.\)';
1.1 raeburn 1295: } elsif (${$foilsref}[$i] eq "romperiod") {
1296: $splitstr = '[ivx]+\.';
1297: } elsif (${$foilsref}[$i] eq "romparen") {
1298: $splitstr = '\([ivx]+\)';
1.5 raeburn 1299: } elsif (${$foilsref}[$i] eq "romoneparen") {
1300: $splitstr = '[ivx]+\)';
1301: } elsif (${$foilsref}[$i] eq "romdotparen") {
1302: $splitstr = '[ivx]+\.\)';
1.1 raeburn 1303: }
1304: for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
1.5 raeburn 1305: @{$multparts{$j}} = split/[\r\n\f]+\s*$splitstr\s*/,$questions[$j];
1.1 raeburn 1306: chomp(@{$multparts{$j}});
1307: }
1308: } elsif (${$qtyperef}[$i] eq "FIB") {
1309: for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
1310: @{$multparts{$j}} = ("$questions[$j]");
1311: }
1312: }
1313: }
1.15 raeburn 1314: }
1315: my ($lastanswer,$footer) = ($questions[-1] =~ /^([,\r\n\f\t\s().A-Za-z]+)(.+)$/);
1316: if ($footer ne '') {
1317: $questions[-1] = $lastanswer;
1318: }
1.1 raeburn 1319: %{$multpartsref} = %multparts;
1.15 raeburn 1320: return (\@questions,\@qids,$footer);
1.1 raeburn 1321: }
1322:
1323: # create_mcq builds an MC, MA, Ord or FIB question
1324:
1325: sub create_mcq {
1.15 raeburn 1326: my ($destdir,$subdir,$qstnref,$answerref,$qtype,$libfile,$res,$header,$footer,$js,$css) = @_;
1327:
1.1 raeburn 1328: my $qstn = ${$qstnref}[0];
1329: my $numfoils = scalar(@{$qstnref}) - 1;
1330: my $datestamp = localtime;
1331: my $numansrs = scalar(@{$answerref});
1.30 raeburn 1332: my $output = '<problem>';
1333: if ($qtype eq 'MC') {
1334: $output .= "\n".'<parameter name="maxtries" type="int_pos" default="2" description="Maximum Number of Tries" />';
1335: }
1336: $output .= '
1.15 raeburn 1337: <startouttext />';
1338: if ($res eq 'application/rtf' || $res eq 'text/html') {
1339: if ($header ne '') {
1340: $output .= &HTML::Entities::decode($header);
1341: }
1342: if ($js ne '') {
1343: $output .= &HTML::Entities::decode($js);
1344: }
1345: if ($css ne '') {
1346: $output .= &HTML::Entities::decode($css);
1347: }
1348: $qstn = &HTML::Entities::decode($qstn);
1349: }
1350: $output .= $qstn.'<endouttext />'."\n";
1.1 raeburn 1351: if ($qtype eq "MA") {
1352: $output .= qq|
1353: <optionresponse max="$numfoils" randomize="yes">
1354: <foilgroup options="('True','False')">
1355: |;
1356: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1357: $output .= " <foil name=\"foil".$k."\" value=\"";
1358: if (grep/^$k$/,@{$answerref}) {
1359: $output .= "True\" location=\"random\"";
1360: } else {
1361: $output .= "False\" location=\"random\"";
1362: }
1.15 raeburn 1363: my $showfoil = ${$qstnref}[$k+1];
1364: if ($res eq 'application/rtf' || $res eq 'text/html') {
1365: $showfoil = &HTML::Entities::decode($showfoil);
1366: }
1367: $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1368: }
1369: chomp($output);
1370: $output .= qq|
1371: </foilgroup>
1.15 raeburn 1372: </optionresponse>|;
1.1 raeburn 1373: }
1374: if ($qtype eq "MC") {
1375: $output .= qq|
1376: <radiobuttonresponse max="$numfoils" randomize="yes">
1377: <foilgroup>
1378: |;
1379: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1380: $output .= " <foil name=\"foil".$k."\" value=\"";
1381: if (grep/^$k$/,@{$answerref}) {
1382: $output .= "true\" location=\"";
1383: } else {
1384: $output .= "false\" location=\"";
1385: }
1386: if (lc (${$qstnref}[$k+1]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {
1387: $output .= "bottom\"";
1388: } else {
1389: $output .= "random\"";
1390: }
1.15 raeburn 1391: my $showfoil = ${$qstnref}[$k+1];
1392: if ($res eq 'application/rtf' || $res eq 'text/html') {
1393: $showfoil = &HTML::Entities::decode($showfoil);
1394: }
1395: $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1396: }
1397: chomp($output);
1398: $output .= qq|
1399: </foilgroup>
1.15 raeburn 1400: </radiobuttonresponse>|;
1.1 raeburn 1401: }
1402: if ($qtype eq "Ord") {
1403: $output .= qq|
1404: <rankresponse max="$numfoils" randomize="yes">
1405: <foilgroup>
1406: |;
1407: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1.14 raeburn 1408: my $ansval;
1409: my $num = 0;
1410: for (my $i=0; $i<@{$answerref}; $i++) {
1411: if ($$answerref[$i] =~ /=/) {
1412: my @tied = split(/=/,$$answerref[$i]);
1413: foreach my $tie (@tied) {
1414: if ($k == $tie) {
1415: $ansval = $num + 1;
1416: last;
1417: }
1418: }
1419: $num += scalar(@tied);
1420: } elsif ($k == $$answerref[$i]) {
1421: $ansval = $num + 1;
1422: last;
1423: } else {
1424: $num ++;
1425: }
1426: }
1.15 raeburn 1427: my $showfoil = ${$qstnref}[$k+1];
1428: if ($res eq 'application/rtf' || $res eq 'text/html') {
1429: $showfoil = &HTML::Entities::decode($showfoil);
1430: }
1431: $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$ansval."\"><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1432: }
1433: chomp($output);
1434: $output .= qq|
1435: </foilgroup>
1.15 raeburn 1436: </rankresponse>|;
1.1 raeburn 1437: }
1438: if ($qtype eq "FIB") {
1439: my $numerical = 1;
1440: for (my $i=0; $i<@{$answerref}; $i++) {
1441: if (${$answerref}[$i] =~ m/([^\d\.]|\.\.)/) {
1442: $numerical = 0;
1443: }
1444: }
1445: if ($numerical) {
1446: my $numans;
1447: my $tol;
1448: if (@{$answerref} == 1) {
1449: $tol = 5;
1450: $numans = $$answerref[0];
1451: } else {
1.2 raeburn 1452: my $min = $$answerref[0];
1453: my $max = $$answerref[0];
1454: for (my $i=1; $i<@{$answerref}; $i++) {
1455: if ($$answerref[$i]<=$min) {
1.1 raeburn 1456: $min = $$answerref[$i];
1.2 raeburn 1457: } elsif ($$answerref[$i] >= $max) {
1.1 raeburn 1458: $max = $$answerref[$i];
1459: }
1460: }
1461: $numans = ($max + $min)/2;
1462: $tol = 100*($max - $min)/($numans*2);
1463: }
1464: $output .= qq|
1465: <numericalresponse answer="$numans">
1466: <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
1467: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures" />
1468: <textline />
1.15 raeburn 1469: </numericalresponse>|;
1.1 raeburn 1470: } else {
1471: if (@{$answerref} == 1) {
1472: $output .= qq|
1473: <stringresponse answer="$$answerref[0]" type="ci">
1474: <textline>
1475: </textline>
1.15 raeburn 1476: </stringresponse>|;
1.1 raeburn 1477: } else {
1478: for (my $i=0; $i<@{$answerref}; $i++) {
1479: ${$answerref}[$i] =~ s/\|/\|/g;
1480: }
1481: my $regexpans = join('|',@{$answerref});
1482: $regexpans = '/('.$regexpans.')/';
1483: $output .= qq|
1484: <stringresponse answer="$regexpans" type="re">
1485: <textline>
1486: </textline>
1.15 raeburn 1487: </stringresponse>|;
1.1 raeburn 1488: }
1489: }
1490: }
1.15 raeburn 1491: if ($footer ne '') {
1492: $output .= '<startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
1493: }
1494: $output .= qq|
1495: </problem>
1496: |;
1497: my $result;
1498: if (-e $destdir.$libfile) {
1499: $result = 'exists';
1500: } else {
1501: if (open(PROB,">$destdir$libfile")) {
1502: print PROB $output;
1503: close(PROB);
1504: $result = 'ok';
1505: } else {
1506: $result = 'failed';
1507: }
1508: }
1509: return ($result,$subdir.$libfile);
1.1 raeburn 1510: }
1511:
1512: # create_ess builds an essay or True/False question
1513:
1514: sub create_ess {
1.15 raeburn 1515: my ($destdir,$subdir,$answer_id,$qstn,$answertxt,$qtype,$libfile,$res,$header,
1516: $footer,$js,$css) = @_;
1517: my $output = '<problem>
1518: <startouttext />';
1519: if ($res eq 'application/rtf' || $res eq 'text/html') {
1520: if ($header ne '') {
1521: $output .= &HTML::Entities::decode($header);
1522: }
1523: if ($js ne '') {
1524: $output .= &HTML::Entities::decode($js);
1525: }
1526: if ($css ne '') {
1527: $output .= &HTML::Entities::decode($css);
1528: }
1529: $qstn = &HTML::Entities::decode($qstn);
1530: $answertxt = &HTML::Entities::decode($answertxt);
1531: }
1532: $output .= $qstn.'<endouttext />';
1.1 raeburn 1533: my $answer = '';
1534: my $answerlog = '';
1535: if ($qtype eq "Ess") {
1.15 raeburn 1536: $output .= '
1.1 raeburn 1537: <essayresponse>
1538: <textfield></textfield>
1539: </essayresponse>
1540: <postanswerdate>
1.13 raeburn 1541: <startouttext />
1.15 raeburn 1542: '.$answertxt
1543: .'<endouttext />
1544: </postanswerdate>';
1.1 raeburn 1545: } elsif ($qtype eq "TF") {
1546: $answer = $answer_id;
1547: $output .= qq|
1548: <radiobuttonresponse max="2" randomize="yes">
1549: <foilgroup>
1550: |;
1551: $output .= " <foil name=\"foil0\" value=\"true\" location=\"random\"><startouttext />";
1552: if ($answer_id) {
1553: $output .= "False";
1554: } else {
1555: $output .= "True";
1556: }
1557: $output .= "<endouttext /></foil>\n";
1558: $output .= " <foil name=\"foil1\" value=\"false\" location=\"random\"><startouttext />";
1559: if ($answer_id) {
1560: $output .= "True";
1561: } else {
1562: $output .= "False";
1563: }
1.15 raeburn 1564: $output .= '<endouttext /></foil>
1.1 raeburn 1565: </foilgroup>
1.15 raeburn 1566: </radiobuttonresponse>';
1.1 raeburn 1567: }
1.15 raeburn 1568: if ($footer ne '') {
1569: $output .= '
1570: <startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
1571: }
1572: $output .= '
1573: </problem>
1574: ';
1575: my $result;
1576: if (-e $destdir.$libfile) {
1577: $result = 'exists';
1578: } else {
1579: if (open(PROB,">$destdir$libfile")) {
1580: print PROB $output;
1581: close(PROB);
1582: } else {
1583: $result = 'failed';
1584: }
1585: }
1586: return ($result,$subdir.$libfile);
1587: }
1588:
1589: sub probfile_name {
1590: my ($j) = @_;
1591: my $libfile = &HTML::Entities::decode($env{'form.probfile_'.$j});
1592: my $qnum = $j + 1;
1593: if ($libfile eq '') {
1594: if (length($qnum) == 1) {
1595: $qnum = "00".$qnum;
1596: } elsif (length($qnum) == 2) {
1597: $qnum = "0".$qnum;
1598: }
1599: $libfile = 'testbank_question_'.$qnum;
1600: $libfile .= '.problem';
1601: }
1602: return $libfile;
1.1 raeburn 1603: }
1604:
1605: sub file_error {
1.33 ! raeburn 1606: my ($r,$fn,$current_page,$webpath,$res) = @_;
1.17 raeburn 1607: $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.').
1608: '</p><p>'.&mt('Extraction of questions is only possible for the following file types:').
1609: '<ul><li>'.&mt('plain text').'</li><li>RTF</li><li>HTML</li></ul>'.
1610: &mt('The file type identified for the file you uploaded is [_1].','<b>'.$res.'</b>').'</p>');
1.33 ! raeburn 1611: $r->print(&page_footer($env{'form.newdir'},$fn,$current_page,$webpath,undef,'badfile').
1.17 raeburn 1612: '</form>');
1613: return;
1.15 raeburn 1614: }
1615:
1616: sub parse_datafile {
1.33 ! raeburn 1617: my ($r,$filename,$dirpath,$webpath,$page_name,$subdir,$timestamp) = @_;
1.15 raeburn 1618: my ($badfile,$res,%allfiles,%codebase);
1619: my $mm = new File::MMagic;
1620: my ($text,$header,$css,$js);
1621: if (-e "$dirpath") {
1622: $res = $mm->checktype_filename($dirpath.$filename);
1623: if ($env{'form.phase'} eq 'three') {
1624: if ($res eq 'text/plain') {
1625: open(TESTBANK,"<$dirpath$filename");
1626: @{$text} = <TESTBANK>;
1627: close(TESTBANK);
1628: } elsif ($res eq 'application/rtf') {
1629: my $html = '';
1.18 raeburn 1630: my $image_uri = $timestamp;
1.15 raeburn 1631: if ($page_name eq 'Target') {
1.33 ! raeburn 1632: $image_uri = "$webpath/$timestamp";
1.15 raeburn 1633: }
1634: my $image_dir;
1635: if ($page_name eq 'Blocks') {
1636: $image_dir = $dirpath;
1637: $image_dir =~ s/\/$//;
1.18 raeburn 1638: $image_dir .= '/'.$timestamp;
1639: if (!-e $image_dir) {
1640: mkdir($image_dir,0755);
1641: }
1.15 raeburn 1642: } else {
1643: $image_dir = $r->dir_config('lonDaemons').'/tmp/'.
1644: $env{'user.name'}.'_'.$env{'user.domain'}.
1645: '_rtfupload_'.$filename.'_'.time.'_'.$$;
1646: if (!-e $image_dir) {
1647: mkdir($image_dir,0755);
1648: }
1649: }
1650: my $parser = RTF::HTMLConverter->new (
1651: in => $dirpath.$filename,
1652: out => \$html,
1653: DOMImplementation => 'XML::DOM',
1654: image_uri => $image_uri,
1655: image_dir => $image_dir,
1656: );
1657: $parser->parse();
1658: utf8::decode($html);
1659: ($text,$header,$css,$js) =
1.18 raeburn 1660: &parse_htmlcontent($res,$subdir,$html,undef,$page_name);
1.15 raeburn 1661: } elsif ($res eq 'text/html') {
1662: ($text,$header,$css,$js) =
1.18 raeburn 1663: &parse_htmlcontent($res,$subdir,undef,$dirpath.$filename,$page_name);
1.15 raeburn 1664: } else {
1665: $badfile = 1;
1666: }
1667: }
1668: }
1669: return ($res,$badfile,$text,$header,$css,$js,\%allfiles,\%codebase);
1670: }
1671:
1672: sub parse_htmlcontent {
1.18 raeburn 1673: my ($res,$subdir,$html,$fullpath,$page_name) = @_;
1.15 raeburn 1674: my ($p,$fh);
1675: if ($res eq 'application/rtf') {
1676: $p = HTML::TokeParser->new( \$html );
1677: } elsif ($res eq 'text/html') {
1678: open($fh, "<:utf8", $fullpath);
1679: $p = HTML::TokeParser->new( $fh );
1680: }
1681: my ($current_tag,$line,@text,$header,$css,$js,$have_header,$delayed);
1682: while (my $token = $p->get_token) {
1683: if (ref($token) eq 'ARRAY') {
1684: if ($token->[0] eq 'S') {
1685: if ($delayed ne '') {
1686: $line.= $delayed;
1687: $delayed = '';
1688: }
1689: $current_tag = $token->[1];
1690: next if ($token->[1] eq 'html' || $token->[1] eq 'head' || $token->[1] eq 'body' || $token->[1] eq 'meta' || $token->[1] eq 'title');
1691: if ($token->[1] eq 'p') {
1692: $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
1693: if (!$have_header) {
1694: $header = $line;
1695: if ($header ne '') {
1696: $header =~ s/\s*[\n\r\f]+/\n/gs;
1697: }
1698: $have_header = 1;
1699: } else {
1700: push(@text,$line);
1701: }
1702: $line = '';
1703: } elsif ($current_tag eq 'style') {
1704: $css .= $token->[4];
1705: } elsif ($current_tag eq 'script') {
1706: $js .= $token->[4];
1707: } else {
1708: my $contents = $token->[4];
1709: if ($subdir ne '') {
1710: if (($token->[1] eq 'img') && ($token->[2]->{'src'} ne '')) {
1.18 raeburn 1711: if (($res eq 'text/html') ||
1712: ($res eq 'application/rtf') && ($page_name ne 'Target')) {
1713: $contents =~ s/(src=\s*["']?)/$1..\//i;
1714: }
1.15 raeburn 1715: }
1716: }
1717: if (($line eq '') && ($current_tag eq 'font')) {
1718: $delayed = &HTML::Entities::encode($contents,'<>&"');
1719: } else {
1720: $line .= &HTML::Entities::encode($contents,'<>&"');
1721: }
1722: }
1723: } elsif ($token->[0] eq 'T') {
1724: if ($current_tag ne 'html' && $current_tag ne 'head' && $current_tag ne 'body' && $current_tag ne 'meta' && $current_tag ne 'title') {
1725: if ($current_tag eq 'style') {
1726: $css .= $token->[1];
1727: } elsif ($current_tag eq 'script') {
1728: $js .= $token->[1];
1729: } else {
1730: if ($delayed ne '') {
1731: my ($id,$rest) = ($token->[1] =~ /^(\s*\(*[A-Za-z0-9]+\)*\.*\s+)(.+)$/s);
1732: if ($id ne '') {
1733: $line .= $id.$delayed.$rest;
1734: } else {
1735: $line .= $token->[1].$delayed;
1736: }
1737: $delayed = '';
1738: } else {
1739: $line .= $token->[1];
1740: }
1741: }
1742: }
1743: } elsif ($token->[0] eq 'E') {
1744: 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');
1745: if ($token->[1] eq 'style') {
1746: $css .= $token->[2];
1747: } elsif ($token->[1] eq 'script') {
1748: $js .= $token->[2];
1749: } else {
1750: $line .= &HTML::Entities::encode($token->[2],'<>&"');
1751: }
1752: $current_tag = '';
1753: }
1754: }
1755: }
1756: if ($line ne '') {
1757: if ($line ne '') {
1758: $line =~ s/\s*[\n\r\f]+/\n/gs;
1759: }
1760: $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
1761: push(@text,$line);
1762: }
1763: if ($res eq 'text/html') {
1764: close($fh);
1765: }
1766: return (\@text,$header,$css,$js);
1767: }
1768:
1769: sub build_image_url {
1.33 ! raeburn 1770: my ($webpath,$item) = @_;
! 1771: $item =~ s/(<img[^>]+src=["']?\s*)(\.?\.?\/?)/$1$webpath/gsi;
! 1772: return $item;
1.15 raeburn 1773: }
1774:
1775: sub print_header {
1.26 raeburn 1776: my ($uname,$udom,$javascript,$loadentries,$title,$current_page,$pagesref,
1777: $namesref) = @_;
1778: my $brcrum = [{'href' => &Apache::loncommon::authorspace(),
1779: 'text' => 'Construction Space'}];
1780: if ($env{'form.phase'} eq 'three') {
1781: if (ref($pagesref) eq 'ARRAY') {
1782: for (my $i=0; $i<$current_page; $i++) {
1783: my $goback = 1 + $i - $current_page;
1784: if (ref($namesref) eq 'HASH') {
1785: if ($namesref->{$pagesref->[$i]} ne '') {
1786: if (ref($brcrum) eq 'ARRAY') {
1787: my $text = $namesref->{$pagesref->[$i]};
1788: my $href;
1789: if ($goback == -1) {
1790: $href = 'javascript:backPage();';
1791: } else {
1792: $href = 'javascript:history.go('.$goback.')';
1793: }
1794: push(@{$brcrum}, {'href' => $href,
1795: 'text' => $text});
1796: }
1797: }
1798: }
1799: }
1800: }
1801: }
1.15 raeburn 1802: my $output = &Apache::loncommon::start_page($title,$javascript,
1.26 raeburn 1803: {'bread_crumbs' => $brcrum,
1804: 'add_entries' => $loadentries});
1.15 raeburn 1805: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.28 www 1806: $output .= '<p class="LC_info">'
1.24 bisitz 1807: .&mt('Co-Author [_1]',$uname.':'.$udom)
1.20 bisitz 1808: .'</p>';
1.15 raeburn 1809: }
1810: return $output;
1811: }
1812:
1.1 raeburn 1813: # ---------------------------------------------------------------- Main Handler
1814: sub handler {
1815: my $r=shift;
1.15 raeburn 1816:
1.33 ! raeburn 1817: my $fn=$env{'form.filename'};
! 1818:
! 1819: if ($env{'form.filename1'}) {
! 1820: $fn=$env{'form.filename1'}.$env{'form.filename2'};
1.1 raeburn 1821: }
1.33 ! raeburn 1822: $fn=~s{\+}{}g;
1.15 raeburn 1823:
1.33 ! raeburn 1824: unless ($fn) {
1.6 albertel 1825: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.1 raeburn 1826: ' unspecified filename for upload', $r->filename);
1827: return HTTP_NOT_FOUND;
1828: }
1829:
1.33 ! raeburn 1830: my ($uname,$udom) = &Apache::loncacc::constructaccess($fn);
! 1831: if (($uname eq '') || ($udom eq '')) {
! 1832: $r->log_reason($uname.':'.$udom.' trying to convert testbank file '.
! 1833: $fn.' - not authorized',$r->filename);
! 1834: return HTTP_NOT_ACCEPTABLE;
! 1835: }
! 1836:
! 1837: my $javascript = '';
! 1838: my $page_name = '';
! 1839: my $current_page = '';
! 1840: my $qcount = '';
! 1841: my $title = 'Upload testbank questions to Construction Space';
! 1842:
1.1 raeburn 1843: # ----------------------------------------------------------- Start page output
1844: &Apache::loncommon::content_type($r,'text/html');
1845: $r->send_http_header;
1846:
1.33 ! raeburn 1847: my ($filename,$webpath) = &File::Basename::fileparse($fn);
1.31 www 1848: my $dirpath = $r->dir_config('lonDocRoot').$webpath;
1.26 raeburn 1849: my ($res,$subdir,$badfile,$textref,$header,$css,$js,%loadentries,@pages,%names);
1.15 raeburn 1850:
1.6 albertel 1851: if ($env{'form.phase'} eq 'three') {
1.1 raeburn 1852: $current_page = &display_control();
1.26 raeburn 1853: @pages = ('Welcome','Blocks','Format','Target','Confirmation');
1854: %names = (
1855: Welcome => 'Testbank Format',
1856: Blocks => 'Classification',
1857: Format => 'Selection',
1858: Target => 'Result'
1859: );
1.15 raeburn 1860: $page_name = $pages[$current_page];
1.18 raeburn 1861: if ($env{'form.timestamp'} eq '') {
1862: $env{'form.timestamp'} = time;
1863: }
1.15 raeburn 1864: if ($env{'form.newdir'} ne '') {
1865: if ($env{'form.newdir'} =~ /^\Q$dirpath\E(.+)$/) {
1866: $subdir = $1;
1867: }
1868: }
1869: ($res,$badfile,$textref,$header,$css,$js) =
1.33 ! raeburn 1870: &parse_datafile($r,$filename,$dirpath,$webpath,$page_name,
! 1871: $subdir,$env{'form.timestamp'});
1.15 raeburn 1872: if ($page_name eq 'Welcome') {
1873: &jscript_zero($webpath,\$javascript);
1874: } elsif ($page_name eq 'Blocks') {
1875: if ($env{'form.go'} eq "PreviousPage") {
1876: $loadentries{'onload'} = "setElements()";
1877: }
1.1 raeburn 1878: &jscript_one(\$javascript);
1.15 raeburn 1879: } elsif ($page_name eq 'Format') {
1880: if ($env{'form.go'} eq "PreviousPage") {
1881: $loadentries{'onload'} = "setElements()";
1882: }
1883: $qcount = question_count($env{'form.qnumformat'},$textref);
1.1 raeburn 1884: &jscript_two(\$javascript,$qcount);
1.15 raeburn 1885: } elsif ($page_name eq 'Target') {
1.6 albertel 1886: if ($env{'form.go'} eq "PreviousPage") {
1.10 albertel 1887: $loadentries{'onload'} = "setElements()";
1.1 raeburn 1888: }
1.15 raeburn 1889: &jscript_three($webpath,\$javascript);
1.1 raeburn 1890: } elsif ($page_name eq 'Confirmation') {
1.15 raeburn 1891: &jscript_four(\$javascript,$webpath);
1892: }
1893: $javascript = "<script type=\"text/javascript\">\n//<!--\n".
1894: $javascript."\n// --></script>\n";
1895: if ($res eq 'application/rtf' || $res eq 'text/html') {
1896: if ($page_name eq 'Target') {
1897: $javascript .= $js.$css;
1898: }
1.1 raeburn 1899: }
1.8 albertel 1900: }
1901:
1.26 raeburn 1902: $r->print(&print_header($uname,$udom,$javascript,\%loadentries,$title,
1.27 raeburn 1903: $current_page,\@pages,\%names));
1.1 raeburn 1904:
1.27 raeburn 1905: if (($env{'form.phase'} eq 'four') || ($env{'form.phase'} eq 'three')) {
1906: if ($env{'form.phase'} eq 'four') {
1907: $r->print(&Apache::lonupload::phasefour($r,$fn,$uname,$udom,'testbank'));
1908: my $current_page = 0;
1909: my $js;
1910: &jscript_zero($webpath,\$js);
1911: $js = '<script type="text/javascript">'."\n$js\n".'</script>';
1912: $r->print($js);
1.33 ! raeburn 1913: &display_zero($r,$fn,$current_page,$webpath);
1.27 raeburn 1914: } elsif ($env{'form.phase'} eq 'three') {
1915: if ($env{'form.action'} eq 'upload_embedded') {
1916: my ($result,$flag) =
1917: &Apache::lonupload::phasethree($r,$fn,$uname,$udom,'testbank');
1918: $r->print($result);
1919: if ($flag eq 'modify_orightml') {
1920: undef($page_name);
1921: $r->print('<form name="testbankForm" method="post" action="/adm/testbank">'.
1.33 ! raeburn 1922: &page_footer('',$fn).'</form>');
1.27 raeburn 1923: }
1924: }
1.15 raeburn 1925: }
1.1 raeburn 1926: if ($badfile) {
1.33 ! raeburn 1927: &file_error($r,$fn,$current_page,$webpath,$res);
1.27 raeburn 1928: } else {
1.33 ! raeburn 1929: &display_zero ($r,$fn,$current_page,$webpath) if $page_name eq 'Welcome';
! 1930: &display_one ($r,$fn,$current_page,$textref,$header) if $page_name eq 'Blocks';
! 1931: &display_two ($r,$fn,$current_page,$textref,$header,$qcount) if $page_name eq 'Format';
! 1932: &display_three ($r,$fn,$current_page,$textref,$res,$header,$webpath,$qcount) if $page_name eq 'Target';
! 1933: &final_display ($r,$fn,$current_page,$textref,$res,$header,$css,$js,$webpath,$dirpath,$subdir) if $page_name eq 'Confirmation';
1.1 raeburn 1934: }
1.6 albertel 1935: } elsif ($env{'form.phase'} eq 'two') {
1.33 ! raeburn 1936: my ($result,$flag) = &Apache::lonupload::phasetwo($r,$fn,'testbank');
1.15 raeburn 1937: $r->print($result);
1.1 raeburn 1938: if ($flag eq 'ok') {
1.29 raeburn 1939: my $current_page = 0;
1.15 raeburn 1940: my $js;
1941: &jscript_zero($webpath,\$js);
1942: $js = '<script type="text/javascript">'."\n$js\n".'</script>';
1943: $r->print($js);
1.33 ! raeburn 1944: &display_zero($r,$fn,$current_page,$webpath);
1.15 raeburn 1945: } elsif ($flag eq 'embedded') {
1946: $r->print($js.'<form name="testbankForm" method="post" action="/adm/testbank">'.
1.33 ! raeburn 1947: &page_footer('',$fn).'</form>');
1.1 raeburn 1948: }
1949: } else {
1.33 ! raeburn 1950: &Apache::lonupload::phaseone($r,$fn,'testbank');
1.1 raeburn 1951: }
1.8 albertel 1952: $r->print(&Apache::loncommon::end_page());
1.1 raeburn 1953: return OK;
1954: }
1.15 raeburn 1955:
1.1 raeburn 1956: 1;
1957: __END__
1958:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to testbankimport.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / publisher