[LON-CAPA-cvs] cvs: loncom /imspackages imsprocessor.pm

raeburn lon-capa-cvs@mail.lon-capa.org
Tue, 04 Apr 2006 08:16:45 -0000


This is a MIME encoded message

--raeburn1144138605
Content-Type: text/plain

raeburn		Tue Apr  4 04:16:45 2006 EDT

  Modified files:              
    /loncom/imspackages	imsprocessor.pm 
  Log:
  Adding support for import of WebCT Vista 4 IMS packages. Work in progress.  True/False, string, shortanswer, multiple choice, essay all functional.   Matching, jumbled and combination still require work.  Work in progress.  
  
  
--raeburn1144138605
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20060404041645.txt"

Index: loncom/imspackages/imsprocessor.pm
diff -u loncom/imspackages/imsprocessor.pm:1.34 loncom/imspackages/imsprocessor.pm:1.35
--- loncom/imspackages/imsprocessor.pm:1.34	Fri Mar 24 12:36:27 2006
+++ loncom/imspackages/imsprocessor.pm	Tue Apr  4 04:16:41 2006
@@ -32,7 +32,7 @@
 
 sub ims_config {
     my ($areas,$cmsmap,$areaname) = @_;
-    @{$areas} = ("doc","extlink","announce","staff","board","quiz","survey","pool","users");
+    @{$areas} = ("doc","extlink","announce","staff","board","quiz","survey","pool","users","question");
     %{$$cmsmap{bb5}} = (
                 announce => 'resource/x-bb-announcement',
                 board => 'resource/x-bb-discussionboard',
@@ -69,6 +69,12 @@
                 survey => 'webctsurvey',
                 doc => 'webcontent'
                 );
+    %{$$cmsmap{webctvista4}} = (
+                question => 'webct.question',
+                quiz => 'webct.assessment',
+                survey => 'webctsurvey',
+                doc => 'webcontent'
+                );
     %{$areaname} = (
                 announce => 'Announcements',
                 board => 'Discussion Boards',
@@ -76,6 +82,7 @@
                 extlink => 'Links to external sites',
                 pool => 'Question pools',
                 quiz => 'Quizzes',
+                question => 'Assessment Questions',
                 staff => 'Staff information',
                 survey => 'Surveys',
                 users => 'Enrollment',
@@ -159,13 +166,9 @@
               bb5 => 'tableofcontents',
               angel => 'organization',
               webctce4 => 'organization',
+              webctvista4 => 'organization'
               );
-    my %contents = ();
-    my @state = ();
-    my $itm = '';
-    my $identifier = '';
     my @seq = "Top";
-    my $lastitem;
     %{$$items{'Top'}} = (
                       contentscount => 0,
                       resnum => 'toplevel',
@@ -187,6 +190,20 @@
     }
 
     my $xmlfile = $tempdir.'/imsmanifest.xml';
+    &parse_manifest($cms,$phase,$tempdir,$xmlfile,\%toc,$includedres,
+                    $includeditems,$items,$resources,$resinfo,$hrefs,\@seq);
+    return 'ok' ;
+}
+
+sub parse_manifest {
+    my ($cms,$phase,$tempdir,$xmlfile,$toc,$includedres,$includeditems,$items,
+        $resources,$resinfo,$hrefs,$seq) = @_;
+    my @state = ();
+    my $itm = '';
+    my %contents = ();
+    my $identifier = '';
+    my @allidentifiers = ();
+    my $lastitem;
     my $p = HTML::Parser->new
     (
        xml_mode => 1,
@@ -195,14 +212,14 @@
                 my ($tagname, $attr) = @_;
                 push @state, $tagname;
                 my $start = @state - 3;
-                if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $toc{$cms}) ) {
+                if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $$toc{$cms}) ) {
                     if ($state[-1] eq 'item') {
                         $itm = $attr->{identifier};
                         if ($$includeditems{$itm} || $phase ne 'build') {
                             %{$$items{$itm}} = ();
                             $$items{$itm}{contentscount} = 0;
                             @{$$items{$itm}{contents}} = ();
-                            if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webctce4') {
+                            if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webctce4' || $cms eq 'webctvista4') {
                                 $$items{$itm}{resnum} = $attr->{identifierref};
                                 if ($cms eq 'bb5') {
                                     $$items{$itm}{title} = $attr->{title};
@@ -216,32 +233,32 @@
                                 %{$$resources{$$items{$itm}{resnum}}} = ();
                             }
                             $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
-                            if ($start > @seq) {
+                            if ($start > @{$seq}) {
                                 unless ($lastitem eq '') {
-                                    push @seq, $lastitem;
-                                    unless ( defined($contents{$seq[-1]}) ) {
-                                        @{$contents{$seq[-1]}} = ();
+                                    push @{$seq}, $lastitem;
+                                    unless ( defined($contents{$$seq[-1]}) ) {
+                                        @{$contents{$$seq[-1]}} = ();
                                     }
-                                    push @{$contents{$seq[-1]}},$itm;
-                                    $$items{$itm}{parentseq} = $seq[-1];
+                                    push @{$contents{$$seq[-1]}},$itm;
+                                    $$items{$itm}{parentseq} = $$seq[-1];
                                 }
-                            } elsif ($start < @seq) {
-                                my $diff = @seq - $start;
+                            } elsif ($start < @{$seq}) {
+                                my $diff = @{$seq} - $start;
                                 while ($diff > 0) {
-                                    pop @seq;
+                                    pop @{$seq};
                                     $diff --;
                                 }
-                                if (@seq) {
-                                    push @{$contents{$seq[-1]}}, $itm;
+                                if (@{$seq}) {
+                                    push @{$contents{$$seq[-1]}}, $itm;
                                 }
                             } else {
-                                push @{$contents{$seq[-1]}}, $itm;
+                                push @{$contents{$$seq[-1]}}, $itm;
                             }
                             my $path;
-                            if (@seq > 1) {
-                                $path = join(',',@seq);
-                            } elsif (@seq > 0) {
-                                $path = $seq[0];
+                            if (@{$seq} > 1) {
+                                $path = join(',',@{$seq});
+                            } elsif (@{$seq} > 0) {
+                                $path = $$seq[0];
                             }
                             $$items{$itm}{filepath} = $path;
                             if ($cms eq 'bb5' || $cms eq 'bb6') {
@@ -252,7 +269,8 @@
                                     $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';
                                 }
                             }
-                            $$items{$seq[-1]}{contentscount} ++;
+                            $$items{$$seq[-1]}{contentscount} ++;
+                            $$resources{$$items{$itm}{resnum}}{seqref} = $seq;
                             $lastitem = $itm;
                         }
                     }
@@ -263,6 +281,7 @@
                     }
                 } elsif ("@state" eq "manifest resources resource" ) {
                     $identifier = $attr->{identifier};
+                    push(@allidentifiers,$identifier);
                     if ($$includedres{$identifier} || $phase ne 'build') { 
                         if ($cms eq 'bb5' || $cms eq 'bb6') {
                             $$resources{$identifier}{file} = $attr->{file};
@@ -270,6 +289,9 @@
                         } elsif ($cms eq 'webctce4') {
                             $$resources{$identifier}{type} = $attr->{type};
                             $$resources{$identifier}{file} = $attr->{href};
+                        } elsif ($cms eq 'webctvista4') {
+                            $$resources{$identifier}{type} = $attr->{type};
+                            $$resources{$identifier}{'webct:coType'} = $attr->{'webct:coType'};
                         } elsif ($cms eq 'angel') {
                             $identifier = substr($identifier,3);
                             if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
@@ -280,14 +302,38 @@
                     }
                 } elsif ("@state" eq "manifest resources resource file") {
                     if ($$includedres{$identifier} || $phase ne 'build') {
-                        if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webctce4') {
+                        if ($cms eq 'webctvista4') {
+                            $$resources{$identifier}{file} = $attr->{href};
+                        }
+                        if ($cms eq 'bb5' || $cms eq 'bb6' || 
+                            $cms eq 'webctce4' || $cms eq 'webctvista4') {
                             push @{$$hrefs{$identifier}},$attr->{href};
+
+                            if ($$resources{$identifier}{type} eq 
+                                'webct.manifest') {
+                                my $manifestfile = $tempdir.'/'.$attr->{href};
+                                my $currseqref = [];
+                                if ($itm) {
+                                    $currseqref =   
+                                    $$resources{$$items{$itm}{resnum}}{seqref};
+                                }
+                                &parse_manifest($cms,$phase,$tempdir,$manifestfile,
+                                                $toc,$includedres,$includeditems,
+                                                $items,$resources,$resinfo,
+                                                $hrefs,$currseqref);
+                            }
                         } elsif ($cms eq 'angel') {
                             if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
                                 push @{$$hrefs{$identifier}},$1;
                             } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
                                 $$resources{$identifier}{type} = $1;
                             }
+                        } 
+                    }
+                } elsif ("@state" eq "manifest webct:ContentObject") {
+                    foreach my $ident (@allidentifiers) {
+                        if ($$resources{$ident}{type} eq 'ims_qtiasiv1p2') {
+                            $$resources{$ident}{type} = $attr->{'webct:coType'};
                         }
                     }
                 }
@@ -298,9 +344,9 @@
                 if ("@state" eq "manifest metadata lom general title langstring") {
                     $$items{'Top'}{title} = $text;
                 }
-                if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq $toc{$cms} && $state[-1] eq "title") {
+                if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq $$toc{$cms} && $state[-1] eq "title") {
                     if ($$includeditems{$itm} || $phase ne 'build') {
-                        if ($cms eq 'angel' || $cms eq 'bb6') {
+                        if ($cms eq 'angel' || $cms eq 'bb6' || $cms eq 'webctvista4') {
                             $$items{$itm}{title} = $text;
                         }
                         if ($cms eq 'webctce4') {
@@ -318,11 +364,9 @@
     );
     $p->parse_file($xmlfile);
     $p->eof;
-
     foreach my $itm (keys %contents) {
         @{$$items{$itm}{contents}} = @{$contents{$itm}};
     }
-    return 'ok' ;
 }
 
 sub get_imports {
@@ -365,14 +409,14 @@
 }
 
 sub copy_resources {
-    my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow) = @_;
+    my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles) = @_;
     if ($context eq 'DOCS') {
         foreach my $key (sort keys %{$hrefs}) {
             if (grep/^$key$/,@{$targets}) {
                 %{$$url{$key}} = ();
                 foreach my $file (@{$$hrefs{$key}}) {
                     my $source = $tempdir.'/'.$key.'/'.$file;
-                    if ($cms eq 'webctce4') {
+                    if ($cms eq 'webctce4' || $cms eq 'webctvista4') {
                         $source = $tempdir.'/'.$file;
                     }
                     my $filename = '';
@@ -384,12 +428,12 @@
                     }
                     $file =~ s-\\-/-g;
                     my $copyfile = $file;
-                    if ($cms eq 'webctce4') {
+                    if ($cms eq 'webctce4' || $cms eq 'webctvista4') {
                         if ($file =~ m-/my_files/(.+)$-) {
                             $copyfile = $1;
                         }
                     }
-                    unless (($cms eq 'webctce4') && ($copyfile =~ m/questionDB\.xml$/ || $copyfile =~ m/quiz_QIZ_\d+\.xml$/ || $copyfile =~ m/properties_QIZ_\d+\.xml$/)) {
+                    unless ((($cms eq 'webctce4') && ($copyfile =~ m/questionDB\.xml$/ || $copyfile =~ m/quiz_QIZ_\d+\.xml$/ || $copyfile =~ m/properties_QIZ_\d+\.xml$/)) || (($cms eq 'webctvista4') && (grep/^$key$/,@{$assessmentfiles}) && $file =~ /\.xml$/))    {
                         $copyfile = $fpath.$copyfile;
                         my $fileresult;
                         if (-e $source) {
@@ -461,6 +505,8 @@
     my $dbparse = 0;
     my $announce_handling = 'include';
     my $longcrs = '';
+    my %allassessments = ();
+    my %allquestions = ();
     my %qzdbsettings = ();
     my %catinfo = ();
     if ($crs =~ m/^(\d)(\d)(\d)/) {
@@ -526,15 +572,15 @@
                 }
             } elsif ($$resources{$key}{type} =~/assessment\/x\-bb\-(qti\-)?pool/) {
                 %{$$resinfo{$key}} = ();
-                &process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs);
+                &process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
                 push @{$pools}, $key;
             } elsif ($$resources{$key}{type} =~ /assessment\/x\-bb\-(qti\-)?quiz/) {
                 %{$$resinfo{$key}} = ();
-                &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs);
+                &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
                 push @{$quizzes}, $key;
             } elsif ($$resources{$key}{type} =~ /assessment\/x\-bb\-(qti\-)?survey/) {
                 %{$$resinfo{$key}} = ();
-                &process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs);
+                &process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
                 push @{$surveys}, $key;
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {
                 %{$$resinfo{$key}} = ();
@@ -576,10 +622,51 @@
                     %{$$resinfo{$key}} = ();
                     &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);
+                    &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
+                }
+            }
+        }
+    } elsif ($cms eq 'webctvista4') {
+        foreach my $key (sort keys %{$resources}) {
+            if (grep/^$key$/,@{$targets}) {
+                %{$$resinfo{$key}} = ();
+                if ($$resources{$key}{type} eq 'webct.question') {
+                    $allquestions{$key} = 1;
+                } elsif ($$resources{$key}{type} eq 'webct.assessment') {
+                    $allassessments{$key} = 1;
                 }
             }
         }
+        if (keys(%allassessments) > 0) {
+            foreach my $key (sort(keys(%allassessments))) {
+                &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
+            }
+        } elsif (keys(%allquestions) > 0) {
+            my %catinfo = ();
+            my @allids = ();
+            my @allquestids = ();
+            my %allanswers = ();
+            my %allchoices = ();
+            my $containerdir;
+            my $newdir;
+            my $cid;
+            my $randompickflag = 0;
+            if ($context eq 'DOCS') {
+                $cid = $env{'request.course.id'};
+            }
+            my $destresdir = $destdir;
+            if ($context eq 'CSTR') {
+                $destresdir =~ s|/home/$uname/public_html/|/res/$udom/$uname/|;
+            } elsif ($context eq 'DOCS') {
+                $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
+            }
+            foreach my $res (sort(keys(%allquestions))) {
+                my $parent = $allquestions{$res};
+                &parse_webctvista4_question($res,$docroot,$resources,$hrefs,\%qzdbsettings,\@allquestids,\%allanswers,\%allchoices,$parent,\%catinfo);
+            }
+            &build_category_sequences($destdir,\%catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$crs,\%qzdbsettings);
+            &write_webct4_questions($cms,\@allquestids,$context,\%qzdbsettings,$dirname,\%allanswers,\%allchoices,$total,$cid,$cdom,$crs,$destdir,\%catinfo);
+        }
     }
 
     $$total{'board'} = $board_count;
@@ -2071,6 +2158,481 @@
     return;
 }
 
+sub parse_webctvista4_assessment {
+    my ($res,$docroot,$href,$allids,$qzparams) = @_;
+    my $xmlfile = $docroot.'/'.$href; #assessment file
+    my @state = ();
+    my $id; # the current question ID
+    my $fieldlabel; # the current qti metadata field label
+    my $outcome_id; # the current question ID for outcomes conditions
+    my $pname; # the current outcomes parameter name
+    my $numids = 0;
+    %{$$qzparams{$res}} = ();
+    %{$$qzparams{$res}{weight}} = ();
+
+    my $p = HTML::Parser->new
+    (
+     xml_mode => 1,
+     start_h =>
+     [sub {
+        my ($tagname, $attr) = @_;
+        push @state, $tagname;
+        my @seq = ();
+        if ("@state" eq "questestinterop assessment section itemref") {
+            $id = $attr->{linkrefid};
+            push(@{$allids},$id);
+            $numids ++;
+        }
+        if ("@state" eq "questestinterop assessment section selection_ordering order") {
+           $$qzparams{$res}{order_type} = $attr->{order_type};
+        }
+
+     }, "tagname, attr"],
+     text_h =>
+     [sub {
+        my ($text) = @_;
+        if ("@state" eq "questestinterop assessment qtimetadata qtimetadatafield fieldlabel") {
+            $fieldlabel = $text;
+        }
+        if ("@state" eq "questestinterop assessment qtimetadata qtimetadatafield fieldentry") {
+            $$qzparams{$res}{$fieldlabel} = $text;
+        }
+        if ("@state" eq "questestinterop assessment section outcomes_processing objects_condition outcomes_metadata") {
+            $outcome_id = $text;
+        }
+        if ("@state" eq "questestinterop assessment section outcomes_processing objects_condition objects_parameter") {
+            if ($pname eq 'qmd_weighting') {
+                $$qzparams{$res}{weight}{$outcome_id} = $text;
+            }
+        }
+        if ("@state" eq "questestinterop assessment section selection_ordering selection selection_number") {
+            $$qzparams{$res}{numpick} = $text;
+        }
+      }, "dtext"],
+     end_h =>
+     [sub {
+        my ($tagname) = @_;
+        pop @state;
+     }, "tagname"],
+    );
+    $p->unbroken_text(1);
+    $p->parse_file($xmlfile);
+    $p->eof;
+    unless(defined($$qzparams{$res}{numpick})) {
+        $$qzparams{$res}{numpick} = $numids;
+    }
+}
+
+sub parse_webctvista4_question {
+    my ($res,$docroot,$resources,$hrefs,$settings,$allquestids,$allanswers,$allchoices,$parent,$catinfo) = @_;
+    my $xmlfile = $docroot.'/'.$$resources{$res}{file};
+    my %classtypes = (
+                      WCT_Calculated => 'numerical',
+                      WCT_TrueFalse => 'multiplechoice',
+                      WCT_ShortAnswer => 'shortanswer',
+                      WCT_Paragraph => 'paragraph',
+                      WCT_MultipleChoice => 'multiplechoice',
+                      WCT_Matching => 'match',
+                      WCT_JumbledSentence => 'jumbled',
+                      WCT_FillInTheBlank => 'string',
+                      WCT_Combination => 'combination'
+    );
+    my @state = ();
+    my $fieldlabel;
+    my %questiondata;
+    my $id; # the current question ID
+    my $list; # the current list ID for multiple choice questions 
+    my $numid; # the current answer ID for numerical questions
+    my $grp; # the current group ID for matching questions
+    my $label; # the current reponse label for string questions
+    my $str_id; # the current string ID for string questions
+    my $unitid; # the current unit ID for numerical questions
+    my $answer_id;  # the current answer ID 
+    my $fdbk; # the current feedback ID
+    my $currvar; # the current variable for numerical problems
+    my $fibtype; # the current fill-in-blank type for numerical or string
+    my $prompt;
+    my $rows;
+    my $columns;
+    my $maxchars;
+    my %setvar = (
+                   varname => '',
+                   action => '',
+                 );
+    my $currtexttype;
+    my $jumble_item;
+    my $numbox = 0;
+    my %str_answers = ();
+    my $currtextlabel;
+    my $textlabel;
+    my $currindex;
+    my %varinfo = ();
+    my $formula;
+    my $p = HTML::Parser->new
+    (
+     xml_mode => 1,
+     start_h =>
+     [sub {
+        my ($tagname, $attr) = @_;
+        push @state, $tagname;
+        if ("@state" eq "questestinterop item") {
+            $id = $attr->{ident};
+            push(@{$allquestids},$id);
+            %{$$settings{$id}} = ();
+            %{$varinfo{$id}} = ();
+            @{$$allchoices{$id}} = ();
+            @{$$settings{$id}{grps}} = ();
+            @{$$settings{$id}{lists}} = ();
+            @{$$settings{$id}{feedback}} = ();
+            @{$$settings{$id}{str}} = ();
+            %{$$settings{$id}{strings}} = ();
+            @{$$settings{$id}{numids}} = ();
+            %{$$allanswers{$id}} = ();
+            $$settings{$id}{title} = $attr->{title};
+        }
+        if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:var") {
+            $currvar = $attr->{'webct:name'};
+            %{$varinfo{$id}{$currvar}} = ();
+            $varinfo{$id}{$currvar}{min} = $attr->{'webct:min'};
+            $varinfo{$id}{$currvar}{max} = $attr->{'webct:max'};
+            $varinfo{$id}{$currvar}{precision} = $attr->{'webct:precision'};
+        }
+        if ("@state" eq "questestinterop item presentation flow response_num") {
+            $numid = $attr->{ident};
+            push(@{$$settings{$id}{numids}},$numid);
+            %{$$settings{$id}{$numid}} = ();
+            %{$$settings{$id}{$numid}{vars}} = ();
+            @{$$settings{$id}{$numid}{units}} = ();
+            $$settings{$id}{$numid}{rcardinality} = $attr->{rcardinality};
+            $$settings{$id}{$numid}{formula} = $formula;
+            foreach my $var (keys(%{$varinfo{$id}})) {
+                %{$$settings{$id}{$numid}{vars}{$var}} = %{$varinfo{$id}{$var}};
+            }
+        }
+        if ("@state" eq "questestinterop item presentation flow material mat_extension webct:variable") {
+            $$settings{$id}{text} .= '['.$attr->{'webct:name'}.']';
+        }
+        if ("@state" eq "questestinterop item presentation flow material matimage") {
+            $$settings{$id}{image} = $attr->{uri};
+        }
+
+        if ("@state" eq "questestinterop item presentation flow material mattext")  {
+            $currtexttype = lc($attr->{texttype});
+            $$settings{$id}{texttype} = $currtexttype;
+            if ($$settings{$id}{class} eq 'combination') {
+                if (exists($attr->{label})) {
+                    $textlabel = $attr->{label};
+                } else {
+                    $textlabel = '';
+                }
+            }
+        }
+        if ("@state" eq "questestinterop item presentation flow response_lid") {
+            $list = $attr->{ident};
+            push(@{$$settings{$id}{lists}},$list);
+            %{$$settings{$id}{$list}} = ();
+            @{$$allanswers{$id}{$list}} = ();
+            @{$$settings{$id}{$list}{correctanswer}} = ();
+            @{$$settings{$id}{$list}{jumbled}} = ();
+            $$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};
+        }
+# Jumbled sentence
+        if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object")  {
+            $$settings{$id}{$list}{orientation} = $attr->{orientation};
+        }
+        if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object material mattext")  {
+            $currtexttype = lc($attr->{texttype});
+            $$settings{$id}{$list}{texttype} = $currtexttype;
+        }
+        if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label")  {
+            $jumble_item = $attr->{ident};
+        }
+        if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label material mattext")  {
+            $currtexttype = lc($attr->{texttype});
+            $$settings{$id}{$list}{$jumble_item}{texttype} = $currtexttype;
+        }
+        if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varequal") { # Jumbled
+            $currindex = $attr->{index};
+        }
+        if ("@state" eq "questestinterop item presentation flow response_lid render_choice") {
+            $$settings{$id}{$list}{randomize} = $attr->{shuffle};
+        }
+        if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label") {
+            $answer_id = $attr->{ident};
+            push(@{$$allanswers{$id}{$list}},$answer_id);
+            %{$$settings{$id}{$list}{$answer_id}} = ();
+        }
+# True/False
+        if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mat_extension webct:localizable_mattext") {
+            $currtexttype = lc($attr->{texttype});
+            $$settings{$id}{$list}{$answer_id}{texttype} = $currtexttype;
+        }
+
+# Multiple Choice and Combination
+        if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mattext") {
+            $currtexttype = lc($attr->{texttype});
+            $$settings{$id}{$list}{$answer_id}{texttype} = $currtexttype;
+            if ($$settings{$id}{class} eq 'combination') {
+                $currtextlabel = $attr->{label};
+            }
+        }
+
+# String, Shortanswer or Paragraph
+        if (($$settings{$id}{class} eq 'string') || 
+            ($$settings{$id}{class} eq 'shortanswer') ||
+            ($$settings{$id}{class} eq 'paragraph')) { 
+            if ("@state" eq "questestinterop item presentation flow response_str") {
+                $str_id = $attr->{ident};
+                %{$$settings{$id}{$str_id}} = ();
+                push(@{$$settings{$id}{str}},$str_id);
+                $$settings{$id}{$str_id}{rcardinality} = $attr->{rcardinality};
+                @{$$settings{$id}{$str_id}{labels}} = ();
+                %{$$settings{$id}{$str_id}{comparison}} = ();
+            }
+        }
+        if ("@state" eq "questestinterop item presentation flow response_str material mattext") { # string
+            $currtexttype = lc($attr->{texttype});
+            $$settings{$id}{$str_id}{texttype} = $currtexttype;
+        }
+        if ("@state" eq "questestinterop item presentation flow response_str render_fib") {
+            $fibtype = $attr->{fibtype};
+            $prompt = $attr->{prompt};
+            $rows = $attr->{rows};
+            $columns = $attr->{columns};
+            $maxchars = $attr->{maxchars};
+        }
+        if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label") {
+            push(@{$$settings{$id}{$str_id}{labels}},$label);
+            @{$$settings{$id}{strings}{$str_id}} = ();
+            %{$$settings{$id}{$str_id}{$label}} = ();
+            $$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
+            if ($$settings{$id}{class} eq 'string') {
+                $$settings{$id}{text} .= '[blank]';
+            }
+        }
+        if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label material mattext") { # Paragraph
+            $textlabel = $attr->{label}; 
+        }
+# Matching
+        if ("@state" eq "questestinterop item presentation flow flow response_grp") {
+            $grp = $attr->{ident};
+            push(@{$$settings{$id}{grps}},$grp);
+            %{$$settings{$id}{$grp}} = ();
+            @{$$settings{$id}{$grp}{correctanswer}} = ();
+            $$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};
+        }
+        if ("@state" eq "questestinterop item presentation flow flow response_grp material mattext") {
+            $currtexttype = lc($attr->{texttype});
+            $$settings{$id}{$grp}{texttype} = $currtexttype;
+        }
+        if ("@state" eq "questestinterop item presentation flow flow response_grp render_choice response_label") {
+            $answer_id = $attr->{ident};
+            push(@{$$allanswers{$id}{$grp}},$answer_id);
+            %{$$settings{$id}{$grp}{$answer_id}} = ();
+            $currtexttype = lc($attr->{texttype});
+            $$settings{$id}{$grp}{$answer_id}{texttype} =  $currtexttype;
+        }
+# Multiple choice or combination or string or match 
+        if ("@state" eq "questestinterop item resprocessing respcondition conditionvar varequal") {
+            if (($$settings{$id}{class} eq 'multiplechoice') || 
+                ($$settings{$id}{class} eq 'combination')) {
+                $list = $attr->{respident};
+            } elsif (($$settings{$id}{class} eq 'string') ||
+                     ($$settings{$id}{class} eq 'shortanswer')) {
+                $label = $attr->{respident};
+            } elsif ($$settings{$id}{class} eq 'match') {
+                $grp = $attr->{respident};
+            }
+        }
+        if ("@state" eq "questestinterop item resprocessing") {
+            if (($$settings{$id}{class} eq 'string') ||
+                ($$settings{$id}{class} eq 'shortanswer')) {
+                foreach my $str_id (@{$$settings{$id}{str}}) {
+                    @{$str_answers{$str_id}} = ();
+                }
+            }
+        }
+        if ("@state" eq "questestinterop item resprocessing respcondition") {
+            if (($$settings{$id}{class} eq 'string') ||
+                ($$settings{$id}{class} eq 'shortanswer')) { 
+                $numbox ++;
+            }
+        }
+        if ("@state" eq "questestinterop item resprocessing respcondition setvar") {
+            foreach my $key (keys(%{$attr})) {
+                $setvar{$key} = $attr->{$key};
+            }
+        }
+        if (($$settings{$id}{class} eq 'string') ||
+            ($$settings{$id}{class} eq 'shortanswer')) {
+            if (("@state" eq "questestinterop item resprocessing respcondition conditionvar or varsubset") || ("@state" eq "questestinterop item resprocessing respcondition conditionvar varsubset")) {
+                $str_id = $attr->{respident};
+                $$settings{$id}{$str_id}{case} = $attr->{case};
+            }
+        }
+        if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varsubset") {
+            $list = $attr->{respident};
+        }
+# Numerical
+        if ("@state" eq "questestinterop item resprocessing itemproc_extension webct:calculated_answer") {
+            $numid = $attr->{respident};
+            $$settings{$id}{$numid}{toltype} = $attr->{'webct:toleranceType'};
+            $$settings{$id}{$numid}{tolerance} = $attr->{'webct:tolerance'};
+        }
+        if ("@state" eq "questestinterop item resprocessing itemproc_extension unit_eval conditionvar varequal") {
+            $unitid = $attr->{respident};
+            %{$$settings{$id}{$numid}{$unitid}} = ();
+            push(@{$$settings{$id}{$numid}{units}},$unitid);
+            $$settings{$id}{$numid}{$unitid}{case} = $attr->{case};
+        }
+# Feedback
+        if ("@state" eq "questestinterop item respcondition displayfeedback") {
+            $fdbk = $attr->{linkrefid};
+            push(@{$$settings{$id}{feedback}},$fdbk);
+            $$settings{$id}{$fdbk} = ();
+            $$settings{$id}{$fdbk}{feedbacktype} = $attr->{feedbacktype};
+        }
+        if ("@state" eq "questestinterop item itemfeedback") {
+            $fdbk = $attr->{ident};
+            push(@{$$settings{$id}{feedback}},$fdbk);
+            $$settings{$id}{$fdbk}{view} = $attr->{view};
+        }
+        if ("@state" eq "questestinterop item itemfeedback material mattext") {
+            $currtexttype = lc($attr->{texttype});
+            $$settings{$id}{$fdbk}{texttype} = $currtexttype;
+        }
+        if ("@state" eq "questestinterop item itemfeedback solution solutionmaterial material mattext") {
+            $currtexttype = lc($attr->{texttype});
+            $$settings{$id}{$fdbk}{texttype} = $currtexttype;
+        }
+     }, "tagname, attr"],
+     text_h =>
+     [sub {
+        my ($text) = @_;
+        if ($currtexttype eq '/text/html') {
+            $text =~ s#(&lt;img\ssrc=")([^"]+)"&gt;#$1../resfiles/$2#g;
+        }
+        if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldlabel") {
+            $fieldlabel = $text;
+        }
+        if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldentry") {
+            $questiondata{$fieldlabel} = $text;
+            if ($fieldlabel eq 'wct_questiontype') {
+                $$settings{$id}{class} = $classtypes{$text};
+            } elsif ($fieldlabel eq 'wct_questioncategory') {
+                $$settings{$id}{category} = $text;
+                unless(exists($$catinfo{$text})) {
+                    %{$$catinfo{$text}} = ();
+                    $$catinfo{$text}{title} = $text;
+                }
+                push(@{$$catinfo{$text}{contents}},$id);
+            }
+        }
+        if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:formula") {
+            $formula = $text;
+        }
+        if ("@state" eq "questestinterop item presentation flow response_str material mattext") {
+            $$settings{$id}{$str_id}{text} = $text;
+        }
+        if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label material mattext") { # Paragraph
+            if ($textlabel eq 'PRE_FILL_ANSWER') {
+                $$settings{$id}{$str_id}{$label}{$textlabel} = $text;
+            }
+        }
+        if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mattext") {
+            $$settings{$id}{$list}{$answer_id}{text} .= $text;
+            if ($$settings{$id}{class} eq 'combination') {
+                if ($currtextlabel =~ /^wct_mc_answer_text\d+_\d+$/) {
+                    $$settings{$id}{$list}{$answer_id}{text} .= ', ';
+                }
+            }
+        }
+        if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mat_extension webct:localizable_mattext") {
+            $$settings{$id}{$list}{$answer_id}{text} = $text;
+        }
+        if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object material mattext")  {
+            $$settings{$id}{$list}{text} .= $text;
+        }
+        if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label material mattext")  {
+            $$settings{$id}{$list}{$jumble_item}{text} = $text;
+            $$settings{$id}{$list}{text} .= $text;
+        }
+        if ("@state" eq "questestinterop item presentation flow material mattext")  {
+            $$settings{$id}{text} .= $text;
+            if ($$settings{$id}{class} eq 'combination') {
+                if ($textlabel =~ /^wct_question_label_\d+$/) {
+                    $$settings{$id}{$text} .= '<br />';
+                }
+                if ($textlabel =~ /^wct_cmc_single_answer_\d+$/) {
+                    $$settings{$id}{$text} .= '<br />';
+                }
+            }
+        }
+        if ("@state" eq "questestinterop item resprocessing itemproc_extension unit_eval conditionvar varequal") {
+            $$settings{$id}{$numid}{$unitid}{text} = $text;
+        }
+        if ("@state" eq "questestinterop item resprocessing respcondition conditionvar varequal") {
+            if (($$settings{$id}{class} eq 'string') ||
+                ($$settings{$id}{class} eq 'shortanswer')) {
+                unless (grep/^$text$/,@{$str_answers{$str_id}}) {
+                    push(@{$str_answers{$str_id}},$text);
+                    $$settings{$id}{$str_id}{comparison}{$text} = $questiondata{'wct_comparison_type'.$numbox};
+                }
+            } else {
+                $answer_id = $text;
+            }
+        }
+        if (("@state" eq "questestinterop item resprocessing respcondition conditionvar or varsubset") || ("@state" eq "questestinterop item resprocessing respcondition conditionvar varsubset")) { # string
+            if (($$settings{$id}{class} eq 'string') ||
+                ($$settings{$id}{class} eq 'shortanswer')) {
+                unless (grep/^$text$/,@{$str_answers{$str_id}}) {
+                    push(@{$str_answers{$str_id}},$text);
+                    $$settings{$id}{$str_id}{comparison}{$text} = $questiondata{'wct_comparison_type'.$numbox};
+                }
+            }
+        }
+        if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varequal") { # Jumbled
+            $$settings{$id}{$list}{jumbled}[$currindex] = $text;
+        }
+        if ("@state" eq "questestinterop item resprocessing respcondition setvar") {
+            if ($setvar{varname} eq "SCORE") { # Multiple Choice, String or Match
+                if ($text =~ m/^[\d\.]+$/) {
+                    if ($text > 0) {
+                        if (($$settings{$id}{class} eq 'multiplechoice') ||
+                            ($$settings{$id}{class} eq 'combination')) {
+                            push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
+                        } elsif (($$settings{$id}{class} eq 'string') ||
+                                 ($$settings{$id}{class} eq 'shortanswer')) {
+                            foreach my $answer (@{$str_answers{$str_id}}) {
+                                unless (grep/^$answer$/,@{$$settings{$id}{strings}{$str_id}}) {
+                                    push(@{$$settings{$id}{strings}{$str_id}},$answer);
+                                }
+                            }
+                        } elsif ($$settings{$id}{class} eq 'match') {
+                            push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
+                        }
+                    }
+                }
+            }
+        }
+        if ("@state" eq "questestinterop item itemfeedback material mattext") {
+            $$settings{$id}{$fdbk}{text} = $text;
+        }
+        if ("@state" eq "questestinterop item itemfeedback solution solutionmaterial material mattext") {
+            $$settings{$id}{$fdbk}{text} = $text;
+        }
+      }, "dtext"],
+     end_h =>
+     [sub {
+        my ($tagname) = @_;
+        pop @state;
+     }, "tagname"],
+    );
+    $p->unbroken_text(1);
+    $p->parse_file($xmlfile);
+    $p->eof;
+}
+
 sub parse_webct4_assessment {
     my ($res,$docroot,$href,$container,$allids) = @_;
     my $xmlfile = $docroot.'/'.$href; #quiz file
@@ -2513,12 +3075,12 @@
 }
 
 sub process_assessment {
-    my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items,$catinfo,$qzdbsettings,$hrefs) = @_;
+    my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items,$catinfo,$qzdbsettings,$hrefs,$allquestions) = @_;
     my @allids = ();
