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

1.3       albertel    1: # Handler for parsing text upload problem descriptions into .problems
1.18    ! raeburn     2: # $Id: testbankimport.pm,v 1.17 2008/09/22 01:53:33 raeburn Exp $
1.3       albertel    3: #
                      4: # Copyright Michigan State University Board of Trustees
                      5: #
                      6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      7: #
                      8: # LON-CAPA is free software; you can redistribute it and/or modify
                      9: # it under the terms of the GNU General Public License as published by
                     10: # the Free Software Foundation; either version 2 of the License, or
                     11: # (at your option) any later version.
                     12: #
                     13: # LON-CAPA is distributed in the hope that it will be useful,
                     14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     16: # GNU General Public License for more details.
                     17: #
                     18: # You should have received a copy of the GNU General Public License
                     19: # along with LON-CAPA; if not, write to the Free Software
                     20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     21: #
                     22: # /home/httpd/html/adm/gpl.txt
                     23: #
                     24: # http://www.lon-capa.org/
                     25: #
                     26: 
1.1       raeburn    27: package Apache::testbankimport;
                     28: 
1.3       albertel   29: use strict;
                     30: use Apache::Constants qw(:common :http :methods);
                     31: use Apache::loncacc;
                     32: use Apache::loncommon();
                     33: use Apache::lonnet;
                     34: use HTML::Entities();
                     35: use Apache::lonlocal;
                     36: use Apache::lonupload;
1.15      raeburn    37: use Apache::londocs;
1.3       albertel   38: use File::Basename();
1.11      albertel   39: use LONCAPA();
1.15      raeburn    40: use File::MMagic;
                     41: use XML::DOM;
                     42: use RTF::HTMLConverter;
                     43: use HTML::TokeParser;
1.1       raeburn    44: 
                     45: # ---------------------------------------------------------------- Display Control
                     46: sub display_control {
                     47: # figure out what page we're on and where we're heading.
1.6       albertel   48:     my $page = $env{'form.page'};
                     49:     my $command = $env{'form.go'};
1.1       raeburn    50:     my $current_page = &calculate_page($page,$command);
                     51:     return $current_page;
                     52: }
                     53: 
                     54: # CALCULATE THE CURRENT PAGE
                     55: sub calculate_page($$) {
                     56:     my ($prev,$dir) = @_;
                     57:     return 0 if $prev eq '';    # start with first page
                     58:     return $prev + 1 if $dir eq 'NextPage';
                     59:     return $prev - 1 if $dir eq 'PreviousPage';
                     60:     return $prev     if $dir eq 'ExitPage';
                     61:     return 0 if $dir eq 'BackToStart';
                     62: }
                     63: 
