--- loncom/publisher/testbankimport.pm 2004/08/05 21:08:24 1.5 +++ loncom/publisher/testbankimport.pm 2012/10/29 17:38:55 1.35 @@ -1,5 +1,5 @@ # Handler for parsing text upload problem descriptions into .problems -# $Id: testbankimport.pm,v 1.5 2004/08/05 21:08:24 raeburn Exp $ +# $Id: testbankimport.pm,v 1.35 2012/10/29 17:38:55 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -28,20 +28,24 @@ package Apache::testbankimport; use strict; use Apache::Constants qw(:common :http :methods); -use Apache::loncacc; use Apache::loncommon(); -use Apache::Log(); use Apache::lonnet; use HTML::Entities(); use Apache::lonlocal; use Apache::lonupload; +use Apache::londocs; use File::Basename(); +use LONCAPA(); +use File::MMagic; +use XML::DOM; +use RTF::HTMLConverter; +use HTML::TokeParser; # ---------------------------------------------------------------- Display Control sub display_control { # figure out what page we're on and where we're heading. - my $page = $ENV{'form.page'}; - my $command = $ENV{'form.go'}; + my $page = $env{'form.page'}; + my $command = $env{'form.go'}; my $current_page = &calculate_page($page,$command); return $current_page; } @@ -56,6 +60,46 @@ sub calculate_page($$) { return 0 if $dir eq 'BackToStart'; } +sub jscript_zero { + my ($webpath,$jsref) = @_; + my $start_page = + &Apache::loncommon::start_page('Create Testbank directory',undef, + {'only_body' => 1, + 'js_ready' => 1,}); + my $end_page = + &Apache::loncommon::end_page({'js_ready' => 1,}); + my %lt = &Apache::lonlocal::texthash( + loca => 'Location', + newd => 'New Directory', + ente => 'Enter the name of the new directory where you will save the converted testbank questions', + go => 'Go', + ); + $$jsref = <<"END_SCRIPT"; +function createWin() { + document.info.newdir.value = ""; + newWindow = window.open("","CreateDir","HEIGHT=400,WIDTH=750,scrollbars=yes") + newWindow.document.open() + newWindow.document.write('$start_page') + newWindow.document.write("[Author Header]\\n") + newWindow.document.write("

$lt{'loca'}: $webpath

$lt{'newd'}

\\n") + newWindow.document.write("
\\n") + newWindow.document.write("$lt{'ente'}.

") + newWindow.document.write("") + newWindow.document.write("") + newWindow.document.write("") + newWindow.document.write("") + newWindow.document.write("$webpath") + newWindow.document.write("
") + newWindow.document.write('$end_page') + newWindow.document.close() + newWindow.focus() +} + +END_SCRIPT + return; +} + + # ---------------------------------------------------------------- Jscript One sub jscript_one { @@ -86,13 +130,14 @@ function setElements() { var iter = 0 var selParam = 0 END_SCRIPT - if (exists($ENV{'form.blocks'}) ) { + if (exists($env{'form.blocks'}) ) { $$jsref .= qq| - document.forms.display.blocks.value = $ENV{'form.blocks'}\n|; - } elsif (exists($ENV{'form.qnumformat'}) ) { + document.forms.display.blocks.value = $env{'form.blocks'}\n|; + } + if (exists($env{'form.qnumformat'}) ) { $$jsref .= <<"TO_HERE"; for (iter=0; iterCreate Testbank directory\\n") - newWindow.document.write("\\n") - newWindow.document.write("[Author Header]\\n") - newWindow.document.write("\\n") - newWindow.document.write("\\n") - newWindow.document.write("\\n") - newWindow.document.write("\\n") - newWindow.document.write("\\n") - newWindow.document.write("
  

Location: $fullpath

New Directory

  
\\n") - newWindow.document.write("Enter the name of the new directory where you will store the converted testbank questions

") - newWindow.document.write("") - newWindow.document.write("") - newWindow.document.write("") - newWindow.document.write("$fullpath") - newWindow.document.write("") - newWindow.document.write("
") - newWindow.document.close() - newWindow.focus() -} END_OF_ONE if ($source eq "PreviousPage") { $$jsref .= qq| @@ -398,264 +414,168 @@ function setElements() { var iter = 0 var selParam = 0 |; - foreach my $item (keys %ENV) { - if ($item =~ m/^form\.(\w+)$/) { + foreach my $item (keys(%env)) { + if ($item =~ m/^form\.(probfile_\d+)$/) { my $name = $1; - my $value = $ENV{"form.$name"}; - unless ($value eq "") { - if ($name eq "newdir") { - $$jsref .= qq( document.forms.dataForm.$name.value = "$value"\n); - } + my $value = $env{"form.$name"}; + if ($value ne '') { + $$jsref .= qq( document.dataForm.$name.value = "$value"\n); } } } $$jsref .= "}"; } -} + $$jsref .= ' +function verify() { +'; + my $blocks = 0; + if ( exists( $env{'form.blocks'}) ) { + $blocks = $env{'form.blocks'}; + } + my $numitems = 0; + for (my $i=0; $i<$blocks; $i++) { + my $count = 0; + if (($env{"form.start_$i"} ne '') && ($env{"form.end_$i"} ne '')) { + $count = $env{"form.end_$i"} - $env{"form.start_$i"} +1; + } + $numitems += $count; + } + if ($numitems > 0) { + my $maxnum = $numitems - 1; + my %lt = &Apache::lonlocal::texthash( + fnmb => 'File names must be unique', + isum => 'is used more than once', + ); + $$jsref .= qq| + for (var j=$maxnum; j>0; j--) { + var currname = document.dataForm.elements['probfile_'+j].value; + for (var k=j-1; k>=0; k--) { + var comparename = document.dataForm.elements['probfile_'+k].value; + if (currname == comparename) { + alert("$lt{fnmb} - "+currname+" $lt{isum}"); + return false; + } + } + } +|; + } + $$jsref .= ' + return true; +} +'; + $$jsref .= &Apache::loncommon::check_uncheck_jscript(); + return; +} # ---------------------------------------------------------------- Jscript Four sub jscript_four { - my ($jsref,$fullpath) = @_; + my ($jsref,$webpath) = @_; $$jsref = qq| function backtoStart() { - document.location.href="$fullpath" + document.location.href="$webpath" } -function backpage() { +function backPage() { document.forms.verify.go.value="PreviousPage" - document.forms.verify.submit() + document.forms.verify.submit(); } |; } # ---------------------------------------------------------------- Display Zero sub display_zero { - my ($r,$uname,$fn,$page,$fullpath) = @_; - $r->print(qq| - - - - - -
  -The Testbank Upload utility can be used by LON-CAPA authors to convert multiple choice, multiple answer correct, fill-in-the-blank, ordering/ranking, true/false and essay questions from a plain text testbank file to LON-CAPA problem files. Five requirements must be met to ensure that you will succeed in converting your plain text file of testbank questions to functioning LON-CAPA problems. -
    -
  1. The questions and answers you upload must be in plain text format. Any header lines should occur before the text containing the questions and answers.
    2. -
  2. All questions (including question text and all foils) must occur before any of the answers. Each question should begin on a new line, and should start with the question number. Questions should be numbered sequentially using a number followed immediately by a space, a period, or enclosed in parentheses, i.e., 1 , 1., (1), 1), or (1 .
    3. -
  3. Multiple choice and multiple answer correct questions should consist of: (i) the question number followed by (ii) the question text beginning on the same line and (iii) two or more foils, with each foil beginning on a new line and prefixed by a unique letter, or Roman numeral, listed in alphabetic or numeric order, beginning at a (alphabetic) or i (Roman numeral), followed by a period, or enclosed in parentheses, i.e., a., (a), i., or (i).
    4. -
  4. One or more correct answers should be provided for all questions (although blank answers may be provided for essay questions). Answers should be numbered sequentially, using the same scheme as used for the questions, and must occur after all the questions. -
  5. If fill-in-the-blank or multiple answer questions have more than one correct answer, each answer should appear in a comma-, tab-, space-, or new line-delimited list. For a ranking/ordering question, the "answer" should contain the foil identifiers correctly ordered in a similarly delimited list.
    6. -
-Five steps are involved in the import process. -
    -
  1. Upload your text file to the server.|); - + my ($r,$fn,$page,$webpath) = @_; + my $go_default = 'NextPage'; if ($fn eq '') { - $r->print("Incomplete. Please return to the construction space menu to upload a file"); - } else { - $r->print(" Completed - successful upload of $fn"); - } - $r->print(qq|
    2. -
  2. Provide information about the question format - i.e., question numbering style, and the number of blocks of questions of each question type.
    3. -
  3. 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.
    4. -
  4. Create a new directory where you will store the converted testbank questions.
    5. -
  5. Complete the import of questions to the selected pool.
    6. -
- -
-
-
- - - - - - - - - - - -
- - - -
- - |); + $r->print(''.&mt('Incomplete file upload').' '.&mt('Return to the [_1]construction space menu[_2] to upload a file','','')); + } + $r->print(&mt('The Testbank Upload utility can be used by LON-CAPA authors to generate LON-CAPA problem files from a testbank file of questions/answers.').'
'. + &mt('The following question types can be converted:').' + + '.&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').'
'. + &mt('Five steps are involved in the conversion process.').' +
    +
  1. '.&mt('Optionally create a new sub-directory where the converted testbank questions will be saved.').'
    2. +
  2. '.&mt('Provide information about the question format - i.e., question numbering style, and the number of blocks of questions of each question type.').'
    3. +
  3. '.&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.').'
    4. +
  4. '.&mt('Review the identified questions, choose which to convert, and (optionally) override the default filename to be used for each problem file.').'
    5. +
  5. '.&mt('Complete the import of questions.').'
    6. +
