--- loncom/imspackages/imsprocessor.pm 2005/03/15 15:25:32 1.16
+++ loncom/imspackages/imsprocessor.pm 2005/03/23 19:54:27 1.17
@@ -177,7 +177,7 @@ sub process_manifest {
unless (-e "$tempdir/imsmanifest.xml") {
return 'nomanifest';
- }
+ }
my $xmlfile = $tempdir.'/imsmanifest.xml';
my $p = HTML::Parser->new
@@ -187,19 +187,9 @@ sub process_manifest {
[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 @@ sub process_manifest {
}
}
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 @@ sub copy_resources {
$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 @@ sub copy_resources {
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 @@ sub process_resinfo {
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 @@ sub process_resinfo {
}
} 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 @@ sub process_resinfo {
%{$$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 @@ sub build_structure {
\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 @@ sub make_structure {
} 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 @@ sub make_structure {
$$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_bb6_assessment {
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_assessment {
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 parse_webct4_questionDB {
}
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 @@ sub process_assessment {
&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||;
+ print $fh qq||;
}
if ($numcats == 1) {
print $fh qq|
@@ -2329,7 +2315,7 @@ sub process_assessment {
$catsrc = "$destresdir/sequences/$seqname.sequence";
print $fh qq|
-\n|;
} else {
@@ -2345,10 +2331,10 @@ sub process_assessment {
}
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 @@ sub process_assessment {
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 @@ sub build_problem_container {
}
print $fh qq|