1.15      raeburn    64: sub jscript_zero {
                     65:     my ($webpath,$jsref) = @_;
                     66:     my $start_page =
                     67:         &Apache::loncommon::start_page('Create Testbank directory',undef,
                     68:                                        {'only_body'   => 1,
                     69:                                         'js_ready'    => 1,});
                     70:     my $end_page =
                     71:         &Apache::loncommon::end_page({'js_ready' => 1,});
                     72:     my %lt = &Apache::lonlocal::texthash(
                     73:                                          loca => 'Location',
                     74:                                          newd => 'New Directory',
                     75:                                          ente => 'Enter the name of the new directory where you will save the converted testbank questions',
                     76:                                          go  => 'Go',
                     77:                                         );
                     78:     $$jsref = <<"END_SCRIPT";
                     79: function createWin() {
                     80:     document.info.newdir.value = "";
                     81:     newWindow = window.open("","CreateDir","HEIGHT=400,WIDTH=750,scrollbars=yes")
                     82:     newWindow.document.open()
                     83:     newWindow.document.write('$start_page')
                     84:     newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]'>\\n")
                     85:     newWindow.document.write("<h3>$lt{'loca'}: <tt>$webpath</tt></h3><h3>$lt{'newd'}</h3>\\n")
                     86:     newWindow.document.write("<form name='fileaction' action='/adm/cfile' method='post'>\\n")
                     87:     newWindow.document.write("$lt{'ente'}.<br /><br />")
                     88:     newWindow.document.write("<input type='hidden' name='filename' value='$webpath'>")
                     89:     newWindow.document.write("<input type='hidden' name='action' value='newdir'>")
                     90:     newWindow.document.write("<input type='hidden' name='callingmode' value='testbank'>")
                     91:     newWindow.document.write("$webpath<input type='text' name='newfilename' value=''/>")
                     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.15      raeburn   487:     my ($r,$uname,$fn,$page,$webpath) = @_;
                    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:     }
                    492:     $r->print(&mt('The <b>Testbank Upload</b> utility can be used by LON-CAPA authors to generate LON-CAPA problem files from a testbank file of questions/answers.').'<br />'.
                    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">'.
                    511:         &topic_bar(1,&mt('Optional: create a sub-directory in which the testbank questions will be saved')).
                    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:'). 
                    513:        ' <input type="button" name="createdir" value="'.&mt('Create sub-directory').'" onClick="javascript:createWin()">'.
                    514:        &page_footer($env{'form.newdir'},$uname,$fn,$page,$webpath).'
                    515:        </form>');
1.1       raeburn   516: }
                    517: 
                    518: # ---------------------------------------------------------------- Display One
                    519: 
                    520: sub display_one {
1.15      raeburn   521:     my ($r,$uname,$fn,$page,$textref,$header) = @_;
                    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">
                    525:                   <option value = "-1" selected>'.&mt('Select').'</option>
                    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".
                    536:               &topic_bar(2,$topics{2}).'<p>'.
                    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".
                    539:               &mt('Correct answers should be numbered in the same way as the questions and should appear after <b>all</b> the questions (including question text and possible foils for all questions).').'<br />'."\n".
                    540:               &mt('Each numbered question must have a corresponding numbered answer, although the answer itself may be blank for essay questions.').'<br /><br />'."\n".
                    541:               &mt('For example, you would select <b>1.</b> if your testbank file contained the following questions:').'<br /><blockquote>'.
                    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>'.
                    559:              &topic_bar(3,$topics{3}).'<p>'.
                    560:              &mt('For example, you would enter <b>6</b> if your testbank file contained the following sequence of questions:').'</p><blockquote>'.
                    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 />'.
                    568:              &page_footer($env{'form.newdir'},$uname,$fn,$page).'
                    569:  </form>');
                    570:     return;
1.1       raeburn   571: }
                    572: 
                    573: # ---------------------------------------------------------------- Display Two
                    574: 
                    575: sub display_two {
1.15      raeburn   576:     my ($r,$uname,$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>'.
                    604:               &mt('You indicated that <b>all</b> questions (and the corresponding answer(s) for each question) begin with a number in the following format: [_1].','<b>'.$qnumtypes{$qnumformat}.'</b>').'</p><p>'.
                    605:               &mt('A total of <b>[quant,_1,question]</b> and <b>[quant,_2,answer]</b> were found in the file you uploaded.',$qcount,$qcount).' '.
                    606:               &mt('If this total does not match the number you expect, examine your original testbank file to verify that each question <i>and</i> each answer begins with a number in the specified format.').' '.
                    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>'.
                    608:               &mt('You also indicated that the <b>[quant,_1,question]</b> can be divided into <b>[quant,_2,block]</b> of questions of a particular question type.',$qcount,$blocks).'</p><p>'.
                    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).
                    611:               &topic_bar(4,$steptitle).'<p>'.
                    612:               &mt('For <i>each</i> of the [_1] question blocks, specify the question numbers of the first and last questions in the block (e.g., 1 and 10), and the question type of the questions in the block.','<b>'.$blocks.'</b>').' '.
                    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".
                    628:                  '<td valign="top">&nbsp;<input type="text" name="end_'.$i.'" value="'.$bl1end.'" size="5">&nbsp;</td>'."\n".
                    629:                  '<td valign="top">
                    630:    <select name="qtype_'.$i.'" onChange="colSet('.$i.')">
                    631:     <option value= "-1" 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>'.
                    650:               &mt('For <i>multiple choice</i>, <i>multiple correct answer</i> and <i>ranking</i> type questions, you must use the <b>Foil format</b> column to choose the format of the identifier used for each of the possible answers (e.g., (a), a, a., i, (i) etc.) provided for a given question stem.').'</li><li>'.
                    651:              &mt('For <i>multiple correct answer</i> and <i>fill-in-the-blank</i> questions with more than one correct answer you must use the <b>Answer format</b> column to choose the separator used between the answers, e.g., if the correct answers for question 28. were listed as:[_1] you would choose "comma", or if they were listed as:[_2] you would choose "new line".','<blockquote><pre>28. (a),(d),(e)</pre></blockquote>','<blockquote><pre>
                    652: 28. (a)
                    653:     (d)
                    654:     (e)
                    655: </pre></blockquote>').'</li><li>'.
                    656:              &mt('For <i>true/false</i> questions you must use the <b>Answer format</b> column to choose how the correct answer - True or False, is displayed in the text file (e.g., T or F, true or false etc.).').'</li><li>'.
                    657:             &mt('For <i>ranking</i> questions you must use the <b>Answer format</b> column to choose the separator used between the (ranked) answers.').'</li></ul>
                    658: <input type="hidden" name="blocks" value="'.$blocks.'" />
                    659: <input type="hidden" name="qnumformat" value="'.$qnumformat.'" />'.
                    660:            &page_footer($env{'form.newdir'},$uname,$fn,$page).'
                    661: </form>');
                    662:     return;
                    663: }
                    664: 
1.1       raeburn   665: # ---------------------------------------------------------------- Display Three
1.15      raeburn   666: sub display_three {
                    667:     my ($r,$uname,$fn,$page,$textref,$res,$header,$urlpath,$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') {
                    717:                 $showheader = &build_image_url($urlpath,$showheader);
                    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).
                    724:               &topic_bar(5,&mt('Choose which problems to convert and names to use for individual problem files')));
                    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') {
                    766:                                         $showqn = &build_image_url($urlpath,$showqn);
                    767:                                     }
                    768:                                 }
                    769:                                 $r->print(&Apache::loncommon::start_data_table_row().
                    770:                                           '<td valign="top">'.$qnum.'.</td>'."\n".
                    771:                                           '<td valign="top"><input name="createprob" type="checkbox" "checked="checked" value="'.$j.'" /></td>'."\n".
                    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') {
                    810:                                         $showfoil = &build_image_url($urlpath,$showfoil);
                    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".
                    832:                                   '<td valign="top"><input name="createprob" type="checkbox" "checked="checked" value="'.$j.'" /></td>'."\n".
                    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:     }
                    861:     $r->print('</p>'.&page_footer($env{'form.newdir'},$uname,$fn,$page).'
                    862:               </form>');
1.1       raeburn   863: }
                    864: 
                    865: # ---------------------------------------------------------------- Final Display
                    866: sub final_display {
1.15      raeburn   867:     my ($r,$uname,$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:     }
                   1035:     $r->print(&topic_bar(6,&mt('Result of conversion of testbank questions to LON-CAPA problems')));
                   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>'.
                   1044:                   &page_footer($env{'form.newdir'},$uname,$fn,$page,$webpath,$subdir,$state).'</form>');
                   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:         }
                   1132:         $r->print(&page_footer($env{'form.newdir'},$uname,$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>'.
                   1136:                   &page_footer($env{'form.newdir'},$uname,$fn,$page,$webpath,$subdir,$state).'</form>');
                   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 {
                   1161:     my ($newdir,$uname,$fn,$page,$webpath,$subdir,$state) = @_;
                   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="uploaduname" value="'.$uname.'" />
                   1187:        <input type="hidden" name="filename" value="'.$fn.'" />
                   1188:        <input type="hidden" name="page" value="'.$page.'" />
                   1189:        <input type="hidden" name="phase" value="three" />
1.18    ! raeburn  1190:        <input type="hidden" name="go" value="'.$go.'" />
        !          1191:        <input type="hidden" name="timestamp" value="'.$env{'form.timestamp'}.'" />';
1.15      raeburn  1192:     if ($page ne '') {
                   1193:         $output .= '
                   1194:        <table border="0">
                   1195:         <tr>
                   1196:          <td>
                   1197:           <input type="button" name="backpage" value="'.$prevval.'" onclick="'.$prevclick.'" />
                   1198:          </td>';
1.17      raeburn  1199:         if (($page < 4) && ($state ne 'badfile'))  {
1.15      raeburn  1200:             $output .= '
                   1201:          <td>&nbsp;</td>
                   1202:          <td>
                   1203:           <input type="button" name="nextpage" value="'.$nextval.'" onclick="'.$nextclick.'">
                   1204:          </td>';
                   1205:         }
                   1206:         $output .= '    </tr>
                   1207:        </table>
                   1208: ';
                   1209:     }
                   1210:     return $output;
1.1       raeburn  1211: }
                   1212: 
                   1213: sub question_count {
                   1214:     my ($qnumformat,$textref) = @_;
                   1215:     my $text_in = join "\n", @{$textref};
                   1216:     $text_in = "\n ".$text_in;
                   1217:     my $qpattern ='';
                   1218:     if ($qnumformat eq "period") {
                   1219:         $qpattern = '\d{1,}\.';
                   1220:     } elsif ($qnumformat eq "paren") {
                   1221:         $qpattern = '\(\d{1,}\)';
                   1222:     } elsif ($qnumformat eq "number") {
                   1223:         $qpattern = '\d{1,}';
                   1224:     } elsif ($qnumformat eq "leadparen") {
                   1225:         $qpattern = '\(\d{1,}';
                   1226:     } elsif ($qnumformat eq "trailparen") {
                   1227:         $qpattern = '\d{1,}\)';
                   1228:     }
                   1229:     my @questions = split/[\r\n\f]+\s?$qpattern\s?/,$text_in;
                   1230:     my $qcount = scalar(@questions);
                   1231:     $qcount = $qcount/2;
                   1232:     $qcount = int($qcount);
                   1233:     return $qcount;
                   1234: }
                   1235: 
1.15      raeburn  1236: sub get_constants {
                   1237:     my @alphabet = ("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z");
                   1238:     my @romans = ("i","ii","iii","iv","v","vi","vii","viii","ix","x","xi","xii","xiii","xiv","xv","xvi","xvii","xviii","xix","xx","xxi","xxii","xxiii","xxiv","xxv","xxvi");
                   1239:     return (\@alphabet,\@romans);
                   1240: }
                   1241: 
1.1       raeburn  1242: sub file_split {
                   1243:     my ($startsref,$endsref,$numsref,$qnumformat,$foilsref,$textref,$multpartsref,$numitems,$qtyperef,$blocks) = @_;
                   1244:     my $text_in = join "\n", @{$textref};
                   1245:     $text_in = "\n ".$text_in;
                   1246:     my $dignum = length($numitems);
1.15      raeburn  1247:     my ($qpatst,$qpatend,$numpat,@questions,@qids);
                   1248:     my $numpat = '\d{1';
1.1       raeburn  1249:     if ($dignum > 1) {
1.15      raeburn  1250:         $numpat .= ','.$dignum.'}';
1.1       raeburn  1251:     } else {
1.15      raeburn  1252:         $numpat .= '}';
1.1       raeburn  1253:     }
                   1254:     if ($qnumformat eq "period") {
1.15      raeburn  1255:         $qpatend = '\.'; 
1.1       raeburn  1256:     } elsif ($qnumformat eq "paren") {
1.15      raeburn  1257:         $qpatst = '\(';
                   1258:         $qpatend = '\)';
1.1       raeburn  1259:     } elsif ($qnumformat eq "leadparen") {
1.15      raeburn  1260:         $qpatst = '\(';
1.1       raeburn  1261:     } elsif ($qnumformat eq "trailparen") {
1.15      raeburn  1262:         $qpatend = '\)';
1.1       raeburn  1263:     }
1.15      raeburn  1264:     my @lines = split/[\r\n\f]+\s*$qpatst($numpat)$qpatend\s*/,$text_in;
1.1       raeburn  1265: # my @questions = split/\n\s\d{1,3}\.\s/,$text_in;
1.15      raeburn  1266:     shift(@lines);
                   1267:     for (my $i=0; $i<@lines; $i++) {
                   1268:         if ($i%2) {
                   1269:             push(@questions,$lines[$i]);
                   1270:         } else {
                   1271:             push(@qids,$lines[$i]);
                   1272:         }
                   1273:     }
1.1       raeburn  1274:     my %multparts = ();
                   1275:     for (my $i=0; $i<$blocks; $i++) {
                   1276:         if (${$numsref}[$i] > 0) {
1.14      raeburn  1277:             if ((${$qtyperef}[$i] eq "MC") || (${$qtyperef}[$i] eq "MA") || (${$qtyperef}[$i] eq "Ord")) {
1.1       raeburn  1278:                 my $splitstr = '';
                   1279:                 if (${$foilsref}[$i] eq "lcperiod") {
                   1280:                     $splitstr = '[a-z]\.';
                   1281:                 } elsif (${$foilsref}[$i] eq "lcparen") {
                   1282:                     $splitstr = '\([a-z]\)';
1.5       raeburn  1283:                 } elsif (${$foilsref}[$i] eq "lconeparen") {
                   1284:                     $splitstr = '[a-z]\)';
                   1285:                 } elsif (${$foilsref}[$i] eq "lcdotparen") {
                   1286:                     $splitstr = '[a-z]\.\)';
1.1       raeburn  1287:                 } elsif (${$foilsref}[$i] eq "ucperiod") {
                   1288:                     $splitstr = '[A-Z]\.';
                   1289:                 } elsif (${$foilsref}[$i] eq "ucparen") {
                   1290:                     $splitstr = '\([A-Z]\)';
1.5       raeburn  1291:                 } elsif (${$foilsref}[$i] eq "uconeparen") {
                   1292:                     $splitstr = '[A-Z]\)';
                   1293:                 } elsif (${$foilsref}[$i] eq "ucdotparen") {
                   1294:                     $splitstr = '[A-Z]\.\)';
1.1       raeburn  1295:                 } elsif (${$foilsref}[$i] eq "romperiod") {
                   1296:                     $splitstr = '[ivx]+\.';
                   1297:                 } elsif (${$foilsref}[$i] eq "romparen") {
                   1298:                     $splitstr = '\([ivx]+\)';
1.5       raeburn  1299:                 } elsif (${$foilsref}[$i] eq "romoneparen") {
                   1300:                     $splitstr = '[ivx]+\)';
                   1301:                 } elsif (${$foilsref}[$i] eq "romdotparen") {
                   1302:                     $splitstr = '[ivx]+\.\)';
1.1       raeburn  1303:                 }
                   1304:                 for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
1.5       raeburn  1305:                     @{$multparts{$j}} = split/[\r\n\f]+\s*$splitstr\s*/,$questions[$j];
1.1       raeburn  1306:                     chomp(@{$multparts{$j}});
                   1307:                 }
                   1308:             } elsif (${$qtyperef}[$i] eq "FIB") { 
                   1309:                 for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
                   1310:                     @{$multparts{$j}} = ("$questions[$j]");
                   1311:                 }
                   1312:             }
                   1313:         }
1.15      raeburn  1314:     }
                   1315:     my ($lastanswer,$footer) = ($questions[-1] =~ /^([,\r\n\f\t\s().A-Za-z]+)(.+)$/);
                   1316:     if ($footer ne '') {
                   1317:         $questions[-1] = $lastanswer;
                   1318:     }
