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