+    my @allquestids = ();
     my %allanswers = ();
     my %allchoices = ();
     my %qzparams = ();
-    my @allquestids = ();
     my %alldbanswers = ();
     my %alldbchoices = ();
     my @alldbquestids = ();
@@ -2543,54 +3105,8 @@
     } elsif ($cms eq 'webctce4') {
         unless($$dbparse) {
             &parse_webct4_questionDB($docroot,$$resources{$res}{file},$catinfo,$qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
-            if (!-e "$destdir/sequences") {
-                mkdir("$destdir/sequences",0755);
-            }
-            my $numcats = scalar(keys %{$catinfo});
-            my $curr_id = 0;
-            my $next_id = 1;
-            my $fh;
-            open($fh,">$destdir/sequences/question_database.sequence");
-            push @{$sequencesfiles},'question_database.sequence';
-            foreach my $category (sort keys %{$catinfo}) {
-                my $seqname = $$catinfo{$category}{title}.'_'.$category;
-                $seqname =~ s/\s/_/g;
-                $seqname =~ s/\W//g;
-                push(@{$sequencesfiles},$seqname.'.sequence');
-                my $catsrc = "$destresdir/sequences/$seqname.sequence";
-                if ($curr_id == 0) {
-                    print $fh qq|<resource id="1" src="$catsrc" type="start" title="$$catinfo{$category}{title}"></resource>|;
-                }
-                if ($numcats == 1) {
-                    print $fh qq|
-<link from="1" to="2" index="1"></link>
-<resource id="2" src="" type="finish">\n|;
-                } else {
-                    $curr_id = $next_id;
-                    $next_id = $curr_id + 1;
-                    $catsrc = "$destresdir/sequences/$seqname.sequence";
-                    print $fh qq|
-<link from="$curr_id" to="$next_id" index="$curr_id"></link>
-<resource id="$next_id" src="$catsrc" title="$$catinfo{$category}{title}"|;
-                    if ($next_id == $numcats) {
-                        print $fh qq| type="finish"></resource>\n|;
-                    } else {
-                        print $fh qq|></resource>\n|;
-                    }
-                }
-                print $fh qq|</map>|;
-                if (!-e "$destdir/problems") {
-                    mkdir("$destdir/problems",0755);
-                }
-                if (!-e "$destdir/problems/$seqname") {
-                    mkdir("$destdir/problems/$seqname",0755);
-                }
-                $newdir = "$destdir/problems/$seqname";
-                my $dbcontainerdir;
-                &build_problem_container($cms,$seqname,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
-            }
-            close($fh);
-            &write_webct4_questions(\@alldbquestids,$context,$qzdbsettings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);
+            &build_category_sequences($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings);
+            &write_webct4_questions($cms,\@alldbquestids,$context,$qzdbsettings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);
             $$dbparse = 1;
         }
         &parse_webct4_assessment($res,$docroot,$$resources{$res}{file},$container,\@allids);
@@ -2601,6 +3117,20 @@
                 $randompickflag = 1;
             }
         }
+    } elsif ($cms eq 'webctvista4') {
+        unless($$dbparse) {
+            foreach my $res (sort keys %{$allquestions}) {
+                my $parent = $$allquestions{$res};
+                &parse_webctvista4_question($res,$docroot,$resources,$hrefs,$settings,\@allquestids,\%allanswers,\%allchoices,$parent,$catinfo);
+            }
+            &build_category_sequences($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings);
+            $$dbparse = 1;
+        }
+        &parse_webctvista4_assessment($res,$docroot,$hrefs,\@allids,\%qzparams);
+        if ($qzparams{$res}{numpick} < @allids) {
+            $$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
+            $randompickflag = 1;
+        }
     }
     my $dirtitle;
     unless ($cms eq 'webctce4') {
@@ -2625,9 +3155,62 @@
         &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot);
     } elsif ($cms eq 'bb6') {
         &write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot);
