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

1.3       albertel    1: # Handler for parsing text upload problem descriptions into .problems
1.33    ! raeburn     2: # $Id: testbankimport.pm,v 1.32 2011/10/31 01:25:32 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.33    ! raeburn   488:     my ($r,$fn,$page,$webpath) = @_;
1.15      raeburn   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.33    ! raeburn   515:        &page_footer($env{'form.newdir'},$fn,$page,$webpath).'
1.15      raeburn   516:        </form>');
1.1       raeburn   517: }
                    518: 
                    519: # ---------------------------------------------------------------- Display One
                    520: 
                    521: sub display_one {
1.33    ! raeburn   522:     my ($r,$fn,$page,$textref,$header) = @_;
1.15      raeburn   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 />'.
1.33    ! raeburn   569:              &page_footer($env{'form.newdir'},$fn,$page).'
1.15      raeburn   570:  </form>');
                    571:     return;
1.1       raeburn   572: }
                    573: 
                    574: # ---------------------------------------------------------------- Display Two
                    575: 
                    576: sub display_two {
1.33    ! raeburn   577:     my ($r,$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.'" />'.
1.33    ! raeburn   661:            &page_footer($env{'form.newdir'},$fn,$page).'
1.15      raeburn   662: </form>');
                    663:     return;
                    664: }
                    665: 
1.1       raeburn   666: # ---------------------------------------------------------------- Display Three
1.15      raeburn   667: sub display_three {
1.33    ! raeburn   668:     my ($r,$fn,$page,$textref,$res,$header,$webpath,$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') {
1.33    ! raeburn   718:                 $showheader = &build_image_url($webpath,$showheader);
1.15      raeburn   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') {
1.33    ! raeburn   767:                                         $showqn = &build_image_url($webpath,$showqn);
1.15      raeburn   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') {
1.33    ! raeburn   811:                                         $showfoil = &build_image_url($webpath,$showfoil);
1.15      raeburn   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:     }
1.33    ! raeburn   862:     $r->print('</p>'.&page_footer($env{'form.newdir'},$fn,$page).'
1.15      raeburn   863:               </form>');
1.1       raeburn   864: }
                    865: 
                    866: # ---------------------------------------------------------------- Final Display
                    867: sub final_display {
1.33    ! raeburn   868:     my ($r,$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>'.
1.33    ! raeburn  1045:                   &page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).'</form>');
1.15      raeburn  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:         }
1.33    ! raeburn  1133:         $r->print(&page_footer($env{'form.newdir'},$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>'.
1.33    ! raeburn  1137:                   &page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).'</form>');
1.15      raeburn  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 {
1.33    ! raeburn  1162:     my ($newdir,$fn,$page,$webpath,$subdir,$state) = @_;
1.15      raeburn  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="filename" value="'.$fn.'" />
                   1188:        <input type="hidden" name="page" value="'.$page.'" />
                   1189:        <input type="hidden" name="phase" value="three" />
1.18      raeburn  1190:        <input type="hidden" name="go" value="'.$go.'" />
                   1191:        <input type="hidden" name="timestamp" value="'.$env{'form.timestamp'}.'" />';
1.15      raeburn  1192:     if ($page ne '') {
                   1193:         $output .= '
                   1194:        <table border="0">
                   1195:         <tr>
                   1196:          <td>
                   1197:           <input type="button" name="backpage" value="'.$prevval.'" onclick="'.$prevclick.'" />
                   1198:          </td>';
1.17      raeburn  1199:         if (($page < 4) && ($state ne 'badfile'))  {
1.15      raeburn  1200:             $output .= '
                   1201:          <td>&nbsp;</td>
                   1202:          <td>
1.21      bisitz   1203:           <input type="button" name="nextpage" value="'.$nextval.'" onclick="'.$nextclick.'" />
1.15      raeburn  1204:          </td>';
                   1205:         }
                   1206:         $output .= '    </tr>
                   1207:        </table>
                   1208: ';
                   1209:     }
                   1210:     return $output;
1.1       raeburn  1211: }
                   1212: 
                   1213: sub question_count {
                   1214:     my ($qnumformat,$textref) = @_;
                   1215:     my $text_in = join "\n", @{$textref};
                   1216:     $text_in = "\n ".$text_in;
                   1217:     my $qpattern ='';
                   1218:     if ($qnumformat eq "period") {
                   1219:         $qpattern = '\d{1,}\.';
                   1220:     } elsif ($qnumformat eq "paren") {
                   1221:         $qpattern = '\(\d{1,}\)';
                   1222:     } elsif ($qnumformat eq "number") {
                   1223:         $qpattern = '\d{1,}';
                   1224:     } elsif ($qnumformat eq "leadparen") {
                   1225:         $qpattern = '\(\d{1,}';
                   1226:     } elsif ($qnumformat eq "trailparen") {
                   1227:         $qpattern = '\d{1,}\)';
                   1228:     }
                   1229:     my @questions = split/[\r\n\f]+\s?$qpattern\s?/,$text_in;
                   1230:     my $qcount = scalar(@questions);
                   1231:     $qcount = $qcount/2;
                   1232:     $qcount = int($qcount);
                   1233:     return $qcount;
                   1234: }
                   1235: 
1.15      raeburn  1236: sub get_constants {
                   1237:     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");
                   1238:     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");
                   1239:     return (\@alphabet,\@romans);
                   1240: }
                   1241: 
1.1       raeburn  1242: sub file_split {
                   1243:     my ($startsref,$endsref,$numsref,$qnumformat,$foilsref,$textref,$multpartsref,$numitems,$qtyperef,$blocks) = @_;
                   1244:     my $text_in = join "\n", @{$textref};
                   1245:     $text_in = "\n ".$text_in;
                   1246:     my $dignum = length($numitems);
1.15      raeburn  1247:     my ($qpatst,$qpatend,$numpat,@questions,@qids);
                   1248:     my $numpat = '\d{1';
1.1       raeburn  1249:     if ($dignum > 1) {
1.15      raeburn  1250:         $numpat .= ','.$dignum.'}';
1.1       raeburn  1251:     } else {
1.15      raeburn  1252:         $numpat .= '}';
1.1       raeburn  1253:     }
                   1254:     if ($qnumformat eq "period") {
1.15      raeburn  1255:         $qpatend = '\.'; 
1.1       raeburn  1256:     } elsif ($qnumformat eq "paren") {
1.15      raeburn  1257:         $qpatst = '\(';
                   1258:         $qpatend = '\)';
1.1       raeburn  1259:     } elsif ($qnumformat eq "leadparen") {
1.15      raeburn  1260:         $qpatst = '\(';
1.1       raeburn  1261:     } elsif ($qnumformat eq "trailparen") {
1.15      raeburn  1262:         $qpatend = '\)';
1.1       raeburn  1263:     }
1.15      raeburn  1264:     my @lines = split/[\r\n\f]+\s*$qpatst($numpat)$qpatend\s*/,$text_in;
1.1       raeburn  1265: # my @questions = split/\n\s\d{1,3}\.\s/,$text_in;
1.15      raeburn  1266:     shift(@lines);
                   1267:     for (my $i=0; $i<@lines; $i++) {
                   1268:         if ($i%2) {
                   1269:             push(@questions,$lines[$i]);
                   1270:         } else {
                   1271:             push(@qids,$lines[$i]);
                   1272:         }
                   1273:     }
1.1       raeburn  1274:     my %multparts = ();
                   1275:     for (my $i=0; $i<$blocks; $i++) {
                   1276:         if (${$numsref}[$i] > 0) {
1.14      raeburn  1277:             if ((${$qtyperef}[$i] eq "MC") || (${$qtyperef}[$i] eq "MA") || (${$qtyperef}[$i] eq "Ord")) {
1.1       raeburn  1278:                 my $splitstr = '';
                   1279:                 if (${$foilsref}[$i] eq "lcperiod") {
                   1280:                     $splitstr = '[a-z]\.';
                   1281:                 } elsif (${$foilsref}[$i] eq "lcparen") {
                   1282:                     $splitstr = '\([a-z]\)';
1.5       raeburn  1283:                 } elsif (${$foilsref}[$i] eq "lconeparen") {
                   1284:                     $splitstr = '[a-z]\)';
                   1285:                 } elsif (${$foilsref}[$i] eq "lcdotparen") {
                   1286:                     $splitstr = '[a-z]\.\)';
1.1       raeburn  1287:                 } elsif (${$foilsref}[$i] eq "ucperiod") {
                   1288:                     $splitstr = '[A-Z]\.';
                   1289:                 } elsif (${$foilsref}[$i] eq "ucparen") {
                   1290:                     $splitstr = '\([A-Z]\)';
1.5       raeburn  1291:                 } elsif (${$foilsref}[$i] eq "uconeparen") {
                   1292:                     $splitstr = '[A-Z]\)';
                   1293:                 } elsif (${$foilsref}[$i] eq "ucdotparen") {
                   1294:                     $splitstr = '[A-Z]\.\)';
1.1       raeburn  1295:                 } elsif (${$foilsref}[$i] eq "romperiod") {
                   1296:                     $splitstr = '[ivx]+\.';
                   1297:                 } elsif (${$foilsref}[$i] eq "romparen") {
                   1298:                     $splitstr = '\([ivx]+\)';
1.5       raeburn  1299:                 } elsif (${$foilsref}[$i] eq "romoneparen") {
                   1300:                     $splitstr = '[ivx]+\)';
                   1301:                 } elsif (${$foilsref}[$i] eq "romdotparen") {
                   1302:                     $splitstr = '[ivx]+\.\)';
1.1       raeburn  1303:                 }
                   1304:                 for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
1.5       raeburn  1305:                     @{$multparts{$j}} = split/[\r\n\f]+\s*$splitstr\s*/,$questions[$j];
1.1       raeburn  1306:                     chomp(@{$multparts{$j}});
                   1307:                 }
                   1308:             } elsif (${$qtyperef}[$i] eq "FIB") { 
                   1309:                 for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
                   1310:                     @{$multparts{$j}} = ("$questions[$j]");
                   1311:                 }
                   1312:             }
                   1313:         }
1.15      raeburn  1314:     }
                   1315:     my ($lastanswer,$footer) = ($questions[-1] =~ /^([,\r\n\f\t\s().A-Za-z]+)(.+)$/);
                   1316:     if ($footer ne '') {
                   1317:         $questions[-1] = $lastanswer;
                   1318:     }
