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

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

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