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

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

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