Annotation of loncom/publisher/testbankimport.pm, revision 1.40
1.3 albertel 1: # Handler for parsing text upload problem descriptions into .problems
1.40 ! bisitz 2: # $Id: testbankimport.pm,v 1.39 2013/06/04 22:20:16 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::loncommon();
32: use Apache::lonnet;
33: use HTML::Entities();
34: use Apache::lonlocal;
35: use Apache::lonupload;
1.15 raeburn 36: use Apache::londocs;
1.3 albertel 37: use File::Basename();
1.11 albertel 38: use LONCAPA();
1.15 raeburn 39: use File::MMagic;
40: use XML::DOM;
41: use RTF::HTMLConverter;
42: use HTML::TokeParser;
1.1 raeburn 43:
44: # ---------------------------------------------------------------- Display Control
45: sub display_control {
46: # figure out what page we're on and where we're heading.
1.6 albertel 47: my $page = $env{'form.page'};
48: my $command = $env{'form.go'};
1.1 raeburn 49: my $current_page = &calculate_page($page,$command);
50: return $current_page;
51: }
52:
53: # CALCULATE THE CURRENT PAGE
54: sub calculate_page($$) {
55: my ($prev,$dir) = @_;
56: return 0 if $prev eq ''; # start with first page
57: return $prev + 1 if $dir eq 'NextPage';
58: return $prev - 1 if $dir eq 'PreviousPage';
59: return $prev if $dir eq 'ExitPage';
60: return 0 if $dir eq 'BackToStart';
61: }
62:
1.15 raeburn 63: sub jscript_zero {
64: my ($webpath,$jsref) = @_;
65: my $start_page =
66: &Apache::loncommon::start_page('Create Testbank directory',undef,
67: {'only_body' => 1,
68: 'js_ready' => 1,});
69: my $end_page =
70: &Apache::loncommon::end_page({'js_ready' => 1,});
71: my %lt = &Apache::lonlocal::texthash(
72: loca => 'Location',
73: newd => 'New Directory',
74: ente => 'Enter the name of the new directory where you will save the converted testbank questions',
75: go => 'Go',
76: );
77: $$jsref = <<"END_SCRIPT";
78: function createWin() {
79: document.info.newdir.value = "";
80: newWindow = window.open("","CreateDir","HEIGHT=400,WIDTH=750,scrollbars=yes")
81: newWindow.document.open()
82: newWindow.document.write('$start_page')
1.22 bisitz 83: newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]' />\\n")
1.15 raeburn 84: newWindow.document.write("<h3>$lt{'loca'}: <tt>$webpath</tt></h3><h3>$lt{'newd'}</h3>\\n")
85: newWindow.document.write("<form name='fileaction' action='/adm/cfile' method='post'>\\n")
86: newWindow.document.write("$lt{'ente'}.<br /><br />")
1.21 bisitz 87: newWindow.document.write("<input type='hidden' name='filename' value='$webpath' />")
1.22 bisitz 88: newWindow.document.write("<input type='hidden' name='action' value='newdir' />")
1.21 bisitz 89: newWindow.document.write("<input type='hidden' name='callingmode' value='testbank' />")
1.26 raeburn 90: newWindow.document.write("<input type='hidden' name='inhibitmenu' value='yes' />")
1.21 bisitz 91: newWindow.document.write("$webpath<input type='text' name='newfilename' value='' />")
1.15 raeburn 92: newWindow.document.write("<input type='button' value='$lt{'go'}' onClick='document.fileaction.submit();' /></form>")
93: newWindow.document.write('$end_page')
94: newWindow.document.close()
95: newWindow.focus()
96: }
97:
98: END_SCRIPT
99: return;
100: }
101:
102:
1.1 raeburn 103: # ---------------------------------------------------------------- Jscript One
104:
105: sub jscript_one {
106: my $jsref = shift;
107: $$jsref = <<"END_SCRIPT";
108: function verify() {
109: if ((document.forms.display.blocks.value == "") || (!document.forms.display.blocks.value) || (document.forms.display.blocks.value == "0")) {
110: alert("You must enter the number of blocks of questions of a given question type. This number must be 1 or more.")
111: return false
112: }
113: if (document.forms.display.qnumformat.options[document.forms.display.qnumformat.selectedIndex].value == "-1") {
114: alert("You must select the format used for the question number, e.g., (1), 1., (1, or 1).")
115: return false
116: }
117: return true
118: }
119: function nextPage() {
120: if (verify()) {
121: document.forms.display.go.value="NextPage"
122: document.forms.display.submit()
123: }
124: }
125: function backPage() {
126: document.forms.display.go.value="PreviousPage"
127: document.forms.display.submit()
128: }
129: function setElements() {
130: var iter = 0
131: var selParam = 0
132: END_SCRIPT
1.6 albertel 133: if (exists($env{'form.blocks'}) ) {
1.1 raeburn 134: $$jsref .= qq|
1.6 albertel 135: document.forms.display.blocks.value = $env{'form.blocks'}\n|;
1.15 raeburn 136: }
137: if (exists($env{'form.qnumformat'}) ) {
1.1 raeburn 138: $$jsref .= <<"TO_HERE";
139: for (iter=0; iter<document.forms.display.qnumformat.length; iter++) {
1.6 albertel 140: if(document.forms.display.qnumformat.options[iter].value == "$env{'form.qnumformat'}") {
1.1 raeburn 141: selParam = iter
142: }
143: }
144: document.forms.display.qnumformat.selectedIndex = selParam
145: TO_HERE
146: }
147: $$jsref .= qq|
148: }
149: |;
150: }
151:
152: # ---------------------------------------------------------------- Jscript Two
153: sub jscript_two {
154: my ($jsref,$qcount) = @_;
155: my $blocks = 0;
1.6 albertel 156: if ( exists( $env{'form.blocks'}) ) {
157: $blocks = $env{'form.blocks'};
1.1 raeburn 158: }
159: $$jsref = <<"END_SCRIPT";
160: function verify() {
161: var poolForm = document.forms.display
162: var curmax = 0
163: var curmin = 0
164: for (var i=0; i<$blocks; i++) {
165: var iter = i+1
166: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "MC") {
167: if (poolForm.elements[5*i+4].selectedIndex == 0) {
168: alert ("You must choose the foil labelling format in Multiple Choice questions")
169: return false
170: }
171: }
172: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "MA") {
173: if (poolForm.elements[5*i+4].selectedIndex == 0) {
174: alert ("You must choose the foil labelling format in Multiple Answer questions")
175: return false
176: }
177: if (poolForm.elements[5*i+5].selectedIndex == 0) {
178: alert ("You must choose the answer format in Multiple Answer questions")
179: return false
180: }
181: }
182: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "FIB") {
183: if (poolForm.elements[5*i+5].selectedIndex == 0) {
184: alert ("You must choose the answer format in Fill-in-the-blank questions")
185: return false
186: }
187: }
188: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "TF") {
189: if (poolForm.elements[5*i+5].selectedIndex == 0) {
190: alert ("You must choose the answer format in True/False questions")
191: return false
192: }
193: }
194: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "Ord") {
195: if (poolForm.elements[5*i+4].selectedIndex == 0) {
196: alert ("You must choose the foil labelling format in Ranking/ordering questions")
197: return false
198: }
199: if (poolForm.elements[5*i+5].selectedIndex == 0) {
200: alert ("You must choose the answer format in Ranking/ordering questions")
201: return false
202: }
203: }
204: if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "-1") {
205: alert ("You must choose the question type for block "+iter)
206: return false
207: }
208: if ((poolForm.elements[5*i+1].value == "") || !(poolForm.elements[5*i+1].value)) {
209: alert ("You must choose the start number for block "+iter)
210: return false
211: }
212: if ((poolForm.elements[5*i+2].value == "") || !(poolForm.elements[5*i+2].value)) {
213: alert ("You must choose the end number for block "+iter)
214: return false
215: }
216: if (poolForm.elements[5*i+2].value - poolForm.elements[5*i+1].value < 0) {
217: alert ("In block: "+iter+" the end number must be the same or greater than the start number")
218: return false
219: }
220: if (i == 0) {
221: curmin = parseInt(poolForm.elements[5*i+1].value)
222: curmax = parseInt(poolForm.elements[5*i+2].value)
223: }
224: else {
225: if (parseInt(poolForm.elements[5*i+1].value) < curmin) {
226: if (parseInt(poolForm.elements[5*i+2].value) >= curmin ) {
227: alert("The question number range for block "+iter+" overlaps with the question number range for one of the previous blocks - this is not permitted.")
228: return false
229: }
230: }
231: else {
232: if (parseInt(poolForm.elements[5*i+1].value) <= curmax) {
233: for (var j=parseInt(poolForm.elements[5*i+1].value); j<=parseInt(poolForm.elements[5*i+2].value); j++) {
234: for (var k=0; k<i; k++) {
235: if ((j >= parseInt(poolForm.elements[5*k+1].value)) && (j <= parseInt(poolForm.elements[5*k+2].value))) {
236: var overlap = k+1
237: alert("The question number range for block "+iter+" overlaps with the question number range for block "+overlap+" - this is not permitted.")
238: return false
239: }
240: }
241: }
242: }
243: }
244: if (parseInt(poolForm.elements[5*i+1].value) < curmin) {
245: curmin = parseInt(poolForm.elements[5*i+1].value)
246: }
247: if (parseInt(poolForm.elements[5*i+2].value) > curmax) {
248: curmax = parseInt(poolForm.elements[5*i+2].value)
249: }
250: }
251: }
252: if (curmax >$qcount+curmin) {
253: 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.")
254: return false
255: }
256: var endpt = $qcount + curmin
257: for (var n=curmin; n<endpt; n++) {
258: var warnFlag = true
259: for (var m=0; m<$blocks; m++) {
260: if ((n >= parseInt(poolForm.elements[5*m+1].value)) && (n <= parseInt(poolForm.elements[5*m+2].value))) {
261: warnFlag = false
262: }
263: }
264: if (warnFlag) {
265: 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)")
266: return false
267: }
268: }
269: return true
270: }
271:
272: function nextPage() {
273: if (verify()) {
274: document.forms.display.go.value="NextPage"
275: document.forms.display.submit()
276: }
277: }
278: function backPage() {
279: document.forms.display.go.value="PreviousPage"
280: document.forms.display.submit()
281: }
282: function colSet(caller) {
283: var poolForm = document.forms.display
284: var curVal = poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value
285: poolForm.elements[caller*5+4].length = 0
286: if (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "-1") {
287: poolForm.elements[caller*5+4].options[0] = new Option("<--- Set type ","-1",true,true)
288: }
289: else {
290: 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 291: poolForm.elements[caller*5+4].options[0] = new Option("Select","-1",true,true)
1.1 raeburn 292: poolForm.elements[caller*5+4].options[1] = new Option("a.","lcperiod",false,false)
293: poolForm.elements[caller*5+4].options[2] = new Option("A.","ucperiod",false,false)
294: poolForm.elements[caller*5+4].options[3] = new Option("(a)","lcparen",false,false)
295: poolForm.elements[caller*5+4].options[4] = new Option("(A)","ucparen",false,false)
1.5 raeburn 296: poolForm.elements[caller*5+4].options[5] = new Option("a)","lconeparen",false,false)
297: poolForm.elements[caller*5+4].options[6] = new Option("A)","uconeparen",false,false)
298: poolForm.elements[caller*5+4].options[7] = new Option("a.)","lcdotparen",false,false)
299: poolForm.elements[caller*5+4].options[8] = new Option("A.)","ucdotparen",false,false)
300: poolForm.elements[caller*5+4].options[9] = new Option("(i)","romparen",false,false)
301: poolForm.elements[caller*5+4].options[10] = new Option("i)","romoneparen",false,false)
302: poolForm.elements[caller*5+4].options[11] = new Option("i.)","romdotparen",false,false)
303: poolForm.elements[caller*5+4].options[12] = new Option("i.","romperiod",false,false)
1.1 raeburn 304: poolForm.elements[caller*5+4].selectedIndex = 0
305: }
306: else {
307: poolForm.elements[caller*5+4].options[0] = new Option("Not required","0",true,true)
308: }
309: }
310: poolForm.elements[caller*5+5].length = 0
311: if (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "-1") {
312: poolForm.elements[caller*5+5].options[0] = new Option("<--- Set type ","-1",true,true)
313: }
314: else {
315: 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 316: poolForm.elements[caller*5+5].options[0] = new Option("Select","-1",true,true)
1.1 raeburn 317: poolForm.elements[caller*5+5].options[1] = new Option("single answer","single",false,false)
318: poolForm.elements[caller*5+5].options[2] = new Option("comma","comma",false,false)
319: poolForm.elements[caller*5+5].options[3] = new Option("space","space",false,false)
320: poolForm.elements[caller*5+5].options[4] = new Option("new line","line",false,false)
321: poolForm.elements[caller*5+5].options[5] = new Option("tab","tab",false,false)
322: }
323: else {
324: if (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "Ord") {
1.15 raeburn 325: poolForm.elements[caller*5+5].options[0] = new Option("Select","-1",true,true)
1.1 raeburn 326: poolForm.elements[caller*5+5].options[1] = new Option("comma","comma",false,false)
327: poolForm.elements[caller*5+5].options[2] = new Option("space","space",false,false)
328: poolForm.elements[caller*5+5].options[3] = new Option("new line","line",false,false)
329: poolForm.elements[caller*5+5].options[4] = new Option("tab","tab",false,false)
330: }
331: else {
332: if (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "TF") {
1.15 raeburn 333: poolForm.elements[caller*5+5].options[0] = new Option("Select","-1",true,true)
1.1 raeburn 334: poolForm.elements[caller*5+5].options[1] = new Option("True or False","word",false,false)
1.5 raeburn 335: poolForm.elements[caller*5+5].options[2] = new Option("true or false","word",false,false)
336: poolForm.elements[caller*5+5].options[3] = new Option("TRUE or FALSE","word",false,false)
337: poolForm.elements[caller*5+5].options[4] = new Option("T or F","lett",false,false)
338: poolForm.elements[caller*5+5].options[5] = new Option("t or f","lett",false,false)
1.1 raeburn 339: }
340: else {
341: poolForm.elements[caller*5+5].options[0] = new Option("Not required","0",true,true)
342: }
343: }
344: }
345: }
346: }
347:
348: function setElements() {
349: var iter = 0
350: var selParam = 0
351: END_SCRIPT
352: my @names = ("start_","end_","qtype_","foilformat_","ansr_");
353: for (my $x=0; $x<$blocks; $x++) {
354: foreach my $name (@names) {
355: my $parname = $name.$x;
1.6 albertel 356: my $value = $env{"form.$parname"};
1.1 raeburn 357: if ($value ne "") {
358: if (($name eq "start_") || ($name eq "end_")) {
359: $$jsref .= qq|
360: document.forms.display.$parname.value = $value\n|;
361: } elsif ($name eq "qtype_") {
362: $$jsref .= qq|
363: for (iter=0; iter<document.forms.display.$parname.length; iter++) {
364: if (document.forms.display.$parname.options[iter].value == "$value") {
365: selParam = iter
366: }
367: }
368: document.forms.display.$parname.selectedIndex = selParam
369: colSet($x)
370: |;
371: } elsif (($name eq "foilformat_") || ($name eq "ansr_")) {
372: $$jsref .= <<"TO_HERE";
373: for (iter=0; iter<document.forms.display.$parname.length; iter++) {
374: if (document.forms.display.$parname.options[iter].value == "$value") {
375: selParam = iter
376: }
377: }
378: document.forms.display.$parname.selectedIndex = selParam
379: TO_HERE
380: }
381: }
382: }
383: }
384: $$jsref .= qq|
385: }
386: |;
387: }
388: # ---------------------------------------------------------------- Jscript Three
389:
390: sub jscript_three {
1.15 raeburn 391: my ($webpath,$jsref) = @_;
1.1 raeburn 392: my $source = '';
1.6 albertel 393: if (exists($env{'form.go'}) ) {
394: $source = $env{'form.go'};
1.1 raeburn 395: }
1.8 albertel 396:
1.1 raeburn 397: $$jsref = <<"END_OF_ONE";
398: function nextPage() {
399: if (verify()) {
400: document.forms.dataForm.go.value="NextPage"
1.15 raeburn 401: document.forms.dataForm.submit();
1.1 raeburn 402: }
403: }
1.15 raeburn 404:
1.1 raeburn 405: function backPage() {
406: document.forms.dataForm.go.value="PreviousPage"
407: document.forms.dataForm.submit()
408: }
409:
410: END_OF_ONE
411: if ($source eq "PreviousPage") {
412: $$jsref .= qq|
413: function setElements() {
414: var iter = 0
415: var selParam = 0
416: |;
1.15 raeburn 417: foreach my $item (keys(%env)) {
418: if ($item =~ m/^form\.(probfile_\d+)$/) {
1.1 raeburn 419: my $name = $1;
1.6 albertel 420: my $value = $env{"form.$name"};
1.15 raeburn 421: if ($value ne '') {
422: $$jsref .= qq( document.dataForm.$name.value = "$value"\n);
1.1 raeburn 423: }
424: }
425: }
426: $$jsref .= "}";
427: }
1.15 raeburn 428: $$jsref .= '
429:
430: function verify() {
431: ';
432: my $blocks = 0;
433: if ( exists( $env{'form.blocks'}) ) {
434: $blocks = $env{'form.blocks'};
435: }
436: my $numitems = 0;
437: for (my $i=0; $i<$blocks; $i++) {
438: my $count = 0;
439: if (($env{"form.start_$i"} ne '') && ($env{"form.end_$i"} ne '')) {
440: $count = $env{"form.end_$i"} - $env{"form.start_$i"} +1;
441: }
442: $numitems += $count;
443: }
444: if ($numitems > 0) {
445: my $maxnum = $numitems - 1;
446: my %lt = &Apache::lonlocal::texthash(
1.38 bisitz 447: fnmb => 'Filenames must be unique',
1.15 raeburn 448: isum => 'is used more than once',
449: );
450: $$jsref .= qq|
451: for (var j=$maxnum; j>0; j--) {
452: var currname = document.dataForm.elements['probfile_'+j].value;
453: for (var k=j-1; k>=0; k--) {
454: var comparename = document.dataForm.elements['probfile_'+k].value;
455: if (currname == comparename) {
456: alert("$lt{fnmb} - "+currname+" $lt{isum}");
457: return false;
458: }
459: }
460: }
461: |;
462: }
463: $$jsref .= '
464: return true;
465: }
466: ';
467: $$jsref .= &Apache::loncommon::check_uncheck_jscript();
468: return;
1.1 raeburn 469: }
470:
471: # ---------------------------------------------------------------- Jscript Four
472: sub jscript_four {
1.15 raeburn 473: my ($jsref,$webpath) = @_;
1.1 raeburn 474: $$jsref = qq|
475: function backtoStart() {
1.15 raeburn 476: document.location.href="$webpath"
1.1 raeburn 477: }
1.15 raeburn 478: function backPage() {
1.1 raeburn 479: document.forms.verify.go.value="PreviousPage"
1.15 raeburn 480: document.forms.verify.submit();
1.1 raeburn 481: }
482: |;
483: }
484:
485: # ---------------------------------------------------------------- Display Zero
486: sub display_zero {
1.33 raeburn 487: my ($r,$fn,$page,$webpath) = @_;
1.15 raeburn 488: my $go_default = 'NextPage';
489: if ($fn eq '') {
1.40 ! bisitz 490: $r->print('<b>'.&mt('Incomplete file upload').'</b> '.&mt('Return to the [_1]Authoring Space menu[_2] to upload a file','<a href="'.$webpath.'">','</a>'));
1.15 raeburn 491: }
1.36 raeburn 492: $r->print(&mt('The [_1]Testbank Upload[_2] utility can be used by LON-CAPA authors to generate LON-CAPA problem files from a testbank file of questions/answers.','<b>','</b>').'<br />'.
1.15 raeburn 493: &mt('The following question types can be converted:').'
494: <ul>
495: <li>'.&mt('multiple choice').'</li>
496: <li>'.&mt('multiple answer correct').'</li>
497: <li>'.&mt('fill-in-the-blank').'</li>
498: <li>'.&mt('ordering/ranking').'</li>
499: <li>'.&mt('true/false').'</li>
500: <li>'.&mt('essay').'</li>
501: </ul>
502: '.&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 />'.
503: &mt('Five steps are involved in the conversion process.').'
1.1 raeburn 504: <ol>
1.15 raeburn 505: <li>'.&mt('Optionally create a new sub-directory where the converted testbank questions will be saved.').'</li>
506: <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>
507: <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>
508: <li>'.&mt('Review the identified questions, choose which to convert, and (optionally) override the default filename to be used for each problem file.').'</li>
509: <li>'.&mt('Complete the import of questions.').'</li>
510: </ol><form name="info" method="post" action="/adm/testbank">'.
1.25 bisitz 511: &Apache::lonhtmlcommon::topic_bar(1,&mt('Optional: create a sub-directory in which the testbank questions will be saved')).
1.15 raeburn 512: &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 513: ' <input type="button" name="createdir" value="'.&mt('Create sub-directory').'" onClick="javascript:createWin()" />'.
1.33 raeburn 514: &page_footer($env{'form.newdir'},$fn,$page,$webpath).'
1.15 raeburn 515: </form>');
1.1 raeburn 516: }
517:
518: # ---------------------------------------------------------------- Display One
519:
520: sub display_one {
1.33 raeburn 521: my ($r,$fn,$page,$textref,$header) = @_;
1.15 raeburn 522: my %topics;
523: $topics{2} = &mt('Select the format of the question number - e.g., 1, 1., 1), (1 or (1) - ').'
524: <select name="qnumformat">
1.23 bisitz 525: <option value="-1" selected="selected">'.&mt('Select').'</option>
1.15 raeburn 526: <option value="number">1</option>
527: <option value="period">1.</option>
528: <option value="paren">(1)</option>
529: <option value="leadparen">(1</option>
530: <option value="trailparen">1)</option>
531: </select>'."\n";
532: $topics{3} = &mt('Indicate the number of blocks of different question types in the testbank file.').' <input type="text" name="blocks" value="" size="5" />';
533: $r->print('<h3>'.&mt('Identification of blocks of questions').'</h3>'."\n".
534: '<form method="post" name="display" action="/adm/testbank">'."\n".
535: &show_uploaded_data($textref,$header)."\n".
1.25 bisitz 536: &Apache::lonhtmlcommon::topic_bar(2,$topics{2}).'<p>'.
1.15 raeburn 537: &mt('A number in the specified format should appear at the start of each question.').'<br />'.
538: &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".
1.36 raeburn 539: &mt('Correct answers should be numbered in the same way as the questions and should appear after [_1]all[_2] the questions (including question text and possible foils for all questions).','<b>','</b>').'<br />'."\n".
1.15 raeburn 540: &mt('Each numbered question must have a corresponding numbered answer, although the answer itself may be blank for essay questions.').'<br /><br />'."\n".
1.36 raeburn 541: &mt('For example, you would select [_1]1.[_2] if your testbank file contained the following questions:','<b>','</b>').'<br /><blockquote>'.
1.15 raeburn 542: '<pre>
543: 1. '.&mt('The capital of the USA is ...').'
544: (a) Washington D.C.
545: (b) New York
546: (c) Los Angeles
547:
548: 2. '.&mt('The capital of Canada is ...').'
549: (a) Toronto
550: (b) Vancouver
551: (c) Ottawa
552:
553: 3. '.&mt('Describe an experiment you could conduct to measure c, the speed of light in a vacuum.').'
554: 1. (a)
555: 2. (c)
556: 3.
557: </pre>'.
558: '</blockquote></p>'.
1.25 bisitz 559: &Apache::lonhtmlcommon::topic_bar(3,$topics{3}).'<p>'.
1.36 raeburn 560: &mt('For example, you would enter [_1]6[_2] if your testbank file contained the following sequence of questions:','<b>','</b>').'</p><blockquote>'.
1.15 raeburn 561: &mt('10 multiple choice questions').'<br />'.
562: &mt('5 essay questions').'<br />'.
563: &mt('5 fill-in-the-blank questions').'<br />'.
564: &mt('5 multiple answer questions').'<br />'.
565: &mt('4 multiple choice questions').'<br />'.
566: &mt('3 essay questions').'</blockquote></p><p>'.
567: &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 568: &page_footer($env{'form.newdir'},$fn,$page).'
1.15 raeburn 569: </form>');
570: return;
1.1 raeburn 571: }
572:
573: # ---------------------------------------------------------------- Display Two
574:
575: sub display_two {
1.33 raeburn 576: my ($r,$fn,$page,$textref,$header,$qcount) = @_;
1.6 albertel 577: my $blocks = $env{'form.blocks'};
578: my $qnumformat = $env{'form.qnumformat'};
1.1 raeburn 579: my @types = ("MC","MA","TF","Ess","FIB","Ord");
580: my %typenames = (
581: MC => "Multiple Choice",
582: TF => "True/False",
583: MA => "Multiple Answer",
584: Ess => "Essay",
585: FIB => "Fill-in-the-blank",
586: Ord => "Ranking/ordering",
587: );
588: my %qnumtypes = (
589: number => "1",
590: period => "1.",
591: paren => "(1)",
592: leadparen => "(1",
593: trailparen => "1)",
594: );
595: my $bl1st = '';
596: my $bl1end = '';
597: if ($blocks == 1) {
598: $bl1st = '1';
599: $bl1end = $qcount;
600: }
1.15 raeburn 601: my $steptitle = &mt('Information about question types and formats in each block.');
602: $r->print('<h3>'.&mt('Classification of blocks').'</h3>'.
603: '<form method="post" name="display" action="/adm/testbank"><p>'.
1.36 raeburn 604: &mt('You indicated that [_1]all[_2] questions (and the corresponding answer(s) for each question) begin with a number in the following format: [_3].','<b>','</b>','<b>'.$qnumtypes{$qnumformat}.'</b>').'</p><p>'.
605: &mt('A total of [_1][quant,_3,question][_2] and [_1][quant,_4,answer][_2] were found in the file you uploaded.','<b>','</b>',$qcount,$qcount).' '.
606: &mt('If this total does not match the number you expect, examine your original testbank file to verify that each question [_1]and[_2] each answer begins with a number in the specified format.','<i>','</i>').' '.
1.15 raeburn 607: &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>'.
1.36 raeburn 608: &mt('You also indicated that the [_1][quant,_3,question][_2] can be divided into [_1][quant,_4,block][_2] of questions of a particular question type.','<b>','</b>',$qcount,$blocks).'</p><p>'.
1.15 raeburn 609: &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>'.
610: &show_uploaded_data($textref,$header).
1.25 bisitz 611: &Apache::lonhtmlcommon::topic_bar(4,$steptitle).'<p>'.
1.36 raeburn 612: &mt('For [_1]each[_2] of the [_3] 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.','<i>','</i>','<b>'.$blocks.'</b>').' '.
1.15 raeburn 613: &mt('If required, provide additional information about foil formats and answer formats for the question types you select.').'</p><p>'.
614: &Apache::loncommon::start_data_table().
615: &Apache::loncommon::start_data_table_header_row().
616: '<th>'.&mt('Block').'</th>'."\n".
617: '<th>'.&mt('First number').'</th>'."\n".
618: '<th>'.&mt('Last number').'</th>'."\n".
619: '<th>'.&mt('Question type').'</th>'."\n".
620: '<th>'.&mt('Foil format').'</th>'."\n".
621: '<th>'.&mt('Answer format').'</th>'."\n".
622: &Apache::loncommon::end_data_table_header_row());
1.1 raeburn 623: for (my $i=0; $i<$blocks; $i++) {
624: my $iter = $i+1;
1.15 raeburn 625: $r->print(&Apache::loncommon::start_data_table_row().
626: '<td valign="top"> '.$iter.' </td>'."\n".
627: '<td valign="top"> <input type="text" name="start_'.$i.'" value="'.$bl1st.'" size="5" /> </td>'."\n".
1.21 bisitz 628: '<td valign="top"> <input type="text" name="end_'.$i.'" value="'.$bl1end.'" size="5" /> </td>'."\n".
1.15 raeburn 629: '<td valign="top">
630: <select name="qtype_'.$i.'" onChange="colSet('.$i.')">
1.23 bisitz 631: <option value="-1" selected="selected">'.&mt('Select').'</option>'."\n");
1.1 raeburn 632: foreach my $qtype (@types) {
1.15 raeburn 633: $r->print('<option value="'.$qtype.'">'.$typenames{$qtype}.'</option>'."\n");
1.1 raeburn 634: }
1.15 raeburn 635: $r->print(' </select>
1.1 raeburn 636: </td>
1.15 raeburn 637: <td align="left" valign="top">
638: <select name="foilformat_'.$i.'">
1.1 raeburn 639: <option value="-1"><--- Set type
640: </select>
641: </td>
1.15 raeburn 642: <td align="left" valign="top">
643: <select name="ansr_'.$i.'">
1.1 raeburn 644: <option value="-1"><--- Set type
645: </select>
1.15 raeburn 646: </td>'.
647: &Apache::loncommon::end_data_table_row());
1.1 raeburn 648: }
1.15 raeburn 649: $r->print(&Apache::loncommon::end_data_table().'</p><ul><li>'.
1.36 raeburn 650: &mt('For [_1]multiple choice[_2], [_1]multiple correct answer[_2] and [_1]ranking[_2] type questions, you must use the [_3]Foil format[_4] 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.','<i>','</i>','<b>','</b>').'</li><li>'.
651: &mt('For [_1]multiple correct answer[_2] and [_1]fill-in-the-blank[_2] questions with more than one correct answer you must use the [_3]Answer format[_4] column to choose the separator used between the answers, e.g., if the correct answers for question 28. were listed as:[_5] you would choose "comma", or if they were listed as:[_6] you would choose "new line".','<i>','</i>','<b>','</b>','<blockquote><pre>28. (a),(d),(e)</pre></blockquote>','<blockquote><pre>
1.15 raeburn 652: 28. (a)
653: (d)
654: (e)
655: </pre></blockquote>').'</li><li>'.
1.36 raeburn 656: &mt('For [_1]true/false[_2] questions you must use the [_3]Answer format[_4] 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.).','<i>','</i>','<b>','</b>').'</li><li>'.
657: &mt('For [_1]ranking[_2] questions you must use the [_3]Answer format[_4] column to choose the separator used between the (ranked) answers.','<i>','</i>','<b>','</b>').'</li></ul>
1.15 raeburn 658: <input type="hidden" name="blocks" value="'.$blocks.'" />
659: <input type="hidden" name="qnumformat" value="'.$qnumformat.'" />'.
1.33 raeburn 660: &page_footer($env{'form.newdir'},$fn,$page).'
1.15 raeburn 661: </form>');
662: return;
663: }
664:
1.1 raeburn 665: # ---------------------------------------------------------------- Display Three
1.15 raeburn 666: sub display_three {
1.33 raeburn 667: my ($r,$fn,$page,$textref,$res,$header,$webpath,$qcount) = @_;
1.6 albertel 668: my $qnumformat = $env{'form.qnumformat'};
669: my $filename = $env{'form.filename'};
670: my $source = $env{'form.go'};
671: my $blocks = $env{'form.blocks'};
1.15 raeburn 672: my ($alphabet,$romans) = &get_constants();
1.1 raeburn 673: my @start = ();
674: my @end = ();
675: my @nums = ();
676: my @qtype = ();
677: my @foilformats = ();
678: my @ansrtypes = ();
679: my %multparts = ();
680: my $numitems = 0;
1.15 raeburn 681: my %lt = &Apache::lonlocal::texthash (
682: crt => 'Create?',
683: typ => 'Type',
1.38 bisitz 684: fnam => 'Filename',
1.15 raeburn 685: ques => 'Question',
686: answ => 'Answer',
687: chka => 'check all',
688: unch => 'uncheck all',
689: );
1.1 raeburn 690: for (my $i=0; $i<$blocks; $i++) {
1.6 albertel 691: if (($env{"form.start_$i"} ne '') && ($env{"form.end_$i"} ne '')) {
692: $start[$i] = $env{"form.start_$i"};
693: $end[$i] = $env{"form.end_$i"};
1.1 raeburn 694: $nums[$i] = $end[$i]-$start[$i] +1;
1.6 albertel 695: $qtype[$i] = $env{"form.qtype_$i"};
1.1 raeburn 696: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
1.6 albertel 697: $foilformats[$i] = $env{"form.foilformat_$i"};
1.1 raeburn 698: } else {
699: $foilformats[$i] = '';
700: }
701: if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) {
1.6 albertel 702: $ansrtypes[$i] = $env{"form.ansr_$i"};
1.1 raeburn 703: } else {
704: $ansrtypes[$i] = '';
705: }
706: } else {
707: $nums[$i] = 0;
708: }
709: $numitems += $nums[$i];
710: }
1.15 raeburn 711: my ($items,$ids,$footer) = &file_split(\@start,\@end,\@nums,$qnumformat,\@foilformats,$textref,\%multparts,$numitems,\@qtype,$blocks);
712: my ($showheader,$showcss);
713: if ($res eq 'application/rtf' || $res eq 'text/html') {
714: if ($header ne '') {
715: $showheader = &HTML::Entities::decode($header);
716: if ($res eq 'text/html') {
1.33 raeburn 717: $showheader = &build_image_url($webpath,$showheader);
1.15 raeburn 718: }
719: }
720: }
721: $r->print('<h3>'.&mt('Review and selection of problems to convert').'</h3>'."\n".
722: '<form name="dataForm" method="post" action="/adm/testbank">'."\n".
723: &mt('Based on your previous responses your data have been split into a total of [quant,_1,question].',$numitems).
1.25 bisitz 724: &Apache::lonhtmlcommon::topic_bar(5,&mt('Choose which problems to convert and names to use for individual problem files')));
1.15 raeburn 725: if ($showheader) {
726: $r->print($showheader.'<br />');
727: }
728: $r->print('<input type="button" value="'.$lt{'chka'}.'" onclick="javascript:checkAll(document.dataForm.createprob)" />
729: <input type="button" value="'.$lt{'unch'}.'" onclick="javascript:uncheckAll(document.dataForm.createprob)" /><br /><br />'.
730: &Apache::loncommon::start_data_table().
731: &Apache::loncommon::start_data_table_header_row().
732: '<th>'.#'.</th>'.
733: '<th>'.$lt{'crt'}.'</th>'.
734: '<th>'.$lt{'typ'}.'</th>'.
735: '<th>'.$lt{'fnam'}.'</th>'.
736: '<th>'.$lt{'ques'}.'</th>'.
737: '<th>'.$lt{'answ'}.'</th>'.
738: &Apache::loncommon::end_data_table_header_row());
739: my $idx;
740: if ($numitems =~ /^\d+$/ && $numitems > 0) {
741: $idx = int(log($numitems)/log(10));
742: $idx ++;
743: }
744: if ($idx<3) {
745: $idx = 3;
746: }
1.1 raeburn 747: for (my $j=0; $j<$numitems; $j++) {
1.15 raeburn 748: my $qnum = $ids->[$j];
749: my $libfile = 'question_';
750: my $leading = 0;
751: while (($idx - length($qnum) - $leading) > 0) {
752: $libfile .= '0';
753: $leading ++;
754: }
755: $libfile .= $qnum.'.problem';
1.1 raeburn 756: for (my $i=0; $i<$blocks; $i++) {
757: if ($nums[$i] > 0) {
758: if (($j+1 >= $start[$i]) && ($j+1 <= $end[$i])) {
759: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA")) {
760: for (my $k=0; $k<@{$multparts{$j}}; $k++) {
761: if ($k == 0) {
1.15 raeburn 762: my $showqn = $multparts{$j}[$k];
763: if (($res eq 'application/rtf') || ($res eq 'text/html')) {
764: $showqn = &HTML::Entities::decode($showqn);
765: if ($res eq 'text/html') {
1.33 raeburn 766: $showqn = &build_image_url($webpath,$showqn);
1.15 raeburn 767: }
768: }
769: $r->print(&Apache::loncommon::start_data_table_row().
770: '<td valign="top">'.$qnum.'.</td>'."\n".
1.23 bisitz 771: '<td valign="top"><input name="createprob" type="checkbox" checked="checked" value="'.$j.'" /></td>'."\n".
1.15 raeburn 772: '<td valign="top"><b>'.$qtype[$i].'</b></td>'."\n".
773: '<td valign="top"><input type="textbox" name="probfile_'.$j.'" value="'.$libfile.'" size="20" /></td>'.
774: '<td valign="top">'.$showqn.'<br /><br />'."\n");
775: } else {
1.1 raeburn 776: my $foiltag = '';
777: if ($foilformats[$i] eq "lcperiod") {
1.15 raeburn 778: $foiltag = $alphabet->[$k-1].'.';
1.1 raeburn 779: } elsif ($foilformats[$i] eq "lcparen") {
1.15 raeburn 780: $foiltag = '('.$alphabet->[$k-1].')';
1.5 raeburn 781: } elsif ($foilformats[$i] eq "lconeparen") {
1.15 raeburn 782: $foiltag = $alphabet->[$k-1].')';
1.5 raeburn 783: } elsif ($foilformats[$i] eq "lcdotparen") {
1.15 raeburn 784: $foiltag = $alphabet->[$k-1].'.)';
1.1 raeburn 785: } elsif ($foilformats[$i] eq "ucperiod") {
1.15 raeburn 786: $foiltag = $alphabet->[$k-1].'.';
1.1 raeburn 787: $foiltag =~ tr/a-z/A-Z/;
788: } elsif ($foilformats[$i] eq "ucparen") {
1.15 raeburn 789: $foiltag = '('.$alphabet->[$k-1].')';
1.1 raeburn 790: $foiltag =~ tr/a-z/A-Z/;
1.5 raeburn 791: } elsif ($foilformats[$i] eq "uconeparen") {
1.15 raeburn 792: $foiltag = $alphabet->[$k-1].')';
1.5 raeburn 793: $foiltag =~ tr/a-z/A-Z/;
794: } elsif ($foilformats[$i] eq "ucdotparen") {
1.15 raeburn 795: $foiltag = $alphabet->[$k-1].'.)';
1.5 raeburn 796: $foiltag =~ tr/a-z/A-Z/;
1.1 raeburn 797: } elsif ($foilformats[$i] eq "romperiod") {
1.15 raeburn 798: $foiltag = $romans->[$k-1].'.';
1.1 raeburn 799: } elsif ($foilformats[$i] eq "romparen") {
1.15 raeburn 800: $foiltag = '('.$romans->[$k-1].')';
1.5 raeburn 801: } elsif ($foilformats[$i] eq "romoneparen") {
1.15 raeburn 802: $foiltag = $romans->[$k-1].')';
1.5 raeburn 803: } elsif ($foilformats[$i] eq "romdotparen") {
1.15 raeburn 804: $foiltag = $romans->[$k-1].'.)';
805: }
806: my $showfoil = $multparts{$j}[$k];
807: if ($res eq 'application/rtf' || $res eq 'text/html') {
808: $showfoil = &HTML::Entities::decode($showfoil);
809: if ($res eq 'text/html') {
1.33 raeburn 810: $showfoil = &build_image_url($webpath,$showfoil);
1.15 raeburn 811: }
1.5 raeburn 812: }
1.15 raeburn 813: $r->print("$foiltag $showfoil<br />\n");
1.1 raeburn 814: }
815: }
1.15 raeburn 816: my $showfoil = $items->[$j+$numitems];
817: if ($res eq 'application/rtf' || $res eq 'text/html') {
818: $showfoil = &HTML::Entities::decode($showfoil);
819: $showfoil =~ s/<\/?[^>]+>//g;
820: }
821:
822: $r->print('<br /></td><td valign="top">'.$showfoil.'</td>'.
823: &Apache::loncommon::end_data_table_row());
1.1 raeburn 824: } else {
1.15 raeburn 825: my $showfoil = $items->[$j+$numitems];
826: if ($res eq 'application/rtf' || $res eq 'text/html') {
827: $showfoil = &HTML::Entities::decode($showfoil);
828: $showfoil =~ s/<\/?[^>]+>//g;
829: }
830: $r->print(&Apache::loncommon::start_data_table_row().
831: '<td valign="top">'.$qnum.'</td>'."\n".
1.23 bisitz 832: '<td valign="top"><input name="createprob" type="checkbox" checked="checked" value="'.$j.'" /></td>'."\n".
1.15 raeburn 833: '<td valign="top"><b>'.$qtype[$i].'</b></td>'."\n".
834: '<td valign="top"><input type="textbox" name="probfile_'.$j.'" value="'.$libfile.'" size="20" /></td>'."\n".
835: '<td valign="top">'.$items->[$j].'</td>'."\n".
836: '<td valign="top">'.$showfoil.'</td>'."\n".
837: &Apache::loncommon::end_data_table_row());
1.1 raeburn 838: }
839: last;
840: }
841: }
842: }
843: }
1.15 raeburn 844: $r->print(&Apache::loncommon::end_data_table().'</p><p>'."\n".
845: '<input type="hidden" name="qnumformat" value="'.$qnumformat.'" />'."\n".
846: '<input type="hidden" name="blocks" value="'.$blocks.'" />');
1.1 raeburn 847: for (my $i=0; $i<$blocks; $i++) {
1.15 raeburn 848: $r->print('
849: <input type="hidden" name="start_'.$i.'" value="'.$start[$i].'" />
850: <input type="hidden" name="end_'.$i.'" value="'.$end[$i].'" />
851: <input type="hidden" name="qtype_'.$i.'" value="'.$qtype[$i].'" />');
1.1 raeburn 852: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
1.15 raeburn 853: $r->print('
854: <input type="hidden" name="foilformat_'.$i.'" value="'.$foilformats[$i].'" />');
1.1 raeburn 855: }
856: if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) {
1.15 raeburn 857: $r->print('
858: <input type="hidden" name="ansr_'.$i.'" value="'.$ansrtypes[$i].'" />');
859: }
860: }
1.33 raeburn 861: $r->print('</p>'.&page_footer($env{'form.newdir'},$fn,$page).'
1.15 raeburn 862: </form>');
1.1 raeburn 863: }
864:
865: # ---------------------------------------------------------------- Final Display
866: sub final_display {
1.33 raeburn 867: my ($r,$fn,$page,$textref,$res,$header,$css,$js,$webpath,$dirpath,$subdir) = @_;
1.6 albertel 868: my $qnumformat = $env{'form.qnumformat'};
869: my $blocks = $env{'form.blocks'};
1.1 raeburn 870: my $question_id = '';
871: my @question_title = ();
872: my @question_status = ();
873: my @qtype = ();
874: my @start = ();
875: my @nums = ();
876: my @end = ();
877: my @foilformats = ();
878: my @ansrtypes = ();
879: my %multparts = ();
880: my $numitems = 0;
1.15 raeburn 881: my @createprobs = &Apache::loncommon::get_env_multiple('form.createprob');
1.1 raeburn 882: for (my $i=0; $i<$blocks; $i++) {
1.6 albertel 883: $start[$i] = $env{"form.start_$i"};
884: $end[$i] = $env{"form.end_$i"};
1.1 raeburn 885: if (($end[$i] - $start[$i]) >= 0) {
886: $nums[$i] = $end[$i] - $start[$i]+1;
887: } else {
888: $nums[$i] = 0;
889: }
1.6 albertel 890: $qtype[$i] = $env{"form.qtype_$i"};
1.1 raeburn 891: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
1.6 albertel 892: $foilformats[$i] = $env{"form.foilformat_$i"};
1.1 raeburn 893: } else {
894: $foilformats[$i] = '';
895: }
896: if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) {
1.6 albertel 897: $ansrtypes[$i] = $env{"form.ansr_$i"};
1.1 raeburn 898: }
899: $numitems += $nums[$i];
900: }
901:
1.15 raeburn 902: my %answers;
903: my ($items,$ids,$footer) = &file_split(\@start,\@end,\@nums,$qnumformat,\@foilformats,$textref,\%multparts,$numitems,\@qtype,$blocks);
1.1 raeburn 904:
905: # Converting MC and MA answer to number, and splitting answers for FIB, and ordering for Ord.
1.15 raeburn 906: my ($alphabet,$romans) = &get_constants();
1.1 raeburn 907: my %patterns = (
908: comma => ',',
909: space => '\s+',
910: line => '[\r\n\f]+',
911: tab => '\t+',
912: );
913: for (my $i=0; $i<$blocks; $i++) {
914: if ($nums[$i] > 0) {
915: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "Ord")) {
916: for (my $k=$numitems+$start[$i]-1; $k<$numitems+$end[$i]; $k++) {
1.15 raeburn 917: my $qnum = $k - $numitems;
918: next if (!grep(/^$qnum$/,@createprobs));
919: if (($res eq 'application/rtf') || ($res eq 'text/html')) {
920: $items->[$k] = &HTML::Entities::decode($items->[$k]);
921: }
922: @{$answers{$qnum}} = ();
1.1 raeburn 923: if ($qtype[$i] eq "MC") {
1.15 raeburn 924: $items->[$k] =~ tr/A-Z/a-z/;
925: $items->[$k] =~ s/<\/?[^>]+>//g;
926: $items->[$k] =~ s/\W//g;
1.5 raeburn 927: 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 928: for (my $j=0; $j<@{$alphabet}; $j++) {
929: if ($alphabet->[$j] eq $items->[$k]) {
930: push @{$answers{$qnum}}, $j;
1.1 raeburn 931: last;
932: }
933: }
1.5 raeburn 934: } elsif (($foilformats[$i] eq "romparen") || ($foilformats[$i] eq "romperiod") || ($foilformats[$i] eq "romoneparen") || ($foilformats[$i] eq "romdotparen")) {
1.15 raeburn 935: for (my $j=0; $j<@{$romans}; $j++) {
936: if ($romans->[$j] eq $items->[$k]) {
937: push @{$answers{$qnum}}, $j;
1.1 raeburn 938: last;
939: }
940: }
941: }
942: } elsif (($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
1.15 raeburn 943: $items->[$k] =~ tr/A-Z/a-z/;
944: $items->[$k] =~ s/<\/?[^>]+>//g;
945: my @corrects = split/$patterns{$ansrtypes[$i]}/,$items->[$k];
1.1 raeburn 946: foreach my $correct (@corrects) {
1.14 raeburn 947: my @tied;
948: if ($qtype[$i] eq "Ord") {
949: if ($correct =~ /=/) {
950: @tied = split(/=/,$correct);
951: for (my $j=0; $j<@tied; $j++) {
952: $tied[$j] =~ s/\W//g;
953: }
954: } else {
955: $correct =~s/\W//g;
956: }
957: } else {
958: $correct =~s/\W//g;
959: }
1.1 raeburn 960: if ($foilformats[$i] eq "lcperiod" || $foilformats[$i] eq "lcparen" || $foilformats[$i] eq "ucparen" || $foilformats[$i] eq "ucperiod") {
1.15 raeburn 961: if (($qtype[$i] eq "Ord") && (@tied > 0)) {
1.14 raeburn 962: my @ties;
963: foreach my $tie (@tied) {
1.15 raeburn 964: for (my $j=0; $j<@{$alphabet}; $j++) {
965: if ($alphabet->[$j] eq $tie) {
1.14 raeburn 966: push(@ties,$j);
967: last;
968: }
969: }
970: }
971: my $ans = join('=',@ties);
1.15 raeburn 972: push(@{$answers{$qnum}},$ans);
1.14 raeburn 973: } else {
1.15 raeburn 974: for (my $j=0; $j<@{$alphabet}; $j++) {
975: if ($alphabet->[$j] eq $correct) {
976: push @{$answers{$qnum}}, $j;
1.14 raeburn 977: last;
978: }
1.1 raeburn 979: }
980: }
1.5 raeburn 981: } elsif (($foilformats[$i] eq "romparen") || ($foilformats[$i] eq "romperiod") || ($foilformats[$i] eq "romoneparen") || ($foilformats[$i] eq "romdotparen")) {
1.14 raeburn 982: if (($qtype[$i] eq "Ord") && (@tied > 0)) {
983: my @ties;
984: foreach my $tie (@tied) {
1.15 raeburn 985: for (my $j=0; $j<@{$romans}; $j++) {
986: if ($romans->[$j] eq $tie) {
1.14 raeburn 987: push(@ties,$j);
988: last;
989: }
990: }
991: }
1.15 raeburn 992: push(@{$answers{$qnum}},join('=',@ties));
1.14 raeburn 993: } else {
1.15 raeburn 994: for (my $j=0; $j<@{$romans}; $j++) {
995: if ($romans->[$j] eq $correct) {
996: push @{$answers{$qnum}}, $j;
1.14 raeburn 997: last;
998: }
1.1 raeburn 999: }
1000: }
1001: }
1002: }
1003: } elsif ($qtype[$i] eq "FIB") {
1.15 raeburn 1004: $items->[$k] =~ s/<\/?[^>]+>//g;
1005: @{$answers{$qnum}} = split/$patterns{$ansrtypes[$i]}/,$items->[$k];
1006: for (my $j=0; $j<@{$answers{$qnum}}; $j++) {
1007: $answers{$qnum}[$j] =~ s/^\s+//;
1008: $answers{$qnum}[$j] =~ s/\s+$//;
1009: if ($j==0) {
1010: $answers{$qnum}[$j] =~ s/^<[^>]+>//;
1011: } elsif ($j == @{$answers{$qnum}}-1) {
1012: $answers{$qnum}[$j] =~ s/<\/[^>]+>$//;
1013: }
1.1 raeburn 1014: }
1015: }
1016: }
1017: }
1018: }
1019: }
1.15 raeburn 1020: my $state;
1021:
1022: $r->print('<form name="verify" method="post" action="/adm/testbank">'."\n".
1023: '<input type="hidden" name="blocks" value="'.$blocks.'" />'."\n".
1024: '<input type="hidden" name="qnumformat" value="'.$qnumformat.'" />'."\n");
1025: for (my $i=0; $i<$blocks; $i++) {
1026: $r->print('<input type="hidden" name="start_'.$i.'" value="'.$start[$i].'" />
1027: <input type="hidden" name="end_'.$i.'" value="'.$end[$i].'" />
1028: <input type="hidden" name="qtype_'.$i.'" value="'.$qtype[$i].'" />
1029: <input type="hidden" name="foilformat_'.$i.'" value="'.$foilformats[$i].'" />
1030: <input type="hidden" name="ansr_'.$i.'" value="'.$ansrtypes[$i].'" />'."\n");
1031: }
1032: for (my $i=0; $i<$numitems; $i++) {
1033: $r->print('<input type="hidden" name="probfile_'.$i.'" value="'.$env{'form.probfile_'.$i}.'" />'."\n");
1034: }
1.25 bisitz 1035: $r->print(&Apache::lonhtmlcommon::topic_bar(6,&mt('Result of conversion of testbank questions to LON-CAPA problems')));
1.15 raeburn 1036: my $destdir = $dirpath;
1037: if ($destdir ne '' && $subdir ne '') {
1038: $subdir .= '/';
1039: $destdir .= $subdir;
1040: }
1041: if (@createprobs == 0) {
1042: $state = 'unchecked';
1043: $r->print('<p>'.&mt('No questions were selected for conversion.').'</p>'.
1.33 raeburn 1044: &page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).'</form>');
1.15 raeburn 1045: } elsif (($destdir ne '') && (-e $destdir)) {
1046: my (@qn_file,@result,@numid);
1.1 raeburn 1047: my $qcount = 0;
1.15 raeburn 1048: my $itemcount = 0;
1.1 raeburn 1049: for (my $i=0; $i<$blocks; $i++) {
1050: if ($nums[$i] > 0) {
1051: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "Ord")) {
1052: for (my $j=$start[$i]-1; $j<$end[$i]; $j++) {
1.15 raeburn 1053: $numid[$qcount] = $ids->[$itemcount];
1054: $itemcount ++;
1055: next if (!grep(/^$qcount$/,@createprobs));
1056: my $libfile = &probfile_name($j);
1.1 raeburn 1057: my $answer = $j + $numitems;
1.15 raeburn 1058: my $numans = scalar(@{$answers{$qcount}});
1.1 raeburn 1059: my $foilcount = 0;
1060: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
1061: $foilcount = @{$multparts{$j}};
1062: $foilcount --;
1063: }
1.15 raeburn 1064: ($result[$qcount],$qn_file[$qcount]) = &create_mcq($destdir,$subdir,\@{$multparts{$j}},\@{$answers{$qcount}},$qtype[$i],$libfile,$res,$header,$footer,$js,$css);
1.1 raeburn 1065: $qcount ++;
1066: }
1067: } elsif ($qtype[$i] eq "TF") {
1068: for (my $j=$start[$i]-1; $j<$end[$i]; $j++) {
1.15 raeburn 1069: $numid[$qcount] = $ids->[$itemcount];
1070: $itemcount ++;
1071: next if (!grep(/^$qcount$/,@createprobs));
1072: my $libfile = &probfile_name($j);
1.1 raeburn 1073: my $answer = $j + $numitems;
1.15 raeburn 1074: $items->[$answer] =~ s/^\s+//;
1075: $items->[$answer] =~ s/\s+$//;
1076: $items->[$answer] =~ s/\W//g;
1077: $items->[$answer] =~ tr/A-Z/a-z/;
1.1 raeburn 1078: my $answer_id = '';
1079: if ($ansrtypes[$i] eq 'word' ) {
1.15 raeburn 1080: if ($items->[$answer] =~ m/true/) {
1.1 raeburn 1081: $answer_id = 0;
1082: } else {
1083: $answer_id = 1;
1084: }
1085: } elsif ($ansrtypes[$i] eq 'lett') {
1.15 raeburn 1086: if ($items->[$answer] =~ m/^t/) {
1.1 raeburn 1087: $answer_id = 0;
1088: } else {
1089: $answer_id = 1;
1090: }
1091: }
1.15 raeburn 1092: ($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 1093: $qcount ++;
1094: }
1095: } elsif ($qtype[$i] eq "Ess") {
1096: for (my $j=$start[$i]-1; $j<$end[$i]; $j++) {
1.15 raeburn 1097: $numid[$qcount] = $ids->[$itemcount];
1098: $itemcount ++;
1099: next if (!grep(/^$qcount$/,@createprobs));
1100: my $libfile = &probfile_name($j);
1.1 raeburn 1101: my $answer = $j + $numitems;
1102: my $answer_id = '';
1.15 raeburn 1103: ($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 1104: $qcount ++;
1105: }
1106: }
1107: }
1108: }
1.15 raeburn 1109: my ($successes,$failures,$existing);
1.1 raeburn 1110: for (my $i=0; $i<@qn_file; $i++) {
1.15 raeburn 1111: if ($result[$i] eq 'ok') {
1112: $successes .= '<b>'.$numid[$i].': <a href="'.$webpath.$qn_file[$i].'">'.
1113: $qn_file[$i].'</a></b><br />'."\n";
1114: } elsif ($result[$i] eq 'failed') {
1115: $failures .= $numid[$i].': '.$qn_file[$i].'<br />'."\n";
1116: } elsif ($result[$i] eq 'exists') {
1117: $existing .= '<b>'.$numid[$i].': <a href="'.$webpath.$qn_file[$i].'">'.
1118: $qn_file[$i].'</a></b><br />'."\n";
1119: }
1120: }
1121: if ($successes) {
1122: $r->print('<p>'.&mt('Individual problem files have been created from the following problems included in the testbank file:').'<br />'.$successes.'</p><p>'.
1123: &mt('The problems must be published before they can be used in a course').'</p>');
1124: }
1125: if ($failures) {
1126: $r->print('<p>'.&mt('An error occurred when opening files for the following problems, so they have not been created:').'<br />'.$failures.'</p>');
1127: }
1128: if ($existing) {
1129: $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>');
1130: $state = 'existing';
1131: }
1.33 raeburn 1132: $r->print(&page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).'</form>');
1.1 raeburn 1133: } else {
1.15 raeburn 1134: $state = 'nodir';
1135: $r->print('<p>'.&mt('No destination directory was available so import of questions could not proceed.').'</p>'.
1.33 raeburn 1136: &page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).'</form>');
1.15 raeburn 1137: }
1.1 raeburn 1138: return;
1.15 raeburn 1139: }
1140:
1141: sub show_uploaded_data {
1142: my ($textref,$header) = @_;
1143: my $output = '<p><b>'.&mt('Testbank data uploaded to the server').'</b></p><p>'."\n".
1.16 raeburn 1144: '<textarea name="rawdata" cols="70" rows="6" wrap="virtual" align="center" readonly>'."\n";
1.15 raeburn 1145: if ($header ne '') {
1146: $output .= $header."\n";
1147: }
1148: if (ref($textref) eq 'ARRAY') {
1149: foreach my $line (@{$textref}) {
1150: $line =~ s/\n//g;
1151: if ($line ne '') {
1152: $output .= $line."\n";
1153: }
1154: }
1155: }
1156: $output .= '</textarea></p>';
1157: return $output;
1158: }
1159:
1160: sub page_footer {
1.33 raeburn 1161: my ($newdir,$fn,$page,$webpath,$subdir,$state) = @_;
1.15 raeburn 1162: my $prevval = &mt('Previous Page');
1163: my $nextval = &mt('Next Page');
1164: my $prevclick = 'javascript:backPage();';
1165: my $nextclick = 'javascript:nextPage();';
1.17 raeburn 1166: my $go = '';
1167: if (($page == 0) || ($state eq 'badfile')) {
1.15 raeburn 1168: $go = 'NextPage';
1169: $prevval = &mt('Exit Now');
1170: $prevclick = 'javascript:location.href='."'$webpath';";
1171: $nextclick = 'javascript:submit();'
1172: } elsif ($page == 3) {
1173: $nextval = &mt('Complete Testbank Conversion');
1174: } elsif ($page == 4) {
1175: if (($state ne 'existing') && ($state ne 'unchecked')) {
1176: my $destdir = $webpath;
1177: if ($subdir ne '') {
1178: $destdir = $webpath.$subdir;
1179: }
1180: $prevval = &mt('Back to Directory');
1181: $prevclick = 'javascript:location.href='."'$destdir';";
1182: }
1183: }
1184: my $output = '
1185: <input type="hidden" name="newdir" value="'.&HTML::Entities::encode($newdir,'<>&"').'" />
1186: <input type="hidden" name="filename" value="'.$fn.'" />
1187: <input type="hidden" name="page" value="'.$page.'" />
1188: <input type="hidden" name="phase" value="three" />
1.18 raeburn 1189: <input type="hidden" name="go" value="'.$go.'" />
1190: <input type="hidden" name="timestamp" value="'.$env{'form.timestamp'}.'" />';
1.15 raeburn 1191: if ($page ne '') {
1192: $output .= '
1193: <table border="0">
1194: <tr>
1195: <td>
1196: <input type="button" name="backpage" value="'.$prevval.'" onclick="'.$prevclick.'" />
1197: </td>';
1.17 raeburn 1198: if (($page < 4) && ($state ne 'badfile')) {
1.15 raeburn 1199: $output .= '
1200: <td> </td>
1201: <td>
1.21 bisitz 1202: <input type="button" name="nextpage" value="'.$nextval.'" onclick="'.$nextclick.'" />
1.15 raeburn 1203: </td>';
1204: }
1205: $output .= ' </tr>
1206: </table>
1207: ';
1208: }
1209: return $output;
1.1 raeburn 1210: }
1211:
1212: sub question_count {
1213: my ($qnumformat,$textref) = @_;
1214: my $text_in = join "\n", @{$textref};
1215: $text_in = "\n ".$text_in;
1216: my $qpattern ='';
1217: if ($qnumformat eq "period") {
1218: $qpattern = '\d{1,}\.';
1219: } elsif ($qnumformat eq "paren") {
1220: $qpattern = '\(\d{1,}\)';
1221: } elsif ($qnumformat eq "number") {
1222: $qpattern = '\d{1,}';
1223: } elsif ($qnumformat eq "leadparen") {
1224: $qpattern = '\(\d{1,}';
1225: } elsif ($qnumformat eq "trailparen") {
1226: $qpattern = '\d{1,}\)';
1227: }
1228: my @questions = split/[\r\n\f]+\s?$qpattern\s?/,$text_in;
1229: my $qcount = scalar(@questions);
1230: $qcount = $qcount/2;
1231: $qcount = int($qcount);
1232: return $qcount;
1233: }
1234:
1.15 raeburn 1235: sub get_constants {
1236: 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");
1237: 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");
1238: return (\@alphabet,\@romans);
1239: }
1240:
1.1 raeburn 1241: sub file_split {
1242: my ($startsref,$endsref,$numsref,$qnumformat,$foilsref,$textref,$multpartsref,$numitems,$qtyperef,$blocks) = @_;
1243: my $text_in = join "\n", @{$textref};
1244: $text_in = "\n ".$text_in;
1245: my $dignum = length($numitems);
1.15 raeburn 1246: my ($qpatst,$qpatend,$numpat,@questions,@qids);
1247: my $numpat = '\d{1';
1.1 raeburn 1248: if ($dignum > 1) {
1.15 raeburn 1249: $numpat .= ','.$dignum.'}';
1.1 raeburn 1250: } else {
1.15 raeburn 1251: $numpat .= '}';
1.1 raeburn 1252: }
1253: if ($qnumformat eq "period") {
1.15 raeburn 1254: $qpatend = '\.';
1.1 raeburn 1255: } elsif ($qnumformat eq "paren") {
1.15 raeburn 1256: $qpatst = '\(';
1257: $qpatend = '\)';
1.1 raeburn 1258: } elsif ($qnumformat eq "leadparen") {
1.15 raeburn 1259: $qpatst = '\(';
1.1 raeburn 1260: } elsif ($qnumformat eq "trailparen") {
1.15 raeburn 1261: $qpatend = '\)';
1.1 raeburn 1262: }
1.15 raeburn 1263: my @lines = split/[\r\n\f]+\s*$qpatst($numpat)$qpatend\s*/,$text_in;
1.1 raeburn 1264: # my @questions = split/\n\s\d{1,3}\.\s/,$text_in;
1.15 raeburn 1265: shift(@lines);
1266: for (my $i=0; $i<@lines; $i++) {
1267: if ($i%2) {
1268: push(@questions,$lines[$i]);
1269: } else {
1270: push(@qids,$lines[$i]);
1271: }
1272: }
1.1 raeburn 1273: my %multparts = ();
1274: for (my $i=0; $i<$blocks; $i++) {
1275: if (${$numsref}[$i] > 0) {
1.14 raeburn 1276: if ((${$qtyperef}[$i] eq "MC") || (${$qtyperef}[$i] eq "MA") || (${$qtyperef}[$i] eq "Ord")) {
1.1 raeburn 1277: my $splitstr = '';
1278: if (${$foilsref}[$i] eq "lcperiod") {
1279: $splitstr = '[a-z]\.';
1280: } elsif (${$foilsref}[$i] eq "lcparen") {
1281: $splitstr = '\([a-z]\)';
1.5 raeburn 1282: } elsif (${$foilsref}[$i] eq "lconeparen") {
1283: $splitstr = '[a-z]\)';
1284: } elsif (${$foilsref}[$i] eq "lcdotparen") {
1285: $splitstr = '[a-z]\.\)';
1.1 raeburn 1286: } elsif (${$foilsref}[$i] eq "ucperiod") {
1287: $splitstr = '[A-Z]\.';
1288: } elsif (${$foilsref}[$i] eq "ucparen") {
1289: $splitstr = '\([A-Z]\)';
1.5 raeburn 1290: } elsif (${$foilsref}[$i] eq "uconeparen") {
1291: $splitstr = '[A-Z]\)';
1292: } elsif (${$foilsref}[$i] eq "ucdotparen") {
1293: $splitstr = '[A-Z]\.\)';
1.1 raeburn 1294: } elsif (${$foilsref}[$i] eq "romperiod") {
1295: $splitstr = '[ivx]+\.';
1296: } elsif (${$foilsref}[$i] eq "romparen") {
1297: $splitstr = '\([ivx]+\)';
1.5 raeburn 1298: } elsif (${$foilsref}[$i] eq "romoneparen") {
1299: $splitstr = '[ivx]+\)';
1300: } elsif (${$foilsref}[$i] eq "romdotparen") {
1301: $splitstr = '[ivx]+\.\)';
1.1 raeburn 1302: }
1303: for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
1.5 raeburn 1304: @{$multparts{$j}} = split/[\r\n\f]+\s*$splitstr\s*/,$questions[$j];
1.1 raeburn 1305: chomp(@{$multparts{$j}});
1306: }
1307: } elsif (${$qtyperef}[$i] eq "FIB") {
1308: for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
1309: @{$multparts{$j}} = ("$questions[$j]");
1310: }
1311: }
1312: }
1.15 raeburn 1313: }
1314: my ($lastanswer,$footer) = ($questions[-1] =~ /^([,\r\n\f\t\s().A-Za-z]+)(.+)$/);
1315: if ($footer ne '') {
1316: $questions[-1] = $lastanswer;
1317: }
1.1 raeburn 1318: %{$multpartsref} = %multparts;
1.15 raeburn 1319: return (\@questions,\@qids,$footer);
1.1 raeburn 1320: }
1321:
1322: # create_mcq builds an MC, MA, Ord or FIB question
1323:
1324: sub create_mcq {
1.15 raeburn 1325: my ($destdir,$subdir,$qstnref,$answerref,$qtype,$libfile,$res,$header,$footer,$js,$css) = @_;
1326:
1.1 raeburn 1327: my $qstn = ${$qstnref}[0];
1328: my $numfoils = scalar(@{$qstnref}) - 1;
1329: my $datestamp = localtime;
1330: my $numansrs = scalar(@{$answerref});
1.30 raeburn 1331: my $output = '<problem>';
1332: if ($qtype eq 'MC') {
1333: $output .= "\n".'<parameter name="maxtries" type="int_pos" default="2" description="Maximum Number of Tries" />';
1334: }
1335: $output .= '
1.15 raeburn 1336: <startouttext />';
1337: if ($res eq 'application/rtf' || $res eq 'text/html') {
1338: if ($header ne '') {
1339: $output .= &HTML::Entities::decode($header);
1340: }
1341: if ($js ne '') {
1342: $output .= &HTML::Entities::decode($js);
1343: }
1344: if ($css ne '') {
1345: $output .= &HTML::Entities::decode($css);
1346: }
1347: $qstn = &HTML::Entities::decode($qstn);
1348: }
1349: $output .= $qstn.'<endouttext />'."\n";
1.1 raeburn 1350: if ($qtype eq "MA") {
1351: $output .= qq|
1352: <optionresponse max="$numfoils" randomize="yes">
1353: <foilgroup options="('True','False')">
1354: |;
1355: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1356: $output .= " <foil name=\"foil".$k."\" value=\"";
1357: if (grep/^$k$/,@{$answerref}) {
1358: $output .= "True\" location=\"random\"";
1359: } else {
1360: $output .= "False\" location=\"random\"";
1361: }
1.15 raeburn 1362: my $showfoil = ${$qstnref}[$k+1];
1363: if ($res eq 'application/rtf' || $res eq 'text/html') {
1364: $showfoil = &HTML::Entities::decode($showfoil);
1365: }
1366: $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1367: }
1368: chomp($output);
1369: $output .= qq|
1370: </foilgroup>
1.15 raeburn 1371: </optionresponse>|;
1.1 raeburn 1372: }
1373: if ($qtype eq "MC") {
1374: $output .= qq|
1375: <radiobuttonresponse max="$numfoils" randomize="yes">
1376: <foilgroup>
1377: |;
1378: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1379: $output .= " <foil name=\"foil".$k."\" value=\"";
1380: if (grep/^$k$/,@{$answerref}) {
1381: $output .= "true\" location=\"";
1382: } else {
1383: $output .= "false\" location=\"";
1384: }
1385: if (lc (${$qstnref}[$k+1]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {
1386: $output .= "bottom\"";
1387: } else {
1388: $output .= "random\"";
1389: }
1.15 raeburn 1390: my $showfoil = ${$qstnref}[$k+1];
1391: if ($res eq 'application/rtf' || $res eq 'text/html') {
1392: $showfoil = &HTML::Entities::decode($showfoil);
1393: }
1394: $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1395: }
1396: chomp($output);
1397: $output .= qq|
1398: </foilgroup>
1.15 raeburn 1399: </radiobuttonresponse>|;
1.1 raeburn 1400: }
1401: if ($qtype eq "Ord") {
1402: $output .= qq|
1403: <rankresponse max="$numfoils" randomize="yes">
1404: <foilgroup>
1405: |;
1406: for (my $k=0; $k<@{$qstnref}-1; $k++) {
1.14 raeburn 1407: my $ansval;
1408: my $num = 0;
1409: for (my $i=0; $i<@{$answerref}; $i++) {
1410: if ($$answerref[$i] =~ /=/) {
1411: my @tied = split(/=/,$$answerref[$i]);
1412: foreach my $tie (@tied) {
1413: if ($k == $tie) {
1414: $ansval = $num + 1;
1415: last;
1416: }
1417: }
1418: $num += scalar(@tied);
1419: } elsif ($k == $$answerref[$i]) {
1420: $ansval = $num + 1;
1421: last;
1422: } else {
1423: $num ++;
1424: }
1425: }
1.15 raeburn 1426: my $showfoil = ${$qstnref}[$k+1];
1427: if ($res eq 'application/rtf' || $res eq 'text/html') {
1428: $showfoil = &HTML::Entities::decode($showfoil);
1429: }
1430: $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$ansval."\"><startouttext />$showfoil<endouttext /></foil>\n";
1.1 raeburn 1431: }
1432: chomp($output);
1433: $output .= qq|
1434: </foilgroup>
1.15 raeburn 1435: </rankresponse>|;
1.1 raeburn 1436: }
1437: if ($qtype eq "FIB") {
1438: my $numerical = 1;
1439: for (my $i=0; $i<@{$answerref}; $i++) {
1440: if (${$answerref}[$i] =~ m/([^\d\.]|\.\.)/) {
1441: $numerical = 0;
1442: }
1443: }
1444: if ($numerical) {
1445: my $numans;
1446: my $tol;
1447: if (@{$answerref} == 1) {
1448: $tol = 5;
1449: $numans = $$answerref[0];
1450: } else {
1.2 raeburn 1451: my $min = $$answerref[0];
1452: my $max = $$answerref[0];
1453: for (my $i=1; $i<@{$answerref}; $i++) {
1454: if ($$answerref[$i]<=$min) {
1.1 raeburn 1455: $min = $$answerref[$i];
1.2 raeburn 1456: } elsif ($$answerref[$i] >= $max) {
1.1 raeburn 1457: $max = $$answerref[$i];
1458: }
1459: }
1460: $numans = ($max + $min)/2;
1461: $tol = 100*($max - $min)/($numans*2);
1462: }
1463: $output .= qq|
1464: <numericalresponse answer="$numans">
1465: <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
1466: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures" />
1467: <textline />
1.15 raeburn 1468: </numericalresponse>|;
1.1 raeburn 1469: } else {
1470: if (@{$answerref} == 1) {
1471: $output .= qq|
1472: <stringresponse answer="$$answerref[0]" type="ci">
1473: <textline>
1474: </textline>
1.15 raeburn 1475: </stringresponse>|;
1.1 raeburn 1476: } else {
1477: for (my $i=0; $i<@{$answerref}; $i++) {
1478: ${$answerref}[$i] =~ s/\|/\|/g;
1479: }
1480: my $regexpans = join('|',@{$answerref});
1481: $regexpans = '/('.$regexpans.')/';
1482: $output .= qq|
1483: <stringresponse answer="$regexpans" type="re">
1484: <textline>
1485: </textline>
1.15 raeburn 1486: </stringresponse>|;
1.1 raeburn 1487: }
1488: }
1489: }
1.15 raeburn 1490: if ($footer ne '') {
1491: $output .= '<startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
1492: }
1493: $output .= qq|
1494: </problem>
1495: |;
1496: my $result;
1497: if (-e $destdir.$libfile) {
1498: $result = 'exists';
1499: } else {
1500: if (open(PROB,">$destdir$libfile")) {
1501: print PROB $output;
1502: close(PROB);
1503: $result = 'ok';
1504: } else {
1505: $result = 'failed';
1506: }
1507: }
1508: return ($result,$subdir.$libfile);
1.1 raeburn 1509: }
1510:
1511: # create_ess builds an essay or True/False question
1512:
1513: sub create_ess {
1.15 raeburn 1514: my ($destdir,$subdir,$answer_id,$qstn,$answertxt,$qtype,$libfile,$res,$header,
1515: $footer,$js,$css) = @_;
1516: my $output = '<problem>
1517: <startouttext />';
1518: if ($res eq 'application/rtf' || $res eq 'text/html') {
1519: if ($header ne '') {
1520: $output .= &HTML::Entities::decode($header);
1521: }
1522: if ($js ne '') {
1523: $output .= &HTML::Entities::decode($js);
1524: }
1525: if ($css ne '') {
1526: $output .= &HTML::Entities::decode($css);
1527: }
1528: $qstn = &HTML::Entities::decode($qstn);
1529: $answertxt = &HTML::Entities::decode($answertxt);
1530: }
1531: $output .= $qstn.'<endouttext />';
1.1 raeburn 1532: my $answer = '';
1533: my $answerlog = '';
1534: if ($qtype eq "Ess") {
1.15 raeburn 1535: $output .= '
1.1 raeburn 1536: <essayresponse>
1537: <textfield></textfield>
1538: </essayresponse>
1539: <postanswerdate>
1.13 raeburn 1540: <startouttext />
1.15 raeburn 1541: '.$answertxt
1542: .'<endouttext />
1543: </postanswerdate>';
1.1 raeburn 1544: } elsif ($qtype eq "TF") {
1545: $answer = $answer_id;
1546: $output .= qq|
1547: <radiobuttonresponse max="2" randomize="yes">
1548: <foilgroup>
1549: |;
1550: $output .= " <foil name=\"foil0\" value=\"true\" location=\"random\"><startouttext />";
1551: if ($answer_id) {
1552: $output .= "False";
1553: } else {
1554: $output .= "True";
1555: }
1556: $output .= "<endouttext /></foil>\n";
1557: $output .= " <foil name=\"foil1\" value=\"false\" location=\"random\"><startouttext />";
1558: if ($answer_id) {
1559: $output .= "True";
1560: } else {
1561: $output .= "False";
1562: }
1.15 raeburn 1563: $output .= '<endouttext /></foil>
1.1 raeburn 1564: </foilgroup>
1.15 raeburn 1565: </radiobuttonresponse>';
1.1 raeburn 1566: }
1.15 raeburn 1567: if ($footer ne '') {
1568: $output .= '
1569: <startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
1570: }
1571: $output .= '
1572: </problem>
1573: ';
1574: my $result;
1575: if (-e $destdir.$libfile) {
1576: $result = 'exists';
1577: } else {
1578: if (open(PROB,">$destdir$libfile")) {
1579: print PROB $output;
1580: close(PROB);
1.37 raeburn 1581: $result = 'ok';
1.15 raeburn 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) = @_;
1.34 raeburn 1778: my $brcrum = [{'href' => &Apache::loncommon::authorspace("/priv/$udom/$uname/"),
1.39 raeburn 1779: 'text' => 'Authoring Space'}];
1.26 raeburn 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.35 raeburn 1830: my ($uname,$udom) = &Apache::lonnet::constructaccess($fn);
1.33 raeburn 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 = '';
1.39 raeburn 1841: my $title = 'Upload testbank questions to Authoring Space';
1.33 raeburn 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