1.1       raeburn  1319:     %{$multpartsref} = %multparts;
1.15      raeburn  1320:     return (\@questions,\@qids,$footer);
1.1       raeburn  1321: }
                   1322:  
                   1323: # create_mcq builds an MC, MA, Ord or FIB question
                   1324: 
                   1325: sub create_mcq {
1.15      raeburn  1326:     my ($destdir,$subdir,$qstnref,$answerref,$qtype,$libfile,$res,$header,$footer,$js,$css) = @_;
                   1327: 
1.1       raeburn  1328:     my $qstn = ${$qstnref}[0];
                   1329:     my $numfoils = scalar(@{$qstnref}) - 1; 
                   1330:     my $datestamp = localtime;
                   1331:     my $numansrs = scalar(@{$answerref});
1.30      raeburn  1332:     my $output = '<problem>';
                   1333:     if ($qtype eq 'MC') {
                   1334:         $output .= "\n".'<parameter name="maxtries" type="int_pos" default="2" description="Maximum Number of Tries" />';
                   1335:     }
                   1336:     $output .= '
1.15      raeburn  1337:  <startouttext />';
                   1338:     if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1339:         if ($header ne '') {
                   1340:             $output .= &HTML::Entities::decode($header);
                   1341:         }
                   1342:         if ($js ne '') {
                   1343:             $output .= &HTML::Entities::decode($js);
                   1344:         }
                   1345:         if ($css ne '') {
                   1346:             $output .= &HTML::Entities::decode($css);
                   1347:         }
                   1348:         $qstn = &HTML::Entities::decode($qstn);
                   1349:     }
                   1350:     $output .= $qstn.'<endouttext />'."\n";