+    } elsif ($cms eq 'webctvista4') {
+        &write_webct4_questions($cms,\@allquestids,$context,$settings,$dirname,\%allanswers,\%allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);
     }
 }
 
+sub build_category_sequences {
+    my ($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings) = @_;
+    if (!-e "$destdir/sequences") {
+        mkdir("$destdir/sequences",0755);
+    }
+    my $numcats = scalar(keys %{$catinfo});
+    my $curr_id = 0;
+    my $next_id = 1;
+    my $fh;
+    open($fh,">$destdir/sequences/question_database.sequence");
+    push @{$sequencesfiles},'question_database.sequence';
+    foreach my $category (sort keys %{$catinfo}) {
+        my $seqname = $$catinfo{$category}{title}.'_'.$category;
+        $seqname =~ s/\s/_/g;
+        $seqname =~ s/\W//g;
+        push(@{$sequencesfiles},$seqname.'.sequence');
+        my $catsrc = "$destresdir/sequences/$seqname.sequence";
+        if ($curr_id == 0) {
+            print $fh qq|<resource id="1" src="$catsrc" type="start" title="$$catinfo{$category}{title}"></resource>|;
+        }
+        if ($numcats == 1) {
+            print $fh qq|
+<link from="1" to="2" index="1"></link>
+<resource id="2" src="" type="finish">\n|;
+        } else {
+            $curr_id = $next_id;
+            $next_id = $curr_id + 1;
+            $catsrc = "$destresdir/sequences/$seqname.sequence";
+            print $fh qq|
+<link from="$curr_id" to="$next_id" index="$curr_id"></link>
+<resource id="$next_id" src="$catsrc" title="$$catinfo{$category}{title}"|;
+            if ($next_id == $numcats) {
+                print $fh qq| type="finish"></resource>\n|;
+            } else {
+                print $fh qq|></resource>\n|;
+            }
+        }
+        print $fh qq|</map>|;
+        if (!-e "$destdir/problems") {
+            mkdir("$destdir/problems",0755);
+        }
+        if (!-e "$destdir/problems/$seqname") {
+            mkdir("$destdir/problems/$seqname",0755);
+        }
+        $$newdir = "$destdir/problems/$seqname";
+        my $dbcontainerdir;
+        &build_problem_container($cms,$seqname,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
+    }
+    close($fh);
+}
+
 sub build_problem_container {
     my ($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,$allids,$udom,$uname,$dirname,$containerdir,$cid,$cdom,$cnum,$catinfo,$settings) = @_;
     my $seqdir = "$destdir/sequences";
@@ -2658,7 +3241,7 @@
     my $probsrc = "/res/lib/templates/simpleproblem.problem";
     if ($context eq 'CSTR') {
         foreach my $id (@{$allids}) {
-            if ($cms eq 'webctce4') {
+            if (($cms eq 'webctce4') || ($cms eq 'webctvista4')) {
                 $probtitle{$id} = $$settings{$id}{title};
             } else {
                 $probtitle{$id} = $$settings{title};
@@ -3094,7 +3677,7 @@
 }
 
 sub write_webct4_questions {
-    my ($alldbquestids,$context,$settings,$dirname,$allanswers,$allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo) = @_;
+    my ($cms,$alldbquestids,$context,$settings,$dirname,$allanswers,$allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo) = @_;
     my $qnum = 0;
     foreach my $id (@{$alldbquestids}) {
         $qnum ++;
@@ -3110,17 +3693,18 @@
             $allfeedback .= $feedback;
         }
         if ($$settings{$id}{texttype} eq 'text/html') {
-            $$settings{$id}{text} =~ s/(\&)(nbsp|gt|lt)(?!;)/$1$2;$3/gi;
-            $$settings{$id}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{text});
-            $$settings{$id}{text} =~ s#(<img src=["']?)([^>]+?)(/?>)#$1../../resfiles/$2 />#gi;
-            $$settings{$id}{text} =~ s#<([bh])r>#<$1r />#g;
-            $$settings{$id}{text} =~ s#<p>#<br /><br />#g;
-            $$settings{$id}{text} =~ s#</p>##g;
-        }
+            if ($$settings{$id}{text}) {
+                $$settings{$id}{text} = &text_cleanup($$settings{$id}{text});
+            }
+        } 
         if ($$settings{$id}{class} eq 'numerical') {
             foreach my $numid (@{$$settings{$id}{numids}}) {
                 foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {
-                    $$settings{$id}{text} =~ s/{($var)}/\$$1 /g;
+                    if ($cms eq 'webct4ce') {
+                        $$settings{$id}{text} =~ s/{($var)}/\$$1 /g;
+                    } elsif ($cms eq 'webctvista4') {
+                        $$settings{$id}{text} =~ s/\[($var)\]/\$$1 /g;
+                    }
                 }
             }
         }
@@ -3143,15 +3727,27 @@
         }
         $$total{prob} ++;
         if (exists($$settings{$id}{uri})) {
-            if ($$settings{$id}{imagtype} =~ /^image\//) {
-                $questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
+            if ($cms eq 'webct4ce') {
+                if ($$settings{$id}{imagtype} =~ /^image\//) {
+                    $questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
+                } else {
+                    $questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
+                }
+            } elsif ($cms eq 'webctvista4') {
+                if ($$settings{$id}{uri} =~ /(gif|jpg|png)$/i) {
+                    $questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
+                    $questionimage =~ s#(//+)#/#g;
+                } else {
+                    $questionimage = '<a href="'.$$settings{$id}{uri}.'" target="exturi" >'.$$settings{$id}{uri}.'</a>';
+                }
             }
         }
         if ($$settings{$id}{class} eq "paragraph") {
+            my $pre_fill_answer = $$settings{$id}{PARA}{PARA}{PRE_FILL_ANSWER};
             if ($context eq 'CSTR') {
                 $output .= qq|<startouttext /><p>$$settings{$id}{text}</p>$questionimage<endouttext />
  <essayresponse>
- <textfield></textfield>
+ <textfield>$pre_fill_answer</textfield>
  </essayresponse>
  <postanswerdate>
   $allfeedback
@@ -3380,59 +3976,69 @@
                 } else {
                     $resourcedata{$symb.'options'} = "('".join("','",@allmatch)."')";
                 }
-            } elsif ($$settings{$id}{class} eq 'string') {
+            } elsif (($$settings{$id}{class} eq 'string') || 
+                     ($$settings{$id}{class} eq 'shortanswer')) {
                 my $labelnum = 0;
-                foreach my $str_id (@{$$settings{$id}{str}}) {
-                    foreach my $label (@{$$settings{$id}{$str_id}{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;
-                                }
+                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];
-                                    }
+                    }
+                    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];
                                 }
-                                $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 ($$settings{$id}{strings}{$label}[$k] >= $max) {
+                                    $max = $$settings{$id}{strings}{$label}[$k];
                                 }
                             }
-                            if ($context eq 'CSTR') {
-                                if (@{$$settings{$id}{str}} > 1) {
-                                    $output .= qq|
-<startouttext />$labelnum.<endouttext />
-|;
+                            $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|
+<startouttext />$labelnum.<endouttext />
+|;
+                            }
+                            $output .= qq|
 <numericalresponse answer="$numans">
         <responseparam type="tolerance" default="$tol" name="tol" description="Numerical Tolerance" />
         <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
@@ -3441,54 +4047,54 @@
 </numericalresponse>
 <startouttext /><br /><endouttext />
 |;
+                        }
+                    } 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 ($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|
+                            if (@{$$settings{$id}{str}} > 1) {
+                                $output .= qq|
 <startouttext />$labelnum.<endouttext />
 |;
+                            }
+                            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';
                                 }
-                                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|
+                                $output .= qq|
 <stringresponse answer="$$settings{$id}{strings}{$label}[0]" type="$casetype">
 <textline>
 </textline>
 </stringresponse>
 <startouttext /><br /><endouttext />
 |;
-                                } 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|
+                            } 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|
 <stringresponse answer="$regexpans" type="re">
 <textline>
 </textline>
 </stringresponse>
 <startouttext /><br /><endouttext />
 |;
