File:
[LON-CAPA] /
loncom /
publisher /
testbankimport.pm
Revision
1.45:
download - view:
text,
annotated -
select for diffs
Sun Nov 12 23:08:58 2017 UTC (6 years, 9 months ago) by
raeburn
Branches:
MAIN
CVS tags:
version_2_11_X,
version_2_11_5_msu,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_msu,
HEAD
- Use three-argument open() to separate file mode from the filename.
1: # Handler for parsing text upload problem descriptions into .problems
2: # $Id: testbankimport.pm,v 1.45 2017/11/12 23:08:58 raeburn Exp $
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:
27: package Apache::testbankimport;
28:
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;
36: use Apache::londocs;
37: use File::Basename();
38: use LONCAPA();
39: use File::MMagic;
40: use XML::DOM;
41: use RTF::HTMLConverter;
42: use HTML::TokeParser;
43:
44: # ---------------------------------------------------------------- Display Control
45: sub display_control {
46: # figure out what page we're on and where we're heading.
47: my $page = $env{'form.page'};
48: my $command = $env{'form.go'};
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:
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')
83: newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]' />\\n")
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 />")
87: newWindow.document.write("<input type='hidden' name='filename' value='$webpath' />")
88: newWindow.document.write("<input type='hidden' name='action' value='newdir' />")
89: newWindow.document.write("<input type='hidden' name='callingmode' value='testbank' />")
90: newWindow.document.write("<input type='hidden' name='inhibitmenu' value='yes' />")
91: newWindow.document.write("$webpath<input type='text' name='newfilename' value='' />")
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:
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
133: if (exists($env{'form.blocks'}) ) {
134: $$jsref .= qq|
135: document.forms.display.blocks.value = $env{'form.blocks'}\n|;
136: }
137: if (exists($env{'form.qnumformat'}) ) {
138: $$jsref .= <<"TO_HERE";
139: for (iter=0; iter<document.forms.display.qnumformat.length; iter++) {
140: if(document.forms.display.qnumformat.options[iter].value == "$env{'form.qnumformat'}") {
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;
156: if ( exists( $env{'form.blocks'}) ) {
157: $blocks = $env{'form.blocks'};
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")) {
291: poolForm.elements[caller*5+4].options[0] = new Option("Select","-1",true,true)
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)
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")) {
318: poolForm.elements[caller*5+5].options[0] = new Option("Select","-1",true,true)
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") {
327: poolForm.elements[caller*5+5].options[0] = new Option("Select","-1",true,true)
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") {
335: poolForm.elements[caller*5+5].options[0] = new Option("Select","-1",true,true)
336: poolForm.elements[caller*5+5].options[1] = new Option("True or False","word",false,false)
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)
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;
358: my $value = $env{"form.$parname"};
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 {
393: my ($webpath,$jsref) = @_;
394: my $source = '';
395: if (exists($env{'form.go'}) ) {
396: $source = $env{'form.go'};
397: }
398:
399: $$jsref = <<"END_OF_ONE";
400: function nextPage() {
401: if (verify()) {
402: document.forms.dataForm.go.value="NextPage"
403: document.forms.dataForm.submit();
404: }
405: }
406:
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: |;
419: foreach my $item (keys(%env)) {
420: if ($item =~ m/^form\.(probfile_\d+)$/) {
421: my $name = $1;
422: my $value = $env{"form.$name"};
423: if ($value ne '') {
424: $$jsref .= qq( document.dataForm.$name.value = "$value"\n);
425: }
426: }
427: }
428: $$jsref .= "}";
429: }
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(
449: fnmb => 'Filenames must be unique',
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;
471: }
472:
473: # ---------------------------------------------------------------- Jscript Four
474: sub jscript_four {
475: my ($jsref,$webpath) = @_;
476: $$jsref = qq|
477: function backtoStart() {
478: document.location.href="$webpath"
479: }
480: function backPage() {
481: document.forms.verify.go.value="PreviousPage"
482: document.forms.verify.submit();
483: }
484: |;
485: }
486:
487: # ---------------------------------------------------------------- Display Zero
488: sub display_zero {
489: my ($r,$fn,$page,$webpath) = @_;
490: my $go_default = 'NextPage';
491: if ($fn eq '') {
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>'));
493: }
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 />'.
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.').'
506: <ol>
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">'.
513: &Apache::lonhtmlcommon::topic_bar(1,&mt('Optional: create a sub-directory in which the testbank questions will be saved')).
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:').
515: ' <input type="button" name="createdir" value="'.&mt('Create sub-directory').'" onclick="javascript:createWin()" />'.
516: &page_footer($env{'form.newdir'},$fn,$page,$webpath).'
517: </form>');
518: }
519:
520: # ---------------------------------------------------------------- Display One
521:
522: sub display_one {
523: my ($r,$fn,$page,$textref,$header) = @_;
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">
527: <option value="-1" selected="selected">'.&mt('Select').'</option>
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".
538: &Apache::lonhtmlcommon::topic_bar(2,$topics{2}).'<p>'.
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".
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".
542: &mt('Each numbered question must have a corresponding numbered answer, although the answer itself may be blank for essay questions.').'<br /><br />'."\n".
543: &mt('For example, you would select [_1]1.[_2] if your testbank file contained the following questions:','<b>','</b>').'<br /><blockquote>'.
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>'.
561: &Apache::lonhtmlcommon::topic_bar(3,$topics{3}).'<p>'.
562: &mt('For example, you would enter [_1]6[_2] if your testbank file contained the following sequence of questions:','<b>','</b>').'</p><blockquote>'.
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 />'.
570: &page_footer($env{'form.newdir'},$fn,$page).'
571: </form>');
572: return;
573: }
574:
575: # ---------------------------------------------------------------- Display Two
576:
577: sub display_two {
578: my ($r,$fn,$page,$textref,$header,$qcount) = @_;
579: my $blocks = $env{'form.blocks'};
580: my $qnumformat = $env{'form.qnumformat'};
581: my @types = ("MC","MA","TF","Ess","FIB","Ord");
582: my %typenames = &Apache::lonlocal::texthash(
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: }
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>'.
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>').' '.
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>'.
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>'.
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).
613: &Apache::lonhtmlcommon::topic_bar(4,$steptitle).'<p>'.
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>').' '.
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());
625: for (my $i=0; $i<$blocks; $i++) {
626: my $iter = $i+1;
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".
630: '<td valign="top"> <input type="text" name="end_'.$i.'" value="'.$bl1end.'" size="5" /> </td>'."\n".
631: '<td valign="top">
632: <select name="qtype_'.$i.'" onchange="colSet('.$i.')">
633: <option value="-1" selected="selected">'.&mt('Select').'</option>'."\n");
634: foreach my $qtype (@types) {
635: $r->print('<option value="'.$qtype.'">'.$typenames{$qtype}.'</option>'."\n");
636: }
637: $r->print(' </select>
638: </td>
639: <td align="left" valign="top">
640: <select name="foilformat_'.$i.'">
641: <option value="-1"><--- Set type
642: </select>
643: </td>
644: <td align="left" valign="top">
645: <select name="ansr_'.$i.'">
646: <option value="-1"><--- Set type
647: </select>
648: </td>'.
649: &Apache::loncommon::end_data_table_row());
650: }
651: $r->print(&Apache::loncommon::end_data_table().'</p><ul><li>'.
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>
654: 28. (a)
655: (d)
656: (e)
657: </pre></blockquote>').'</li><li>'.
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>
660: <input type="hidden" name="blocks" value="'.$blocks.'" />
661: <input type="hidden" name="qnumformat" value="'.$qnumformat.'" />'.
662: &page_footer($env{'form.newdir'},$fn,$page).'
663: </form>');
664: return;
665: }
666:
667: # ---------------------------------------------------------------- Display Three
668: sub display_three {
669: my ($r,$fn,$page,$textref,$res,$header,$webpath,$qcount) = @_;
670: my $qnumformat = $env{'form.qnumformat'};
671: my $filename = $env{'form.filename'};
672: my $source = $env{'form.go'};
673: my $blocks = $env{'form.blocks'};
674: my ($alphabet,$romans) = &get_constants();
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;
683: my %lt = &Apache::lonlocal::texthash (
684: crt => 'Create?',
685: typ => 'Type',
686: fnam => 'Filename',
687: ques => 'Question',
688: answ => 'Answer',
689: chka => 'check all',
690: unch => 'uncheck all',
691: );
692: for (my $i=0; $i<$blocks; $i++) {
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"};
696: $nums[$i] = $end[$i]-$start[$i] +1;
697: $qtype[$i] = $env{"form.qtype_$i"};
698: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
699: $foilformats[$i] = $env{"form.foilformat_$i"};
700: } else {
701: $foilformats[$i] = '';
702: }
703: if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) {
704: $ansrtypes[$i] = $env{"form.ansr_$i"};
705: } else {
706: $ansrtypes[$i] = '';
707: }
708: } else {
709: $nums[$i] = 0;
710: }
711: $numitems += $nums[$i];
712: }
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') {
719: $showheader = &build_image_url($webpath,$showheader);
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).
726: &Apache::lonhtmlcommon::topic_bar(5,&mt('Choose which problems to convert and names to use for individual problem files')));
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: }
749: for (my $j=0; $j<$numitems; $j++) {
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';
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) {
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') {
768: $showqn = &build_image_url($webpath,$showqn);
769: }
770: }
771: $r->print(&Apache::loncommon::start_data_table_row().
772: '<td valign="top">'.$qnum.'.</td>'."\n".
773: '<td valign="top"><input name="createprob" type="checkbox" checked="checked" value="'.$j.'" /></td>'."\n".
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 {
778: my $foiltag = '';
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") {
785: $foiltag = $alphabet->[$k-1].'.';
786: } elsif ($foilformats[$i] eq "lcparen") {
787: $foiltag = '('.$alphabet->[$k-1].')';
788: } elsif ($foilformats[$i] eq "lconeparen") {
789: $foiltag = $alphabet->[$k-1].')';
790: } elsif ($foilformats[$i] eq "lcdotparen") {
791: $foiltag = $alphabet->[$k-1].'.)';
792: } elsif ($foilformats[$i] eq "ucperiod") {
793: $foiltag = $alphabet->[$k-1].'.';
794: $foiltag =~ tr/a-z/A-Z/;
795: } elsif ($foilformats[$i] eq "ucparen") {
796: $foiltag = '('.$alphabet->[$k-1].')';
797: $foiltag =~ tr/a-z/A-Z/;
798: } elsif ($foilformats[$i] eq "uconeparen") {
799: $foiltag = $alphabet->[$k-1].')';
800: $foiltag =~ tr/a-z/A-Z/;
801: } elsif ($foilformats[$i] eq "ucdotparen") {
802: $foiltag = $alphabet->[$k-1].'.)';
803: $foiltag =~ tr/a-z/A-Z/;
804: } elsif ($foilformats[$i] eq "romperiod") {
805: $foiltag = $romans->[$k-1].'.';
806: } elsif ($foilformats[$i] eq "romparen") {
807: $foiltag = '('.$romans->[$k-1].')';
808: } elsif ($foilformats[$i] eq "romoneparen") {
809: $foiltag = $romans->[$k-1].')';
810: } elsif ($foilformats[$i] eq "romdotparen") {
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') {
817: $showfoil = &build_image_url($webpath,$showfoil);
818: }
819: }
820: $r->print("$foiltag $showfoil<br />\n");
821: }
822: }
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());
831: } else {
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".
839: '<td valign="top"><input name="createprob" type="checkbox" checked="checked" value="'.$j.'" /></td>'."\n".
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());
845: }
846: last;
847: }
848: }
849: }
850: }
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.'" />');
854: for (my $i=0; $i<$blocks; $i++) {
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].'" />');
859: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
860: $r->print('
861: <input type="hidden" name="foilformat_'.$i.'" value="'.$foilformats[$i].'" />');
862: }
863: if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) {
864: $r->print('
865: <input type="hidden" name="ansr_'.$i.'" value="'.$ansrtypes[$i].'" />');
866: }
867: }
868: $r->print('</p>'.&page_footer($env{'form.newdir'},$fn,$page).'
869: </form>');
870: }
871:
872: # ---------------------------------------------------------------- Final Display
873: sub final_display {
874: my ($r,$fn,$page,$textref,$res,$header,$css,$js,$webpath,$dirpath,$subdir) = @_;
875: my $qnumformat = $env{'form.qnumformat'};
876: my $blocks = $env{'form.blocks'};
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;
888: my @createprobs = &Apache::loncommon::get_env_multiple('form.createprob');
889: for (my $i=0; $i<$blocks; $i++) {
890: $start[$i] = $env{"form.start_$i"};
891: $end[$i] = $env{"form.end_$i"};
892: if (($end[$i] - $start[$i]) >= 0) {
893: $nums[$i] = $end[$i] - $start[$i]+1;
894: } else {
895: $nums[$i] = 0;
896: }
897: $qtype[$i] = $env{"form.qtype_$i"};
898: if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
899: $foilformats[$i] = $env{"form.foilformat_$i"};
900: } else {
901: $foilformats[$i] = '';
902: }
903: if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) {
904: $ansrtypes[$i] = $env{"form.ansr_$i"};
905: }
906: $numitems += $nums[$i];
907: }
908:
909: my %answers;
910: my ($items,$ids,$footer) = &file_split(\@start,\@end,\@nums,$qnumformat,\@foilformats,$textref,\%multparts,$numitems,\@qtype,$blocks);
911:
912: # Converting MC and MA answer to number, and splitting answers for FIB, and ordering for Ord.
913: my ($alphabet,$romans) = &get_constants();
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++) {
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}} = ();
930: if ($qtype[$i] eq "MC") {
931: $items->[$k] =~ tr/A-Z/a-z/;
932: $items->[$k] =~ s/<\/?[^>]+>//g;
933: $items->[$k] =~ s/\W//g;
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") {
935: for (my $j=0; $j<@{$alphabet}; $j++) {
936: if ($alphabet->[$j] eq $items->[$k]) {
937: push @{$answers{$qnum}}, $j;
938: last;
939: }
940: }
941: } elsif (($foilformats[$i] eq "romparen") || ($foilformats[$i] eq "romperiod") || ($foilformats[$i] eq "romoneparen") || ($foilformats[$i] eq "romdotparen")) {
942: for (my $j=0; $j<@{$romans}; $j++) {
943: if ($romans->[$j] eq $items->[$k]) {
944: push @{$answers{$qnum}}, $j;
945: last;
946: }
947: }
948: }
949: } elsif (($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) {
950: $items->[$k] =~ tr/A-Z/a-z/;
951: $items->[$k] =~ s/<\/?[^>]+>//g;
952: my @corrects = split/$patterns{$ansrtypes[$i]}/,$items->[$k];
953: foreach my $correct (@corrects) {
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: }
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") {
968: if (($qtype[$i] eq "Ord") && (@tied > 0)) {
969: my @ties;
970: foreach my $tie (@tied) {
971: for (my $j=0; $j<@{$alphabet}; $j++) {
972: if ($alphabet->[$j] eq $tie) {
973: push(@ties,$j);
974: last;
975: }
976: }
977: }
978: my $ans = join('=',@ties);
979: push(@{$answers{$qnum}},$ans);
980: } else {
981: for (my $j=0; $j<@{$alphabet}; $j++) {
982: if ($alphabet->[$j] eq $correct) {
983: push @{$answers{$qnum}}, $j;
984: last;
985: }
986: }
987: }
988: } elsif (($foilformats[$i] eq "romparen") || ($foilformats[$i] eq "romperiod") || ($foilformats[$i] eq "romoneparen") || ($foilformats[$i] eq "romdotparen")) {
989: if (($qtype[$i] eq "Ord") && (@tied > 0)) {
990: my @ties;
991: foreach my $tie (@tied) {
992: for (my $j=0; $j<@{$romans}; $j++) {
993: if ($romans->[$j] eq $tie) {
994: push(@ties,$j);
995: last;
996: }
997: }
998: }
999: push(@{$answers{$qnum}},join('=',@ties));
1000: } else {
1001: for (my $j=0; $j<@{$romans}; $j++) {
1002: if ($romans->[$j] eq $correct) {
1003: push @{$answers{$qnum}}, $j;
1004: last;
1005: }
1006: }
1007: }
1008: }
1009: }
1010: } elsif ($qtype[$i] eq "FIB") {
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: }
1021: }
1022: }
1023: }
1024: }
1025: }
1026: }
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: }
1042: $r->print(&Apache::lonhtmlcommon::topic_bar(6,&mt('Result of conversion of testbank questions to LON-CAPA problems')));
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>'.
1051: &page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).'</form>');
1052: } elsif (($destdir ne '') && (-e $destdir)) {
1053: my (@qn_file,@result,@numid);
1054: my $qcount = 0;
1055: my $itemcount = 0;
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++) {
1060: $numid[$qcount] = $ids->[$itemcount];
1061: $itemcount ++;
1062: next if (!grep(/^$qcount$/,@createprobs));
1063: my $libfile = &probfile_name($j);
1064: my $answer = $j + $numitems;
1065: my $numans = scalar(@{$answers{$qcount}});
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: }
1071: ($result[$qcount],$qn_file[$qcount]) = &create_mcq($destdir,$subdir,\@{$multparts{$j}},\@{$answers{$qcount}},$qtype[$i],$libfile,$res,$header,$footer,$js,$css);
1072: $qcount ++;
1073: }
1074: } elsif ($qtype[$i] eq "TF") {
1075: for (my $j=$start[$i]-1; $j<$end[$i]; $j++) {
1076: $numid[$qcount] = $ids->[$itemcount];
1077: $itemcount ++;
1078: next if (!grep(/^$qcount$/,@createprobs));
1079: my $libfile = &probfile_name($j);
1080: my $answer = $j + $numitems;
1081: $items->[$answer] =~ s/^\s+//;
1082: $items->[$answer] =~ s/\s+$//;
1083: $items->[$answer] =~ s/\W//g;
1084: $items->[$answer] =~ tr/A-Z/a-z/;
1085: my $answer_id = '';
1086: if ($ansrtypes[$i] eq 'word' ) {
1087: if ($items->[$answer] =~ m/true/) {
1088: $answer_id = 0;
1089: } else {
1090: $answer_id = 1;
1091: }
1092: } elsif ($ansrtypes[$i] eq 'lett') {
1093: if ($items->[$answer] =~ m/^t/) {
1094: $answer_id = 0;
1095: } else {
1096: $answer_id = 1;
1097: }
1098: }
1099: ($result[$qcount],$qn_file[$qcount]) = &create_ess($destdir,$subdir,$answer_id,$items->[$j],$items->[$answer],$qtype[$i],$libfile,$res,$header,$footer,$js,$css);
1100: $qcount ++;
1101: }
1102: } elsif ($qtype[$i] eq "Ess") {
1103: for (my $j=$start[$i]-1; $j<$end[$i]; $j++) {
1104: $numid[$qcount] = $ids->[$itemcount];
1105: $itemcount ++;
1106: next if (!grep(/^$qcount$/,@createprobs));
1107: my $libfile = &probfile_name($j);
1108: my $answer = $j + $numitems;
1109: my $answer_id = '';
1110: ($result[$qcount],$qn_file[$qcount]) = &create_ess($destdir,$subdir,$answer_id,$items->[$j],$items->[$answer],$qtype[$i],$libfile,$res,$header,$footer,$js,$css);
1111: $qcount ++;
1112: }
1113: }
1114: }
1115: }
1116: my ($successes,$failures,$existing);
1117: for (my $i=0; $i<@qn_file; $i++) {
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: }
1139: $r->print(&page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).'</form>');
1140: } else {
1141: $state = 'nodir';
1142: $r->print('<p>'.&mt('No destination directory was available so import of questions could not proceed.').'</p>'.
1143: &page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).'</form>');
1144: }
1145: return;
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".
1151: '<textarea name="rawdata" cols="70" rows="6" wrap="virtual" align="center" readonly>'."\n";
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 {
1168: my ($newdir,$fn,$page,$webpath,$subdir,$state) = @_;
1169: my $prevval = &mt('Previous Page');
1170: my $nextval = &mt('Next Page');
1171: my $prevclick = 'javascript:backPage();';
1172: my $nextclick = 'javascript:nextPage();';
1173: my $go = '';
1174: if (($page == 0) || ($state eq 'badfile')) {
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" />
1196: <input type="hidden" name="go" value="'.$go.'" />
1197: <input type="hidden" name="timestamp" value="'.$env{'form.timestamp'}.'" />';
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>';
1205: if (($page < 4) && ($state ne 'badfile')) {
1206: $output .= '
1207: <td> </td>
1208: <td>
1209: <input type="button" name="nextpage" value="'.$nextval.'" onclick="'.$nextclick.'" />
1210: </td>';
1211: }
1212: $output .= ' </tr>
1213: </table>
1214: ';
1215: }
1216: return $output;
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:
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:
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);
1253: my ($qpatst,$qpatend,$numpat,@questions,@qids);
1254: my $numpat = '\d{1';
1255: if ($dignum > 1) {
1256: $numpat .= ','.$dignum.'}';
1257: } else {
1258: $numpat .= '}';
1259: }
1260: if ($qnumformat eq "period") {
1261: $qpatend = '\.';
1262: } elsif ($qnumformat eq "paren") {
1263: $qpatst = '\(';
1264: $qpatend = '\)';
1265: } elsif ($qnumformat eq "leadparen") {
1266: $qpatst = '\(';
1267: } elsif ($qnumformat eq "trailparen") {
1268: $qpatend = '\)';
1269: }
1270: my @lines = split/[\r\n\f]+\s*$qpatst($numpat)$qpatend\s*/,$text_in;
1271: # my @questions = split/\n\s\d{1,3}\.\s/,$text_in;
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: }
1280: my %multparts = ();
1281: for (my $i=0; $i<$blocks; $i++) {
1282: if (${$numsref}[$i] > 0) {
1283: if ((${$qtyperef}[$i] eq "MC") || (${$qtyperef}[$i] eq "MA") || (${$qtyperef}[$i] eq "Ord")) {
1284: my $splitstr = '';
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") {
1290: $splitstr = '[a-z]\.';
1291: } elsif (${$foilsref}[$i] eq "lcparen") {
1292: $splitstr = '\([a-z]\)';
1293: } elsif (${$foilsref}[$i] eq "lconeparen") {
1294: $splitstr = '[a-z]\)';
1295: } elsif (${$foilsref}[$i] eq "lcdotparen") {
1296: $splitstr = '[a-z]\.\)';
1297: } elsif (${$foilsref}[$i] eq "ucperiod") {
1298: $splitstr = '[A-Z]\.';
1299: } elsif (${$foilsref}[$i] eq "ucparen") {
1300: $splitstr = '\([A-Z]\)';
1301: } elsif (${$foilsref}[$i] eq "uconeparen") {
1302: $splitstr = '[A-Z]\)';
1303: } elsif (${$foilsref}[$i] eq "ucdotparen") {
1304: $splitstr = '[A-Z]\.\)';
1305: } elsif (${$foilsref}[$i] eq "romperiod") {
1306: $splitstr = '[ivx]+\.';
1307: } elsif (${$foilsref}[$i] eq "romparen") {
1308: $splitstr = '\([ivx]+\)';
1309: } elsif (${$foilsref}[$i] eq "romoneparen") {
1310: $splitstr = '[ivx]+\)';
1311: } elsif (${$foilsref}[$i] eq "romdotparen") {
1312: $splitstr = '[ivx]+\.\)';
1313: }
1314: for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
1315: @{$multparts{$j}} = split/[\r\n\f]+\s*$splitstr\s*/,$questions[$j];
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: }
1324: }
1325: my ($lastanswer,$footer) = ($questions[-1] =~ /^([,\r\n\f\t\s().A-Za-z]+)(.+)$/);
1326: if ($footer ne '') {
1327: $questions[-1] = $lastanswer;
1328: }
1329: %{$multpartsref} = %multparts;
1330: return (\@questions,\@qids,$footer);
1331: }
1332:
1333: # create_mcq builds an MC, MA, Ord or FIB question
1334:
1335: sub create_mcq {
1336: my ($destdir,$subdir,$qstnref,$answerref,$qtype,$libfile,$res,$header,$footer,$js,$css) = @_;
1337:
1338: my $qstn = ${$qstnref}[0];
1339: my $numfoils = scalar(@{$qstnref}) - 1;
1340: my $datestamp = localtime;
1341: my $numansrs = scalar(@{$answerref});
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 .= '
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";
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: }
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";
1378: }
1379: chomp($output);
1380: $output .= qq|
1381: </foilgroup>
1382: </optionresponse>|;
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: }
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";
1406: }
1407: chomp($output);
1408: $output .= qq|
1409: </foilgroup>
1410: </radiobuttonresponse>|;
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++) {
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: }
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";
1442: }
1443: chomp($output);
1444: $output .= qq|
1445: </foilgroup>
1446: </rankresponse>|;
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 {
1462: my $min = $$answerref[0];
1463: my $max = $$answerref[0];
1464: for (my $i=1; $i<@{$answerref}; $i++) {
1465: if ($$answerref[$i]<=$min) {
1466: $min = $$answerref[$i];
1467: } elsif ($$answerref[$i] >= $max) {
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 />
1479: </numericalresponse>|;
1480: } else {
1481: if (@{$answerref} == 1) {
1482: $output .= qq|
1483: <stringresponse answer="$$answerref[0]" type="ci">
1484: <textline>
1485: </textline>
1486: </stringresponse>|;
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>
1497: </stringresponse>|;
1498: }
1499: }
1500: }
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);
1520: }
1521:
1522: # create_ess builds an essay or True/False question
1523:
1524: sub create_ess {
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 />';
1543: my $answer = '';
1544: my $answerlog = '';
1545: if ($qtype eq "Ess") {
1546: $output .= '
1547: <essayresponse>
1548: <textfield></textfield>
1549: </essayresponse>
1550: <postanswerdate>
1551: <startouttext />
1552: '.$answertxt
1553: .'<endouttext />
1554: </postanswerdate>';
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: }
1574: $output .= '<endouttext /></foil>
1575: </foilgroup>
1576: </radiobuttonresponse>';
1577: }
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);
1592: $result = 'ok';
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;
1614: }
1615:
1616: sub file_error {
1617: my ($r,$fn,$current_page,$webpath,$res) = @_;
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>'.
1621: '<li>'.&mt('plain text').'</li>'.
1622: '<li>'.&mt('RTF').'</li>'.
1623: '<li>'.&mt('HTML').'</li></ul>'.
1624: &mt('The file type identified for the file you uploaded is [_1].','<b>'.$res.'</b>').'</p>');
1625: $r->print(&page_footer($env{'form.newdir'},$fn,$current_page,$webpath,undef,'badfile').
1626: '</form>');
1627: return;
1628: }
1629:
1630: sub parse_datafile {
1631: my ($r,$filename,$dirpath,$webpath,$page_name,$subdir,$timestamp) = @_;
1632: my ($badfile,$res,%allfiles,%codebase);
1633: my $mm = new File::MMagic;
1634: my ($text,$header,$css,$js);
1635: if (-e "$dirpath") {
1636: $res = $mm->checktype_filename($dirpath.$filename);
1637: if ($env{'form.phase'} eq 'three') {
1638: if ($res eq 'text/plain') {
1639: open(TESTBANK,"<",$dirpath.$filename);
1640: @{$text} = <TESTBANK>;
1641: close(TESTBANK);
1642: } elsif ($res eq 'application/rtf') {
1643: my $html = '';
1644: my $image_uri = $timestamp;
1645: if ($page_name eq 'Target') {
1646: $image_uri = "$webpath/$timestamp";
1647: }
1648: my $image_dir;
1649: if ($page_name eq 'Blocks') {
1650: $image_dir = $dirpath;
1651: $image_dir =~ s/\/$//;
1652: $image_dir .= '/'.$timestamp;
1653: if (!-e $image_dir) {
1654: mkdir($image_dir,0755);
1655: }
1656: } else {
1657: $image_dir = $r->dir_config('lonDaemons').'/tmp/'.
1658: $env{'user.name'}.'_'.$env{'user.domain'}.
1659: '_rtfupload_'.$filename.'_'.time.'_'.$$;
1660: if (!-e $image_dir) {
1661: mkdir($image_dir,0755);
1662: }
1663: }
1664: my $parser = RTF::HTMLConverter->new (
1665: in => $dirpath.$filename,
1666: out => \$html,
1667: DOMImplementation => 'XML::DOM',
1668: image_uri => $image_uri,
1669: image_dir => $image_dir,
1670: );
1671: $parser->parse();
1672: utf8::decode($html);
1673: ($text,$header,$css,$js) =
1674: &parse_htmlcontent($res,$subdir,$html,undef,$page_name);
1675: } elsif ($res eq 'text/html') {
1676: ($text,$header,$css,$js) =
1677: &parse_htmlcontent($res,$subdir,undef,$dirpath.$filename,$page_name);
1678: } else {
1679: $badfile = 1;
1680: }
1681: }
1682: }
1683: return ($res,$badfile,$text,$header,$css,$js,\%allfiles,\%codebase);
1684: }
1685:
1686: sub parse_htmlcontent {
1687: my ($res,$subdir,$html,$fullpath,$page_name) = @_;
1688: my ($p,$fh);
1689: if ($res eq 'application/rtf') {
1690: $p = HTML::TokeParser->new( \$html );
1691: } elsif ($res eq 'text/html') {
1692: open($fh, "<:utf8", $fullpath);
1693: $p = HTML::TokeParser->new( $fh );
1694: }
1695: my ($current_tag,$line,@text,$header,$css,$js,$have_header,$delayed);
1696: while (my $token = $p->get_token) {
1697: if (ref($token) eq 'ARRAY') {
1698: if ($token->[0] eq 'S') {
1699: if ($delayed ne '') {
1700: $line.= $delayed;
1701: $delayed = '';
1702: }
1703: $current_tag = $token->[1];
1704: next if ($token->[1] eq 'html' || $token->[1] eq 'head' || $token->[1] eq 'body' || $token->[1] eq 'meta' || $token->[1] eq 'title');
1705: if ($token->[1] eq 'p') {
1706: $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
1707: if (!$have_header) {
1708: $header = $line;
1709: if ($header ne '') {
1710: $header =~ s/\s*[\n\r\f]+/\n/gs;
1711: }
1712: $have_header = 1;
1713: } else {
1714: push(@text,$line);
1715: }
1716: $line = '';
1717: } elsif ($current_tag eq 'style') {
1718: $css .= $token->[4];
1719: } elsif ($current_tag eq 'script') {
1720: $js .= $token->[4];
1721: } else {
1722: my $contents = $token->[4];
1723: if ($subdir ne '') {
1724: if (($token->[1] eq 'img') && ($token->[2]->{'src'} ne '')) {
1725: if (($res eq 'text/html') ||
1726: ($res eq 'application/rtf') && ($page_name ne 'Target')) {
1727: $contents =~ s/(src=\s*["']?)/$1..\//i;
1728: }
1729: }
1730: }
1731: if (($line eq '') && ($current_tag eq 'font')) {
1732: $delayed = &HTML::Entities::encode($contents,'<>&"');
1733: } else {
1734: $line .= &HTML::Entities::encode($contents,'<>&"');
1735: }
1736: }
1737: } elsif ($token->[0] eq 'T') {
1738: if ($current_tag ne 'html' && $current_tag ne 'head' && $current_tag ne 'body' && $current_tag ne 'meta' && $current_tag ne 'title') {
1739: if ($current_tag eq 'style') {
1740: $css .= $token->[1];
1741: } elsif ($current_tag eq 'script') {
1742: $js .= $token->[1];
1743: } else {
1744: if ($delayed ne '') {
1745: my ($id,$rest) = ($token->[1] =~ /^(\s*\(*[A-Za-z0-9]+\)*\.*\s+)(.+)$/s);
1746: if ($id ne '') {
1747: $line .= $id.$delayed.$rest;
1748: } else {
1749: $line .= $token->[1].$delayed;
1750: }
1751: $delayed = '';
1752: } else {
1753: $line .= $token->[1];
1754: }
1755: }
1756: }
1757: } elsif ($token->[0] eq 'E') {
1758: 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');
1759: if ($token->[1] eq 'style') {
1760: $css .= $token->[2];
1761: } elsif ($token->[1] eq 'script') {
1762: $js .= $token->[2];
1763: } else {
1764: $line .= &HTML::Entities::encode($token->[2],'<>&"');
1765: }
1766: $current_tag = '';
1767: }
1768: }
1769: }
1770: if ($line ne '') {
1771: if ($line ne '') {
1772: $line =~ s/\s*[\n\r\f]+/\n/gs;
1773: }
1774: $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
1775: push(@text,$line);
1776: }
1777: if ($res eq 'text/html') {
1778: close($fh);
1779: }
1780: return (\@text,$header,$css,$js);
1781: }
1782:
1783: sub build_image_url {
1784: my ($webpath,$item) = @_;
1785: $item =~ s/(<img[^>]+src=["']?\s*)(\.?\.?\/?)/$1$webpath/gsi;
1786: return $item;
1787: }
1788:
1789: sub print_header {
1790: my ($uname,$udom,$javascript,$loadentries,$title,$current_page,$pagesref,
1791: $namesref) = @_;
1792: my $brcrum = [{'href' => &Apache::loncommon::authorspace("/priv/$udom/$uname/"),
1793: 'text' => 'Authoring Space'}];
1794: if ($env{'form.phase'} eq 'three') {
1795: if (ref($pagesref) eq 'ARRAY') {
1796: for (my $i=0; $i<$current_page; $i++) {
1797: my $goback = 1 + $i - $current_page;
1798: if (ref($namesref) eq 'HASH') {
1799: if ($namesref->{$pagesref->[$i]} ne '') {
1800: if (ref($brcrum) eq 'ARRAY') {
1801: my $text = $namesref->{$pagesref->[$i]};
1802: my $href;
1803: if ($goback == -1) {
1804: $href = 'javascript:backPage();';
1805: } else {
1806: $href = 'javascript:history.go('.$goback.')';
1807: }
1808: push(@{$brcrum}, {'href' => $href,
1809: 'text' => $text});
1810: }
1811: }
1812: }
1813: }
1814: }
1815: }
1816: my $output = &Apache::loncommon::start_page($title,$javascript,
1817: {'bread_crumbs' => $brcrum,
1818: 'add_entries' => $loadentries});
1819: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1820: $output .= '<p class="LC_info">'
1821: .&mt('Co-Author [_1]',$uname.':'.$udom)
1822: .'</p>';
1823: }
1824: return $output;
1825: }
1826:
1827: # ---------------------------------------------------------------- Main Handler
1828: sub handler {
1829: my $r=shift;
1830:
1831: my $fn=$env{'form.filename'};
1832:
1833: if ($env{'form.filename1'}) {
1834: $fn=$env{'form.filename1'}.$env{'form.filename2'};
1835: }
1836: $fn=~s{\+}{}g;
1837:
1838: unless ($fn) {
1839: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1840: ' unspecified filename for upload', $r->filename);
1841: return HTTP_NOT_FOUND;
1842: }
1843:
1844: my ($uname,$udom) = &Apache::lonnet::constructaccess($fn);
1845: if (($uname eq '') || ($udom eq '')) {
1846: $r->log_reason($uname.':'.$udom.' trying to convert testbank file '.
1847: $fn.' - not authorized',$r->filename);
1848: return HTTP_NOT_ACCEPTABLE;
1849: }
1850:
1851: my $javascript = '';
1852: my $page_name = '';
1853: my $current_page = '';
1854: my $qcount = '';
1855: my $title = 'Upload testbank questions to Authoring Space';
1856:
1857: # ----------------------------------------------------------- Start page output
1858: &Apache::loncommon::content_type($r,'text/html');
1859: $r->send_http_header;
1860:
1861: my ($filename,$webpath) = &File::Basename::fileparse($fn);
1862: my $dirpath = $r->dir_config('lonDocRoot').$webpath;
1863: my ($res,$subdir,$badfile,$textref,$header,$css,$js,%loadentries,@pages,%names);
1864:
1865: if ($env{'form.phase'} eq 'three') {
1866: $current_page = &display_control();
1867: @pages = ('Welcome','Blocks','Format','Target','Confirmation');
1868: %names = &Apache::lonlocal::texthash(
1869: Welcome => 'Testbank Format',
1870: Blocks => 'Classification',
1871: Format => 'Selection',
1872: Target => 'Result'
1873: );
1874: $page_name = $pages[$current_page];
1875: if ($env{'form.timestamp'} eq '') {
1876: $env{'form.timestamp'} = time;
1877: }
1878: if ($env{'form.newdir'} ne '') {
1879: if ($env{'form.newdir'} =~ /^\Q$dirpath\E(.+)$/) {
1880: $subdir = $1;
1881: }
1882: }
1883: ($res,$badfile,$textref,$header,$css,$js) =
1884: &parse_datafile($r,$filename,$dirpath,$webpath,$page_name,
1885: $subdir,$env{'form.timestamp'});
1886: if ($page_name eq 'Welcome') {
1887: &jscript_zero($webpath,\$javascript);
1888: } elsif ($page_name eq 'Blocks') {
1889: if ($env{'form.go'} eq "PreviousPage") {
1890: $loadentries{'onload'} = "setElements()";
1891: }
1892: &jscript_one(\$javascript);
1893: } elsif ($page_name eq 'Format') {
1894: if ($env{'form.go'} eq "PreviousPage") {
1895: $loadentries{'onload'} = "setElements()";
1896: }
1897: $qcount = question_count($env{'form.qnumformat'},$textref);
1898: &jscript_two(\$javascript,$qcount);
1899: } elsif ($page_name eq 'Target') {
1900: if ($env{'form.go'} eq "PreviousPage") {
1901: $loadentries{'onload'} = "setElements()";
1902: }
1903: &jscript_three($webpath,\$javascript);
1904: } elsif ($page_name eq 'Confirmation') {
1905: &jscript_four(\$javascript,$webpath);
1906: }
1907: $javascript = "<script type=\"text/javascript\">\n//<!--\n".
1908: $javascript."\n// --></script>\n";
1909: if ($res eq 'application/rtf' || $res eq 'text/html') {
1910: if ($page_name eq 'Target') {
1911: $javascript .= $js.$css;
1912: }
1913: }
1914: }
1915:
1916: $r->print(&print_header($uname,$udom,$javascript,\%loadentries,$title,
1917: $current_page,\@pages,\%names));
1918:
1919: if (($env{'form.phase'} eq 'four') || ($env{'form.phase'} eq 'three')) {
1920: if ($env{'form.phase'} eq 'four') {
1921: $r->print(&Apache::lonupload::phasefour($r,$fn,$uname,$udom,'testbank'));
1922: my $current_page = 0;
1923: my $js;
1924: &jscript_zero($webpath,\$js);
1925: $js = '<script type="text/javascript">'."\n$js\n".'</script>';
1926: $r->print($js);
1927: &display_zero($r,$fn,$current_page,$webpath);
1928: } elsif ($env{'form.phase'} eq 'three') {
1929: if ($env{'form.action'} eq 'upload_embedded') {
1930: my ($result,$flag) =
1931: &Apache::lonupload::phasethree($r,$fn,$uname,$udom,'testbank');
1932: $r->print($result);
1933: if ($flag eq 'modify_orightml') {
1934: undef($page_name);
1935: $r->print('<form name="testbankForm" method="post" action="/adm/testbank">'.
1936: &page_footer('',$fn).'</form>');
1937: }
1938: }
1939: }
1940: if ($badfile) {
1941: &file_error($r,$fn,$current_page,$webpath,$res);
1942: } else {
1943: &display_zero ($r,$fn,$current_page,$webpath) if $page_name eq 'Welcome';
1944: &display_one ($r,$fn,$current_page,$textref,$header) if $page_name eq 'Blocks';
1945: &display_two ($r,$fn,$current_page,$textref,$header,$qcount) if $page_name eq 'Format';
1946: &display_three ($r,$fn,$current_page,$textref,$res,$header,$webpath,$qcount) if $page_name eq 'Target';
1947: &final_display ($r,$fn,$current_page,$textref,$res,$header,$css,$js,$webpath,$dirpath,$subdir) if $page_name eq 'Confirmation';
1948: }
1949: } elsif ($env{'form.phase'} eq 'two') {
1950: my ($result,$flag) = &Apache::lonupload::phasetwo($r,$fn,'testbank');
1951: $r->print($result);
1952: if ($flag eq 'ok') {
1953: my $current_page = 0;
1954: my $js;
1955: &jscript_zero($webpath,\$js);
1956: $js = '<script type="text/javascript">'."\n$js\n".'</script>';
1957: $r->print($js);
1958: &display_zero($r,$fn,$current_page,$webpath);
1959: } elsif ($flag eq 'embedded') {
1960: $r->print($js.'<form name="testbankForm" method="post" action="/adm/testbank">'.
1961: &page_footer('',$fn).'</form>');
1962: }
1963: } else {
1964: &Apache::lonupload::phaseone($r,$fn,'testbank',$uname,$udom);
1965: }
1966: $r->print(&Apache::loncommon::end_page());
1967: return OK;
1968: }
1969:
1970: 1;
1971: __END__
1972:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>