1.1       raeburn  1351:     if ($qtype eq "MA") {
                   1352:         $output .= qq|
                   1353:    <optionresponse max="$numfoils" randomize="yes">
                   1354:     <foilgroup options="('True','False')">
                   1355:         |;
                   1356:         for (my $k=0; $k<@{$qstnref}-1; $k++) {
                   1357:             $output .= "   <foil name=\"foil".$k."\" value=\"";
                   1358:             if (grep/^$k$/,@{$answerref}) {
                   1359:                 $output .= "True\" location=\"random\"";
                   1360:             } else {
                   1361:                 $output .= "False\" location=\"random\"";
                   1362:             }
1.15      raeburn  1363:             my $showfoil = ${$qstnref}[$k+1];
                   1364:             if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1365:                 $showfoil = &HTML::Entities::decode($showfoil);
                   1366:             }
                   1367:             $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1       raeburn  1368:         }
                   1369:         chomp($output);
                   1370:         $output .= qq|
                   1371:     </foilgroup>
1.15      raeburn  1372:    </optionresponse>|;
1.1       raeburn  1373:     }
                   1374:     if ($qtype eq "MC") {
                   1375:         $output .= qq|
                   1376:    <radiobuttonresponse max="$numfoils" randomize="yes">
                   1377:     <foilgroup>
                   1378:         |;
                   1379:         for (my $k=0; $k<@{$qstnref}-1; $k++) {
                   1380:             $output .= "   <foil name=\"foil".$k."\" value=\"";
                   1381:             if (grep/^$k$/,@{$answerref}) {
                   1382:                 $output .= "true\" location=\"";
                   1383:             } else {
                   1384:                 $output .= "false\" location=\"";
                   1385:             }
                   1386:             if (lc (${$qstnref}[$k+1]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) { 
                   1387:                 $output .= "bottom\"";
                   1388:             } else {
                   1389:                 $output .= "random\"";
                   1390:             }
1.15      raeburn  1391:             my $showfoil = ${$qstnref}[$k+1];
                   1392:             if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1393:                 $showfoil = &HTML::Entities::decode($showfoil);
                   1394:             }
                   1395:             $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1       raeburn  1396:         }
                   1397:         chomp($output);
                   1398:         $output .= qq|
                   1399:     </foilgroup>
1.15      raeburn  1400:    </radiobuttonresponse>|;
1.1       raeburn  1401:     }
                   1402:     if ($qtype eq "Ord") {
                   1403:         $output .= qq|
                   1404:    <rankresponse max="$numfoils" randomize="yes">
                   1405:     <foilgroup>
                   1406:         |;
                   1407:         for (my $k=0; $k<@{$qstnref}-1; $k++) {
1.14      raeburn  1408:             my $ansval;
                   1409:             my $num = 0;
                   1410:             for (my $i=0; $i<@{$answerref}; $i++) {
                   1411:                 if ($$answerref[$i] =~ /=/) {
                   1412:                     my @tied = split(/=/,$$answerref[$i]);
                   1413:                     foreach my $tie (@tied) {
                   1414:                         if ($k == $tie) {
                   1415:                             $ansval = $num + 1;
                   1416:                             last;
                   1417:                         }
                   1418:                     }
                   1419:                     $num += scalar(@tied);
                   1420:                 } elsif ($k == $$answerref[$i]) {
                   1421:                     $ansval = $num + 1;
                   1422:                     last;
                   1423:                 } else {
                   1424:                     $num ++;
                   1425:                 }
                   1426:             }
1.15      raeburn  1427:             my $showfoil = ${$qstnref}[$k+1];
                   1428:             if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1429:                 $showfoil = &HTML::Entities::decode($showfoil);
                   1430:             }
                   1431:             $output .= "   <foil location=\"random\" name=\"foil".$k."\" value=\"".$ansval."\"><startouttext />$showfoil<endouttext /></foil>\n";
1.1       raeburn  1432:         }
                   1433:         chomp($output);
                   1434:         $output .= qq|
                   1435:     </foilgroup>