-                                }
                             }
                         }
                     }
@@ -3514,7 +4120,6 @@
                     'sqrt' => 'sqrt',
                     'tan' => 'tan',
                 );
-
                 my $scriptblock = qq|
 <script type="loncapa/perl">
 |;
@@ -3534,8 +4139,12 @@
                                 $deccount --;
                             }
                             $increment .= '1';
-                        } 
-                        $formula =~ s/{($var)}/(\$$1)/g;
+                        }
+                        if ($cms eq 'webct4ce') { 
+                            $formula =~ s/{($var)}/(\$$1)/g;
+                        } elsif ($cms eq 'webctvista4') {
+                            $formula =~ s/\[($var)\]/(\$$1)/g;
+                        }
                         $scriptblock .= qq|
 \$$var=&random($$settings{$id}{$numid}{vars}{$var}{min},$$settings{$id}{$numid}{vars}{$var}{max},$increment);
 |;
@@ -3557,7 +4166,7 @@
                             $ansformat = 'format="'.$ansformat.'"';
                         }
                         my $tolerance = $$settings{$id}{$numid}{tolerance};
-                        if ($$settings{$id}{$numid}{toltype} eq 'percent') {
+                        if (lc($$settings{$id}{$numid}{toltype}) eq 'percent') {
                             $tolerance .= '%';
                         }
                         my $unit = '';
@@ -3605,6 +4214,17 @@
     }
 }
 
+sub text_cleanup {
+    my ($text) = @_;
+    $text =~ s/(\&)(nbsp|gt|lt)(?!;)/$1$2;$3/gi;
+    $text = &Apache::loncleanup::htmlclean($text);
+    $text =~ s#(<img src=["']?)([^>]+?)(/?>)#$1../../resfiles/$2 />#gi;
+    $text =~ s#<([bh])r>#<$1r />#g;
+    $text =~ s#<p>#<br /><br />#g;
+    $text =~ s#</p>##g;
+    return $text;
+}
+
 sub test_for_html {
     my ($source) = @_; 
     my @tags = ();

--raeburn1144138605--