1.1       raeburn  1319:     %{$multpartsref} = %multparts;
1.15      raeburn  1320:     return (\@questions,\@qids,$footer);
1.1       raeburn  1321: }
                   1322:  
                   1323: # create_mcq builds an MC, MA, Ord or FIB question
                   1324: 
                   1325: sub create_mcq {
1.15      raeburn  1326:     my ($destdir,$subdir,$qstnref,$answerref,$qtype,$libfile,$res,$header,$footer,$js,$css) = @_;
                   1327: 
1.1       raeburn  1328:     my $qstn = ${$qstnref}[0];
                   1329:     my $numfoils = scalar(@{$qstnref}) - 1; 
                   1330:     my $datestamp = localtime;
                   1331:     my $numansrs = scalar(@{$answerref});
1.15      raeburn  1332:     my $output = '<problem>
                   1333:  <startouttext />';
                   1334:     if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1335:         if ($header ne '') {
                   1336:             $output .= &HTML::Entities::decode($header);
                   1337:         }
                   1338:         if ($js ne '') {
                   1339:             $output .= &HTML::Entities::decode($js);
                   1340:         }
                   1341:         if ($css ne '') {
                   1342:             $output .= &HTML::Entities::decode($css);
                   1343:         }
                   1344:         $qstn = &HTML::Entities::decode($qstn);
                   1345:     }
                   1346:     $output .= $qstn.'<endouttext />'."\n";