'. + &Apache::lonhtmlcommon::topic_bar(1,&mt('Optional: create a sub-directory in which the testbank questions will be saved')). + &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:'). + ' '. + &page_footer($env{'form.newdir'},$fn,$page,$webpath).' +
'); } - # ---------------------------------------------------------------- Display One sub display_one { - my ($r,$uname,$fn,$page,$textref) = @_; - $r->print(qq| -
- - - - - - - - - - - -
  -

Step 2: Identification of blocks of questions 

-
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  - Testbank data uploaded to the server: -
 
  - -
 
 
    - - -Select the format of the question number [e.g., 1, 1., 1), (1 or (1)].  - - -
 
  -A number in the specified format should appear at the start of each question. 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. Correct answers should be numbered in the same way as the questions and should appear after all the questions (including question text and possible foils for all questions). Each numbered question must have a corresponding numbered answer, although the answer itself may be blank for essay questions.
 
  - - For example, you would select 1. if your text file contained the following questions:

- 1. The capital of the USA is ..
-   (a) Washington D.C.
-   (b) New York
-   (c) Los Angeles
-
- 2. The capital of Canada is ..
-   (a) Toronto
-   (b) Vancouver
-   (c) Ottawa
-
- 3. Describe an experiment you could conduct to measure c, the speed of light in a vacuum.

- 1. (a)
- 2. (c)
- 3.
-
 
    - - -Please indicate the number of blocks of different question types in the text file.   - -
 
  - - For example, you would enter 6 if your text file contained the following sequence of questions:

- 10 multiple choice questions
- 5 essay questions
- 5 fill-in-the-blank questions
- 5 multiple answer questions
- 4 multiple choice questions
- 3 essay questions
- -
 
 You will indicate the question type and the question number range for each of the blocks on the next page.
 
- - - - - -
- - - -
- - - - - -
-
-
- |); + my ($r,$fn,$page,$textref,$header) = @_; + my %topics; + $topics{2} = &mt('Select the format of the question number - e.g., 1, 1., 1), (1 or (1) - ').'  + '."\n"; + $topics{3} = &mt('Indicate the number of blocks of different question types in the testbank file.').'  '; + $r->print('

'.&mt('Identification of blocks of questions').'

'."\n". + '
'."\n". + &show_uploaded_data($textref,$header)."\n". + &Apache::lonhtmlcommon::topic_bar(2,$topics{2}).'

'. + &mt('A number in the specified format should appear at the start of each question.').'
'. + &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.').'
'."\n". + &mt('Correct answers should be numbered in the same way as the questions and should appear after all the questions (including question text and possible foils for all questions).').'
'."\n". + &mt('Each numbered question must have a corresponding numbered answer, although the answer itself may be blank for essay questions.').'

'."\n". + &mt('For example, you would select 1. if your testbank file contained the following questions:').'

'. +'
+ 1. '.&mt('The capital of the USA is ...').'
+ (a) Washington D.C.
+ (b) New York
+ (c) Los Angeles
+
+ 2. '.&mt('The capital of Canada is ...').'
+ (a) Toronto
+ (b) Vancouver
+ (c) Ottawa
+
+ 3. '.&mt('Describe an experiment you could conduct to measure c, the speed of light in a vacuum.').'
+ 1. (a)
+ 2. (c)
+ 3.
+
'. + '

'. + &Apache::lonhtmlcommon::topic_bar(3,$topics{3}).'

'. + &mt('For example, you would enter 6 if your testbank file contained the following sequence of questions:').'

'. + &mt('10 multiple choice questions').'
'. + &mt('5 essay questions').'
'. + &mt('5 fill-in-the-blank questions').'
'. + &mt('5 multiple answer questions').'
'. + &mt('4 multiple choice questions').'
'. + &mt('3 essay questions').'

'. + &mt('You will indicate the question type and the question number range for each of the blocks on the next page.').'


'. + &page_footer($env{'form.newdir'},$fn,$page).' +
'); + return; } # ---------------------------------------------------------------- Display Two sub display_two { - my ($r,$uname,$fn,$page,$textref,$qcount) = @_; - my $blocks = $ENV{'form.blocks'}; - my $qnumformat = $ENV{'form.qnumformat'}; + my ($r,$fn,$page,$textref,$header,$qcount) = @_; + my $blocks = $env{'form.blocks'}; + my $qnumformat = $env{'form.qnumformat'}; my @types = ("MC","MA","TF","Ess","FIB","Ord"); my %typenames = ( MC => "Multiple Choice", @@ -672,210 +592,84 @@ sub display_two { leadparen => "(1", trailparen => "1)", ); - my @bgcolors = ('#ffffff','#eeeeee'); my $bl1st = ''; my $bl1end = ''; if ($blocks == 1) { $bl1st = '1'; $bl1end = $qcount; } - $r->print(<<"END_OF_FUNC"); -

Step 3: Classification of blocks 

-
- - - - - - - -
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  - You indicated that all questions (and the corresponding answer(s) for each question) begin with a number in the following format: $qnumtypes{$qnumformat}.

A total of $qcount questions and $qcount corresponding answers were found in the file you uploaded. If this questions total does not match the number you expect, please examine your original text file to verify that each question and each answer begins with a number in the specified format. If necessary use a text editor to edit your text file of questions, and click "Return to step 2" on this page and the "Return to Step 1" on the preceding page, so you can upload your text file again.

- You also indicated that the $qcount questions can be divided into $blocks blocks of questions of a particular question type. -
 
  - Please 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. -
 
  -The following data were uploaded to the server
- -
 
-    - Information about question types and formats in each block. -
 
 For each of the $blocks question blocks, please 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. Please provide additional information about foil formats and answer formats if required for the question type you selected. -
 
  - - - - -
- - - - -
- - - - - - - - - - |); + my $steptitle = &mt('Information about question types and formats in each block.'); + $r->print('

'.&mt('Classification of blocks').'

'. + '

'. + &mt('You indicated that all questions (and the corresponding answer(s) for each question) begin with a number in the following format: [_1].',''.$qnumtypes{$qnumformat}.'').'

'. + &mt('A total of [quant,_1,question] and [quant,_2,answer] were found in the file you uploaded.',$qcount,$qcount).' '. + &mt('If this total does not match the number you expect, examine your original testbank file to verify that each question and each answer begins with a number in the specified format.').' '. + &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.').'

'. + &mt('You also indicated that the [quant,_1,question] can be divided into [quant,_2,block] of questions of a particular question type.',$qcount,$blocks).'

'. + &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.').'

'. + &show_uploaded_data($textref,$header). + &Apache::lonhtmlcommon::topic_bar(4,$steptitle).'

'. + &mt('For each 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.',''.$blocks.'').' '. + &mt('If required, provide additional information about foil formats and answer formats for the question types you select.').'

'. + &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + '

