--- loncom/imspackages/imsprocessor.pm 2008/08/23 21:08:29 1.43 +++ loncom/imspackages/imsprocessor.pm 2008/08/26 01:35:15 1.45 @@ -1,3 +1,8 @@ +# The LearningOnline Network with CAPA +# Processor for IMS Packages +# +# $Id: imsprocessor.pm,v 1.45 2008/08/26 01:35:15 www Exp $ +# # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). @@ -635,7 +640,11 @@ sub process_resinfo { if (grep/^$key$/,@{$targets}) { if ($$resources{$key}{type} eq "webcontent") { %{$$resinfo{$key}} = (); - &webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles); + if ($$resources{$key}{file} eq 'questiondb.xml') { + &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions); + } else { + &webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles); + } } elsif ($$resources{$key}{type} eq "webctquiz") { &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions); } @@ -2775,8 +2784,13 @@ sub parse_webct4_quizprops { sub parse_webct4_questionDB { my ($docroot,$href,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_; - $href =~ s#[^/]+$##; - my $xmlfile = $docroot.'/'.$href.'questionDB.xml'; #quizDB file + my $xmlfile; + if ($href eq 'questiondb.xml') { + $xmlfile = $docroot.'/'.$href; + } else { + $href =~ s#[^/]+$##; + $xmlfile = $docroot.'/'.$href.'questionDB.xml'; #quizDB file + } my @state = (); my $category; # the current category ID my $id; # the current question ID @@ -2797,14 +2811,19 @@ sub parse_webct4_questionDB { action => '', ); my $currtexttype; - my $currimagtype; + my $currimagtype; + my $is_objectbank; my $p = HTML::Parser->new ( xml_mode => 1, start_h => [sub { my ($tagname, $attr) = @_; - push @state, $tagname; + if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) { + $is_objectbank = 1; + } else { + push @state, $tagname; + } if ("@state" eq "questestinterop section") { $category = $attr->{ident}; %{$$catinfo{$category}} = (); @@ -2893,6 +2912,10 @@ sub parse_webct4_questionDB { $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype}; $currtexttype = $attr->{texttype}; } + if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label flow_mat material mattext") { + $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype}; + $currtexttype = $attr->{texttype}; + } # Numerical if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") { @@ -2979,7 +3002,9 @@ sub parse_webct4_questionDB { } } if ("@state" eq "questestinterop section item resprocessing respcondition setvar") { - $setvar{varname} = $attr->{varname}; + foreach my $key (keys(%{$attr})) { + $setvar{$key} = $attr->{$key}; + } if ($setvar{varname} eq 'WebCT_Correct') { push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id); } @@ -3010,6 +3035,7 @@ sub parse_webct4_questionDB { } if ("@state" eq "questestinterop section item itemfeedback") { $fdbk = $attr->{ident}; + push(@{$$settings{$id}{feedback}},$fdbk); $$settings{$id}{$fdbk}{view} = $attr->{view}; } if ("@state" eq "questestinterop section item itemfeedback material mattext") { @@ -3053,6 +3079,9 @@ sub parse_webct4_questionDB { if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") { $$settings{$id}{$list}{$answer_id}{text} = $text; } + if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label flow_mat material mattext") { + $$settings{$id}{$list}{$answer_id}{text} = $text; + } # Numerical if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") { @@ -3103,6 +3132,14 @@ sub parse_webct4_questionDB { push(@{$$settings{$id}{$list}{correctanswer}},$answer_id); } } + } elsif ($is_objectbank) { #Multiple Choice WebCT 4.1 D2L objectbank + if ($setvar{action} eq "Set") { + if ($text =~ /^\d+\.?\d*$/) { + if ($text > 0.000000001) { + push(@{$$settings{$id}{$list}{correctanswer}},$answer_id); + } + } + } } } if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") { @@ -3119,7 +3156,11 @@ sub parse_webct4_questionDB { end_h => [sub { my ($tagname) = @_; - pop @state; + if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) { + $is_objectbank = ''; + } else { + pop @state; + } }, "tagname"], ); $p->unbroken_text(1); @@ -3137,6 +3178,22 @@ sub parse_webct4_questionDB { } } } + } elsif ($$settings{$id}{class} eq 'multiplechoice') { + if (ref($$settings{$id}) eq 'HASH') { + foreach my $list (keys(%{$$settings{$id}})) { + if (ref($$settings{$id}{$list}) eq 'HASH') { + if (defined($$settings{$id}{$list}{rcardinality})) { + if ($$settings{$id}{$list}{rcardinality} eq 'Multiple') { + if (ref($$settings{$id}{$list}{correctanswer}) eq 'ARRAY') { + if (@{$$settings{$id}{$list}{correctanswer}} == 1) { + $$settings{$id}{$list}{rcardinality} = 'Single'; + } + } + } + } + } + } + } } } } @@ -3215,7 +3272,9 @@ sub process_assessment { } if ($cms eq 'webctce4') { - &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings); + if (@allids > 0 && $allids[0] ne '') { + &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings); + } } else { &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings,\%qzparams); } @@ -3328,6 +3387,7 @@ sub build_problem_container { } $probtitle{$id} =~ s/\s+/_/g; $probtitle{$id} =~ s/:/_/g; + $probtitle{$id} =~ s/\//_/g; $probtitle{$id} .= '_'.$id; } if (($cms eq 'webctce4' && $container ne 'database') || @@ -3787,10 +3847,12 @@ sub write_webct4_questions { my $questionimage; foreach my $fdbk (@{$$settings{$id}{feedback}}) { my $feedback = $$settings{$id}{$fdbk}{text}; - if ($$settings{$id}{$fdbk}{texttype} eq 'text/html') { - $feedback = &HTML::Entities::decode($feedback); + if ($feedback ne '') { + if ($$settings{$id}{$fdbk}{texttype} eq 'text/html') { + $feedback = &HTML::Entities::decode($feedback); + } + $allfeedback .= $feedback; } - $allfeedback .= $feedback; } if ($$settings{$id}{texttype} eq 'text/html') { if ($$settings{$id}{text}) { @@ -3850,9 +3912,6 @@ sub write_webct4_questions { $pre_fill_answer - - $allfeedback - |; } else { $resourcedata{$symb.'questiontext'} = '

'.$$settings{$id}{text}.'

'.$questionimage; @@ -4363,11 +4422,19 @@ $$settings{$id}{$list}{jumbledtext}[$k] if (!-e "$destdir/problems/$probdir") { mkdir("$destdir/problems/$probdir",0755); } + if ($allfeedback ne '') { + $output .= qq| + + $allfeedback + +|; + } $output .= qq| |; my $title = $$settings{$id}{title}; $title =~ s/\s/_/g; $title =~ s/:/_/g; + $title =~ s/\//_/g; $title .= '_'.$id; open(PROB,">$destdir/problems/$probdir/$title.problem"); print PROB $output;