1.1       raeburn  1347:     if ($qtype eq "MA") {
                   1348:         $output .= qq|
                   1349:    <optionresponse max="$numfoils" randomize="yes">
                   1350:     <foilgroup options="('True','False')">
                   1351:         |;
                   1352:         for (my $k=0; $k<@{$qstnref}-1; $k++) {
                   1353:             $output .= "   <foil name=\"foil".$k."\" value=\"";
                   1354:             if (grep/^$k$/,@{$answerref}) {
                   1355:                 $output .= "True\" location=\"random\"";
                   1356:             } else {
                   1357:                 $output .= "False\" location=\"random\"";
                   1358:             }
1.15      raeburn  1359:             my $showfoil = ${$qstnref}[$k+1];
                   1360:             if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1361:                 $showfoil = &HTML::Entities::decode($showfoil);
                   1362:             }
                   1363:             $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1       raeburn  1364:         }
                   1365:         chomp($output);
                   1366:         $output .= qq|
                   1367:     </foilgroup>
1.15      raeburn  1368:    </optionresponse>|;
1.1       raeburn  1369:     }
                   1370:     if ($qtype eq "MC") {
                   1371:         $output .= qq|
                   1372:    <radiobuttonresponse max="$numfoils" randomize="yes">
                   1373:     <foilgroup>
                   1374:         |;
                   1375:         for (my $k=0; $k<@{$qstnref}-1; $k++) {
                   1376:             $output .= "   <foil name=\"foil".$k."\" value=\"";
                   1377:             if (grep/^$k$/,@{$answerref}) {
                   1378:                 $output .= "true\" location=\"";
                   1379:             } else {
                   1380:                 $output .= "false\" location=\"";
                   1381:             }
                   1382:             if (lc (${$qstnref}[$k+1]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) { 
                   1383:                 $output .= "bottom\"";
                   1384:             } else {
                   1385:                 $output .= "random\"";
                   1386:             }
1.15      raeburn  1387:             my $showfoil = ${$qstnref}[$k+1];
                   1388:             if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1389:                 $showfoil = &HTML::Entities::decode($showfoil);
                   1390:             }
                   1391:             $output .= "\><startouttext />$showfoil<endouttext /></foil>\n";
1.1       raeburn  1392:         }
                   1393:         chomp($output);
                   1394:         $output .= qq|
                   1395:     </foilgroup>
1.15      raeburn  1396:    </radiobuttonresponse>|;
1.1       raeburn  1397:     }
                   1398:     if ($qtype eq "Ord") {
                   1399:         $output .= qq|
                   1400:    <rankresponse max="$numfoils" randomize="yes">
                   1401:     <foilgroup>
                   1402:         |;
                   1403:         for (my $k=0; $k<@{$qstnref}-1; $k++) {
1.14      raeburn  1404:             my $ansval;
                   1405:             my $num = 0;
                   1406:             for (my $i=0; $i<@{$answerref}; $i++) {
                   1407:                 if ($$answerref[$i] =~ /=/) {
                   1408:                     my @tied = split(/=/,$$answerref[$i]);
                   1409:                     foreach my $tie (@tied) {
                   1410:                         if ($k == $tie) {
                   1411:                             $ansval = $num + 1;
                   1412:                             last;
                   1413:                         }
                   1414:                     }
                   1415:                     $num += scalar(@tied);
                   1416:                 } elsif ($k == $$answerref[$i]) {
                   1417:                     $ansval = $num + 1;
                   1418:                     last;
                   1419:                 } else {
                   1420:                     $num ++;
                   1421:                 }
                   1422:             }
1.15      raeburn  1423:             my $showfoil = ${$qstnref}[$k+1];
                   1424:             if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1425:                 $showfoil = &HTML::Entities::decode($showfoil);
                   1426:             }
                   1427:             $output .= "   <foil location=\"random\" name=\"foil".$k."\" value=\"".$ansval."\"><startouttext />$showfoil<endouttext /></foil>\n";
1.1       raeburn  1428:         }
                   1429:         chomp($output);
                   1430:         $output .= qq|
                   1431:     </foilgroup>