1.15      raeburn  1436:    </rankresponse>|;
1.1       raeburn  1437:     }
                   1438:     if ($qtype eq "FIB") {
                   1439:         my $numerical = 1;
                   1440:         for (my $i=0; $i<@{$answerref}; $i++) {
                   1441:             if (${$answerref}[$i] =~ m/([^\d\.]|\.\.)/) {
                   1442:                 $numerical = 0;
                   1443:             }
                   1444:         }
                   1445:         if ($numerical) {
                   1446:             my $numans;
                   1447:             my $tol;
                   1448:             if (@{$answerref} == 1) {
                   1449:                 $tol = 5;
                   1450:                 $numans = $$answerref[0];
                   1451:             } else {
1.2       raeburn  1452:                 my $min = $$answerref[0];
                   1453:                 my $max = $$answerref[0];    
                   1454:                 for (my $i=1; $i<@{$answerref}; $i++) {
                   1455:                     if ($$answerref[$i]<=$min) {
1.1       raeburn  1456:                         $min = $$answerref[$i];
1.2       raeburn  1457:                     } elsif ($$answerref[$i] >= $max) {
1.1       raeburn  1458:                         $max = $$answerref[$i];
                   1459:                     }
                   1460:                 }
                   1461:                 $numans = ($max + $min)/2;
                   1462:                 $tol = 100*($max - $min)/($numans*2); 
                   1463:             }
                   1464:             $output .= qq|
                   1465: <numericalresponse answer="$numans">
                   1466: 	<responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
                   1467: 	<responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures" />
                   1468: 	<textline />
1.15      raeburn  1469: </numericalresponse>|;
1.1       raeburn  1470:         } else {
                   1471:             if (@{$answerref} == 1) {
                   1472:                 $output .= qq|
                   1473: <stringresponse answer="$$answerref[0]" type="ci">
                   1474: <textline>
                   1475: </textline>
1.15      raeburn  1476: </stringresponse>|;
1.1       raeburn  1477:             } else {
                   1478:                 for (my $i=0; $i<@{$answerref}; $i++) {
                   1479:                     ${$answerref}[$i] =~ s/\|/\|/g;
                   1480:                 }
                   1481:                 my $regexpans = join('|',@{$answerref});
                   1482:                 $regexpans = '/('.$regexpans.')/'; 
                   1483:                 $output .= qq|
                   1484: <stringresponse answer="$regexpans" type="re">
                   1485: <textline>
                   1486: </textline>
1.15      raeburn  1487: </stringresponse>|;
1.1       raeburn  1488:             }
                   1489:         }
                   1490:     }
1.15      raeburn  1491:     if ($footer ne '') {
                   1492:         $output .= '<startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
                   1493:     }
                   1494:     $output .= qq|
                   1495:   </problem>
                   1496: |;
                   1497:     my $result;
                   1498:     if (-e $destdir.$libfile) {
                   1499:         $result = 'exists';
                   1500:     } else {
                   1501:         if (open(PROB,">$destdir$libfile")) {
                   1502:             print PROB $output;
                   1503:             close(PROB);
                   1504:             $result = 'ok';
                   1505:         } else {
                   1506:             $result = 'failed';
                   1507:         } 
                   1508:     }
                   1509:     return ($result,$subdir.$libfile);
1.1       raeburn  1510: }
                   1511: 
                   1512: # create_ess builds an essay or True/False question
                   1513: 
                   1514: sub create_ess {
1.15      raeburn  1515:     my ($destdir,$subdir,$answer_id,$qstn,$answertxt,$qtype,$libfile,$res,$header,
                   1516:         $footer,$js,$css) = @_;
                   1517:     my $output = '<problem>
                   1518:  <startouttext />';
                   1519:     if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1520:         if ($header ne '') {
                   1521:             $output .= &HTML::Entities::decode($header);
                   1522:         }
                   1523:         if ($js ne '') {
                   1524:             $output .= &HTML::Entities::decode($js);
                   1525:         }
                   1526:         if ($css ne '') {
                   1527:             $output .= &HTML::Entities::decode($css);
                   1528:         }
                   1529:         $qstn = &HTML::Entities::decode($qstn);
                   1530:         $answertxt = &HTML::Entities::decode($answertxt);
                   1531:     }
                   1532:     $output .= $qstn.'<endouttext />';
