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

raeburn lon-capa-cvs@mail.lon-capa.org
Wed, 23 Mar 2005 19:54:28 -0000


This is a MIME encoded message

--raeburn1111607668
Content-Type: text/plain

raeburn		Wed Mar 23 14:54:28 2005 EDT

  Modified files:              
    /loncom/imspackages	imsprocessor.pm 
  Log:
  Clean up. Remove or replace debugging to STDERR with logging via &logthis(). Cetegory info and settings hashes for webct4 question database need to be passed by reference to process_assessment() because questionDB.xml is only processed the first time process_assessment() is called.  Change to imsmanifest parser so quiz_properties attributes are stored.
  
  
--raeburn1111607668
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20050323145428.txt"

Index: loncom/imspackages/imsprocessor.pm
diff -u loncom/imspackages/imsprocessor.pm:1.16 loncom/imspackages/imsprocessor.pm:1.17
--- loncom/imspackages/imsprocessor.pm:1.16	Tue Mar 15 10:25:32 2005
+++ loncom/imspackages/imsprocessor.pm	Wed Mar 23 14:54:27 2005
@@ -177,7 +177,7 @@
 
     unless (-e "$tempdir/imsmanifest.xml") {
         return 'nomanifest';
-    } 
+    }
 
     my $xmlfile = $tempdir.'/imsmanifest.xml';
     my $p = HTML::Parser->new
@@ -187,19 +187,9 @@
            [sub {
                 my ($tagname, $attr) = @_;
                 push @state, $tagname;
-                my $num = @state - 3;
-                my $start = $num;
-                my $statestr = '';
-                foreach (@state) {
-                    $statestr .= "$_ ";
-                }
+                my $start = @state - 3;
                 if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $toc{$cms}) ) {
-                    my $searchstr = "manifest organizations $toc{$cms}";
-                    while ($num > 0) {
-                        $searchstr .= " item";
-                        $num --; 
-                    }
-                    if (("@state" eq $searchstr) && (@state > 3)) {
+                    if ($state[-1] eq 'item') {
                         $itm = $attr->{identifier};
                         if ($$includeditems{$itm} || $phase ne 'build') {
                             %{$$items{$itm}} = ();
@@ -260,7 +250,7 @@
                         }
                     }
                     if ($cms eq 'webct4') {
-                        if ("@state" eq "$searchstr webct:properties") {
+                        if (($state[-1] eq "webct:properties") && (@state > 4)) {
                             $$items{$itm}{properties} = $attr->{identifierref};
                         }
                     }
@@ -392,7 +382,7 @@
                             $copyfile = $1;
                         }
                     }
-                    unless (($cms eq 'webct4') && ($copyfile eq 'questionDB.xml' || $copyfile =~ m/^quiz_QIZ_\d+\.xml$/)) {
+                    unless (($cms eq 'webct4') && ($copyfile =~ m/questionDB\.xml$/ || $copyfile =~ m/quiz_QIZ_\d+\.xml$/ || $copyfile =~ m/properties_QIZ_\d+\.xml$/)) {
                         $copyfile = $fpath.$copyfile;
                         my $fileresult;
                         if (-e $source) {
@@ -447,10 +437,8 @@
                             if (-e "$tempdir/$file") {
                                 rename("$tempdir/$file","$destdir/resfiles/$copyfile");
                             }
-                        } elsif ($file =~ m-/data/(.+)$-) {
-                            print STDERR "File $file is a WebCT data file \n";
-                        } else {
-                            print STDERR "File $file is in unexpected location\n";
+                        } elsif ($file !~ m-/data/(.+)$-) {
+                            &Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
                         }
                     }
                 }
@@ -466,6 +454,8 @@
     my $dbparse = 0;
     my $announce_handling = 'include';
     my $longcrs = '';
+    my %qzdbsettings = ();
+    my %catinfo = ();
     if ($crs =~ m/^(\d)(\d)(\d)/) {
         $longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
     }
@@ -529,15 +519,15 @@
                 }
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {
                 %{$$resinfo{$key}} = ();
-                &process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);
+                &process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings);
                 push @{$pools}, $key;
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {
                 %{$$resinfo{$key}} = ();
-                &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);
+                &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings);
                 push @{$quizzes}, $key;
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-survey") {
                 %{$$resinfo{$key}} = ();
-                &process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);
+                &process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings);
                 push @{$surveys}, $key;
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {
                 %{$$resinfo{$key}} = ();
@@ -579,8 +569,7 @@
                     %{$$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") {
-#                    &webct4_assessment($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
-                    &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);
+                    &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings);
                 }
             }
         }
