functionality is available.
+ $output .= '(Not shown to students) '."\n".'The following alternates were imported from the corresponding WebCT Vista 4 jumbled sentence question, but are not included in the LON-CAPA version, because this style of question does not currently support multiple correct solutions.'."\n";
+ for (my $i=2; $i<@{$$settings{$id}{$list}{jumbled}}; $i++) {
+ my $altid = $i-1;
+ my $jnum = 0;
+ $output .= $altid.'. ';
+ for (my $k=0; $k<@{$$settings{$id}{$list}{jumbledtype}}; $k++) {
+ if ($$settings{$id}{$list}{jumbledtype}[$k] eq 'No') {
+ $output .= "$$settings{$id}{$list}{jumbledtext}[$k]" ;
+ } elsif ($$settings{$id}{$list}{jumbledtype}[$k] eq 'Yes') {
+ $jnum ++;
+ my $jumble_item = $$settings{$id}{$list}{jumbled}[$i][$jnum];
+ $output .= '['.$$settings{$id}{$list}{$jumble_item}{text}.']';
+ }
+ }
+ $output .= " \n";
+ }
+ $output .= '';
+ }
+ }
+ }
+ } else {
+ if ($context eq 'CSTR') {
+ $output .= qq|$$settings{$id}{text}
$questionimage\n|;
+ } else {
+ $resourcedata{$symb.'questiontext'} = ''.$$settings{$id}{text}.'
'.$questionimage;
+ }
+ if (($$settings{$id}{class} eq 'multiplechoice') ||
+ ($$settings{$id}{class} eq 'combination')) {
+ foreach my $list (@{$$settings{$id}{lists}}) {
+ my $numfoils = @{$$allanswers{$id}{$list}};
+ if ($$settings{$id}{$list}{rcardinality} eq 'Single') {
+ if ($context eq 'CSTR') {
+ $output .= qq|
+
+
+|;
+ } else {
+ $resourcedata{$symb.'hiddenparts'} = '!radio';
+ $resourcedata{$symb.'questiontype'} = 'radio';
+ $resourcedata{$symb.'maxfoils'} = $numfoils;
+ }
+ for (my $k=0; $k<@{$$allanswers{$id}{$list}}; $k++) {
+ my $iter = $k+1;
+ $output .= " ".$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
+ $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
+ $output .= ''."\n";
+ }
+ if ($context eq 'CSTR') {
+ chomp($output);
+ $output .= qq|
+
+
+|;
+ }
+ } else {
+ if ($context eq 'CSTR') {
+ $output .= qq|
+
+
+|;
+ } else {
+ $resourcedata{$symb.'newopt'} = '';
+ $resourcedata{$symb.'delopt'} = '';
+ $resourcedata{$symb.'options'} = "('True','False')";
+ $resourcedata{$symb.'hiddenparts'} = '!option';
+ $resourcedata{$symb.'questiontype'} = 'option';
+ $resourcedata{$symb.'maxfoils'} = $numfoils;
+ }
+ for (my $k=0; $k<@{$$allanswers{$id}{$list}}; $k++) {
+ my $iter = $k+1;
+ $output .= " ".$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text}."
\n";
+ $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
+ }
+ if ($context eq 'CSTR') {
+ chomp($output);
+ $output .= qq|
+
+
+|;
+ }
+ }
+ }
+ } elsif ($$settings{$id}{class} eq 'match') {
+ my %allmatchers = ();
+ my @allmatch = ();
+ my %matchtext = ();
+ my $anscount = 0;
+ my %ansnum = ();
+ my $maxfoils = 0;
+ my $test_for_html = 0;
+ foreach my $grp (@{$$allchoices{$id}}) {
+ $maxfoils += @{$$settings{$id}{$grp}{correctanswer}};
+ foreach my $answer_id (@{$$allanswers{$id}{$grp}}) {
+ if ($$settings{$id}{$grp}{$answer_id}{texttype} eq '/text/html') {
+
+ $$settings{$id}{$grp}{$answer_id}{text} = &HTML::Entities::decode($$settings{$id}{$grp}{$answer_id}{text});
+ $test_for_html = &test_for_html($$settings{$id}{$grp}{$answer_id}{text});
+ $$settings{$id}{$grp}{$answer_id}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$grp}{$answer_id}{text});
+ $$settings{$id}{$grp}{$answer_id}{text} =~ s#(![]()([^>]+)>#$1../../resfiles/$2 />#gi;
+ $$settings{$id}{$grp}{$answer_id}{text} =~ s#</?p>##g;
+ }
+ unless (exists($allmatchers{$$settings{$id}{$grp}{$answer_id}{text}})) {
+ $allmatchers{$$settings{$id}{$grp}{$answer_id}{text}} = $anscount;
+ $allmatch[$anscount] = $$settings{$id}{$grp}{$answer_id}{text};
+ $anscount ++;
+
+ }
+ if (grep/^$answer_id$/,@{$$settings{$id}{$grp}{correctanswer}}) {
+ push(@{$ansnum{$grp}},$allmatchers{$$settings{$id}{$grp}{$answer_id}{text}});
+ }
+ }
+ if ($context eq 'DOCS') {
+ $matchtext{$ansnum{$grp}[0]} = $allmatch[$ansnum{$grp}[0]-1];
+ }
+ }
+ my $allmatchlist = )
+
+
+|;
+ } else {
+ $output .= qq|
+
+
+|;
+ }
+ } else {
+ $resourcedata{$symb.'newopt'} = '';
+ $resourcedata{$symb.'delopt'} = '';
+ $resourcedata{$symb.'hiddenparts'} = '!option';
+ $resourcedata{$symb.'questiontype'} = 'option';
+ $resourcedata{$symb.'maxfoils'} = $maxfoils;
+ }
+ my $iter = 0;
+ foreach my $match (@allmatch) {
+ $iter ++;
+ if ($context eq 'CSTR') {
+ if ($test_for_html) {
+ $output .= qq|
+-
+$match
+
+|;
+ }
+ }
+ }
+ if ($context eq 'CSTR') {
+ if ($test_for_html) {
+ $output .= qq|
+
+|;
+ }
+ }
+ $iter = 0;
+ for (my $k=0; $k<@{$$allchoices{$id}}; $k++) {
+ if ($$settings{$id}{$$allchoices{$id}[$k]}{texttype} eq 'text/html') {
+ $$settings{$id}{$$allchoices{$id}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$$allchoices{$id}[$k]}{text});
+ $$settings{$id}{$$allchoices{$id}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$$allchoices{$id}[$k]}{text});
+ $$settings{$id}{$$allchoices{$id}[$k]}{text} =~ s#(![]()([^>]+)>#$1../../resfiles/$2 />#gi;
+ $$settings{$id}{$$allchoices{$id}[$k]}{text} =~ s#</?p>##g;
+ }
+ foreach my $ans (@{$ansnum{$$allchoices{$id}[$k]}}) {
+ $iter ++;
+ my $ans_id = $ans + 1;
+ if ($context eq 'CSTR') {
+ my $value;
+ if ($test_for_html) {
+ $value = 'ans_'.$ans_id;
+ } else {
+ $value = $allmatch[$ans];
+ }
+ $output .= qq|
+ <foil location=)
+ $$settings{$id}{$$allchoices{$id}[$k]}{text}
+
+
+|;
+ }
+ }
+ if ($context eq 'DOCS') {
+ $resourcedata{$symb.'value'.$iter} = $matchtext{$ansnum{$$allchoices{$id}[$k]}[0]};
+ $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allchoices{$id}[0]}{text};
+ }
+ }
+ if ($context eq 'CSTR') {
+ $output .= qq|
+
+|;
+ if ($test_for_html) {
+ $output .= qq|
+
+|;
+ } else {
+ $output .= qq|
+
+|;
+ }
+ } else {
+ $resourcedata{$symb.'options'} = "('".join("','",@allmatch)."')";
+ }
+ } elsif (($$settings{$id}{class} eq 'string') ||
+ ($$settings{$id}{class} eq 'shortanswer')) {
+ my $labelnum = 0;
+ my @str_labels = ();
+ if ($cms eq 'webct4ce') {
+ foreach my $str_id (@{$$settings{$id}{str}}) {
+ foreach my $label (@{$$settings{$id}{$str_id}{labels}}) {
+ push(@str_labels,$label);
+ }
+ }
+ } elsif ($cms eq 'webctvista4') {
+ @str_labels = @{$$settings{$id}{str}};
+ }
+ foreach my $label (@str_labels) {
+ $labelnum ++;
+ my $numerical = 1;
+ if ($context eq 'DOCS') {
+ $numerical = 0;
+ } else {
+ for (my $i=0; $i<@{$$settings{$id}{strings}{$label}}; $i++) {
+ $$settings{$id}{strings}{$label}[$i] =~ s/^\s+//;
+ $$settings{$id}{strings}{$label}[$i] =~ s/\s+$//;
+ if ($$settings{$id}{strings}{$label}[$i] =~ m/([^\-\d\.]|\.\.)/) {
+ $numerical = 0;
+ }
+ }
+ }
+ if ($numerical) {
+ my $numans;
+ my $tol;
+ if (@{$$settings{$id}{strings}{$label}} == 1) {
+ $tol = '5%';
+ $numans = $$settings{$id}{strings}{$label}[0];
+ } else {
+ my $min = $$settings{$id}{strings}{$label}[0];
+ my $max = $$settings{$id}{strings}{$label}[0];
+ for (my $k=1; $k<@{$$settings{$id}{strings}{$label}}; $k++) {
+ if ($$settings{$id}{strings}{$label}[$k] <= $min) {
+ $min = $$settings{$id}{strings}{$label}[$k];
+ }
+ if ($$settings{$id}{strings}{$label}[$k] >= $max) {
+ $max = $$settings{$id}{strings}{$label}[$k];
+ }
+ }
+ $numans = ($max + $min)/2;
+ if ($numans == 0) {
+ my $dev = abs($max - $numans);
+ if (abs($numans - $min) > $dev) {
+ $dev = abs($numans - $min);
+ }
+ $tol = $dev;
+ } else {
+ $tol = 100*($max - $min)/($numans*2);
+ $tol .= '%';
+ }
+ }
+ if ($context eq 'CSTR') {
+ if (@{$$settings{$id}{str}} > 1) {
+ $output .= qq|
+$labelnum.
+|;
+ }
+ $output .= qq|
+
+
+
+
+
+
+|;
+ }
+ } else {
+ if ($context eq 'DOCS') {
+ $resourcedata{$symb.'hiddenparts'} = '!string';
+ $resourcedata{$symb.'questiontype'} = 'string';
+ $resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}{strings}{$label}};
+ $resourcedata{$symb.'hiddenparts'} = '!string';
+ if ($$settings{$id}{$label}{case} eq "No") {
+ $resourcedata{$symb.'stringtype'} = 'ci';
+ } elsif ($$settings{$id}{$label}{case} eq "Yes") {
+ $resourcedata{$symb.'stringtype'} = 'cs';
+ }
+ $resourcedata{$symb.'stringanswer'} = $$settings{$id}{strings}{$label}[0];
+ } else {
+ if (@{$$settings{$id}{str}} > 1) {
+ $output .= qq|
+$labelnum.
+|;
+ }
+ if (@{$$settings{$id}{strings}{$label}} == 1) {
+ my $casetype;
+ if ($$settings{$id}{$label}{case} eq "No") {
+ $casetype = 'ci';
+ } elsif ($$settings{$id}{$label}{case} eq "Yes") {
+ $casetype = 'cs';
+ }
+ $output .= qq|
+
+
+
+
+
+|;
+ } else {
+ my @answertext = ();
+ for (my $k=0; $k<@{$$settings{$id}{strings}{$label}}; $k++) {
+ $$settings{$id}{strings}{$label}[$k] =~ s/\|/\|/g;
+ push @answertext, $$settings{$id}{strings}{$label}[$k];
+ }
+ my $regexpans = join('|',@answertext);
+ $regexpans = '/^('.$regexpans.')\b/';
+ $output .= qq|
+
+
+
+
+
+|;
+ }
+ }
+ }
+ }
+ } elsif ($$settings{$id}{class} eq 'numerical') {
+ my %mathfns = (
+ 'abs' => 'abs',
+ 'acos' => 'acos',
+ 'asin' => 'asin',
+ 'atan' => 'atan',
+ 'ceil' => 'ceil',
+ 'cos' => 'cos',
+ 'exp' => 'exp',
+ 'fact' => 'factorial',
+ 'floor' => 'floor',
+ 'int' => 'int',
+ 'ln' => 'log',
+ 'log' => 'log',
+ 'max' => 'max',
+ 'min' => 'min',
+ 'round' => 'roundto',
+ 'sin' => 'sin',
+ 'sqrt' => 'sqrt',
+ 'tan' => 'tan',
+ );
+ my $scriptblock = qq|
+
+|;
+ if ($context eq 'CSTR') {
+ $output = "\n".$scriptblock.$output;
+ my $ansformat = '';
+ my $sigfig = '0,15';
+ if ($$settings{$id}{$numid}{format} eq 'sig') {
+ $sigfig = $$settings{$id}{$numid}{digits}.','.$$settings{$id}{$numid}{digits};
+ } elsif ($$settings{$id}{$numid}{format} eq 'dec') {
+ $ansformat = $$settings{$id}{$numid}{digits}.'f';
+ }
+ if ($ansformat) {
+ $ansformat = 'format="'.$ansformat.'"';
+ }
+ my $tolerance = $$settings{$id}{$numid}{tolerance};
+ if (lc($$settings{$id}{$numid}{toltype}) eq 'percent') {
+ $tolerance .= '%';
+ }
+ my $unit = '';
+ foreach my $unitid (@{$$settings{$id}{$numid}{units}}) {
+ $unit .= $$settings{$id}{$numid}{$unitid}{text};
+ }
+ my $unitentry = '';
+ if ($unit ne '') {
+ $unitentry = 'unit="'.$unit.'"';
+ }
+ $output .= qq|
+
+
+
+
+
+|;
+ }
+ }
+ }
+ }
+ if ($context eq 'CSTR') {
+ my $probdir;
+ my $catid = $$settings{$id}{category};
+ if ($catid) {
+ if ($cms eq 'webct4ce') {
+ $probdir = $$catinfo{$catid}{title}.'_'.$catid;
+ } else {
+ $probdir = $$catinfo{$catid}{title};
+ }
+ $probdir =~ s/\s/_/g;
+ $probdir =~ s/://g;
+ } elsif (defined($dirtitle)) {
+ $probdir = $dirtitle;
+ }
+ if (!-e "$destdir/problems/$probdir") {
+ mkdir("$destdir/problems/$probdir",0755);
+ }
+ $output .= qq|
+|;
+ my $title = $$settings{$id}{title};
+ $title =~ s/\s/_/g;
+ $title =~ s/:/_/g;
+ $title .= '_'.$id;
+ open(PROB,">$destdir/problems/$probdir/$title.problem");
+ print PROB $output;
+ close PROB;
+ } else {
+# put %resourcedata;
+ my $reply=&Apache::lonnet::cput
+ ('resourcedata',\%resourcedata,$cdom,$cnum);
+ }
+ }
+}
+
+sub text_cleanup {
+ my ($text) = @_;
+ $text =~ s/(\&)(nbsp|gt|lt)(?!;)/$1$2;$3/gi;
+ $text = &Apache::loncleanup::htmlclean($text);
+ $text =~ s#(![](["']?)([^)
]+?)(/?>)#$1../../resfiles/$2 />#gi;
+ $text =~ s#<([bh])r>#<$1r />#g;
+ $text =~ s##
#g;
+ $text =~ s#
##g;
+ return $text;
}
+sub test_for_html {
+ my ($source) = @_;
+ my @tags = ();
+ my $p = HTML::Parser->new
+ (
+ xml_mode => 1,
+ start_h =>
+ [sub {
+ my ($tagname) = @_;
+ push @tags, $tagname;
+ }, "tagname"],
+ );
+ $p->parse($source);
+ $p->eof;
+ return length(@tags);
+}
+
sub write_bb6_questions {
- my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices) = @_;
+ my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
+ my $qnum = 0;
+ foreach my $id (@{$allids}) {
+ my $questiontext = $$settings{$id}{question}{text};
+ my $question_texttype = $$settings{$id}{question}{texttype};
+ &process_html(\$questiontext,'bb6',$question_texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
+ $qnum ++;
+ my $output;
+ my $permcontainer = $containerdir;
+ $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
+ my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
+ my %resourcedata = ();
+ for (my $i=0; $i<10; $i++) {
+ my $iter = $i+1;
+ $resourcedata{$symb.'text'.$iter} = "";
+ $resourcedata{$symb.'value'.$iter} = "unused";
+ $resourcedata{$symb.'position'.$iter} = "random";
+ }
+ $resourcedata{$symb.'randomize'} = 'yes';
+ $resourcedata{$symb.'maxfoils'} = 10;
+ if ($context eq 'CSTR') {
+ $output = qq|
+|;
+ }
+ $$total{prob} ++;
+ $questiontext .= &add_images_links('question',$context,$settings,$id,$dirname,$res);
+ if ($$settings{$id}{class} eq "Essay") {
+ if ($context eq 'CSTR') {
+ $output .= qq|$questiontext
+
+
+
+|;
+ } else {
+ $resourcedata{$symb.'questiontext'} = $questiontext;
+ $resourcedata{$symb.'hiddenparts'} = '!essay';
+ $resourcedata{$symb.'questiontype'} = 'essay';
+ }
+ } else {
+ if ($context eq 'CSTR') {
+ $output .= qq|$questiontext\n|;
+ } else {
+ $resourcedata{$symb.'questiontext'} = $questiontext;
+ }
+ my $numfoils = @{$$settings{$id}{answers}};
+ if (($$settings{$id}{class} eq 'Multiple Choice') ||
+ ($$settings{$id}{class} eq 'True/False')) {
+ if ($context eq 'CSTR') {
+ $output .= qq|
+
+
+|;
+ } else {
+ $resourcedata{$symb.'hiddenparts'} = '!radio';
+ $resourcedata{$symb.'questiontype'} = 'radio';
+ $resourcedata{$symb.'maxfoils'} = $numfoils;
+ }
+ for (my $k=0; $k<$numfoils; $k++) {
+ my $iter = $k+1;
+ my $answer_id = $$settings{$id}{answers}[$k];
+ my $answer_text = $$settings{$id}{$answer_id}{text};
+ my $texttype = $$settings{$id}{$answer_id}{texttype};
+ &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
+ $answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res);
+ $output .= " '."\n";
+ $resourcedata{$symb.'text'.$iter} = $answer_text;
+ }
+ if ($context eq 'CSTR') {
+ chomp($output);
+ $output .= qq|
+
+
+
+
+
+
+
+
+
+|;
+ }
+ } elsif ($$settings{$id}{class} eq 'Multiple Answer') {
+ if ($context eq 'CSTR') {
+ $output .= qq|
+
+
+|;
+ } else {
+ $resourcedata{$symb.'newopt'} = '';
+ $resourcedata{$symb.'delopt'} = '';
+ $resourcedata{$symb.'options'} = "('True','False')";
+ $resourcedata{$symb.'hiddenparts'} = '!option';
+ $resourcedata{$symb.'questiontype'} = 'option';
+ $resourcedata{$symb.'maxfoils'} = $numfoils;
+ }
+ for (my $k=0; $k<$numfoils; $k++) {
+ my $iter = $k+1;
+ my $answer_id = $$settings{$id}{answers}[$k];
+ my $answer_text = $$settings{$id}{$answer_id}{text};
+ my $texttype = $$settings{$id}{$answer_id}{texttype};
+ &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
+ $answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res);
+
+ $output .= " \n";
+ $resourcedata{$symb.'text'.$iter} = $answer_text;
+ }
+ if ($context eq 'CSTR') {
+ chomp($output);
+ $output .= qq|
+
+
+
+
+
+
+
+
+
+|;
+ }
+ } elsif ($$settings{$id}{class} eq 'Ordering') {
+ my @allorder = ();
+ if ($context eq 'CSTR') {
+ $output .= qq|
+
+
+|;
+ } else {
+ $resourcedata{$symb.'newopt'} = '';
+ $resourcedata{$symb.'delopt'} = '';
+ $resourcedata{$symb.'hiddenparts'} = '!option';
+ $resourcedata{$symb.'questiontype'} = 'option';
+ $resourcedata{$symb.'maxfoils'} = $numfoils;
+ }
+ for (my $k=0; $k<$numfoils; $k++) {
+ my $answer_id = $$settings{$id}{answers}[$k];
+ my $answer_text = $$settings{$id}{$answer_id}{text};
+ my $texttype = $$settings{$id}{$answer_id}{texttype};
+ &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
+ $answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res);
+ my $iter = $k+1;
+ if ($context eq 'CSTR') {
+ $output .= " ".$answer_text."\n";
+ } else {
+ $resourcedata{$symb.'text'.$iter} = $answer_text;
+ $resourcedata{$symb.'value'.$iter} = $$settings{$id}{$answer_id}{order};
+ if (!grep/^$$settings{$id}{$answer_id}{order}$/,@allorder) {
+ push(@allorder,$$settings{$id}{$answer_id}{order});
+ }
+ }
+ }
+ if ($context eq 'CSTR') {
+ chomp($output);
+ $output .= qq|
+
+
+|;
+ } else {
+ @allorder = sort {$a <=> $b} @allorder;
+ $resourcedata{$symb.'options'} = "('".join("','",@allorder)."')";
+ }
+ } elsif ($$settings{$id}{class} eq 'Fill in the Blank') {
+ my $numerical = 1;
+ if ($context eq 'DOCS') {
+ $numerical = 0;
+ } else {
+ for (my $k=0; $k<@{$$settings{$id}{correctanswer}}; $k++) {
+ if ($$settings{$id}{correctanswer}[$k] =~ m/([^\d\.]|\.\.)/) {
+ $numerical = 0;
+ }
+ }
+ }
+ if ($numerical) {
+ my $numans;
+ my $tol;
+ if (@{$$settings{$id}{correctanswer}} == 1) {
+ $tol = 5;
+ $numans = $$settings{$id}{correctanswer}[0];
+ } else {
+ my $min = $$settings{$id}{correctanswer}[0];;
+ my $max = $min;
+ for (my $k=1; $k<@{$$settings{$id}{correctanswer}}; $k++) {
+ if ($$settings{$id}{correctanswer}[$k] <= $min) {
+ $min = $$settings{$id}{correctanswer}[$k];
+ }
+ if ($$settings{$id}{correctanswer}[$k] >= $max) {
+ $max = $$settings{$id}{correctanswer}[$k];
+ }
+ }
+ $numans = ($max + $min)/2;
+ $tol = 100*($max - $min)/($numans*2);
+ $tol = 5;
+ }
+ if ($context eq 'CSTR') {
+ $output .= qq|
+
+
+
+
+
+
+
+
+
+
+
+
+|;
+ }
+ } else {
+ if ($context eq 'DOCS') {
+ $resourcedata{$symb.'hiddenparts'} = '!string';
+ $resourcedata{$symb.'questiontype'} = 'string';
+ $resourcedata{$symb.'maxfoils'} = 1;
+ $resourcedata{$symb.'hiddenparts'} = '!string';
+ $resourcedata{$symb.'stringtype'} = 'ci';
+ $resourcedata{$symb.'stringanswer'} = $$settings{$id}{correctanswer}[0];
+ } else {
+ if (@{$$settings{$id}{correctanswer}} == 1) {
+ $output .= qq|
+
+
+
+
+
+
+
+
+
+
+
+|;
+ } else {
+ my @answertext = ();
+ for (my $k=0; $k<@{$$settings{$id}{correctanswer}}; $k++) {
+ my $answer_text = $$settings{$id}{correctanswer}[$k];
+ $answer_text =~ s/\|/\|/g;
+ push @answertext, $answer_text;
+ }
+ my $regexpans = join('|',@answertext);
+ $regexpans = '/^('.$regexpans.')\b/';
+ $output .= qq|
+
+
+
+
+
+
+
+
+
+
+
+|;
+ }
+ }
+ }
+ } elsif ($$settings{$id}{class} eq "Matching") {
+ my @allmatchers = ();
+ my %matchtext = ();
+ if ($context eq 'CSTR') {
+ $output .= qq|
+
+
+
+|;
+ } else {
+ $resourcedata{$symb.'newopt'} = '';
+ $resourcedata{$symb.'delopt'} = '';
+ $resourcedata{$symb.'hiddenparts'} = '!option';
+ $resourcedata{$symb.'questiontype'} = 'option';
+ $resourcedata{$symb.'maxfoils'} = $numfoils;
+ }
+ for (my $k=0; $k<$$settings{$id}{allchoices}; $k++) {
+ my $choice_id = 'rightmatch'.$k;
+ my $choice_text = $$settings{$id}{$choice_id}{text};
+ my $texttype = $$settings{$id}{$choice_id}{texttype};
+ my $choice_plaintext = &remove_html($choice_text);
+ &process_html(\$choice_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
+ $choice_text .= &add_images_links($choice_id,$context,$settings,$id,$dirname,$res);
+ push(@allmatchers,$choice_plaintext);
+ if ($context eq 'CSTR') {
+ $output .= qq|
+-
+$choice_text
+
+ |;
+ }
+ }
+ if ($context eq 'CSTR') {
+ $output .= qq|
+
+|;
+ }
+ for (my $k=0; $k<$numfoils; $k++) {
+ my $answer_id = $$settings{$id}{answers}[$k];
+ my $answer_text = $$settings{$id}{$answer_id}{text};
+ my $texttype = $$settings{$id}{$answer_id}{texttype};
+ &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
+ $answer_text .= &add_images_links($answer_id,$context,$settings,$id,$dirname,$res);
+ if ($context eq 'CSTR') {
+ $output .= '
+
+ '.$answer_text.'
+
+';
+ } else {
+ my $iter = $k+1;
+ $resourcedata{$symb.'value'.$iter} = "$allmatchers[$$settings{$id}{$$settings{$id}{$answer_id}{correctanswer}}{order}]";
+ $resourcedata{$symb.'text'.$iter} = $answer_text;
+ }
+ }
+ if ($context eq 'CSTR') {
+ $output .= qq|
+
+
+|;
+ } else {
+ $resourcedata{$symb.'options'} = "('".join("','",@allmatchers)."')";
+ }
+ }
+ }
+ if ($context eq 'CSTR') {
+
+ $output .= qq|
+
+ $$settings{$id}{solutionfeedback}{text}
+
+
+|;
+ my $title = $$settings{title};
+ $title =~ s/\s/_/g;
+ $title =~ s/\W//g;
+ $title .= '_'.$id;
+ open(PROB,">$newdir/$title.problem");
+ print PROB $output;
+ close PROB;
+ } else {
+# put %resourcedata;
+ my $reply=&Apache::lonnet::cput
+ ('resourcedata',\%resourcedata,$cdom,$cnum);
+ }
+ }
+}
+
+sub retrieve_image {
+ my ($context,$res,$dirname,$cdom,$cname,$docroot,$destdir,$urlpath,$filename) = @_;
+ my $contents;
+ my $url = $urlpath.$filename;
+ my $ua=new LWP::UserAgent;
+ my $request=new HTTP::Request('GET',$url);
+ my $response=$ua->request($request);
+ if ($response->is_success) {
+ $contents = $response->content;
+ if (!-e "$docroot/$res") {
+ mkdir("$docroot/$res",0755);
+ }
+ if (!-e "$docroot/$res/webimages") {
+ mkdir("$docroot/$res/webimages",0755);
+ }
+ open(my $fh,">$docroot/$res/webimages/$filename");
+ print $fh $contents;
+ close($fh);
+ if ($context eq 'DOCS') {
+ my $copyfile = $dirname.'/'.$filename;
+ my $source = "$docroot/$res/webimages/$filename";
+ my $fileresult;
+ if (-e $source) {
+ $fileresult = &Apache::lonnet::process_coursefile('copy',$cname,$cdom,$copyfile,$source);
+ }
+ return $fileresult;
+ } elsif ($context eq 'CSTR') {
+ if (!-e "$destdir/resfiles/$res") {
+ mkdir("$destdir/resfiles/$res",0755);
+ }
+ if (!-e "$destdir/resfiles/$res/webimages") {
+ mkdir("$destdir/resfiles/$res/webimages",0755);
+ }
+ rename("$docroot/$res/webimages/$filename","$destdir/resfiles/$res/webimages/$filename");
+ return 'ok';
+ }
+ } else {
+ return -1;
+ }
}
# ---------------------------------------------------------------- Process Blackboard Announcements
@@ -3234,11 +5316,59 @@ $linktag
}
}
-# ---------------------------------------------------------------- WebCT assessments
-sub webct4_assessment {
- my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
- print STDERR "webct assessment detected - $res, $docroot, $destdir, $type,$title\n";
+sub process_html {
+ my ($text,$caller,$html_cond,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir) = @_;
+ my $pathstart;
+ if ($context eq 'CSTR') {
+ $pathstart = '../..';
+ } else {
+ $pathstart = $dirname;
+ }
+ if ($caller eq 'bb5') {
+ if ($html_cond eq 'true') {
+ $$text = &HTML::Entities::decode($$text);
+ }
+ } elsif ($caller eq 'bb6') {
+ if ($html_cond eq 'HTML') {
+ $$text = &HTML::Entities::decode($$text);
+ }
+ }
+ if ($$text =~ m#![](['"]?(https?://[^\s]+/)([^/\s\'"]+)['"]?[^)
]*>#) {
+ if (&retrieve_image($context,$res,$dirname,$cdom,$cnum,$docroot,$destdir,$1,$2) eq 'ok') {
+ $$text =~ s#(![](['"]?)(https?://[^\s]+/)([^/\s'"]+)(['"]?[^)
]*>)#$1$pathstart/resfiles/$res/webimages/$3$4#g;
+ }
+ }
+ $$text =~ s#(
]+)/*>#$1 />#gi;
+ $$text =~ s#
#
#g;
+ return;
}
+sub add_images_links {
+ my ($type,$context,$settings,$id,$dirname,$res) = @_;
+ my ($image,$imglink,$url,$pathstart);
+ if ($context eq 'CSTR') {
+ $pathstart = '../..';
+ } else {
+ $pathstart = $dirname;
+ }
+ if ((defined($$settings{$id}{$type}{image})) && ($$settings{$id}{$type}{image} ne '')) {
+ if ( $$settings{$id}{$type}{style} eq 'Inline' ) {
+ $image = qq|
|;
+ } else {
+ $imglink = qq|
$$settings{$id}{$type}{label}
|;
+ }
+ }
+ if ((defined($$settings{$id}{$type}{link})) && ($$settings{$id}{$type}{link} ne '' )) {
+ $url = qq|
$$settings{$id}{$type}{linkname}
|;
+ }
+ return $image.$imglink.$url;
+}
+
+sub remove_html {
+ my ($choice_text) = @_;
+ return $choice_text;
+}
+
+
1;
__END__