Annotation of loncom/publisher/testbankimport.pm, revision 1.45

1.3       albertel    1: # Handler for parsing text upload problem descriptions into .problems
1.45    ! raeburn     2: # $Id: testbankimport.pm,v 1.44 2014/02/11 19:11:18 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) - ').'&nbsp;
                    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.').'&nbsp;&nbsp;<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");
1.44      bisitz    582:     my %typenames = &Apache::lonlocal::texthash(
1.1       raeburn   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">&nbsp;'.$iter.'&nbsp;</td>'."\n".
                    629:                  '<td valign="top">&nbsp;<input type="text" name="start_'.$i.'" value="'.$bl1st.'" size="5" />&nbsp;</td>'."\n".
1.21      bisitz    630:                  '<td valign="top">&nbsp;<input type="text" name="end_'.$i.'" value="'.$bl1end.'" size="5" />&nbsp;</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">&nbsp;
                    640:     <select name="foilformat_'.$i.'">
1.1       raeburn   641:      <option value="-1">&lt;--- Set type&nbsp; 
                    642:     </select>&nbsp;
                    643:   </td>
1.15      raeburn   644:   <td align="left" valign="top">&nbsp;
                    645:     <select name="ansr_'.$i.'">
1.1       raeburn   646:      <option value="-1">&lt;--- Set type&nbsp;
                    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)" /> &nbsp;
                    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].':&nbsp;<a href="'.$webpath.$qn_file[$i].'">'.
                   1120:                           $qn_file[$i].'</a></b><br />'."\n";
                   1121:             } elsif ($result[$i] eq 'failed') {
                   1122:                 $failures .= $numid[$i].':&nbsp;'.$qn_file[$i].'<br />'."\n";
                   1123:             } elsif ($result[$i] eq 'exists') {
                   1124:                 $existing .= '<b>'.$numid[$i].':&nbsp;<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>&nbsp;</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 {
1.45    ! raeburn  1511:         if (open(PROB,">",$destdir.$libfile)) {
1.15      raeburn  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 {
1.45    ! raeburn  1589:          if (open(PROB,">",$destdir.$libfile)) {
1.15      raeburn  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:').
1.44      bisitz   1620:               '<ul>'.
                   1621:               '<li>'.&mt('plain text').'</li>'.
                   1622:               '<li>'.&mt('RTF').'</li>'.
                   1623:               '<li>'.&mt('HTML').'</li></ul>'.
1.17      raeburn  1624:               &mt('The file type identified for the file you uploaded is [_1].','<b>'.$res.'</b>').'</p>');
1.33      raeburn  1625:     $r->print(&page_footer($env{'form.newdir'},$fn,$current_page,$webpath,undef,'badfile').
1.17      raeburn  1626:              '</form>');
                   1627:     return;
1.15      raeburn  1628: }
                   1629: 
                   1630: sub parse_datafile {
1.33      raeburn  1631:     my ($r,$filename,$dirpath,$webpath,$page_name,$subdir,$timestamp) = @_;
1.15      raeburn  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') {
1.45    ! raeburn  1639:                 open(TESTBANK,"<",$dirpath.$filename);
1.15      raeburn  1640:                 @{$text} = <TESTBANK>;
                   1641:                 close(TESTBANK);
                   1642:             } elsif ($res eq 'application/rtf') {
                   1643:                 my $html = '';
1.18      raeburn  1644:                 my $image_uri = $timestamp;
1.15      raeburn  1645:                 if ($page_name eq 'Target') {
1.33      raeburn  1646:                     $image_uri = "$webpath/$timestamp";
1.15      raeburn  1647:                 }
                   1648:                 my $image_dir;
                   1649:                 if ($page_name eq 'Blocks') {
                   1650:                     $image_dir = $dirpath;
                   1651:                     $image_dir =~ s/\/$//;
1.18      raeburn  1652:                     $image_dir .= '/'.$timestamp;
                   1653:                     if (!-e $image_dir) {
                   1654:                         mkdir($image_dir,0755);
                   1655:                     }
1.15      raeburn  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) = 
1.18      raeburn  1674:                     &parse_htmlcontent($res,$subdir,$html,undef,$page_name);
1.15      raeburn  1675:             } elsif ($res eq 'text/html') {
                   1676:                 ($text,$header,$css,$js) = 
1.18      raeburn  1677:                     &parse_htmlcontent($res,$subdir,undef,$dirpath.$filename,$page_name);
1.15      raeburn  1678:             } else {
                   1679:                 $badfile = 1;
                   1680:             }
                   1681:         }
                   1682:     }
                   1683:     return ($res,$badfile,$text,$header,$css,$js,\%allfiles,\%codebase);
                   1684: }
                   1685: 
                   1686: sub parse_htmlcontent {
1.18      raeburn  1687:     my ($res,$subdir,$html,$fullpath,$page_name) = @_;
1.15      raeburn  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 '')) {
1.18      raeburn  1725:                             if (($res eq 'text/html') || 
                   1726:                                 ($res eq 'application/rtf') && ($page_name ne 'Target')) {
                   1727:                                 $contents =~ s/(src=\s*["']?)/$1..\//i;
                   1728:                             }
1.15      raeburn  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 {
1.33      raeburn  1784:     my ($webpath,$item) = @_;
                   1785:     $item =~ s/(<img[^>]+src=["']?\s*)(\.?\.?\/?)/$1$webpath/gsi;
                   1786:     return $item;
1.15      raeburn  1787: }
                   1788: 
                   1789: sub print_header {
1.26      raeburn  1790:     my ($uname,$udom,$javascript,$loadentries,$title,$current_page,$pagesref,
                   1791:         $namesref) = @_;
1.34      raeburn  1792:     my $brcrum = [{'href' => &Apache::loncommon::authorspace("/priv/$udom/$uname/"),
1.39      raeburn  1793:                    'text' => 'Authoring Space'}];
1.26      raeburn  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:     }
1.15      raeburn  1816:     my $output = &Apache::loncommon::start_page($title,$javascript,
1.26      raeburn  1817:                                              {'bread_crumbs' => $brcrum,
                   1818:                                               'add_entries' => $loadentries});
1.15      raeburn  1819:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.28      www      1820:         $output .= '<p class="LC_info">'
1.24      bisitz   1821:                  .&mt('Co-Author [_1]',$uname.':'.$udom)
1.20      bisitz   1822:                  .'</p>';
1.15      raeburn  1823:     }
                   1824:     return $output;
                   1825: }
                   1826: 
1.1       raeburn  1827: # ---------------------------------------------------------------- Main Handler
                   1828: sub handler {
                   1829:     my $r=shift;
1.15      raeburn  1830: 
1.33      raeburn  1831:     my $fn=$env{'form.filename'};
                   1832: 
                   1833:     if ($env{'form.filename1'}) {
                   1834:        $fn=$env{'form.filename1'}.$env{'form.filename2'};
1.1       raeburn  1835:     }
1.33      raeburn  1836:     $fn=~s{\+}{}g;
1.15      raeburn  1837: 
1.33      raeburn  1838:     unless ($fn) {
1.6       albertel 1839:         $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.1       raeburn  1840:                        ' unspecified filename for upload', $r->filename);
                   1841:         return HTTP_NOT_FOUND;
                   1842:     }
                   1843: 
1.35      raeburn  1844:     my ($uname,$udom) = &Apache::lonnet::constructaccess($fn);
1.33      raeburn  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 = '';
1.39      raeburn  1855:     my $title = 'Upload testbank questions to Authoring Space';
1.33      raeburn  1856: 
1.1       raeburn  1857: # ----------------------------------------------------------- Start page output
                   1858:     &Apache::loncommon::content_type($r,'text/html');
                   1859:     $r->send_http_header;
                   1860: 
1.33      raeburn  1861:     my ($filename,$webpath) = &File::Basename::fileparse($fn);
1.31      www      1862:     my $dirpath = $r->dir_config('lonDocRoot').$webpath;
1.26      raeburn  1863:     my ($res,$subdir,$badfile,$textref,$header,$css,$js,%loadentries,@pages,%names);
1.15      raeburn  1864: 
1.6       albertel 1865:     if ($env{'form.phase'} eq 'three') {
1.1       raeburn  1866:         $current_page = &display_control();
1.26      raeburn  1867:         @pages = ('Welcome','Blocks','Format','Target','Confirmation');
1.44      bisitz   1868:         %names = &Apache::lonlocal::texthash(
1.26      raeburn  1869:                    Welcome      => 'Testbank Format',
                   1870:                    Blocks       => 'Classification',
                   1871:                    Format       => 'Selection',
                   1872:                    Target       => 'Result'
                   1873:         );
1.15      raeburn  1874:         $page_name = $pages[$current_page];
1.18      raeburn  1875:         if ($env{'form.timestamp'} eq '') {
                   1876:             $env{'form.timestamp'} = time; 
                   1877:         }
1.15      raeburn  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) = 
1.33      raeburn  1884:             &parse_datafile($r,$filename,$dirpath,$webpath,$page_name,
                   1885:                             $subdir,$env{'form.timestamp'});
1.15      raeburn  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:             }
1.1       raeburn  1892:             &jscript_one(\$javascript);
1.15      raeburn  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);
1.1       raeburn  1898:  	    &jscript_two(\$javascript,$qcount);
1.15      raeburn  1899:         } elsif ($page_name eq 'Target') {
1.6       albertel 1900:              if ($env{'form.go'} eq "PreviousPage") {
1.10      albertel 1901:                  $loadentries{'onload'} = "setElements()";
1.1       raeburn  1902:  	     }
1.15      raeburn  1903: 	     &jscript_three($webpath,\$javascript);
1.1       raeburn  1904:         } elsif ($page_name eq 'Confirmation') {
1.15      raeburn  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:             }
1.1       raeburn  1913:         }
1.8       albertel 1914:     }
                   1915: 