1.15      raeburn  1432:    </rankresponse>|;
1.1       raeburn  1433:     }
                   1434:     if ($qtype eq "FIB") {
                   1435:         my $numerical = 1;
                   1436:         for (my $i=0; $i<@{$answerref}; $i++) {
                   1437:             if (${$answerref}[$i] =~ m/([^\d\.]|\.\.)/) {
                   1438:                 $numerical = 0;
                   1439:             }
                   1440:         }
                   1441:         if ($numerical) {
                   1442:             my $numans;
                   1443:             my $tol;
                   1444:             if (@{$answerref} == 1) {
                   1445:                 $tol = 5;
                   1446:                 $numans = $$answerref[0];
                   1447:             } else {
1.2       raeburn  1448:                 my $min = $$answerref[0];
                   1449:                 my $max = $$answerref[0];    
                   1450:                 for (my $i=1; $i<@{$answerref}; $i++) {
                   1451:                     if ($$answerref[$i]<=$min) {
1.1       raeburn  1452:                         $min = $$answerref[$i];
1.2       raeburn  1453:                     } elsif ($$answerref[$i] >= $max) {
1.1       raeburn  1454:                         $max = $$answerref[$i];
                   1455:                     }
                   1456:                 }
                   1457:                 $numans = ($max + $min)/2;
                   1458:                 $tol = 100*($max - $min)/($numans*2); 
                   1459:             }
                   1460:             $output .= qq|
                   1461: <numericalresponse answer="$numans">
                   1462: 	<responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
                   1463: 	<responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures" />
                   1464: 	<textline />
1.15      raeburn  1465: </numericalresponse>|;
1.1       raeburn  1466:         } else {
                   1467:             if (@{$answerref} == 1) {
                   1468:                 $output .= qq|
                   1469: <stringresponse answer="$$answerref[0]" type="ci">
                   1470: <textline>
                   1471: </textline>
1.15      raeburn  1472: </stringresponse>|;
1.1       raeburn  1473:             } else {
                   1474:                 for (my $i=0; $i<@{$answerref}; $i++) {
                   1475:                     ${$answerref}[$i] =~ s/\|/\|/g;
                   1476:                 }
                   1477:                 my $regexpans = join('|',@{$answerref});
                   1478:                 $regexpans = '/('.$regexpans.')/'; 
                   1479:                 $output .= qq|
                   1480: <stringresponse answer="$regexpans" type="re">
                   1481: <textline>
                   1482: </textline>
1.15      raeburn  1483: </stringresponse>|;
1.1       raeburn  1484:             }
                   1485:         }
                   1486:     }
1.15      raeburn  1487:     if ($footer ne '') {
                   1488:         $output .= '<startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
                   1489:     }
                   1490:     $output .= qq|
                   1491:   </problem>
                   1492: |;
                   1493:     my $result;
                   1494:     if (-e $destdir.$libfile) {
                   1495:         $result = 'exists';
                   1496:     } else {
                   1497:         if (open(PROB,">$destdir$libfile")) {
                   1498:             print PROB $output;
                   1499:             close(PROB);
                   1500:             $result = 'ok';
                   1501:         } else {
                   1502:             $result = 'failed';
                   1503:         } 
                   1504:     }
                   1505:     return ($result,$subdir.$libfile);
1.1       raeburn  1506: }
                   1507: 
                   1508: # create_ess builds an essay or True/False question
                   1509: 
                   1510: sub create_ess {
1.15      raeburn  1511:     my ($destdir,$subdir,$answer_id,$qstn,$answertxt,$qtype,$libfile,$res,$header,
                   1512:         $footer,$js,$css) = @_;
                   1513:     my $output = '<problem>
                   1514:  <startouttext />';
                   1515:     if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1516:         if ($header ne '') {
                   1517:             $output .= &HTML::Entities::decode($header);
                   1518:         }
                   1519:         if ($js ne '') {
                   1520:             $output .= &HTML::Entities::decode($js);
                   1521:         }
                   1522:         if ($css ne '') {
                   1523:             $output .= &HTML::Entities::decode($css);
                   1524:         }
                   1525:         $qstn = &HTML::Entities::decode($qstn);
                   1526:         $answertxt = &HTML::Entities::decode($answertxt);
                   1527:     }
                   1528:     $output .= $qstn.'<endouttext />';
1.1       raeburn  1529:     my $answer = '';
                   1530:     my $answerlog = '';
                   1531:     if ($qtype eq "Ess") {
1.15      raeburn  1532:         $output .= '
1.1       raeburn  1533:    <essayresponse>
                   1534:    <textfield></textfield>
                   1535:    </essayresponse>
                   1536:    <postanswerdate>
1.13      raeburn  1537:     <startouttext />
1.15      raeburn  1538:    '.$answertxt
                   1539:    .'<endouttext />
                   1540:    </postanswerdate>';
1.1       raeburn  1541:     } elsif ($qtype eq "TF") {
                   1542:          $answer = $answer_id;
                   1543:          $output .= qq|
                   1544:    <radiobuttonresponse max="2" randomize="yes">
                   1545:     <foilgroup>
                   1546:          |;
                   1547:          $output .= "   <foil name=\"foil0\" value=\"true\" location=\"random\"><startouttext />";
                   1548:          if ($answer_id) {
                   1549:               $output .= "False";
                   1550:          } else {
                   1551:               $output .= "True";
                   1552:          }
                   1553:          $output .= "<endouttext /></foil>\n";
                   1554:          $output .= "   <foil name=\"foil1\" value=\"false\" location=\"random\"><startouttext />";
                   1555:          if ($answer_id) {
                   1556:               $output .= "True";
                   1557:          } else {
                   1558:               $output .= "False";
                   1559:          }
1.15      raeburn  1560:          $output .= '<endouttext /></foil>
1.1       raeburn  1561:     </foilgroup>
1.15      raeburn  1562:    </radiobuttonresponse>';
1.1       raeburn  1563:      }
1.15      raeburn  1564:      if ($footer ne '') {
                   1565:         $output .= '
                   1566: <startouttext />'.&HTML::Entities::decode($footer).'<endouttext />';
                   1567:      }
                   1568:      $output .= '
                   1569:   </problem>
                   1570: ';
                   1571:      my $result;
                   1572:      if (-e $destdir.$libfile) {
                   1573:          $result = 'exists';
                   1574:      } else {
                   1575:          if (open(PROB,">$destdir$libfile")) {
                   1576:              print PROB $output;
                   1577:              close(PROB);
                   1578:          } else {
                   1579:              $result = 'failed';
                   1580:          }
                   1581:      }
                   1582:      return ($result,$subdir.$libfile);
                   1583: }
                   1584: 
                   1585: sub probfile_name {
                   1586:     my ($j) = @_;
                   1587:     my $libfile = &HTML::Entities::decode($env{'form.probfile_'.$j});
                   1588:     my $qnum = $j + 1;
                   1589:     if ($libfile eq '') {
                   1590:         if (length($qnum) == 1) {
                   1591:             $qnum = "00".$qnum;
                   1592:         } elsif (length($qnum) == 2) {
                   1593:             $qnum = "0".$qnum;
                   1594:         }
                   1595:         $libfile = 'testbank_question_'.$qnum;
                   1596:         $libfile .= '.problem';
                   1597:     }
                   1598:     return $libfile;
1.1       raeburn  1599: }
                   1600: 
                   1601: sub file_error {
1.17      raeburn  1602:     my ($r,$uname,$fn,$current_page,$webpath,$res) = @_;
                   1603:     $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.').
                   1604:               '</p><p>'.&mt('Extraction of questions is only possible for the following file types:').
                   1605:               '<ul><li>'.&mt('plain text').'</li><li>RTF</li><li>HTML</li></ul>'.
                   1606:               &mt('The file type identified for the file you uploaded is [_1].','<b>'.$res.'</b>').'</p>');
                   1607:     $r->print(&page_footer($env{'form.newdir'},$uname,$fn,$current_page,$webpath,undef,'badfile').
                   1608:              '</form>');
                   1609:     return;
