--- loncom/imspackages/imsprocessor.pm 2005/03/15 15:25:32 1.16
+++ loncom/imspackages/imsprocessor.pm 2005/04/07 06:56:22 1.19
@@ -95,7 +95,7 @@ sub uploadzip {
my ($context,$tempdir,$source) = @_;
my $fname;
if ($context eq 'DOCS') {
- $fname=$ENV{'form.uploadname.filename'};
+ $fname=$env{'form.uploadname.filename'};
# Replace Windows backslashes by forward slashes
$fname=~s/\\/\//g;
# Get rid of everything but the actual filename
@@ -107,9 +107,9 @@ sub uploadzip {
# See if there is anything left
unless ($fname) { return 'error: no uploaded file'; }
# Save the file
- chomp($ENV{'form.uploadname'});
+ chomp($env{'form.uploadname'});
open(my $fh,'>'.$tempdir.'/'.$fname);
- print $fh $ENV{'form.uploadname'};
+ print $fh $env{'form.uploadname'};
close($fh);
} elsif ($context eq 'CSTR') {
if ($source =~ m/\/([^\/]+)$/) {
@@ -128,14 +128,8 @@ sub expand_zip {
return 'no zip';
}
if ($filename =~ m|\.zip$|i) {
- # unzip can cause an sh launch which can pass along all of %ENV
- # which can be too large for /bin/sh to handle
- my %oldENV=%ENV;
- undef(%ENV);
open(OUTPUT, "unzip -o $zipfile -d $tempdir 2> /dev/null |");
close(OUTPUT);
- %ENV=%oldENV;
- undef(%oldENV);
} else {
return 'nozip';
}
@@ -177,7 +171,7 @@ sub process_manifest {
unless (-e "$tempdir/imsmanifest.xml") {
return 'nomanifest';
- }
+ }
my $xmlfile = $tempdir.'/imsmanifest.xml';
my $p = HTML::Parser->new
@@ -187,19 +181,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 +244,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 +376,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 +431,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 +448,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 +513,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,$hrefs);
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,$hrefs);
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,$hrefs);
push @{$surveys}, $key;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {
%{$$resinfo{$key}} = ();
@@ -579,8 +563,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,$hrefs);
}
}
}
@@ -670,12 +653,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};
@@ -691,8 +673,12 @@ sub build_structure {
if (grep/^$res$/,@{$packages}) {
$packageflag = 1;
}
- $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount);
+ $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem});
unless ($flag{$key}{page} == 1) {
+ if ($$randompicks{$contitem}) {
+ $seqtext{$key} .= qq|
+\n|;
+ }
$seqtext{$key} .= qq|
-
+\n|;
+ if ($$randompicks{$contitem}) {
+ $seqtext{$key} .= qq|
+|;
+ }
+ $seqtext{$key} .= qq|
-
+\n|;
+ if ($$randompicks{$contitem}) {
+ $seqtext{$key} .= qq|
+\n|;
+ }
+ $seqtext{$key} .= qq|
0)) {
$src = $srcstem.'/sequences/'.$contitem.'.sequence';
$$flag{$key}{page} = 0;
$$flag{$key}{seq} = 1;
$$count{$key}{seq} ++;
+ } elsif ($cms eq 'webct4' && $randompick) {
+ $src = $srcstem.'/sequences/'.$res.'.sequence';
+ $$flag{$key}{page} = 0;
+ $$flag{$key}{seq} = 1;
+ $$count{$key}{seq} ++;
} elsif ($cms eq 'angel' && $type eq 'BOARD') {
$src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard';
$$flag{$key}{page} = 0;
@@ -900,7 +900,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 +928,11 @@ sub make_structure {
$$flag{$key}{seq} = 0;
}
} elsif ($cms eq 'webct4') {
- unless ($type eq 'webctquiz') {
+ if ($type eq 'webctquiz') {
+ $src = $srcstem.'/pages/'.$res.'.page';
+ $$count{$key}{page} ++;
+ $$flag{$key}{seq} = 0;
+ } else {
if (grep/^$file$/,@{$$hrefs{$res}}) {
my $filename;
if ($file =~ m-/([^/]+)$-) {
@@ -1827,7 +1831,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 +1865,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
@@ -1872,15 +1874,6 @@ sub parse_webct4_quizprops {
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
- my $depth = 0;
- my @seq = ();
- if ($state[0] eq 'properties' && $state[1] eq 'processing') {
- if ($state[2] eq 'scores' && $state[3] eq 'score') {
- $$qzparams{$res}{weight} = $attr->{linkrefid};
- } elsif ($state[2] eq 'selection' && $state[3] eq 'select') {
- $$qzparams{$res}{numpick} = $attr->{linkrefid};
- }
- }
}, "tagname, attr"],
text_h =>
[sub {
@@ -1889,15 +1882,23 @@ sub parse_webct4_quizprops {
if ($state[2] eq 'time_available') {
$$qzparams{$res}{opendate} = $text;
} elsif ($state[2] eq 'time_due') {
- $$qzparams{$res}{opendate} = $text;
+ $$qzparams{$res}{duedate} = $text;
} elsif ($state[3] eq 'max_attempt') {
$$qzparams{$res}{tries} = $text;
} elsif ($state[3] eq 'post_submission') {
$$qzparams{$res}{posts} = $text;
+ } elsif ($state[3] eq 'method') {
+ $$qzparams{$res}{method} = $text;
+ }
+ } elsif ($state[0] eq 'properties' && $state[1] eq 'processing') {
+ if ($state[2] eq 'scores' && $state[3] eq 'score') {
+ $$qzparams{$res}{weight} = $text;
+ } elsif ($state[2] eq 'selection' && $state[3] eq 'select') {
+ $$qzparams{$res}{numpick} = $text;
}
} elsif ($state[0] eq 'properties' && $state[1] eq 'result') {
if ($state[2] eq 'display_answer') {
- $$qzparams{$res}{answerdate} = $text;
+ $$qzparams{$res}{showanswer} = $text;
}
}
}, "dtext"],
@@ -2269,14 +2270,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,$hrefs) = @_;
my @allids = ();
my %allanswers = ();
my %allchoices = ();
my %qzparams = ();
my @allquestids = ();
- my %catinfo = ();
- my %qzdbsettings = ();
my %alldbanswers = ();
my %alldbchoices = ();
my @alldbquestids = ();
@@ -2285,7 +2284,7 @@ sub process_assessment {
my $randompickflag = 0;
my ($cid,$cdom,$cnum);
if ($context eq 'DOCS') {
- $cid = $ENV{'request.course.id'};
+ $cid = $env{'request.course.id'};
($cdom,$cnum) = split/_/,$cid;
}
my $destresdir = $destdir;
@@ -2300,24 +2299,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 +2328,7 @@ sub process_assessment {
$catsrc = "$destresdir/sequences/$seqname.sequence";
print $fh qq|
-\n|;
} else {
@@ -2345,20 +2344,18 @@ 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);
- &parse_webct4_quizprops($res,$docroot,$$resources{$$items{$$resources{$res}{revitm}}{properties}}{file},$container,\%qzparams);
- foreach (sort keys %qzparams) {
- if (exists($qzparams{$res}{numpick})) {
- if ($qzparams{$res}{numpick} < @allids) {
- $$randompicks{$res} = $qzparams{$res}{numpick};
- $randompickflag = 1;
- }
+ &parse_webct4_quizprops($res,$docroot,$$hrefs{$$items{$$resources{$res}{revitm}}{properties}}[0],$container,\%qzparams);
+ if (exists($qzparams{$res}{numpick})) {
+ if ($qzparams{$res}{numpick} < @allids) {
+ $$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
+ $randompickflag = 1;
}
}
}
@@ -2376,7 +2373,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 +2407,21 @@ sub build_problem_container {
}
print $fh qq|