[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--