1.15      raeburn  1610: }
                   1611: 
                   1612: sub parse_datafile {
1.18    ! raeburn  1613:     my ($r,$uname,$filename,$pathname,$dirpath,$urlpath,$page_name,$subdir,$timestamp) = @_;
1.15      raeburn  1614:     my ($badfile,$res,%allfiles,%codebase);
                   1615:     my $mm = new File::MMagic;
                   1616:     my ($text,$header,$css,$js);
                   1617:     if (-e "$dirpath") {
                   1618:         $res = $mm->checktype_filename($dirpath.$filename);
                   1619:         if ($env{'form.phase'} eq 'three') {          
                   1620:             if ($res eq 'text/plain') {
                   1621:                 open(TESTBANK,"<$dirpath$filename");
                   1622:                 @{$text} = <TESTBANK>;
                   1623:                 close(TESTBANK);
                   1624:             } elsif ($res eq 'application/rtf') {
                   1625:                 my $html = '';
1.18    ! raeburn  1626:                 my $image_uri = $timestamp;
1.15      raeburn  1627:                 if ($page_name eq 'Target') {
1.18    ! raeburn  1628:                     $image_uri = $urlpath.'/'.$timestamp;
1.15      raeburn  1629:                 }
                   1630:                 my $image_dir;
                   1631:                 if ($page_name eq 'Blocks') {
                   1632:                     $image_dir = $dirpath;
                   1633:                     $image_dir =~ s/\/$//;
1.18    ! raeburn  1634:                     $image_dir .= '/'.$timestamp;
        !          1635:                     if (!-e $image_dir) {
        !          1636:                         mkdir($image_dir,0755);
        !          1637:                     }
1.15      raeburn  1638:                 } else {
                   1639:                     $image_dir = $r->dir_config('lonDaemons').'/tmp/'.
                   1640:                                  $env{'user.name'}.'_'.$env{'user.domain'}.
                   1641:                                  '_rtfupload_'.$filename.'_'.time.'_'.$$;
                   1642:                    if (!-e $image_dir) {
                   1643:                        mkdir($image_dir,0755);
                   1644:                    }
                   1645:                 }
                   1646:                 my $parser = RTF::HTMLConverter->new (
                   1647:                                   in                => $dirpath.$filename,
                   1648:                                   out               => \$html,
                   1649:                                   DOMImplementation => 'XML::DOM',
                   1650:                                   image_uri         => $image_uri,
                   1651:                                   image_dir         => $image_dir,
                   1652:                              );
                   1653:                 $parser->parse();
                   1654:                 utf8::decode($html);
                   1655:                 ($text,$header,$css,$js) = 
1.18    ! raeburn  1656:                     &parse_htmlcontent($res,$subdir,$html,undef,$page_name);
1.15      raeburn  1657:             } elsif ($res eq 'text/html') {
                   1658:                 ($text,$header,$css,$js) = 
1.18    ! raeburn  1659:                     &parse_htmlcontent($res,$subdir,undef,$dirpath.$filename,$page_name);
1.15      raeburn  1660:             } else {
                   1661:                 $badfile = 1;
                   1662:             }
                   1663:         }
                   1664:     }
                   1665:     return ($res,$badfile,$text,$header,$css,$js,\%allfiles,\%codebase);
                   1666: }
                   1667: 
                   1668: sub parse_htmlcontent {
1.18    ! raeburn  1669:     my ($res,$subdir,$html,$fullpath,$page_name) = @_;
1.15      raeburn  1670:     my ($p,$fh);
                   1671:     if ($res eq 'application/rtf') {
                   1672:         $p = HTML::TokeParser->new( \$html );
                   1673:     } elsif ($res eq 'text/html') {
                   1674:         open($fh, "<:utf8", $fullpath);
                   1675:         $p = HTML::TokeParser->new( $fh );
                   1676:     }
                   1677:     my ($current_tag,$line,@text,$header,$css,$js,$have_header,$delayed);
                   1678:     while (my $token = $p->get_token) {
                   1679:         if (ref($token) eq 'ARRAY') {
                   1680:             if ($token->[0] eq 'S') {
                   1681:                 if ($delayed ne '') {
                   1682:                     $line.= $delayed;
                   1683:                     $delayed = '';
                   1684:                 }
                   1685:                 $current_tag = $token->[1];
                   1686:                 next if ($token->[1] eq 'html' || $token->[1] eq 'head' || $token->[1] eq 'body' || $token->[1] eq 'meta' || $token->[1] eq 'title');
                   1687:                 if ($token->[1] eq 'p') {
                   1688:                     $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
                   1689:                     if (!$have_header) {
                   1690:                         $header = $line;
                   1691:                         if ($header ne '') {
                   1692:                             $header =~ s/\s*[\n\r\f]+/\n/gs;
                   1693:                         }
                   1694:                         $have_header = 1;
                   1695:                     } else {
                   1696:                         push(@text,$line);
                   1697:                     }
                   1698:                     $line = '';
                   1699:                 } elsif ($current_tag eq 'style') {
                   1700:                     $css .= $token->[4];
                   1701:                 } elsif ($current_tag eq 'script') {
                   1702:                     $js .= $token->[4];
                   1703:                 } else {
                   1704:                     my $contents = $token->[4];
                   1705:                     if ($subdir ne '') {
                   1706:                         if (($token->[1] eq 'img') && ($token->[2]->{'src'} ne '')) {
1.18    ! raeburn  1707:                             if (($res eq 'text/html') || 
        !          1708:                                 ($res eq 'application/rtf') && ($page_name ne 'Target')) {
        !          1709:                                 $contents =~ s/(src=\s*["']?)/$1..\//i;
        !          1710:                             }
1.15      raeburn  1711:                         }
                   1712:                     }
                   1713:                     if (($line eq '') && ($current_tag eq 'font')) {
                   1714:                         $delayed = &HTML::Entities::encode($contents,'<>&"');
                   1715:                     } else {
                   1716:                         $line .= &HTML::Entities::encode($contents,'<>&"');
                   1717:                     }
                   1718:                 }
                   1719:             } elsif ($token->[0] eq 'T') {
                   1720:                 if ($current_tag ne 'html' && $current_tag ne 'head' && $current_tag ne 'body' && $current_tag ne 'meta' && $current_tag ne 'title') {
                   1721:                     if ($current_tag eq 'style') { 
                   1722:                        $css .=  $token->[1];
                   1723:                     } elsif ($current_tag eq 'script') {
                   1724:                        $js .=  $token->[1];
                   1725:                     } else {
                   1726:                         if ($delayed ne '') {
                   1727:                             my ($id,$rest) = ($token->[1] =~ /^(\s*\(*[A-Za-z0-9]+\)*\.*\s+)(.+)$/s);
                   1728:                             if ($id ne '') {
                   1729:                                 $line .= $id.$delayed.$rest;
                   1730:                             } else {
                   1731:                                 $line .= $token->[1].$delayed;
                   1732:                             }
                   1733:                             $delayed = '';
                   1734:                         } else {
                   1735:                             $line .= $token->[1];
                   1736:                         }
                   1737:                     }
                   1738:                 }
                   1739:             } elsif ($token->[0] eq 'E') {
                   1740:                 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');
                   1741:                 if ($token->[1] eq 'style') {
                   1742:                     $css .= $token->[2];
                   1743:                 } elsif ($token->[1] eq 'script') {
                   1744:                     $js .= $token->[2];
                   1745:                 } else {
                   1746:                     $line .= &HTML::Entities::encode($token->[2],'<>&"');
                   1747:                 }
                   1748:                 $current_tag = '';
                   1749:             }
                   1750:         }
                   1751:     }
                   1752:     if ($line ne '') {
                   1753:         if ($line ne '') {
                   1754:             $line =~ s/\s*[\n\r\f]+/\n/gs;
                   1755:         }
                   1756:         $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/;
                   1757:         push(@text,$line);
                   1758:     }
                   1759:     if ($res eq 'text/html') {
                   1760:         close($fh);
                   1761:     }
                   1762:     return (\@text,$header,$css,$js);
                   1763: }
                   1764: 
                   1765: sub build_image_url {
                   1766:     my ($urlpath,$item) = @_;
                   1767:     $item =~ s/(<img[^>]+src=["']?\s*)(\.?\.?\/?)/$1$urlpath/gsi;
                   1768:     return $item; 
                   1769: }
                   1770: 
                   1771: sub print_header {
                   1772:     my ($uname,$udom,$javascript,$loadentries,$title) = @_;
                   1773:     my $output = &Apache::loncommon::start_page($title,$javascript,
                   1774:                                              {'add_entries' => $loadentries});
                   1775:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
                   1776:         $output .= '<h3><span class="LC_error">'.&mt('Co-Author').': '.$uname.
                   1777:                    &mt(' at ').$udom.'</span></h3>';
                   1778:     }
                   1779:     return $output;
                   1780: }
                   1781: 
                   1782: sub topic_bar {
                   1783:     my ($imgnum,$title) = @_;
                   1784:     my $output = '
                   1785: <div class="LC_topic_bar">
                   1786:     <img alt="'.&mt('Step [_1]',$imgnum).
                   1787:               ' "src="/res/adm/pages/bl_step'.$imgnum.'.gif" />&nbsp;'.$title.'
                   1788: </div>
                   1789: ';
                   1790:     return $output;
                   1791: }
1.1       raeburn  1792: 
                   1793: # ---------------------------------------------------------------- Main Handler
                   1794: sub handler {
                   1795:     my $r=shift;
                   1796:     my $uname;
                   1797:     my $udom;
                   1798:     my $javascript = '';
                   1799:     my $page_name = '';
                   1800:     my $current_page = '';
                   1801:     my $qcount = '';
1.15      raeburn  1802:     my $title = 'Upload testbank questions to Construction Space';
                   1803: 
1.6       albertel 1804:     if ($env{'form.uploaduname'}) {
                   1805:         $env{'form.filename'}='/priv/'.$env{'form.uploaduname'}.'/'.
                   1806:             $env{'form.filename'};
1.1       raeburn  1807:     }
                   1808:     ($uname,$udom)=
1.6       albertel 1809:         &Apache::loncacc::constructaccess($env{'form.filename'},
1.1       raeburn  1810:                                           $r->dir_config('lonDefDomain'));
                   1811:     unless (($uname) && ($udom)) {
1.15      raeburn  1812:         $r->log_reason($uname.':'.$udom.' trying to convert testbank file '.
                   1813:                        $env{'form.filename'}.' - not authorized',$r->filename);
1.1       raeburn  1814:         return HTTP_NOT_ACCEPTABLE;
                   1815:     }
1.15      raeburn  1816: 
                   1817:     my ($fn,$filename);
1.6       albertel 1818:     if ($env{'form.filename'}) {
                   1819:         $fn=$env{'form.filename'};
1.1       raeburn  1820:         $fn=~s/^http\:\/\/[^\/]+\///;
                   1821:         $fn=~s/^\///;
1.11      albertel 1822:         $fn=~s{(~|priv/)($LONCAPA::username_re)}{};
1.1       raeburn  1823:         $fn=~s/\/+/\//g;
                   1824:     } else {
1.6       albertel 1825:         $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.1       raeburn  1826:                        ' unspecified filename for upload', $r->filename);
                   1827:         return HTTP_NOT_FOUND;
                   1828:     }
                   1829: 
                   1830: # ----------------------------------------------------------- Start page output
                   1831:     &Apache::loncommon::content_type($r,'text/html');
                   1832:     $r->send_http_header;
                   1833: 
1.15      raeburn  1834:     my ($filename,$pathname) = &File::Basename::fileparse($fn);
                   1835:     my $webpath = '/priv/'.$uname.$pathname;
                   1836:     my $urlpath = '/~'.$uname.$pathname;
                   1837:     my $dirpath = '/home/'.$uname.'/public_html'.$pathname;
                   1838:     my ($res,$subdir,$badfile,$textref,$header,$css,$js,%loadentries);
                   1839: 
1.6       albertel 1840:     if ($env{'form.phase'} eq 'three') {
1.1       raeburn  1841:         $current_page = &display_control();
1.15      raeburn  1842:         my @pages = ('Welcome','Blocks','Format','Target','Confirmation');
                   1843:         $page_name = $pages[$current_page];
1.18    ! raeburn  1844:         if ($env{'form.timestamp'} eq '') {
        !          1845:             $env{'form.timestamp'} = time; 
        !          1846:         }
1.15      raeburn  1847:         if ($env{'form.newdir'} ne '') {
                   1848:             if ($env{'form.newdir'} =~ /^\Q$dirpath\E(.+)$/) {
                   1849:                 $subdir = $1;
                   1850:             }
                   1851:         }
                   1852:         ($res,$badfile,$textref,$header,$css,$js) = 
                   1853:             &parse_datafile($r,$uname,$filename,$pathname,$dirpath,$urlpath,
1.18    ! raeburn  1854:                             $page_name,$subdir,$env{'form.timestamp'});
1.15      raeburn  1855:         if ($page_name eq 'Welcome') {
                   1856:              &jscript_zero($webpath,\$javascript);
                   1857:         } elsif ($page_name eq 'Blocks') {
                   1858:             if ($env{'form.go'} eq "PreviousPage") {
                   1859: 	        $loadentries{'onload'} = "setElements()";
                   1860:             }
1.1       raeburn  1861:             &jscript_one(\$javascript);
1.15      raeburn  1862:         } elsif ($page_name eq 'Format') {
                   1863:             if ($env{'form.go'} eq "PreviousPage") {
                   1864:                 $loadentries{'onload'} = "setElements()";
                   1865:             }
                   1866:             $qcount = question_count($env{'form.qnumformat'},$textref);
1.1       raeburn  1867:  	    &jscript_two(\$javascript,$qcount);
1.15      raeburn  1868:         } elsif ($page_name eq 'Target') {
1.6       albertel 1869:              if ($env{'form.go'} eq "PreviousPage") {
1.10      albertel 1870:                  $loadentries{'onload'} = "setElements()";
1.1       raeburn  1871:  	     }
1.15      raeburn  1872: 	     &jscript_three($webpath,\$javascript);
1.1       raeburn  1873:         } elsif ($page_name eq 'Confirmation') {
1.15      raeburn  1874: 	     &jscript_four(\$javascript,$webpath);
                   1875:         }
                   1876:         $javascript = "<script type=\"text/javascript\">\n//<!--\n".
                   1877: 	              $javascript."\n// --></script>\n";
                   1878:         if ($res eq 'application/rtf' || $res eq 'text/html') {
                   1879:             if ($page_name eq 'Target') {
                   1880:                 $javascript .= $js.$css;
                   1881:             }
1.1       raeburn  1882:         }
1.8       albertel 1883:     }
                   1884: 
1.15      raeburn  1885:     $r->print(&print_header($uname,$udom,$javascript,\%loadentries,$title));
1.1       raeburn  1886: 
1.6       albertel 1887:     if ($env{'form.phase'} eq 'three') {
1.15      raeburn  1888:         if ($env{'form.action'} eq 'upload_embedded') {
                   1889:             $r->print(&Apache::lonupload::phasethree($r,$fn,$uname,$udom,'testbank'));
                   1890:         }
1.1       raeburn  1891:         if ($badfile) {
1.17      raeburn  1892:             &file_error($r,$uname,$fn,$current_page,$webpath,$res);
1.1       raeburn  1893:         } else {        
1.15      raeburn  1894:             &display_zero ($r,$uname,$fn,$current_page,$webpath) if $page_name eq 'Welcome';
                   1895:             &display_one ($r,$uname,$fn,$current_page,$textref,$header) if $page_name eq 'Blocks';
                   1896:             &display_two ($r,$uname,$fn,$current_page,$textref,$header,$qcount) if $page_name eq 'Format';
                   1897:             &display_three ($r,$uname,$fn,$current_page,$textref,$res,$header,$urlpath,$qcount) if $page_name eq 'Target';
                   1898:             &final_display ($r,$uname,$fn,$current_page,$textref,$res,$header,$css,$js,$webpath,$dirpath,$subdir) if $page_name eq 'Confirmation';
1.1       raeburn  1899:         }
1.6       albertel 1900:     } elsif ($env{'form.phase'} eq 'two') {
1.15      raeburn  1901:         my ($result,$flag) = &Apache::lonupload::phasetwo($r,$fn,$uname,$udom,'testbank');
                   1902:         $r->print($result);
1.1       raeburn  1903:         if ($flag eq 'ok') {
                   1904:             my $current_page = 0;
1.15      raeburn  1905:             my $js;
                   1906:             &jscript_zero($webpath,\$js);
                   1907:             $js = '<script type="text/javascript">'."\n$js\n".'</script>';
                   1908:             $r->print($js);
                   1909:             &display_zero($r,$uname,$fn,$current_page,$webpath);
                   1910:         } elsif ($flag eq 'embedded') {
                   1911:             $r->print($js.'<form name="testbankForm" method="post" action="/adm/testbank">'.
                   1912:                       &page_footer('',$uname,$fn).'</form>');
1.1       raeburn  1913:         }
                   1914:     } else {
                   1915:         &Apache::lonupload::phaseone($r,$fn,$uname,$udom,'testbank');
                   1916:     }
1.8       albertel 1917:     $r->print(&Apache::loncommon::end_page());
1.1       raeburn  1918:     return OK;
                   1919: }
1.15      raeburn  1920: 
1.1       raeburn  1921: 1;
                   1922: __END__
                   1923: 

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