@@ -670,12 +659,11 @@
 <resource id="$next_id" src="" type="finish"></resource>\n|;
                 }
             } else {
-                print "key is $key\n";
                 my $contcount = 0;
                 if (defined($$items{$key}{contents})) { 
                     $contcount = @{$$items{$key}{contents}};
                 } else {
-                    print STDERR "not defined for $key\n";
+                    &Apache::lonnet::logthis("IMS Import error for item: $key- contents count = $contentscount, but identity of contents not defined.");
                 }
                 my $contitem = $$items{$key}{contents}[0];
                 my $contitemcount = $$items{$contitem}{contentscount}; 
@@ -900,7 +888,7 @@
     } elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) )  {
         if ($$flag{$key}{page}) {
             if ($$count{$key}{page} == -1) {
-                print STDERR "Array index is -1, we shouldnt be here, key is $key, type is $type\n";
+                &Apache::lonnet::logthis("IMS Angel import error in array index for page: value = -1, resource is $key, type is $type.");
             } else { 
                 push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
             }
@@ -928,7 +916,9 @@
             $$flag{$key}{seq} = 0;
         }
     } elsif ($cms eq 'webct4') {
-        unless ($type eq 'webctquiz') {
+        if ($type eq 'webctquiz') {
+            $src =  $srcstem.'/pages/'.$res.'.page';
+        } else {
             if (grep/^$file$/,@{$$hrefs{$res}}) {
                 my $filename;
                 if ($file =~ m-/([^/]+)$-) {
@@ -1827,7 +1817,6 @@
 sub parse_webct4_assessment {
     my ($res,$docroot,$href,$container,$allids) = @_;
     my $xmlfile = $docroot.'/'.$href; #quiz file
-    print STDERR "quiz file -- XML file is $xmlfile\n";
     my @state = ();
     my $id; # the current question ID
     my $p = HTML::Parser->new
@@ -1862,7 +1851,6 @@
 sub parse_webct4_quizprops {
     my ($res,$docroot,$href,$container,$qzparams) = @_;
     my $xmlfile = $docroot.'/'.$href; #properties file
-    print STDERR "props file -- XML file is $xmlfile\n";
     my @state = ();
     %{$$qzparams{$res}} = ();
     my $p = HTML::Parser->new
@@ -2269,14 +2257,12 @@
 }
 
 sub process_assessment {
-    my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items) = @_;
+    my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items,$catinfo,$qzdbsettings) = @_;
     my @allids = ();
     my %allanswers = ();
     my %allchoices = ();
     my %qzparams = ();
     my @allquestids = ();
-    my %catinfo = ();
-    my %qzdbsettings = ();
     my %alldbanswers = ();
     my %alldbchoices = ();
     my @alldbquestids = ();
@@ -2300,24 +2286,24 @@
         &parse_bb6_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
     } elsif ($cms eq 'webct4') {
         unless($$dbparse) {
-            &parse_webct4_questionDB($docroot,$$resources{$res}{file},\%catinfo,\%qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
+            &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 $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;
+            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>|;
+                    print $fh qq|<resource id="1" src="$catsrc" type="start" title="$$catinfo{$category}{title}"></resource>|;
                 }
                 if ($numcats == 1) {
                     print $fh qq|
@@ -2329,7 +2315,7 @@
                     $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}"|;
+<resource id="$next_id" src="$catsrc" title="$$catinfo{$category}{title}"|;
                     if ($next_id == $numcats) {
                         print $fh qq| type="finish"></resource>\n|;
                     } else {
@@ -2345,10 +2331,10 @@
                 }
                 my $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);
+                &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);
+            &write_webct4_questions(\@alldbquestids,$context,$qzdbsettings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);
             $$dbparse = 1;
         }
         &parse_webct4_assessment($res,$docroot,$$resources{$res}{file},$container,\@allids);
@@ -2376,7 +2362,7 @@
         my $newdir = "$destdir/problems/$dirtitle";
     }
 
-    &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,\%catinfo,\%qzdbsettings);
+    &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
     if ($cms eq 'bb5') {
         &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
     } elsif ($cms eq 'bb6') {
@@ -2410,14 +2396,21 @@
     }
     print $fh qq|<map>
 |;
+    my %probtitle = ();
     my $probsrc = "/res/lib/templates/simpleproblem.problem";
     if ($context eq 'CSTR') {
+        foreach my $id (@{$allids}) {
+            $probtitle{$id} = $$settings{$id}{title};
+            $probtitle{$id} =~ s/\s/_/g;
+            $probtitle{$id} =~ s/\W//g;
+            $probtitle{$id} .= '_'.$id;
+        }
         if ($cms eq 'webct4' && $container ne 'database') {
             my $catid = $$settings{$$allids[0]}{category};
             my $probdir = $$catinfo{$catid}{title}.'_'.$catid;
             $probdir =~ s/\s/_/g;
             $probdir =~ s/\W//g;
-            $probsrc = "$dirname/problems/$probdir/$$allids[0].problem";
+            $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";
         } else {
             $probsrc="$dirname/problems/$dirtitle/$$allids[0].problem";
         }
@@ -2441,7 +2434,7 @@
                     my $probdir = $$catinfo{$catid}{title}.'_'.$catid;
                     $probdir =~ s/\s/_/g;
                     $probdir =~ s/\W//g;
-                    $probsrc = "$dirname/problems/$probdir/$$allids[$j].problem";
+                    $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";
                 } else {
                     $probsrc = "$dirname/problems/$dirtitle/$$allids[$j].problem";
                 }
@@ -3873,11 +3866,5 @@
     }
 }
 
-# ---------------------------------------------------------------- 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";
-}
-
 1;
 __END__

--raeburn1111607668--