'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + &Apache::loncommon::end_data_table_header_row()); for (my $i=0; $i<$blocks; $i++) { my $iter = $i+1; - my $rowcol = $i%2; - $r->print(qq| - - - - - '."\n". + ''."\n". + ''."\n". + ' - - - - |); + '. + &Apache::loncommon::end_data_table_row()); } - $r->print(qq| -
-  Block  -   -  First number  -   -  Last number  -   -  Question type  -   -  Foil format  -   -  Answer format  -
'.&mt('Block').''.&mt('First number').''.&mt('Last number').''.&mt('Question type').''.&mt('Foil format').''.&mt('Answer format').'
-  $iter. -   -   -   -   - - -  '.$iter.'      + - + $r->print('   -   +     -   + -
-
-
-
 
  -For multiple choice, multiple correct answer and ranking type questions, you must use the Foil format 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. For multiple correct answer and fill-in-the-blank questions with more than one correct answer you must use the Answer format column to choose the separator used between the answers, e.g., if the correct answers for question 28. were listed as: 28. (a),(d),(e) you would choose "comma", or if they were listed as:
28. (a)
 (d)
 (e)
-you would choose "new line". For true/false questions you must use the Answer format 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.). For ranking questions you must use the Answer format column to choose the separator used between the (ranked) answers.

-
 
- - - - - - - -
- - - -
- - - - - - -
-
- |); -} + $r->print(&Apache::loncommon::end_data_table().'

+ +'. + &page_footer($env{'form.newdir'},$fn,$page).' +'); + return; +} + # ---------------------------------------------------------------- Display Three -sub display_three { - my ($r,$uname,$fn,$page,$textref,$qcount) = @_; - my $qnumformat = $ENV{'form.qnumformat'}; - my $filename = $ENV{'form.filename'}; - my $source = $ENV{'form.go'}; - my $blocks = $ENV{'form.blocks'}; - my @items = (); - my @bgcolors = ('#ffffff','#eeeeee'); - my @types = ("MC","MA","TF","Ess","FIB","Ord"); - 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"); - 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"); +sub display_three { + my ($r,$fn,$page,$textref,$res,$header,$webpath,$qcount) = @_; + my $qnumformat = $env{'form.qnumformat'}; + my $filename = $env{'form.filename'}; + my $source = $env{'form.go'}; + my $blocks = $env{'form.blocks'}; + my ($alphabet,$romans) = &get_constants(); my @start = (); my @end = (); my @nums = (); @@ -884,19 +678,28 @@ sub display_three { my @ansrtypes = (); my %multparts = (); my $numitems = 0; + my %lt = &Apache::lonlocal::texthash ( + crt => 'Create?', + typ => 'Type', + fnam => 'File Name', + ques => 'Question', + answ => 'Answer', + chka => 'check all', + unch => 'uncheck all', + ); for (my $i=0; $i<$blocks; $i++) { - if (($ENV{"form.start_$i"} ne '') && ($ENV{"form.end_$i"} ne '')) { - $start[$i] = $ENV{"form.start_$i"}; - $end[$i] = $ENV{"form.end_$i"}; + if (($env{"form.start_$i"} ne '') && ($env{"form.end_$i"} ne '')) { + $start[$i] = $env{"form.start_$i"}; + $end[$i] = $env{"form.end_$i"}; $nums[$i] = $end[$i]-$start[$i] +1; - $qtype[$i] = $ENV{"form.qtype_$i"}; + $qtype[$i] = $env{"form.qtype_$i"}; if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) { - $foilformats[$i] = $ENV{"form.foilformat_$i"}; + $foilformats[$i] = $env{"form.foilformat_$i"}; } else { $foilformats[$i] = ''; } if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) { - $ansrtypes[$i] = $ENV{"form.ansr_$i"}; + $ansrtypes[$i] = $env{"form.ansr_$i"}; } else { $ansrtypes[$i] = ''; } @@ -905,202 +708,165 @@ sub display_three { } $numitems += $nums[$i]; } - - my $import = join//,@{$textref}; - @items = &file_split(\@start,\@end,\@nums,$qnumformat,\@foilformats,$textref,\%multparts,$numitems,\@qtype,$blocks); - $r->print(<<"END_OF_ONE"); -

Step 4: Review and selection of destination directory 

-
- - - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
  -Based on your previous responses your data have been split into a total of $numitems questions. -
 
  - - - - -
- - - - -
- - - - -
- - -END_OF_ONE + my ($items,$ids,$footer) = &file_split(\@start,\@end,\@nums,$qnumformat,\@foilformats,$textref,\%multparts,$numitems,\@qtype,$blocks); + my ($showheader,$showcss); + if ($res eq 'application/rtf' || $res eq 'text/html') { + if ($header ne '') { + $showheader = &HTML::Entities::decode($header); + if ($res eq 'text/html') { + $showheader = &build_image_url($webpath,$showheader); + } + } + } + $r->print('

'.&mt('Review and selection of problems to convert').'

'."\n". + ''."\n". + &mt('Based on your previous responses your data have been split into a total of [quant,_1,question].',$numitems). + &Apache::lonhtmlcommon::topic_bar(5,&mt('Choose which problems to convert and names to use for individual problem files'))); + if ($showheader) { + $r->print($showheader.'
'); + } + $r->print('   +

'. + &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + ''. + ''. + ''. + ''. + ''. + ''. + &Apache::loncommon::end_data_table_header_row()); + my $idx; + if ($numitems =~ /^\d+$/ && $numitems > 0) { + $idx = int(log($numitems)/log(10)); + $idx ++; + } + if ($idx<3) { + $idx = 3; + } for (my $j=0; $j<$numitems; $j++) { - my $qnum = $j+1; - my $rowcol = $j%2; - $rowcol = @bgcolors[$rowcol]; + my $qnum = $ids->[$j]; + my $libfile = 'question_'; + my $leading = 0; + while (($idx - length($qnum) - $leading) > 0) { + $libfile .= '0'; + $leading ++; + } + $libfile .= $qnum.'.problem'; for (my $i=0; $i<$blocks; $i++) { if ($nums[$i] > 0) { if (($j+1 >= $start[$i]) && ($j+1 <= $end[$i])) { if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA")) { for (my $k=0; $k<@{$multparts{$j}}; $k++) { if ($k == 0) { - $r->print(qq|'."\n". + ''."\n". + ''."\n". + ''. + '|); + my $showfoil = $items->[$j+$numitems]; + if ($res eq 'application/rtf' || $res eq 'text/html') { + $showfoil = &HTML::Entities::decode($showfoil); + $showfoil =~ s/<\/?[^>]+>//g; + } + + $r->print('
'. + &Apache::loncommon::end_data_table_row()); } else { - $r->print(qq||); + my $showfoil = $items->[$j+$numitems]; + if ($res eq 'application/rtf' || $res eq 'text/html') { + $showfoil = &HTML::Entities::decode($showfoil); + $showfoil =~ s/<\/?[^>]+>//g; + } + $r->print(&Apache::loncommon::start_data_table_row(). + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + &Apache::loncommon::end_data_table_row()); } last; } } } } - $r->print(qq| -
#TypeQuestionAnswer
'.#'.'.$lt{'crt'}.''.$lt{'typ'}.''.$lt{'fnam'}.''.$lt{'ques'}.''.$lt{'answ'}.'
$qnum.$qtype[$i]$multparts{$j}[$k]

\n|); - } else { + my $showqn = $multparts{$j}[$k]; + if (($res eq 'application/rtf') || ($res eq 'text/html')) { + $showqn = &HTML::Entities::decode($showqn); + if ($res eq 'text/html') { + $showqn = &build_image_url($webpath,$showqn); + } + } + $r->print(&Apache::loncommon::start_data_table_row(). + '		'.$qnum.'.'.$qtype[$i].''.$showqn.'

'."\n"); + } else { my $foiltag = ''; if ($foilformats[$i] eq "lcperiod") { - $foiltag = $alphabet[$k-1].'.'; + $foiltag = $alphabet->[$k-1].'.'; } elsif ($foilformats[$i] eq "lcparen") { - $foiltag = '('.$alphabet[$k-1].')'; + $foiltag = '('.$alphabet->[$k-1].')'; } elsif ($foilformats[$i] eq "lconeparen") { - $foiltag = $alphabet[$k-1].')'; + $foiltag = $alphabet->[$k-1].')'; } elsif ($foilformats[$i] eq "lcdotparen") { - $foiltag = $alphabet[$k-1].'.)'; + $foiltag = $alphabet->[$k-1].'.)'; } elsif ($foilformats[$i] eq "ucperiod") { - $foiltag = $alphabet[$k-1].'.'; + $foiltag = $alphabet->[$k-1].'.'; $foiltag =~ tr/a-z/A-Z/; } elsif ($foilformats[$i] eq "ucparen") { - $foiltag = '('.$alphabet[$k-1].')'; + $foiltag = '('.$alphabet->[$k-1].')'; $foiltag =~ tr/a-z/A-Z/; } elsif ($foilformats[$i] eq "uconeparen") { - $foiltag = $alphabet[$k-1].')'; + $foiltag = $alphabet->[$k-1].')'; $foiltag =~ tr/a-z/A-Z/; } elsif ($foilformats[$i] eq "ucdotparen") { - $foiltag = $alphabet[$k-1].'.)'; + $foiltag = $alphabet->[$k-1].'.)'; $foiltag =~ tr/a-z/A-Z/; } elsif ($foilformats[$i] eq "romperiod") { - $foiltag = $romans[$k-1].'.'; + $foiltag = $romans->[$k-1].'.'; } elsif ($foilformats[$i] eq "romparen") { - $foiltag = '('.$romans[$k-1].')'; + $foiltag = '('.$romans->[$k-1].')'; } elsif ($foilformats[$i] eq "romoneparen") { - $foiltag = $romans[$k-1].')'; + $foiltag = $romans->[$k-1].')'; } elsif ($foilformats[$i] eq "romdotparen") { - $foiltag = $romans[$k-1].'.)'; + $foiltag = $romans->[$k-1].'.)'; + } + my $showfoil = $multparts{$j}[$k]; + if ($res eq 'application/rtf' || $res eq 'text/html') { + $showfoil = &HTML::Entities::decode($showfoil); + if ($res eq 'text/html') { + $showfoil = &build_image_url($webpath,$showfoil); + } } - $r->print(qq|$foiltag $multparts{$j}[$k]
\n|); + $r->print("$foiltag $showfoil
\n"); } } - $r->print(qq|
$items[$j+$numitems]
'.$showfoil.'
$qnum.$qtype[$i]$items[$j]$items[$j+$numitems]
'.$qnum.''.$qtype[$i].''.$items->[$j].''.$showfoil.'
-
-
-
-
 
-    - Create a directory to store your testbank questions. -
 
  - -Please choose a destination LON-CAPA directory in which to store your uploaded questions.   -
 
 If you are satisfied with the questions and answers extracted from your uploaded text file, as shown above, and you have created a destination directory click the "Continue to step 5" button to convert the questions in your testbank to LON-CAPA problem files.
- - - - - - - - |); + $r->print(&Apache::loncommon::end_data_table().'

'."\n". + ''."\n". + ''); for (my $i=0; $i<$blocks; $i++) { - $r->print(qq| - - - - |); + $r->print(' + + + '); if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) { - $r->print(qq| - - |); + $r->print(' + '); } if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) { - $r->print(qq| - - |); - } - } - $r->print(qq| -

 

- - - - - -
- - - -
-
-
-
- |); + $r->print(' + '); + } + } + $r->print('

'.&page_footer($env{'form.newdir'},$fn,$page).' + '); } # ---------------------------------------------------------------- Final Display sub final_display { - my ($r,$uname,$fn,$page,$textref) = @_; - my $qnumformat = $ENV{'form.qnumformat'}; - my $blocks = $ENV{'form.blocks'}; - my $newdir = $ENV{'form.newdir'}; - my $linkdir = $newdir; - if ($linkdir =~ m#^/home/$uname/public_html/(.+)$#) { - $linkdir = '/priv/'.$uname.'/'.$1; - } + my ($r,$fn,$page,$textref,$res,$header,$css,$js,$webpath,$dirpath,$subdir) = @_; + my $qnumformat = $env{'form.qnumformat'}; + my $blocks = $env{'form.blocks'}; my $question_id = ''; my @question_title = (); my @question_status = (); @@ -1112,35 +878,32 @@ sub final_display { my @ansrtypes = (); my %multparts = (); my $numitems = 0; + my @createprobs = &Apache::loncommon::get_env_multiple('form.createprob'); for (my $i=0; $i<$blocks; $i++) { - $start[$i] = $ENV{"form.start_$i"}; - $end[$i] = $ENV{"form.end_$i"}; + $start[$i] = $env{"form.start_$i"}; + $end[$i] = $env{"form.end_$i"}; if (($end[$i] - $start[$i]) >= 0) { $nums[$i] = $end[$i] - $start[$i]+1; } else { $nums[$i] = 0; } - $qtype[$i] = $ENV{"form.qtype_$i"}; + $qtype[$i] = $env{"form.qtype_$i"}; if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) { - $foilformats[$i] = $ENV{"form.foilformat_$i"}; + $foilformats[$i] = $env{"form.foilformat_$i"}; } else { $foilformats[$i] = ''; } if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF") || ($qtype[$i] eq "Ord")) { - $ansrtypes[$i] = $ENV{"form.ansr_$i"}; + $ansrtypes[$i] = $env{"form.ansr_$i"}; } $numitems += $nums[$i]; } - my @bgcolors = ('#ffffff','#eeeeee'); - - my $import = join/'\s'/,@{$textref}; - my %answers = (); - my @items = &file_split(\@start,\@end,\@nums,$qnumformat,\@foilformats,$textref,\%multparts,$numitems,\@qtype,$blocks); + my %answers; + my ($items,$ids,$footer) = &file_split(\@start,\@end,\@nums,$qnumformat,\@foilformats,$textref,\%multparts,$numitems,\@qtype,$blocks); # Converting MC and MA answer to number, and splitting answers for FIB, and ordering for Ord. - 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"); - 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"); + my ($alphabet,$romans) = &get_constants(); my %patterns = ( comma => ',', space => '\s+', @@ -1151,240 +914,299 @@ sub final_display { if ($nums[$i] > 0) { if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "Ord")) { for (my $k=$numitems+$start[$i]-1; $k<$numitems+$end[$i]; $k++) { - @{$answers{$k}} = (); + my $qnum = $k - $numitems; + next if (!grep(/^$qnum$/,@createprobs)); + if (($res eq 'application/rtf') || ($res eq 'text/html')) { + $items->[$k] = &HTML::Entities::decode($items->[$k]); + } + @{$answers{$qnum}} = (); if ($qtype[$i] eq "MC") { - $items[$k] =~ tr/A-Z/a-z/; - $items[$k] =~ s/\W//g; + $items->[$k] =~ tr/A-Z/a-z/; + $items->[$k] =~ s/<\/?[^>]+>//g; + $items->[$k] =~ s/\W//g; 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") { - for (my $j=0; $j<@alphabet; $j++) { - if ($alphabet[$j] eq $items[$k]) { - push @{$answers{$k}}, $j; + for (my $j=0; $j<@{$alphabet}; $j++) { + if ($alphabet->[$j] eq $items->[$k]) { + push @{$answers{$qnum}}, $j; last; } } } elsif (($foilformats[$i] eq "romparen") || ($foilformats[$i] eq "romperiod") || ($foilformats[$i] eq "romoneparen") || ($foilformats[$i] eq "romdotparen")) { - for (my $j=0; $j<@romans; $j++) { - if ($romans[$j] eq $items[$k]) { - push @{$answers{$k}}, $j; + for (my $j=0; $j<@{$romans}; $j++) { + if ($romans->[$j] eq $items->[$k]) { + push @{$answers{$qnum}}, $j; last; } } } } elsif (($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) { - $items[$k] =~ tr/A-Z/a-z/; - my @corrects = split/$patterns{$ansrtypes[$i]}/,$items[$k]; + $items->[$k] =~ tr/A-Z/a-z/; + $items->[$k] =~ s/<\/?[^>]+>//g; + my @corrects = split/$patterns{$ansrtypes[$i]}/,$items->[$k]; foreach my $correct (@corrects) { - $correct =~s/\W//g; + my @tied; + if ($qtype[$i] eq "Ord") { + if ($correct =~ /=/) { + @tied = split(/=/,$correct); + for (my $j=0; $j<@tied; $j++) { + $tied[$j] =~ s/\W//g; + } + } else { + $correct =~s/\W//g; + } + } else { + $correct =~s/\W//g; + } if ($foilformats[$i] eq "lcperiod" || $foilformats[$i] eq "lcparen" || $foilformats[$i] eq "ucparen" || $foilformats[$i] eq "ucperiod") { - for (my $j=0; $j<@alphabet; $j++) { - if ($alphabet[$j] eq $correct) { - push @{$answers{$k}}, $j; - last; + if (($qtype[$i] eq "Ord") && (@tied > 0)) { + my @ties; + foreach my $tie (@tied) { + for (my $j=0; $j<@{$alphabet}; $j++) { + if ($alphabet->[$j] eq $tie) { + push(@ties,$j); + last; + } + } + } + my $ans = join('=',@ties); + push(@{$answers{$qnum}},$ans); + } else { + for (my $j=0; $j<@{$alphabet}; $j++) { + if ($alphabet->[$j] eq $correct) { + push @{$answers{$qnum}}, $j; + last; + } } } } elsif (($foilformats[$i] eq "romparen") || ($foilformats[$i] eq "romperiod") || ($foilformats[$i] eq "romoneparen") || ($foilformats[$i] eq "romdotparen")) { - for (my $j=0; $j<@romans; $j++) { - if ($romans[$j] eq $correct) { - push @{$answers{$k}}, $j; - last; + if (($qtype[$i] eq "Ord") && (@tied > 0)) { + my @ties; + foreach my $tie (@tied) { + for (my $j=0; $j<@{$romans}; $j++) { + if ($romans->[$j] eq $tie) { + push(@ties,$j); + last; + } + } + } + push(@{$answers{$qnum}},join('=',@ties)); + } else { + for (my $j=0; $j<@{$romans}; $j++) { + if ($romans->[$j] eq $correct) { + push @{$answers{$qnum}}, $j; + last; + } } } } } } elsif ($qtype[$i] eq "FIB") { - @{$answers{$k}} = split/$patterns{$ansrtypes[$i]}/,$items[$k]; - for (my $j=0; $j<@{$answers{$k}}; $j++) { - $answers{$k}[$j] =~ s/^\s+//; - $answers{$k}[$j] =~ s/\s+$//; + $items->[$k] =~ s/<\/?[^>]+>//g; + @{$answers{$qnum}} = split/$patterns{$ansrtypes[$i]}/,$items->[$k]; + for (my $j=0; $j<@{$answers{$qnum}}; $j++) { + $answers{$qnum}[$j] =~ s/^\s+//; + $answers{$qnum}[$j] =~ s/\s+$//; + if ($j==0) { + $answers{$qnum}[$j] =~ s/^<[^>]+>//; + } elsif ($j == @{$answers{$qnum}}-1) { + $answers{$qnum}[$j] =~ s/<\/[^>]+>$//; + } } } } } } } - my $pooltarget = ''; - my $pooldesc = ''; - my @newquestions = (); - my $numquestions = 0; - my %qtype = (); - my %qtext = (); - my %qflag = (); - - $r->print(<<"END_OF_BLOCK"); -
- - - - - - - - - - - -END_OF_BLOCK - if ($newdir ne "") { - my @qn_file = (); + my $state; + + $r->print(''."\n". + ''."\n". + ''."\n"); + for (my $i=0; $i<$blocks; $i++) { + $r->print(' + + + + '."\n"); + } + for (my $i=0; $i<$numitems; $i++) { + $r->print(''."\n"); + } + $r->print(&Apache::lonhtmlcommon::topic_bar(6,&mt('Result of conversion of testbank questions to LON-CAPA problems'))); + my $destdir = $dirpath; + if ($destdir ne '' && $subdir ne '') { + $subdir .= '/'; + $destdir .= $subdir; + } + if (@createprobs == 0) { + $state = 'unchecked'; + $r->print('

'.&mt('No questions were selected for conversion.').'

'. + &page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).''); + } elsif (($destdir ne '') && (-e $destdir)) { + my (@qn_file,@result,@numid); my $qcount = 0; + my $itemcount = 0; for (my $i=0; $i<$blocks; $i++) { if ($nums[$i] > 0) { if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "Ord")) { for (my $j=$start[$i]-1; $j<$end[$i]; $j++) { + $numid[$qcount] = $ids->[$itemcount]; + $itemcount ++; + next if (!grep(/^$qcount$/,@createprobs)); + my $libfile = &probfile_name($j); my $answer = $j + $numitems; - my $numans = scalar(@{$answers{$answer}}); + my $numans = scalar(@{$answers{$qcount}}); my $foilcount = 0; if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "Ord")) { $foilcount = @{$multparts{$j}}; $foilcount --; } - $qn_file[$qcount] = &create_mcq($newdir,\@{$multparts{$j}},\@{$answers{$answer}},$qtype[$i],$j); + ($result[$qcount],$qn_file[$qcount]) = &create_mcq($destdir,$subdir,\@{$multparts{$j}},\@{$answers{$qcount}},$qtype[$i],$libfile,$res,$header,$footer,$js,$css); $qcount ++; - push @newquestions, $question_id; } } elsif ($qtype[$i] eq "TF") { for (my $j=$start[$i]-1; $j<$end[$i]; $j++) { + $numid[$qcount] = $ids->[$itemcount]; + $itemcount ++; + next if (!grep(/^$qcount$/,@createprobs)); + my $libfile = &probfile_name($j); my $answer = $j + $numitems; - $items[$answer] =~ s/^\s+//; - $items[$answer] =~ s/\s+$//; - $items[$answer] =~ s/\W//g; - $items[$answer] =~ tr/A-Z/a-z/; + $items->[$answer] =~ s/^\s+//; + $items->[$answer] =~ s/\s+$//; + $items->[$answer] =~ s/\W//g; + $items->[$answer] =~ tr/A-Z/a-z/; my $answer_id = ''; if ($ansrtypes[$i] eq 'word' ) { - if ($items[$answer] =~ m/true/) { + if ($items->[$answer] =~ m/true/) { $answer_id = 0; } else { $answer_id = 1; } } elsif ($ansrtypes[$i] eq 'lett') { - if ($items[$answer] =~ m/^t/) { + if ($items->[$answer] =~ m/^t/) { $answer_id = 0; } else { $answer_id = 1; } } - $qn_file[$qcount] = create_ess($newdir,$answer_id,$items[$j],$items[$answer],$qtype[$i],$j); - push @newquestions, $question_id; + ($result[$qcount],$qn_file[$qcount]) = &create_ess($destdir,$subdir,$answer_id,$items->[$j],$items->[$answer],$qtype[$i],$libfile,$res,$header,$footer,$js,$css); $qcount ++; } } elsif ($qtype[$i] eq "Ess") { for (my $j=$start[$i]-1; $j<$end[$i]; $j++) { + $numid[$qcount] = $ids->[$itemcount]; + $itemcount ++; + next if (!grep(/^$qcount$/,@createprobs)); + my $libfile = &probfile_name($j); my $answer = $j + $numitems; my $answer_id = ''; - $qn_file[$qcount] = create_ess($newdir,$answer_id,$items[$j],$items[$answer],$qtype[$i],$j); - push @newquestions, $question_id; + ($result[$qcount],$qn_file[$qcount]) = &create_ess($destdir,$subdir,$answer_id,$items->[$j],$items->[$answer],$qtype[$i],$libfile,$res,$header,$footer,$js,$css); $qcount ++; } } } } - $r->print(qq| - - - |); + if ($result[$i] eq 'ok') { + $successes .= ''.$numid[$i].': '. + $qn_file[$i].'
'."\n"; + } elsif ($result[$i] eq 'failed') { + $failures .= $numid[$i].': '.$qn_file[$i].'
'."\n"; + } elsif ($result[$i] eq 'exists') { + $existing .= ''.$numid[$i].': '. + $qn_file[$i].'
'."\n"; + } + } + if ($successes) { + $r->print('

'.&mt('Individual problem files have been created from the following problems included in the testbank file:').'
'.$successes.'

'. + &mt('The problems must be published before they can be used in a course').'

'); + } + if ($failures) { + $r->print('

'.&mt('An error occurred when opening files for the following problems, so they have not been created:').'
'.$failures.'

'); + } + if ($existing) { + $r->print('

'.&mt('The following files already existed, and were not overwritten so these problems generated from the testbank have not been saved:').'
'.$existing.'

'); + $state = 'existing'; + } + $r->print(&page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).''); } else { - $r->print(qq| - - - - - - - -
  -
  -    -  Result of conversion of tesbank questions to LON-CAPA problems. -
 
 Individual problem files have been created from the problems included in the textbank file: -
    |); + my ($successes,$failures,$existing); for (my $i=0; $i<@qn_file; $i++) { - my $display = $i+1; - $r->print(qq| -
  • Problem $display file
    • - |); - } - $r->print(qq| -
 The problems must be published before they can be used in a course.
 No destination file was selected or created, so import of your questions could not proceed. - Please return to the previous page and select a valid file into which to import the questions. - - - - - - - - - |); - for (my $i=0; $i<$blocks; $i++) { - $r->print(qq| - - - - - - |); - } - $r->print(<<"END_OF_FAIL"); -
- - - - -
- -
-
- - - - - - - - - -END_OF_FAIL + $state = 'nodir'; + $r->print('

'.&mt('No destination directory was available so import of questions could not proceed.').'

'. + &page_footer($env{'form.newdir'},$fn,$page,$webpath,$subdir,$state).''); + } return; - } - $r->print(<<"END_OF_BODY"); - - - - - - - -   - - - - - - - - - - - - - - - - -
- -
- - - - - - - - - - -END_OF_BODY +} + +sub show_uploaded_data { + my ($textref,$header) = @_; + my $output = '

'.&mt('Testbank data uploaded to the server').'

'."\n". + '

'; + return $output; +} + +sub page_footer { + my ($newdir,$fn,$page,$webpath,$subdir,$state) = @_; + my $prevval = &mt('Previous Page'); + my $nextval = &mt('Next Page'); + my $prevclick = 'javascript:backPage();'; + my $nextclick = 'javascript:nextPage();'; + my $go = ''; + if (($page == 0) || ($state eq 'badfile')) { + $go = 'NextPage'; + $prevval = &mt('Exit Now'); + $prevclick = 'javascript:location.href='."'$webpath';"; + $nextclick = 'javascript:submit();' + } elsif ($page == 3) { + $nextval = &mt('Complete Testbank Conversion'); + } elsif ($page == 4) { + if (($state ne 'existing') && ($state ne 'unchecked')) { + my $destdir = $webpath; + if ($subdir ne '') { + $destdir = $webpath.$subdir; + } + $prevval = &mt('Back to Directory'); + $prevclick = 'javascript:location.href='."'$destdir';"; + } + } + my $output = ' + + + + + + '; + if ($page ne '') { + $output .= ' + + + '; + if (($page < 4) && ($state ne 'badfile')) { + $output .= ' + + '; + } + $output .= ' +
+ +   + +
+'; + } + return $output; } sub question_count { @@ -1410,36 +1232,48 @@ sub question_count { return $qcount; } +sub get_constants { + 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"); + 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"); + return (\@alphabet,\@romans); +} + sub file_split { my ($startsref,$endsref,$numsref,$qnumformat,$foilsref,$textref,$multpartsref,$numitems,$qtyperef,$blocks) = @_; my $text_in = join "\n", @{$textref}; $text_in = "\n ".$text_in; my $dignum = length($numitems); - my $numpat; + my ($qpatst,$qpatend,$numpat,@questions,@qids); + my $numpat = '\d{1'; if ($dignum > 1) { - $numpat = ','.$dignum.'}'; + $numpat .= ','.$dignum.'}'; } else { - $numpat = '}'; + $numpat .= '}'; } - my $qpattern =''; if ($qnumformat eq "period") { - $qpattern = '\d{1'.$numpat.'\.'; + $qpatend = '\.'; } elsif ($qnumformat eq "paren") { - $qpattern = '\(\d{1'.$numpat.'\)'; - } elsif ($qnumformat eq "number") { - $qpattern = '\d{1'.$numpat; + $qpatst = '\('; + $qpatend = '\)'; } elsif ($qnumformat eq "leadparen") { - $qpattern = '\(\d{1'.$numpat; + $qpatst = '\('; } elsif ($qnumformat eq "trailparen") { - $qpattern = '\d{1'.$numpat.'\)'; + $qpatend = '\)'; } - my @questions = split/[\r\n\f]+\s*$qpattern\s*/,$text_in; + my @lines = split/[\r\n\f]+\s*$qpatst($numpat)$qpatend\s*/,$text_in; # my @questions = split/\n\s\d{1,3}\.\s/,$text_in; - shift @questions; + shift(@lines); + for (my $i=0; $i<@lines; $i++) { + if ($i%2) { + push(@questions,$lines[$i]); + } else { + push(@qids,$lines[$i]); + } + } my %multparts = (); for (my $i=0; $i<$blocks; $i++) { if (${$numsref}[$i] > 0) { - if ((${$qtyperef}[$i] eq "MC") || (${$qtyperef}[$i] eq "MA")) { + if ((${$qtyperef}[$i] eq "MC") || (${$qtyperef}[$i] eq "MA") || (${$qtyperef}[$i] eq "Ord")) { my $splitstr = ''; if (${$foilsref}[$i] eq "lcperiod") { $splitstr = '[a-z]\.'; @@ -1476,32 +1310,43 @@ sub file_split { } } } - } + } + my ($lastanswer,$footer) = ($questions[-1] =~ /^([,\r\n\f\t\s().A-Za-z]+)(.+)$/); + if ($footer ne '') { + $questions[-1] = $lastanswer; + } %{$multpartsref} = %multparts; - return @questions; + return (\@questions,\@qids,$footer); } # create_mcq builds an MC, MA, Ord or FIB question sub create_mcq { - my ($newdir,$qstnref,$answerref,$qtype,$qnum) = @_; - $qnum ++; - if (length($qnum) == 1) { - $qnum = "00".$qnum; - } elsif (length($qnum) == 2) { - $qnum = "0".$qnum; - } + my ($destdir,$subdir,$qstnref,$answerref,$qtype,$libfile,$res,$header,$footer,$js,$css) = @_; + my $qstn = ${$qstnref}[0]; my $numfoils = scalar(@{$qstnref}) - 1; my $datestamp = localtime; - my $timestamp = time; - my $libfile = 'question_'.$qnum; - $libfile .= '.problem'; my $numansrs = scalar(@{$answerref}); - my $output = qq| - $qstn - |; - + my $output = ''; + if ($qtype eq 'MC') { + $output .= "\n".''; + } + $output .= ' + '; + if ($res eq 'application/rtf' || $res eq 'text/html') { + if ($header ne '') { + $output .= &HTML::Entities::decode($header); + } + if ($js ne '') { + $output .= &HTML::Entities::decode($js); + } + if ($css ne '') { + $output .= &HTML::Entities::decode($css); + } + $qstn = &HTML::Entities::decode($qstn); + } + $output .= $qstn.''."\n"; if ($qtype eq "MA") { $output .= qq| @@ -1514,14 +1359,16 @@ sub create_mcq { } else { $output .= "False\" location=\"random\""; } - $output .= "\>".${$qstnref}[$k+1]."\n"; + my $showfoil = ${$qstnref}[$k+1]; + if ($res eq 'application/rtf' || $res eq 'text/html') { + $showfoil = &HTML::Entities::decode($showfoil); + } + $output .= "\>$showfoil\n"; } chomp($output); $output .= qq| - - - |; + |; } if ($qtype eq "MC") { $output .= qq| @@ -1540,32 +1387,53 @@ sub create_mcq { } else { $output .= "random\""; } - $output .= "\>".${$qstnref}[$k+1]."\n"; + my $showfoil = ${$qstnref}[$k+1]; + if ($res eq 'application/rtf' || $res eq 'text/html') { + $showfoil = &HTML::Entities::decode($showfoil); + } + $output .= "\>$showfoil\n"; } chomp($output); $output .= qq| - - - |; + |; } - if ($qtype eq "Ord") { $output .= qq| |; for (my $k=0; $k<@{$qstnref}-1; $k++) { - $output .= " ".${$qstnref}[$k+1]."\n"; + my $ansval; + my $num = 0; + for (my $i=0; $i<@{$answerref}; $i++) { + if ($$answerref[$i] =~ /=/) { + my @tied = split(/=/,$$answerref[$i]); + foreach my $tie (@tied) { + if ($k == $tie) { + $ansval = $num + 1; + last; + } + } + $num += scalar(@tied); + } elsif ($k == $$answerref[$i]) { + $ansval = $num + 1; + last; + } else { + $num ++; + } + } + my $showfoil = ${$qstnref}[$k+1]; + if ($res eq 'application/rtf' || $res eq 'text/html') { + $showfoil = &HTML::Entities::decode($showfoil); + } + $output .= " $showfoil\n"; } chomp($output); $output .= qq| - - - |; + |; } - if ($qtype eq "FIB") { my $numerical = 1; for (my $i=0; $i<@{$answerref}; $i++) { @@ -1597,18 +1465,14 @@ sub create_mcq { - - -|; +|; } else { if (@{$answerref} == 1) { $output .= qq| - - -|; +|; } else { for (my $i=0; $i<@{$answerref}; $i++) { ${$answerref}[$i] =~ s/\|/\|/g; @@ -1619,44 +1483,64 @@ sub create_mcq { - - -|; +|; } } } - open(PROB,">$newdir/$libfile"); - print PROB $output; - close PROB; - return $libfile; + if ($footer ne '') { + $output .= ''.&HTML::Entities::decode($footer).''; + } + $output .= qq| + +|; + my $result; + if (-e $destdir.$libfile) { + $result = 'exists'; + } else { + if (open(PROB,">$destdir$libfile")) { + print PROB $output; + close(PROB); + $result = 'ok'; + } else { + $result = 'failed'; + } + } + return ($result,$subdir.$libfile); } # create_ess builds an essay or True/False question sub create_ess { - my ($newdir,$answer_id,$qstn,$answertxt,$qtype,$qnum) = @_; - $qnum ++; - if (length($qnum) == 1) { - $qnum = "00".$qnum; - } elsif (length($qnum) == 2) { - $qnum = "0".$qnum; - } - my $libfile = 'question_'.$qnum; - $libfile .= '.problem'; - my $output = qq| - $qstn|; - + my ($destdir,$subdir,$answer_id,$qstn,$answertxt,$qtype,$libfile,$res,$header, + $footer,$js,$css) = @_; + my $output = ' + '; + if ($res eq 'application/rtf' || $res eq 'text/html') { + if ($header ne '') { + $output .= &HTML::Entities::decode($header); + } + if ($js ne '') { + $output .= &HTML::Entities::decode($js); + } + if ($css ne '') { + $output .= &HTML::Entities::decode($css); + } + $qstn = &HTML::Entities::decode($qstn); + $answertxt = &HTML::Entities::decode($answertxt); + } + $output .= $qstn.''; my $answer = ''; my $answerlog = ''; if ($qtype eq "Ess") { - $output .= qq| + $output .= ' - $answertxt - - |; + + '.$answertxt + .' + '; } elsif ($qtype eq "TF") { $answer = $answer_id; $output .= qq| @@ -1676,139 +1560,398 @@ sub create_ess { } else { $output .= "False"; } - $output .= qq| + $output .= ' - - |; + '; + } + if ($footer ne '') { + $output .= ' +'.&HTML::Entities::decode($footer).''; + } + $output .= ' + +'; + my $result; + if (-e $destdir.$libfile) { + $result = 'exists'; + } else { + if (open(PROB,">$destdir$libfile")) { + print PROB $output; + close(PROB); + } else { + $result = 'failed'; + } } - open(PROB,">$newdir/$libfile"); - print PROB $output; - close PROB; - return $libfile; + return ($result,$subdir.$libfile); +} + +sub probfile_name { + my ($j) = @_; + my $libfile = &HTML::Entities::decode($env{'form.probfile_'.$j}); + my $qnum = $j + 1; + if ($libfile eq '') { + if (length($qnum) == 1) { + $qnum = "00".$qnum; + } elsif (length($qnum) == 2) { + $qnum = "0".$qnum; + } + $libfile = 'testbank_question_'.$qnum; + $libfile .= '.problem'; + } + return $libfile; } sub file_error { - my ($r,$uname,$fn,$current_page); - $r->print("No data here"); -} + my ($r,$fn,$current_page,$webpath,$res) = @_; + $r->print('

'.&mt('The file you uploaded does not appear to be in the correct format.'). + '

'.&mt('Extraction of questions is only possible for the following file types:'). + '

  • '.&mt('plain text').'
  • RTF
  • HTML
'. + &mt('The file type identified for the file you uploaded is [_1].',''.$res.'').'

'); + $r->print(&page_footer($env{'form.newdir'},$fn,$current_page,$webpath,undef,'badfile'). + '
'); + return; +} + +sub parse_datafile { + my ($r,$filename,$dirpath,$webpath,$page_name,$subdir,$timestamp) = @_; + my ($badfile,$res,%allfiles,%codebase); + my $mm = new File::MMagic; + my ($text,$header,$css,$js); + if (-e "$dirpath") { + $res = $mm->checktype_filename($dirpath.$filename); + if ($env{'form.phase'} eq 'three') { + if ($res eq 'text/plain') { + open(TESTBANK,"<$dirpath$filename"); + @{$text} = ; + close(TESTBANK); + } elsif ($res eq 'application/rtf') { + my $html = ''; + my $image_uri = $timestamp; + if ($page_name eq 'Target') { + $image_uri = "$webpath/$timestamp"; + } + my $image_dir; + if ($page_name eq 'Blocks') { + $image_dir = $dirpath; + $image_dir =~ s/\/$//; + $image_dir .= '/'.$timestamp; + if (!-e $image_dir) { + mkdir($image_dir,0755); + } + } else { + $image_dir = $r->dir_config('lonDaemons').'/tmp/'. + $env{'user.name'}.'_'.$env{'user.domain'}. + '_rtfupload_'.$filename.'_'.time.'_'.$$; + if (!-e $image_dir) { + mkdir($image_dir,0755); + } + } + my $parser = RTF::HTMLConverter->new ( + in => $dirpath.$filename, + out => \$html, + DOMImplementation => 'XML::DOM', + image_uri => $image_uri, + image_dir => $image_dir, + ); + $parser->parse(); + utf8::decode($html); + ($text,$header,$css,$js) = + &parse_htmlcontent($res,$subdir,$html,undef,$page_name); + } elsif ($res eq 'text/html') { + ($text,$header,$css,$js) = + &parse_htmlcontent($res,$subdir,undef,$dirpath.$filename,$page_name); + } else { + $badfile = 1; + } + } + } + return ($res,$badfile,$text,$header,$css,$js,\%allfiles,\%codebase); +} + +sub parse_htmlcontent { + my ($res,$subdir,$html,$fullpath,$page_name) = @_; + my ($p,$fh); + if ($res eq 'application/rtf') { + $p = HTML::TokeParser->new( \$html ); + } elsif ($res eq 'text/html') { + open($fh, "<:utf8", $fullpath); + $p = HTML::TokeParser->new( $fh ); + } + my ($current_tag,$line,@text,$header,$css,$js,$have_header,$delayed); + while (my $token = $p->get_token) { + if (ref($token) eq 'ARRAY') { + if ($token->[0] eq 'S') { + if ($delayed ne '') { + $line.= $delayed; + $delayed = ''; + } + $current_tag = $token->[1]; + next if ($token->[1] eq 'html' || $token->[1] eq 'head' || $token->[1] eq 'body' || $token->[1] eq 'meta' || $token->[1] eq 'title'); + if ($token->[1] eq 'p') { + $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/; + if (!$have_header) { + $header = $line; + if ($header ne '') { + $header =~ s/\s*[\n\r\f]+/\n/gs; + } + $have_header = 1; + } else { + push(@text,$line); + } + $line = ''; + } elsif ($current_tag eq 'style') { + $css .= $token->[4]; + } elsif ($current_tag eq 'script') { + $js .= $token->[4]; + } else { + my $contents = $token->[4]; + if ($subdir ne '') { + if (($token->[1] eq 'img') && ($token->[2]->{'src'} ne '')) { + if (($res eq 'text/html') || + ($res eq 'application/rtf') && ($page_name ne 'Target')) { + $contents =~ s/(src=\s*["']?)/$1..\//i; + } + } + } + if (($line eq '') && ($current_tag eq 'font')) { + $delayed = &HTML::Entities::encode($contents,'<>&"'); + } else { + $line .= &HTML::Entities::encode($contents,'<>&"'); + } + } + } elsif ($token->[0] eq 'T') { + if ($current_tag ne 'html' && $current_tag ne 'head' && $current_tag ne 'body' && $current_tag ne 'meta' && $current_tag ne 'title') { + if ($current_tag eq 'style') { + $css .= $token->[1]; + } elsif ($current_tag eq 'script') { + $js .= $token->[1]; + } else { + if ($delayed ne '') { + my ($id,$rest) = ($token->[1] =~ /^(\s*\(*[A-Za-z0-9]+\)*\.*\s+)(.+)$/s); + if ($id ne '') { + $line .= $id.$delayed.$rest; + } else { + $line .= $token->[1].$delayed; + } + $delayed = ''; + } else { + $line .= $token->[1]; + } + } + } + } elsif ($token->[0] eq 'E') { + 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'); + if ($token->[1] eq 'style') { + $css .= $token->[2]; + } elsif ($token->[1] eq 'script') { + $js .= $token->[2]; + } else { + $line .= &HTML::Entities::encode($token->[2],'<>&"'); + } + $current_tag = ''; + } + } + } + if ($line ne '') { + if ($line ne '') { + $line =~ s/\s*[\n\r\f]+/\n/gs; + } + $line =~ s/^[\s\240]*(.*?)[\s\240]*$/$1/; + push(@text,$line); + } + if ($res eq 'text/html') { + close($fh); + } + return (\@text,$header,$css,$js); +} + +sub build_image_url { + my ($webpath,$item) = @_; + $item =~ s/(]+src=["']?\s*)(\.?\.?\/?)/$1$webpath/gsi; + return $item; +} + +sub print_header { + my ($uname,$udom,$javascript,$loadentries,$title,$current_page,$pagesref, + $namesref) = @_; + my $brcrum = [{'href' => &Apache::loncommon::authorspace("/priv/$udom/$uname/"), + 'text' => 'Construction Space'}]; + if ($env{'form.phase'} eq 'three') { + if (ref($pagesref) eq 'ARRAY') { + for (my $i=0; $i<$current_page; $i++) { + my $goback = 1 + $i - $current_page; + if (ref($namesref) eq 'HASH') { + if ($namesref->{$pagesref->[$i]} ne '') { + if (ref($brcrum) eq 'ARRAY') { + my $text = $namesref->{$pagesref->[$i]}; + my $href; + if ($goback == -1) { + $href = 'javascript:backPage();'; + } else { + $href = 'javascript:history.go('.$goback.')'; + } + push(@{$brcrum}, {'href' => $href, + 'text' => $text}); + } + } + } + } + } + } + my $output = &Apache::loncommon::start_page($title,$javascript, + {'bread_crumbs' => $brcrum, + 'add_entries' => $loadentries}); + if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { + $output .= '

' + .&mt('Co-Author [_1]',$uname.':'.$udom) + .'

'; + } + return $output; +} # ---------------------------------------------------------------- Main Handler sub handler { my $r=shift; - my $uname; - my $udom; - my $javascript = ''; - my $page_name = ''; - my $current_page = ''; - my $loadentries = ''; - my $qcount = ''; -# -# phase two: re-attach user -# - if ($ENV{'form.uploaduname'}) { - $ENV{'form.filename'}='/priv/'.$ENV{'form.uploaduname'}.'/'. - $ENV{'form.filename'}; - } - ($uname,$udom)= - &Apache::loncacc::constructaccess($ENV{'form.filename'}, - $r->dir_config('lonDefDomain')); - unless (($uname) && ($udom)) { - $r->log_reason($uname.' at '.$udom. - ' trying to publish file '.$ENV{'form.filename'}. - ' - not authorized', - $r->filename); - return HTTP_NOT_ACCEPTABLE; + + my $fn=$env{'form.filename'}; + + if ($env{'form.filename1'}) { + $fn=$env{'form.filename1'}.$env{'form.filename2'}; } - - my $fn; - my $badfile = 0; - if ($ENV{'form.filename'}) { - $fn=$ENV{'form.filename'}; - $fn=~s/^http\:\/\/[^\/]+\///; - $fn=~s/^\///; - $fn=~s/(\~|priv\/)(\w+)//; - $fn=~s/\/+/\//g; - } else { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + $fn=~s{\+}{}g; + + unless ($fn) { + $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. ' unspecified filename for upload', $r->filename); return HTTP_NOT_FOUND; } - my $pathname = &File::Basename::dirname($fn); - my $fullpath = '/priv/'.$uname.$pathname; - unless ($pathname eq '/') { - $fullpath .= '/'; - } - my $dirpath = '/home/'.$uname.'/public_html'; - - my @text = (); - my $loadentries = ''; - if ($ENV{'form.phase'} eq 'three') { - if (-e "$dirpath$fn") { - open(TESTBANK,"<$dirpath$fn"); - @text = ; - close(TESTBANK); - } else { - $badfile = 1; - } + my ($uname,$udom) = &Apache::lonnet::constructaccess($fn); + if (($uname eq '') || ($udom eq '')) { + $r->log_reason($uname.':'.$udom.' trying to convert testbank file '. + $fn.' - not authorized',$r->filename); + return HTTP_NOT_ACCEPTABLE; } - + + my $javascript = ''; + my $page_name = ''; + my $current_page = ''; + my $qcount = ''; + my $title = 'Upload testbank questions to Construction Space'; + # ----------------------------------------------------------- Start page output &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; - if ($ENV{'form.phase'} eq 'three') { - $current_page = &display_control(); - my @PAGES = ('Welcome','Blocks','Format','Target','Confirmation'); - $page_name = $PAGES[$current_page]; + my ($filename,$webpath) = &File::Basename::fileparse($fn); + my $dirpath = $r->dir_config('lonDocRoot').$webpath; + my ($res,$subdir,$badfile,$textref,$header,$css,$js,%loadentries,@pages,%names); - if ($page_name eq 'Blocks') { - $loadentries = 'onLoad= "setElements()"'; + if ($env{'form.phase'} eq 'three') { + $current_page = &display_control(); + @pages = ('Welcome','Blocks','Format','Target','Confirmation'); + %names = ( + Welcome => 'Testbank Format', + Blocks => 'Classification', + Format => 'Selection', + Target => 'Result' + ); + $page_name = $pages[$current_page]; + if ($env{'form.timestamp'} eq '') { + $env{'form.timestamp'} = time; + } + if ($env{'form.newdir'} ne '') { + if ($env{'form.newdir'} =~ /^\Q$dirpath\E(.+)$/) { + $subdir = $1; + } + } + ($res,$badfile,$textref,$header,$css,$js) = + &parse_datafile($r,$filename,$dirpath,$webpath,$page_name, + $subdir,$env{'form.timestamp'}); + if ($page_name eq 'Welcome') { + &jscript_zero($webpath,\$javascript); + } elsif ($page_name eq 'Blocks') { + if ($env{'form.go'} eq "PreviousPage") { + $loadentries{'onload'} = "setElements()"; + } &jscript_one(\$javascript); - } elsif ($page_name eq 'Format') { - $qcount = question_count($ENV{'form.qnumformat'},\@text); + } elsif ($page_name eq 'Format') { + if ($env{'form.go'} eq "PreviousPage") { + $loadentries{'onload'} = "setElements()"; + } + $qcount = question_count($env{'form.qnumformat'},$textref); &jscript_two(\$javascript,$qcount); - } elsif ($page_name eq 'Target') { - if ($ENV{'form.go'} eq "PreviousPage") { - $loadentries = 'onLoad = "setElements()"'; + } elsif ($page_name eq 'Target') { + if ($env{'form.go'} eq "PreviousPage") { + $loadentries{'onload'} = "setElements()"; } - &jscript_three($fullpath,\$javascript); + &jscript_three($webpath,\$javascript); } elsif ($page_name eq 'Confirmation') { - &jscript_four(\$javascript,$fullpath); + &jscript_four(\$javascript,$webpath); + } + $javascript = "\n"; + if ($res eq 'application/rtf' || $res eq 'text/html') { + if ($page_name eq 'Target') { + $javascript .= $js.$css; + } } - } - - $r->print("LON-CAPA Construction Space\n"); - - $r->print(&Apache::loncommon::bodytag('Upload testbank questions to Construction Space',undef,$loadentries)); - - if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { - $r->print('

'.&mt('Co-Author').': '.$uname. - &mt(' at ').$udom.'

'); } - if ($ENV{'form.phase'} eq 'three') { - if ($badfile) { - &file_error($r,$uname,$fn,$current_page); - } else { - &display_zero ($r,$uname,$fn,$current_page,$fullpath) if $page_name eq 'Welcome'; - &display_one ($r,$uname,$fn,$current_page,\@text) if $page_name eq 'Blocks'; - &display_two ($r,$uname,$fn,$current_page,\@text,$qcount) if $page_name eq 'Format'; - &display_three ($r,$uname,$fn,$current_page,\@text,$qcount) if $page_name eq 'Target'; - &final_display ($r,$uname,$fn,$current_page,\@text) if $page_name eq 'Confirmation'; + $r->print(&print_header($uname,$udom,$javascript,\%loadentries,$title, + $current_page,\@pages,\%names)); + + if (($env{'form.phase'} eq 'four') || ($env{'form.phase'} eq 'three')) { + if ($env{'form.phase'} eq 'four') { + $r->print(&Apache::lonupload::phasefour($r,$fn,$uname,$udom,'testbank')); + my $current_page = 0; + my $js; + &jscript_zero($webpath,\$js); + $js = ''; + $r->print($js); + &display_zero($r,$fn,$current_page,$webpath); + } elsif ($env{'form.phase'} eq 'three') { + if ($env{'form.action'} eq 'upload_embedded') { + my ($result,$flag) = + &Apache::lonupload::phasethree($r,$fn,$uname,$udom,'testbank'); + $r->print($result); + if ($flag eq 'modify_orightml') { + undef($page_name); + $r->print('
'. + &page_footer('',$fn).'
'); + } + } } - } elsif ($ENV{'form.phase'} eq 'two') { - my $flag = &Apache::lonupload::phasetwo($r,$fn,$uname,$udom,'testbank'); + if ($badfile) { + &file_error($r,$fn,$current_page,$webpath,$res); + } else { + &display_zero ($r,$fn,$current_page,$webpath) if $page_name eq 'Welcome'; + &display_one ($r,$fn,$current_page,$textref,$header) if $page_name eq 'Blocks'; + &display_two ($r,$fn,$current_page,$textref,$header,$qcount) if $page_name eq 'Format'; + &display_three ($r,$fn,$current_page,$textref,$res,$header,$webpath,$qcount) if $page_name eq 'Target'; + &final_display ($r,$fn,$current_page,$textref,$res,$header,$css,$js,$webpath,$dirpath,$subdir) if $page_name eq 'Confirmation'; + } + } elsif ($env{'form.phase'} eq 'two') { + my ($result,$flag) = &Apache::lonupload::phasetwo($r,$fn,'testbank'); + $r->print($result); if ($flag eq 'ok') { my $current_page = 0; - &display_zero($r,$uname,$fn,$current_page,$fullpath); + my $js; + &jscript_zero($webpath,\$js); + $js = ''; + $r->print($js); + &display_zero($r,$fn,$current_page,$webpath); + } elsif ($flag eq 'embedded') { + $r->print($js.'
'. + &page_footer('',$fn).'
'); } } else { - &Apache::lonupload::phaseone($r,$fn,$uname,$udom,'testbank'); + &Apache::lonupload::phaseone($r,$fn,'testbank'); } - $r->print(''); + $r->print(&Apache::loncommon::end_page()); return OK; } + 1; __END__