1.1       raeburn  1533:     my $answer = '';
                   1534:     my $answerlog = '';
                   1535:     if ($qtype eq "Ess") {
1.15      raeburn  1536:         $output .= '
1.1       raeburn  1537:    <essayresponse>
                   1538:    <textfield></textfield>
                   1539:    </essayresponse>
                   1540:    <postanswerdate>
1.13      raeburn  1541:     <startouttext />
1.15      raeburn  1542:    '.$answertxt
                   1543:    .'<endouttext />
                   1544:    </postanswerdate>';
1.1       raeburn  1545:     } elsif ($qtype eq "TF") {
                   1546:          $answer = $answer_id;
                   1547:          $output .= qq|
                   1548:    <radiobuttonresponse max="2" randomize="yes">
                   1549:     <foilgroup>
                   1550:          |;
                   1551:          $output .= "   <foil name=\"foil0\" value=\"true\" location=\"random\"><startouttext />";
                   1552:          if ($answer_id) {
                   1553:               $output .= "False";
                   1554:          } else {
                   1555:               $output .= "True";
                   1556:          }
                   1557:          $output .= "<endouttext /></foil>\n";
                   1558:          $output .= "   <foil name=\"foil1\" value=\"false\" location=\"random\"><startouttext />";
                   1559:          if ($answer_id) {
                   1560:               $output .= "True";
                   1561:          } else {
                   1562:               $output .= "False";
                   1563:          }
1.15      raeburn  1564:          $output .= '<endouttext /></foil>
1.1       raeburn  1565:     </foilgroup>
1.15      raeburn  1566:    </radiobuttonresponse>';
1.1       raeburn  1567:      }
1.15      raeburn  1568:      if ($footer ne '') {
                   1569:         $output .= '
                   1570: <startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
                   1571:      }
                   1572:      $output .= '
                   1573:   </problem>
                   1574: ';
                   1575:      my $result;
                   1576:      if (-e $destdir.$libfile) {
                   1577:          $result = 'exists';
                   1578:      } else {
                   1579:          if (open(PROB,">$destdir$libfile")) {
                   1580:              print PROB $output;
                   1581:              close(PROB);
                   1582:          } else {
                   1583:              $result = 'failed';
                   1584:          }
                   1585:      }
                   1586:      return ($result,$subdir.$libfile);
                   1587: }
                   1588: 
                   1589: sub probfile_name {
                   1590:     my ($j) = @_;
                   1591:     my $libfile = &HTML::Entities::decode($env{'form.probfile_'.$j});
                   1592:     my $qnum = $j + 1;
                   1593:     if ($libfile eq '') {
                   1594:         if (length($qnum) == 1) {
                   1595:             $qnum = "00".$qnum;
                   1596:         } elsif (length($qnum) == 2) {
                   1597:             $qnum = "0".$qnum;
                   1598:         }
                   1599:         $libfile = 'testbank_question_'.$qnum;
                   1600:         $libfile .= '.problem';
                   1601:     }
                   1602:     return $libfile;
1.1       raeburn  1603: }
                   1604: 
                   1605: sub file_error {
1.33    ! raeburn  1606:     my ($r,$fn,$current_page,$webpath,$res) = @_;
1.17      raeburn  1607:     $r->print('<p><form name="display" method="post" action="/adm/testbank">'.&mt('The file you uploaded does not appear to be in the correct format.').
                   1608:               '</p><p>'.&mt('Extraction of questions is only possible for the following file types:').
                   1609:               '<ul><li>'.&mt('plain text').'</li><li>RTF</li><li>HTML</li></ul>'.
                   1610:               &mt('The file type identified for the file you uploaded is [_1].','<b>'.$res.'</b>').'</p>');
1.33    ! raeburn  1611:     $r->print(&page_footer($env{'form.newdir'},$fn,$current_page,$webpath,undef,'badfile').
1.17      raeburn  1612:              '</form>');
                   1613:     return;
1.15      raeburn  1614: }
                   1615: 
                   1616: sub parse_datafile {
1.33    ! raeburn  1617:     my ($r,$filename,$dirpath,$webpath,$page_name,$subdir,$timestamp) = @_;
1.15      raeburn  1618:     my ($badfile,$res,%allfiles,%codebase);
                   1619:     my $mm = new File::MMagic;
                   1620:     my ($text,$header,$css,$js);
                   1621:     if (-e "$dirpath") {
                   1622:         $res = $mm->checktype_filename($dirpath.$filename);
                   1623:         if ($env{'form.phase'} eq 'three') {          
                   1624:             if ($res eq 'text/plain') {
                   1625:                 open(TESTBANK,"<$dirpath$filename");
                   1626:                 @{$text} = <TESTBANK>;
                   1627:                 close(TESTBANK);
                   1628:             } elsif ($res eq 'application/rtf') {
                   1629:                 my $html = '';
1.18      raeburn  1630:                 my $image_uri = $timestamp;
1.15      raeburn  1631:                 if ($page_name eq 'Target') {
1.33    ! raeburn  1632:                     $image_uri = "$webpath/$timestamp";
1.15      raeburn  1633:                 }
                   1634:                 my $image_dir;
                   1635:                 if ($page_name eq 'Blocks') {
                   1636:                     $image_dir = $dirpath;
                   1637:                     $image_dir =~ s/\/$//;
1.18      raeburn  1638:                     $image_dir .= '/'.$timestamp;
                   1639:                     if (!-e $image_dir) {
                   1640:                         mkdir($image_dir,0755);
                   1641:                     }
1.15      raeburn  1642:                 } else {
                   1643:                     $image_dir = $r->dir_config('lonDaemons').'/tmp/'.
                   1644:                                  $env{'user.name'}.'_'.$env{'user.domain'}.
                   1645:                                  '_rtfupload_'.$filename.'_'.time.'_'.$$;
                   1646:                    if (!-e $image_dir) {
                   1647:                        mkdir($image_dir,0755);
                   1648:                    }
                   1649:                 }
                   1650:                 my $parser = RTF::HTMLConverter->new (
                   1651:                                   in                => $dirpath.$filename,
                   1652:                                   out               => \$html,
                   1653:                                   DOMImplementation => 'XML::DOM',
                   1654:                                   image_uri         => $image_uri,
                   1655:                                   image_dir         => $image_dir,
                   1656:                              );
                   1657:                 $parser->parse();
                   1658:                 utf8::decode($html);
                   1659:                 ($text,$header,$css,$js) = 
1.18      raeburn  1660:                     &parse_htmlcontent($res,$subdir,$html,undef,$page_name);
1.15      raeburn  1661:             } elsif ($res eq 'text/html') {
                   1662:                 ($text,$header,$css,$js) = 
1.18      raeburn  1663:                     &parse_htmlcontent($res,$subdir,undef,$dirpath.$filename,$page_name);
1.15      raeburn  1664:             } else {
                   1665:                 $badfile = 1;
                   1666:             }
                   1667:         }
                   1668:     }
                   1669:     return ($res,$badfile,$text,$header,$css,$js,\%allfiles,\%codebase);
                   1670: }
                   1671: 
                   1672: sub parse_htmlcontent {
1.18      raeburn  1673:     my ($res,$subdir,$html,$fullpath,$page_name) = @_;
1.15      raeburn  1674:     my ($p,$fh);
                   1675:     if ($res eq 'application/rtf') {
                   1676:         $p = HTML::TokeParser->new( \$html );
                   1677:     } elsif ($res eq 'text/html') {
                   1678:         open($fh, "<:utf8", $fullpath);
                   1679:         $p = HTML::TokeParser->new( $fh );
                   1680:     }
                   1681:     my ($current_tag,$line,@text,$header,$css,$js,$have_header,$delayed);
                   1682:     while (my $token = $p->get_token) {
                   1683:         if (ref($token) eq 'ARRAY') {
                   1684:             if ($token->[0] eq 'S') {
                   1685:                 if ($delayed ne '') {
                   1686:                     $line.= $delayed;
                   1687:                     $delayed = '';
                   1688:                 }
                   1689:                 $current_tag = $token->[1];
                   1690:                 next if ($token->[1] eq 'html' || $token->[1] eq 'head' || $token->[1] eq 'body' || $token->[1] eq 'meta' || $token->[1] eq 'title');
                   1691:                 if ($token->[1] eq 'p') {
                   1692:                     $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
                   1693:                     if (!$have_header) {
                   1694:                         $header = $line;
                   1695:                         if ($header ne '') {
                   1696:                             $header =~ s/\s*[\n\r\f]+/\n/gs;
                   1697:                         }
                   1698:                         $have_header = 1;
                   1699:                     } else {
                   1700:                         push(@text,$line);
                   1701:                     }
                   1702:                     $line = '';
                   1703:                 } elsif ($current_tag eq 'style') {
                   1704:                     $css .= $token->[4];
                   1705:                 } elsif ($current_tag eq 'script') {
                   1706:                     $js .= $token->[4];
                   1707:                 } else {
                   1708:                     my $contents = $token->[4];
                   1709:                     if ($subdir ne '') {
                   1710:                         if (($token->[1] eq 'img') && ($token->[2]->{'src'} ne '')) {
1.18      raeburn  1711:                             if (($res eq 'text/html') || 
                   1712:                                 ($res eq 'application/rtf') && ($page_name ne 'Target')) {
                   1713:                                 $contents =~ s/(src=\s*["']?)/$1..\//i;
                   1714:                             }
1.15      raeburn  1715:                         }
                   1716:                     }
                   1717:                     if (($line eq '') && ($current_tag eq 'font')) {
                   1718:                         $delayed = &HTML::Entities::encode($contents,'<>&"');
                   1719:                     } else {
                   1720:                         $line .= &HTML::Entities::encode($contents,'<>&"');
                   1721:                     }
                   1722:                 }
                   1723:             } elsif ($token->[0] eq 'T') {
                   1724:                 if ($current_tag ne 'html' && $current_tag ne 'head' && $current_tag ne 'body' && $current_tag ne 'meta' && $current_tag ne 'title') {
                   1725:                     if ($current_tag eq 'style') { 
                   1726:                        $css .=  $token->[1];
                   1727:                     } elsif ($current_tag eq 'script') {
                   1728:                        $js .=  $token->[1];
                   1729:                     } else {
                   1730:                         if ($delayed ne '') {
                   1731:                             my ($id,$rest) = ($token->[1] =~ /^(\s*\(*[A-Za-z0-9]+\)*\.*\s+)(.+)$/s);
                   1732:                             if ($id ne '') {
                   1733:                                 $line .= $id.$delayed.$rest;
                   1734:                             } else {
                   1735:                                 $line .= $token->[1].$delayed;
                   1736:                             }
                   1737:                             $delayed = '';
                   1738:                         } else {
                   1739:                             $line .= $token->[1];
                   1740:                         }
                   1741:                     }
                   1742:                 }
                   1743:             } elsif ($token->[0] eq 'E') {
                   1744:                 next if ($token->[1] eq 'html' || $token->[1] eq 'head' || $token->[1] eq 'body' || $token->[1] eq 'meta' || $token->[1] eq 'title' || $token->[1] eq 'p');
                   1745:                 if ($token->[1] eq 'style') {
                   1746:                     $css .= $token->[2];
                   1747:                 } elsif ($token->[1] eq 'script') {
                   1748:                     $js .= $token->[2];
                   1749:                 } else {
                   1750:                     $line .= &HTML::Entities::encode($token->[2],'<>&"');
                   1751:                 }
                   1752:                 $current_tag = '';
                   1753:             }
                   1754:         }
                   1755:     }
                   1756:     if ($line ne '') {
                   1757:         if ($line ne '') {
                   1758:             $line =~ s/\s*[\n\r\f]+/\n/gs;
                   1759:         }
                   1760:         $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
                   1761:         push(@text,$line);
                   1762:     }
                   1763:     if ($res eq 'text/html') {
                   1764:         close($fh);
                   1765:     }
                   1766:     return (\@text,$header,$css,$js);
                   1767: }
                   1768: 
                   1769: sub build_image_url {
1.33    ! raeburn  1770:     my ($webpath,$item) = @_;
        !          1771:     $item =~ s/(<img[^>]+src=["']?\s*)(\.?\.?\/?)/$1$webpath/gsi;
        !          1772:     return $item;
1.15      raeburn  1773: }
                   1774: 
                   1775: sub print_header {
1.26      raeburn  1776:     my ($uname,$udom,$javascript,$loadentries,$title,$current_page,$pagesref,
                   1777:         $namesref) = @_;
                   1778:     my $brcrum = [{'href' => &Apache::loncommon::authorspace(),
                   1779:                    'text' => 'Construction Space'}];
                   1780:     if ($env{'form.phase'} eq 'three') {
                   1781:         if (ref($pagesref) eq 'ARRAY') {
                   1782:             for (my $i=0; $i<$current_page; $i++) {
                   1783:                 my $goback = 1 + $i - $current_page;
                   1784:                 if (ref($namesref) eq 'HASH') {
                   1785:                     if ($namesref->{$pagesref->[$i]} ne '') {
                   1786:                         if (ref($brcrum) eq 'ARRAY') {
                   1787:                             my $text = $namesref->{$pagesref->[$i]};
                   1788:                             my $href;
                   1789:                             if ($goback == -1) {
                   1790:                                 $href = 'javascript:backPage();';
                   1791:                             } else {
                   1792:                                 $href = 'javascript:history.go('.$goback.')';
                   1793:                             }
                   1794:                             push(@{$brcrum}, {'href' => $href,
                   1795:                                               'text' => $text});
                   1796:                         }
                   1797:                     }
                   1798:                 }
                   1799:             }
                   1800:         }
                   1801:     }
1.15      raeburn  1802:     my $output = &Apache::loncommon::start_page($title,$javascript,
1.26      raeburn  1803:                                              {'bread_crumbs' => $brcrum,
                   1804:                                               'add_entries' => $loadentries});
1.15      raeburn  1805:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.28      www      1806:         $output .= '<p class="LC_info">'
1.24      bisitz   1807:                  .&mt('Co-Author [_1]',$uname.':'.$udom)
1.20      bisitz   1808:                  .'</p>';
1.15      raeburn  1809:     }
                   1810:     return $output;
                   1811: }
                   1812: 
1.1       raeburn  1813: # ---------------------------------------------------------------- Main Handler
                   1814: sub handler {
                   1815:     my $r=shift;
1.15      raeburn  1816: 
1.33    ! raeburn  1817:     my $fn=$env{'form.filename'};
        !          1818: 
        !          1819:     if ($env{'form.filename1'}) {
        !          1820:        $fn=$env{'form.filename1'}.$env{'form.filename2'};
1.1       raeburn  1821:     }
1.33    ! raeburn  1822:     $fn=~s{\+}{}g;
1.15      raeburn  1823: 
1.33    ! raeburn  1824:     unless ($fn) {
1.6       albertel 1825:         $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.1       raeburn  1826:                        ' unspecified filename for upload', $r->filename);
                   1827:         return HTTP_NOT_FOUND;
                   1828:     }
                   1829: 
1.33    ! raeburn  1830:     my ($uname,$udom) = &Apache::loncacc::constructaccess($fn);
        !          1831:     if (($uname eq '') || ($udom eq '')) {
        !          1832:         $r->log_reason($uname.':'.$udom.' trying to convert testbank file '.
        !          1833:                        $fn.' - not authorized',$r->filename);
        !          1834:         return HTTP_NOT_ACCEPTABLE;
        !          1835:     }
        !          1836: 
        !          1837:     my $javascript = '';
        !          1838:     my $page_name = '';
        !          1839:     my $current_page = '';
        !          1840:     my $qcount = '';
        !          1841:     my $title = 'Upload testbank questions to Construction Space';
        !          1842: 
1.1       raeburn  1843: # ----------------------------------------------------------- Start page output
                   1844:     &Apache::loncommon::content_type($r,'text/html');
                   1845:     $r->send_http_header;
                   1846: 
1.33    ! raeburn  1847:     my ($filename,$webpath) = &File::Basename::fileparse($fn);
1.31      www      1848:     my $dirpath = $r->dir_config('lonDocRoot').$webpath;
1.26      raeburn  1849:     my ($res,$subdir,$badfile,$textref,$header,$css,$js,%loadentries,@pages,%names);
1.15      raeburn  1850: 
1.6       albertel 1851:     if ($env{'form.phase'} eq 'three') {
1.1       raeburn  1852:         $current_page = &display_control();
1.26      raeburn  1853:         @pages = ('Welcome','Blocks','Format','Target','Confirmation');
                   1854:         %names = (
                   1855:                    Welcome      => 'Testbank Format',
                   1856:                    Blocks       => 'Classification',
                   1857:                    Format       => 'Selection',
                   1858:                    Target       => 'Result'
                   1859:         );
1.15      raeburn  1860:         $page_name = $pages[$current_page];
1.18      raeburn  1861:         if ($env{'form.timestamp'} eq '') {
                   1862:             $env{'form.timestamp'} = time; 
                   1863:         }
1.15      raeburn  1864:         if ($env{'form.newdir'} ne '') {
                   1865:             if ($env{'form.newdir'} =~ /^\Q$dirpath\E(.+)$/) {
                   1866:                 $subdir = $1;
                   1867:             }
                   1868:         }
                   1869:         ($res,$badfile,$textref,$header,$css,$js) = 
1.33    ! raeburn  1870:             &parse_datafile($r,$filename,$dirpath,$webpath,$page_name,
        !          1871:                             $subdir,$env{'form.timestamp'});
1.15      raeburn  1872:         if ($page_name eq 'Welcome') {
                   1873:              &jscript_zero($webpath,\$javascript);
                   1874:         } elsif ($page_name eq 'Blocks') {
                   1875:             if ($env{'form.go'} eq "PreviousPage") {
                   1876: 	        $loadentries{'onload'} = "setElements()";
                   1877:             }
1.1       raeburn  1878:             &jscript_one(\$javascript);
1.15      raeburn  1879:         } elsif ($page_name eq 'Format') {
                   1880:             if ($env{'form.go'} eq "PreviousPage") {
                   1881:                 $loadentries{'onload'} = "setElements()";
                   1882:             }
                   1883:             $qcount = question_count($env{'form.qnumformat'},$textref);
1.1       raeburn  1884:  	    &jscript_two(\$javascript,$qcount);
1.15      raeburn  1885:         } elsif ($page_name eq 'Target') {
1.6       albertel 1886:              if ($env{'form.go'} eq "PreviousPage") {
1.10      albertel 1887:                  $loadentries{'onload'} = "setElements()";
1.1       raeburn  1888:  	     }
1.15      raeburn  1889: 	     &jscript_three($webpath,\$javascript);
1.1       raeburn  1890:         } elsif ($page_name eq 'Confirmation') {
1.15      raeburn  1891: 	     &jscript_four(\$javascript,$webpath);
                   1892:         }
                   1893:         $javascript = "<script type=\"text/javascript\">\n//<!--\n".
                   1894: 	              $javascript."\n// --></script>\n";
                   1895:         if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1896:             if ($page_name eq 'Target') {
                   1897:                 $javascript .= $js.$css;
                   1898:             }
1.1       raeburn  1899:         }
1.8       albertel 1900:     }
                   1901: 
1.26      raeburn  1902:     $r->print(&print_header($uname,$udom,$javascript,\%loadentries,$title,
1.27      raeburn  1903:                             $current_page,\@pages,\%names));
1.1       raeburn  1904: 
1.27      raeburn  1905:     if (($env{'form.phase'} eq 'four') || ($env{'form.phase'} eq 'three')) {
                   1906:         if ($env{'form.phase'} eq 'four') {
                   1907:             $r->print(&Apache::lonupload::phasefour($r,$fn,$uname,$udom,'testbank'));
                   1908:             my $current_page = 0; 
                   1909:             my $js;
                   1910:             &jscript_zero($webpath,\$js);
                   1911:             $js = '<script type="text/javascript">'."\n$js\n".'</script>';
                   1912:             $r->print($js);
1.33    ! raeburn  1913:             &display_zero($r,$fn,$current_page,$webpath);
1.27      raeburn  1914:         } elsif ($env{'form.phase'} eq 'three') {
                   1915:             if ($env{'form.action'} eq 'upload_embedded') {
                   1916:                 my ($result,$flag) = 
                   1917:                      &Apache::lonupload::phasethree($r,$fn,$uname,$udom,'testbank');
                   1918:                 $r->print($result);
                   1919:                 if ($flag eq 'modify_orightml') {
                   1920:                     undef($page_name); 
                   1921:                     $r->print('<form name="testbankForm" method="post" action="/adm/testbank">'.
1.33    ! raeburn  1922:                               &page_footer('',$fn).'</form>');
1.27      raeburn  1923:                 }
                   1924:             }
1.15      raeburn  1925:         }
1.1       raeburn  1926:         if ($badfile) {
1.33    ! raeburn  1927:             &file_error($r,$fn,$current_page,$webpath,$res);
1.27      raeburn  1928:         } else {
1.33    ! raeburn  1929:             &display_zero ($r,$fn,$current_page,$webpath) if $page_name eq 'Welcome';
        !          1930:             &display_one ($r,$fn,$current_page,$textref,$header) if $page_name eq 'Blocks';
        !          1931:             &display_two ($r,$fn,$current_page,$textref,$header,$qcount) if $page_name eq 'Format';
        !          1932:             &display_three ($r,$fn,$current_page,$textref,$res,$header,$webpath,$qcount) if $page_name eq 'Target';
        !          1933:             &final_display ($r,$fn,$current_page,$textref,$res,$header,$css,$js,$webpath,$dirpath,$subdir) if $page_name eq 'Confirmation';
1.1       raeburn  1934:         }
1.6       albertel 1935:     } elsif ($env{'form.phase'} eq 'two') {
1.33    ! raeburn  1936:         my ($result,$flag) = &Apache::lonupload::phasetwo($r,$fn,'testbank');
1.15      raeburn  1937:         $r->print($result);
1.1       raeburn  1938:         if ($flag eq 'ok') {
1.29      raeburn  1939:             my $current_page = 0;
1.15      raeburn  1940:             my $js;
                   1941:             &jscript_zero($webpath,\$js);
                   1942:             $js = '<script type="text/javascript">'."\n$js\n".'</script>';
                   1943:             $r->print($js);
1.33    ! raeburn  1944:             &display_zero($r,$fn,$current_page,$webpath);
1.15      raeburn  1945:         } elsif ($flag eq 'embedded') {
                   1946:             $r->print($js.'<form name="testbankForm" method="post" action="/adm/testbank">'.
1.33    ! raeburn  1947:                       &page_footer('',$fn).'</form>');
1.1       raeburn  1948:         }
                   1949:     } else {
1.33    ! raeburn  1950:         &Apache::lonupload::phaseone($r,$fn,'testbank');
1.1       raeburn  1951:     }
1.8       albertel 1952:     $r->print(&Apache::loncommon::end_page());
1.1       raeburn  1953:     return OK;
                   1954: }
1.15      raeburn  1955: 
1.1       raeburn  1956: 1;
                   1957: __END__
                   1958: 

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