1.26      raeburn  1916:     $r->print(&print_header($uname,$udom,$javascript,\%loadentries,$title,
1.27      raeburn  1917:                             $current_page,\@pages,\%names));
1.1       raeburn  1918: 
1.27      raeburn  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);
1.33      raeburn  1927:             &display_zero($r,$fn,$current_page,$webpath);
1.27      raeburn  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">'.
1.33      raeburn  1936:                               &page_footer('',$fn).'</form>');
1.27      raeburn  1937:                 }
                   1938:             }
1.15      raeburn  1939:         }
1.1       raeburn  1940:         if ($badfile) {
1.33      raeburn  1941:             &file_error($r,$fn,$current_page,$webpath,$res);
1.27      raeburn  1942:         } else {
1.33      raeburn  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';
1.1       raeburn  1948:         }
1.6       albertel 1949:     } elsif ($env{'form.phase'} eq 'two') {
1.33      raeburn  1950:         my ($result,$flag) = &Apache::lonupload::phasetwo($r,$fn,'testbank');
1.15      raeburn  1951:         $r->print($result);
1.1       raeburn  1952:         if ($flag eq 'ok') {
1.29      raeburn  1953:             my $current_page = 0;
1.15      raeburn  1954:             my $js;
                   1955:             &jscript_zero($webpath,\$js);
                   1956:             $js = '<script type="text/javascript">'."\n$js\n".'</script>';
                   1957:             $r->print($js);
1.33      raeburn  1958:             &display_zero($r,$fn,$current_page,$webpath);
1.15      raeburn  1959:         } elsif ($flag eq 'embedded') {
                   1960:             $r->print($js.'<form name="testbankForm" method="post" action="/adm/testbank">'.
1.33      raeburn  1961:                       &page_footer('',$fn).'</form>');
1.1       raeburn  1962:         }
                   1963:     } else {
1.41      raeburn  1964:         &Apache::lonupload::phaseone($r,$fn,'testbank',$uname,$udom);
1.1       raeburn  1965:     }
1.8       albertel 1966:     $r->print(&Apache::loncommon::end_page());
1.1       raeburn  1967:     return OK;
                   1968: }
1.15      raeburn  1969: 
1.1       raeburn  1970: 1;
                   1971: __END__
                   1972: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>