--- loncom/imspackages/imsprocessor.pm	2008/08/23 17:47:44	1.42
+++ loncom/imspackages/imsprocessor.pm	2008/08/25 13:43:39	1.44
@@ -409,7 +409,7 @@ sub target_resources {
 }
 
 sub copy_resources {
-    my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles) = @_;
+    my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles,$total) = @_;
     if ($context eq 'DOCS') {
         foreach my $key (sort keys %{$hrefs}) {
             if (grep/^$key$/,@{$targets}) {
@@ -472,7 +472,11 @@ sub copy_resources {
                         } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
                             $renameres = rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
                         }
-                        if (!$renameres) {
+                        if ($renameres) {
+                            if (ref($total) eq 'HASH') {
+                                $$total{'file'} ++;
+                            }
+                        } else {
                             &Apache::lonnet::logthis("IMS import error: $cms - renaming failed for file $file");
                         }
                     } elsif ($cms eq 'webctce4') {
@@ -491,7 +495,11 @@ sub copy_resources {
                             }
                             if (-e "$tempdir/$file") {
                                 my $renameres = rename("$tempdir/$file","$destdir/resfiles/$copyfile");
-                                if (!$renameres) {
+                                if ($renameres) {
+                                    if (ref($total) eq 'HASH') {
+                                        $$total{'file'} ++;
+                                    }
+                                } else {
                                     &Apache::lonnet::logthis("IMS import error: WebCT4 - renaming failed for file $file");
                                 }
                             }
@@ -627,7 +635,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);
                 }
@@ -2767,8 +2779,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
@@ -2789,14 +2806,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}} = ();
@@ -2885,6 +2907,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") {
@@ -2971,7 +2997,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);
             }
@@ -3002,6 +3030,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") {
@@ -3045,6 +3074,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") {
@@ -3095,6 +3127,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") {
@@ -3111,7 +3151,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);
@@ -3129,6 +3173,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';
+                                    }
+                                }
+                            }
+                        }
+                    }
+                }
+            }
         }
     }
 }
@@ -3207,7 +3267,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);
     }
@@ -3320,6 +3382,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') ||
@@ -3779,10 +3842,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}) {
@@ -3842,9 +3907,6 @@ sub write_webct4_questions {
  <essayresponse>
  <textfield>$pre_fill_answer</textfield>
  </essayresponse>
- <postanswerdate>
-  $allfeedback
- </postanswerdate>
 |;
             } else {
                 $resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;
@@ -4355,11 +4417,19 @@ $$settings{$id}{$list}{jumbledtext}[$k]
             if (!-e "$destdir/problems/$probdir") {
                 mkdir("$destdir/problems/$probdir",0755);
             }
+            if ($allfeedback ne '') {
+                $output .= qq|
+ <postanswerdate>
+  $allfeedback
+ </postanswerdate>
+|;
+            }
             $output .= qq|</problem>
 |;
             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;