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