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

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

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