[LON-CAPA-cvs] cvs: loncom /imspackages imsimport.pm imsimportdocs.pm imsprocessor.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Mon, 21 Feb 2005 23:47:47 -0000
This is a MIME encoded message
--raeburn1109029667
Content-Type: text/plain
raeburn Mon Feb 21 18:47:47 2005 EDT
Modified files:
/loncom/imspackages imsimport.pm imsimportdocs.pm imsprocessor.pm
Log:
Add option to import WebCT4 IMS package. Work still required on import of questions and quizzes. Import of BB6 assessments also requires work (BB6 IMS packaging uses QTI-type packaging for assessments unlike BB5).
--raeburn1109029667
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20050221184747.txt"
Index: loncom/imspackages/imsimport.pm
diff -u loncom/imspackages/imsimport.pm:1.9 loncom/imspackages/imsimport.pm:1.10
--- loncom/imspackages/imsimport.pm:1.9 Mon Feb 14 17:46:12 2005
+++ loncom/imspackages/imsimport.pm Mon Feb 21 18:47:46 2005
@@ -293,9 +293,10 @@
Please choose the CMS used to create your IMS content package.
<select name="source">
<option value='-1' selected="true">Please select
- <option value='bb6'>Blackboard 6
<option value='bb5'>Blackboard 5
+ <option value='bb6'>Blackboard 6
<option value='angel'>ANGEL
+ <option value='webct4'>WebCT 4
</select>
</font>
</td>
@@ -402,7 +403,7 @@
$manifest_result = &Apache::imsprocessor::process_manifest($cms,$tempdir,\%resources,\%items,\%hrefs,\%resinfo,'choose',\%includedres,\%includeditems);
if ($manifest_result eq 'ok') {
foreach my $res (sort keys %resources) {
- if ($cms eq 'bb5' || $cms eq 'bb6') {
+ if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {
foreach my $area (keys %{$$cmsmap{$cms}}) {
if ($resources{$res}{type} eq $$cmsmap{$cms}{$area}) {
$count{$area} ++;
@@ -624,6 +625,7 @@
my %importareas = ();
my %includedres = ();
my %includeditems = ();
+ my %randompicks = ();
my @targets = ();
my %resources = ();
my %items = ();
@@ -695,11 +697,11 @@
my @topnames = ();
my @packages = ();
- &Apache::imsprocessor::process_resinfo($cms,'CSTR',$tempdir,$destdir,\%items,\%resources,\@targets,\@boards,\@announcements,\@quizzes,\@surveys,\@pools,\@groups,\%messages,\@timestamp,\%boardnum,\%resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,\%total,$seqstem,$seqstem,\@resrcfiles,\@packages,\%hrefs,\@pages,\@sequences);
+ &Apache::imsprocessor::process_resinfo($cms,'CSTR',$tempdir,$destdir,\%items,\%resources,\@targets,\@boards,\@announcements,\@quizzes,\@surveys,\@pools,\@groups,\%messages,\@timestamp,\%boardnum,\%resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,\%total,$seqstem,$seqstem,\@resrcfiles,\@packages,\%hrefs,\@pages,\@sequences,\%randompicks);
my $copy_result = &Apache::imsprocessor::copy_resources('CSTR',$cms,\%hrefs,$tempdir,\@targets,\%urls,$crs,$cdom,$chome,$destdir,$timenow,\%importareas);
- &Apache::imsprocessor::build_structure($cms,'CSTR',$destdir,\%items,\%resinfo,\%resources,\@targets,\%hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,\@timestamp,\%total,\@boards,\@announcements,\@quizzes,\@surveys,\@pools,\%boardnum,\@pages,\@sequences,\@topurls,\@topnames,\@packages,\%includeditems);
+ &Apache::imsprocessor::build_structure($cms,'CSTR',$destdir,\%items,\%resinfo,\%resources,\@targets,\%hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,\@timestamp,\%total,\@boards,\@announcements,\@quizzes,\@surveys,\@pools,\%boardnum,\@pages,\@sequences,\@topurls,\@topnames,\@packages,\%includeditems,\%randompicks);
$r->print("<h3>IMS import completed</h3>");
@@ -708,7 +710,7 @@
} elsif ($cms eq 'angel') {
$r->print("<font face='arial,helvetica,sans-serif'>Your IMS package has been processed successfully. A total of $total{seq} sequences, $total{page} pages, and $total{board} bulletin boards have been created.<br /><br />\n");
}
- $r->print("Please view the imported items and use the LON-CAPA editing tools to make changes. The sequences directory contains a file named 'Top.sequence' whichincludes links to the items found at the top level of your IMS package. From there you can follow links to display all the imported items. Alternatively, you can browse the pages, sequences, problems and resfiles directories directly. Note if you rename a file, you will need to modify any .sequence files or .page files which include a reference to the renamed file.<br /><br />The final step in the IMS import process is to publish the materials you have imported into your Construction Space so that you can use them in a course. Once your file are published, subsequent re-publication will result in the storage of information about changes between the different versions.<br /><br /><a href='/priv/".$uname."/".$newdir."'>Display new directory</a></font>");
+ $r->print("Please view the imported items and use the LON-CAPA editing tools to make changes. The sequences directory contains a file named 'Top.sequence' which includes links to the items found at the top level of your IMS package. From there you can follow links to display all the imported items. Alternatively, you can browse the pages, sequences, problems and resfiles directories directly. Note if you rename a file, you will need to modify any .sequence files or .page files which include a reference to the renamed file.<br /><br />The final step in the IMS import process is to publish the materials you have imported into your Construction Space so that you can use them in a course. Once your file are published, subsequent re-publication will result in the storage of information about changes between the different versions.<br /><br /><a href='/priv/".$uname."/".$newdir."'>Display new directory</a></font>");
if ($destdir =~ m-^/home/$uname/public_html/-) {
system (" rm -r -f $destdir/temp");
}
Index: loncom/imspackages/imsimportdocs.pm
diff -u loncom/imspackages/imsimportdocs.pm:1.10 loncom/imspackages/imsimportdocs.pm:1.11
--- loncom/imspackages/imsimportdocs.pm:1.10 Wed Feb 16 15:24:15 2005
+++ loncom/imspackages/imsimportdocs.pm Mon Feb 21 18:47:46 2005
@@ -235,6 +235,7 @@
<option value='bb5'>Blackboard 5
<option value='bb6'>Blackboard 6
<option value='angel'>ANGEL
+ <option value='webct4'>WebCT 4
</select>
</font>
</td>
@@ -336,7 +337,7 @@
$manifest_result = &Apache::imsprocessor::process_manifest($cms,$tempdir,\%resources,\%items,\%hrefs,\%resinfo,'choose',\%includedres,\%includeditems);
if ($manifest_result eq 'ok') {
foreach my $res (sort keys %resources) {
- if ($cms eq 'bb5' || $cms eq 'bb6') {
+ if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {
foreach my $area (keys %{$cmsmap{$cms}}) {
if ($resources{$res}{type} eq $cmsmap{$cms}{$area}) {
$count{$area} ++;
@@ -616,7 +617,7 @@
my $copy_result = &Apache::imsprocessor::copy_resources('DOCS',$cms,\%hrefs,$tempdir,\@targets,\%urls,$crs,$cdom,$chome,$destdir,$timenow,\%importareas);
&Apache::imsprocessor::build_structure($cms,'DOCS',$destdir,\%items,\%resinfo,\%resources,\@targets,\%hrefs,$udom,$uname,'',$timenow,$cdom,$crs,\@timestamp,\%total,\@boards,\@announcements,\@quizzes,\@surveys,\@pools,\%boardnum,\@pages,\@sequences,\@topurls,\@topnames,\@packages,\%includeditems);
-
+
foreach my $item (@pages) {
my $filename = $timenow.'/pages/'.$item;
my $fetchresult= &Apache::lonnet::process_coursefile('propagate',$crs,$cdom,$chome,$filename,'');
Index: loncom/imspackages/imsprocessor.pm
diff -u loncom/imspackages/imsprocessor.pm:1.14 loncom/imspackages/imsprocessor.pm:1.15
--- loncom/imspackages/imsprocessor.pm:1.14 Mon Feb 14 17:46:12 2005
+++ loncom/imspackages/imsprocessor.pm Mon Feb 21 18:47:46 2005
@@ -51,6 +51,11 @@
survey => 'FORM',
);
@{$$cmsmap{angel}{doc}} = ('FILE','PAGE');
+ %{$$cmsmap{webct4}} = (
+ quiz => 'webctquiz',
+ survey => 'webctsurvey',
+ doc => 'webcontent'
+ );
%{$areaname} = (
announce => 'Announcements',
board => 'Discussion Boards',
@@ -146,6 +151,7 @@
bb6 => 'organization',
bb5 => 'tableofcontents',
angel => 'organization',
+ webct4 => 'organization',
);
my %contents = ();
my @state = ();
@@ -198,7 +204,7 @@
if ($$includeditems{$itm} || $phase ne 'build') {
%{$$items{$itm}} = ();
$$items{$itm}{contentscount} = 0;
- if ($cms eq 'bb5' || $cms eq 'bb6') {
+ if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {
$$items{$itm}{resnum} = $attr->{identifierref};
if ($cms eq 'bb5') {
$$items{$itm}{title} = $attr->{title};
@@ -255,7 +261,7 @@
} elsif ("@state" eq "manifest resources resource" ) {
$identifier = $attr->{identifier};
if ($$includedres{$identifier} || $phase ne 'build') {
- if ($cms eq 'bb5' || $cms eq 'bb6') {
+ if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {
$$resources{$identifier}{file} = $attr->{file};
$$resources{$identifier}{type} = $attr->{type};
} elsif ($cms eq 'angel') {
@@ -268,7 +274,7 @@
}
} elsif ("@state" eq "manifest resources resource file") {
if ($$includedres{$identifier} || $phase ne 'build') {
- if ($cms eq 'bb5' || $cms eq 'bb6') {
+ if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {
push @{$$hrefs{$identifier}},$attr->{href};
} elsif ($cms eq 'angel') {
if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
@@ -283,11 +289,18 @@
text_h =>
[sub {
my ($text) = @_;
+ if ("@state" eq "manifest metadata lom general title langstring") {
+ $$items{'Top'}{title} = $text;
+ }
if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq $toc{$cms} && $state[-1] eq "title") {
if ($$includeditems{$itm} || $phase ne 'build') {
if ($cms eq 'angel' || $cms eq 'bb6') {
$$items{$itm}{title} = $text;
}
+ if ($cms eq 'webct4') {
+ $$items{$itm}{title} = $text;
+ $$items{$itm}{title} =~ s/(<[^>]*>)//g;
+ }
}
}
}, "dtext"],
@@ -353,6 +366,9 @@
%{$$url{$key}} = ();
foreach my $file (@{$$hrefs{$key}}) {
my $source = $tempdir.'/'.$key.'/'.$file;
+ if ($cms eq 'webct4') {
+ $source = $tempdir.'/'.$file;
+ }
my $filename = '';
my $fpath = $timenow.'/resfiles/'.$key.'/';
if ($cms eq 'angel') {
@@ -361,8 +377,19 @@
}
}
$file =~ s-\\-/-g;
- $file = $fpath.$file;
- my $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$chome,$file,$source);
+ my $copyfile = $file;
+ if ($cms eq 'webct4') {
+ if ($file =~ m-/([^/]+)$-) {
+ $copyfile = $1;
+ }
+ }
+ unless (($cms eq 'webct4') && ($copyfile eq 'questionDB.xml' || $copyfile =~ m/^quiz_QIZ_\d+\.xml$/)) {
+ $copyfile = $fpath.$copyfile;
+ my $fileresult;
+ if (-e $source) {
+ $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$chome,$copyfile,$source);
+ }
+ }
}
}
}
@@ -374,11 +401,10 @@
if (grep/^$key$/,@{$targets}) {
foreach my $file (@{$$hrefs{$key}}) {
$file =~ s-\\-/-g;
- if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') || ($cms eq 'bb6') ) {
+ if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') || ($cms eq 'bb6')) {
if (!-e "$destdir/resfiles/$key") {
mkdir("$destdir/resfiles/$key",0770);
}
-
my $filepath = $file;
my $front = '';
while ($filepath =~ m-(\w+)/(.+)-) {
@@ -395,6 +421,16 @@
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
}
+ } elsif ($cms eq 'webct4') {
+ if (!-e "$destdir/resfiles/$key") {
+ mkdir("$destdir/resfiles/$key",0770);
+ }
+ if ($file =~ m-/([^/]+)$-) {
+ my $copyfile = $1;
+ unless ($copyfile eq 'questionDB.xml' || $copyfile =~ m/^quiz_QIZ_\d+\.xml$/) {
+ rename("$tempdir/$file","$destdir/resfiles/$key/$1");
+ }
+ }
}
}
}
@@ -403,9 +439,10 @@
}
sub process_resinfo {
- my ($cms,$context,$docroot,$destdir,$items,$resources,$targets,$boards,$announcements,$quizzes,$surveys,$pools,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles,$packages,$hrefs,$pagesfiles,$sequencesfiles) = @_;
+ my ($cms,$context,$docroot,$destdir,$items,$resources,$targets,$boards,$announcements,$quizzes,$surveys,$pools,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles,$packages,$hrefs,$pagesfiles,$sequencesfiles,$randompicks) = @_;
my $board_id = time;
my $board_count = 0;
+ my $dbparse = 0;
my $announce_handling = 'include';
my $longcrs = '';
if ($crs =~ m/^(\d)(\d)(\d)/) {
@@ -471,15 +508,15 @@
}
} elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {
%{$$resinfo{$key}} = ();
- &process_assessment($context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles);
+ &process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse);
push @{$pools}, $key;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {
%{$$resinfo{$key}} = ();
- &process_assessment($context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles);
+ &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse);
push @{$quizzes}, $key;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-survey") {
%{$$resinfo{$key}} = ();
- &process_assessment($context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles);
+ &process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse);
push @{$surveys}, $key;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {
%{$$resinfo{$key}} = ();
@@ -514,6 +551,19 @@
if (@{$pools}) {
$$items{'Top'}{'contentscount'} ++;
}
+ } elsif ($cms eq 'webct4') {
+ foreach my $key (sort keys %{$resources}) {
+ if (grep/^$key$/,@{$targets}) {
+ if ($$resources{$key}{type} eq "webcontent") {
+ %{$$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);
+
+ }
+ }
+ }
}
$$total{'board'} = $board_count;
@@ -523,7 +573,7 @@
}
sub build_structure {
- my ($cms,$context,$destdir,$items,$resinfo,$resources,$targets,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$pools,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames,$packages,$includeditems) = @_;
+ my ($cms,$context,$destdir,$items,$resinfo,$resources,$targets,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$pools,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames,$packages,$includeditems,$randompicks) = @_;
my %flag = ();
my %count = ();
my %pagecontents = ();
@@ -582,11 +632,13 @@
my $curr_id = 1;
my $resnum = $$items{$key}{resnum};
my $type = $$resources{$resnum}{type};
- if (($cms eq 'angel' && $type eq "FOLDER") || (($cms eq 'bb5' || $cms eq 'bb6') && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") || ($type eq "resource/x-bb-staffinfo") || ($type eq "resource/x-bb-externallink")) ) {
+ my $contentscount = $$items{$key}{'contentscount'};
+ if (($cms eq 'angel' && $type eq "FOLDER") || (($cms eq 'bb5' || $cms eq 'bb6') && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") || ($type eq "resource/x-bb-staffinfo") || ($type eq "resource/x-bb-externallink")) || ($cms eq 'webct4' && $contentscount > 0)) {
+ print STDERR "$key is identified as a folder has $contentscount\n";
unless (($cms eq 'bb5') && $key eq 'Top') {
$seqtext{$key} = "<map>\n";
}
- if ($$items{$key}{contentscount} == 0) {
+ if ($contentscount == 0) {
if ($key eq 'Top') {
unless ($topspecials) {
$seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>
@@ -601,14 +653,19 @@
} else {
my $contcount = @{$$items{$key}{contents}};
my $contitem = $$items{$key}{contents}[0];
- my $res = $$items{$contitem}{resnum};
- my $type = $$resources{$res}{type};
+ my $contitemcount = $$items{$contitem}{contentscount};
+ my ($res,$itm,$type);
+ if (exists($$items{$contitem}{resnum})) {
+ $res = $$items{$contitem}{resnum};
+ $itm = $$resources{$res}{revitm};
+ $type = $$resources{$res}{type};
+ }
my $title = $$items{$contitem}{title};
my $packageflag = 0;
if (grep/^$res$/,@{$packages}) {
$packageflag = 1;
}
- $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag);
+ $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount);
unless ($flag{$key}{page} == 1) {
$seqtext{$key} .= qq|<resource id="$curr_id" src="$src" title="$title" type="start"|;
unless ($flag{$key}{seq} || $flag{$key}{board} || $flag{$key}{file}) {
@@ -635,6 +692,7 @@
if ($contcount > 2 ) {
for (my $i=1; $i<$contcount-1; $i++) {
my $contitem = $$items{$key}{contents}[$i];
+ my $contitemcount = $$items{$contitem}{contentscount};
my $res = $$items{$contitem}{resnum};
my $type = $$resources{$res}{type};
my $title = $$items{$contitem}{title};
@@ -642,7 +700,8 @@
if (grep/^$res$/,@{$packages}) {
$packageflag = 1;
}
- $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag);
+ $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount);
+
unless ($flag{$key}{page} == 1) {
$seqtext{$key} .= qq|></resource>
<link from="$curr_id" to="$next_id" index="$curr_id"></link>
@@ -660,6 +719,7 @@
}
}
my $contitem = $$items{$key}{contents}[-1];
+ my $contitemcount = $$items{$contitem}{contentscount};
my $res = $$items{$contitem}{resnum};
my $type = $$resources{$res}{type};
my $title = $$items{$contitem}{title};
@@ -667,7 +727,8 @@
if (grep/^$res$/,@{$packages}) {
$packageflag = 1;
}
- $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag);
+ $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount);
+
if ($flag{$key}{page}) {
if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {
$seqtext{$key} .= qq|></resource>
@@ -788,9 +849,9 @@
}
sub make_structure {
- my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag) = @_;
+ my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount) = @_;
my $src ='';
- if (($cms eq 'angel' && $type eq 'FOLDER') || (($cms eq 'bb5' || $cms eq 'bb6') && ($$resinfo{$res}{'isfolder'} eq 'true') || ($key eq 'Top')) ) {
+ if (($cms eq 'angel' && $type eq 'FOLDER') || (($cms eq 'bb5' || $cms eq 'bb6') && (($$resinfo{$res}{'isfolder'} eq 'true') || $key eq 'Top')) || ($cms eq 'webct4' && $contitemcount > 0)) {
$src = $srcstem.'/sequences/'.$contitem.'.sequence';
$$flag{$key}{page} = 0;
$$flag{$key}{seq} = 1;
@@ -838,6 +899,18 @@
}
$$flag{$key}{seq} = 0;
}
+ } elsif ($cms eq 'webct4') {
+ unless ($type eq 'webctquiz') {
+ foreach my $file (@{$$hrefs{$res}}) {
+ my $filename;
+ if ($file =~ m-/([^/]+)$-) {
+ $filename = $1;
+ }
+ $src = $srcstem.'/resfiles/'.$res.'/'.$filename;
+ }
+ $$flag{$key}{page} = 0;
+ $$flag{$key}{file} = 1;
+ }
}
return $src;
}
@@ -1275,7 +1348,7 @@
} elsif ("@state" eq "EXTERNALLINK TEXTCOLOR") {
$$settings{textcolor} = $attr->{value};
} elsif ("@state" eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {
- $$settings{ishtml} = $attr->{value};
+ $$settings{ishtml} = $attr->{value};
} elsif ("@state" eq "EXTERNALLINK FLAGS ISAVAILABLE" ) {
$$settings{isavailable} = $attr->{value};
} elsif ("@state" eq "EXTERNALLINK FLAGS LAUNCHINNEWWINDOW" ) {
@@ -1549,15 +1622,12 @@
}
return $status;
}
-# ---------------------------------------------------------------- Process Blackboard Assessments - pools, quizzes, surveys
-sub process_assessment {
- my ($context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles) = @_;
+
+sub parse_bb5_assessment {
+ my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
# print "XML file is $xmlfile\n";
my @state = ();
- my @allids = ();
- my %allanswers = ();
- my %allchoices = ();
my $id; # the current question ID
my $answer_id; # the current answer ID
my %toptag = ( pool => 'POOL',
@@ -1603,9 +1673,9 @@
}
if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {
$id = $attr->{id};
- push @allids, $id;
+ push @{$allids}, $id;
%{$$settings{$id}} = ();
- @{$allanswers{$id}} = ();
+ @{$$allanswers{$id}} = ();
$$settings{$id}{class} = $attr->{class};
unless ($container eq "pool") {
$$settings{$id}{points} = $attr->{points};
@@ -1627,7 +1697,7 @@
$$settings{$id}{name} = $attr->{name};
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {
$answer_id = $attr->{id};
- push @{$allanswers{$id}},$answer_id;
+ push @{$$allanswers{$id}},$answer_id;
%{$$settings{$id}{$answer_id}} = ();
$$settings{$id}{$answer_id}{position} = $attr->{position};
if ($$settings{$id}{class} eq 'QUESTION_MATCH') {
@@ -1636,7 +1706,7 @@
}
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {
$answer_id = $attr->{id};
- push @{$allchoices{$id}},$answer_id;
+ push @{$$allchoices{$id}},$answer_id;
%{$$settings{$id}{$answer_id}} = ();
$$settings{$id}{$answer_id}{position} = $attr->{position};
$$settings{$id}{$answer_id}{placement} = $attr->{placement};
@@ -1699,7 +1769,484 @@
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
+}
+
+sub parse_bb6_assessment {
+ my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;
+ return;
+}
+
+sub parse_webct4_assessment {
+ my ($res,$docroot,$container,$allids) = @_;
+ my $xmlfile = $docroot.'/quiz'.$res.".xml"; #quiz file
+ print STDERR "XML file is $xmlfile\n";
+ my @state = ();
+ my $id; # the current question ID
+ my $p = HTML::Parser->new
+ (
+ xml_mode => 1,
+ start_h =>
+ [sub {
+ my ($tagname, $attr) = @_;
+ push @state, $tagname;
+ my $depth = 0;
+ my @seq = ();
+ my $class;
+ if ("@state" eq "questestinterop assessment section itemref") {
+ $id = $attr->{linkrefid};
+ push(@{$allids},$id);
+ }
+ }, "tagname, attr"],
+ text_h =>
+ [sub {
+ my ($text) = @_;
+ }, "dtext"],
+ end_h =>
+ [sub {
+ my ($tagname) = @_;
+ pop @state;
+ }, "tagname"],
+ );
+ $p->unbroken_text(1);
+ $p->parse_file($xmlfile);
+ $p->eof;
+}
+
+sub parse_webct_quizprops {
+ my ($res,$docroot,$container,$qzparams) = @_;
+ my $xmlfile = $docroot.'/quiz'.$res.".xml"; #quiz file
+ print STDERR "XML file is $xmlfile\n";
+ my @state = ();
+ %{$$qzparams{$res}} = ();
+ my $p = HTML::Parser->new
+ (
+ xml_mode => 1,
+ start_h =>
+ [sub {
+ my ($tagname, $attr) = @_;
+ push @state, $tagname;
+ my $depth = 0;
+ my @seq = ();
+ my $class;
+ 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 {
+ my ($text) = @_;
+ if ($state[0] eq 'properties' && $state[1] eq 'delivery') {
+ if ($state[2] eq 'time_available') {
+ $$qzparams{$res}{opendate} = $text;
+ } elsif ($state[2] eq 'time_due') {
+ $$qzparams{$res}{opendate} = $text;
+ } elsif ($state[3] eq 'max_attempt') {
+ $$qzparams{$res}{tries} = $text;
+ } elsif ($state[3] eq 'post_submission') {
+ $$qzparams{$res}{posts} = $text;
+ }
+ } elsif ($state[0] eq 'properties' && $state[1] eq 'result') {
+ if ($state[2] eq 'display_answer') {
+ $$qzparams{$res}{answerdate} = $text;
+ }
+ }
+ }, "dtext"],
+ end_h =>
+ [sub {
+ my ($tagname) = @_;
+ pop @state;
+ }, "tagname"],
+ );
+ $p->unbroken_text(1);
+ $p->parse_file($xmlfile);
+ $p->eof;
+}
+
+sub parse_webct4_questionDB {
+ my ($docroot,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;
+ my $xmlfile = $docroot.'/questionDB.xml'; #quizDB file
+ print STDERR "XML file is $xmlfile\n";
+ my @state = ();
+ my $category; # the current category ID
+ my $id; # the current question ID
+ my $list; # the current list ID for multiple choice questions
+ my $numid; # the current answer ID for numerical questions
+ my $grp; # the current group ID for matching questions
+ my $label; # the current reponse label for string questions
+ my $str_id; # the current string ID for string questions
+ my $unitid; # the current unit ID for numerical questions
+ my $answer_id; # the current answer ID
+ my $fdbk; # the current feedback ID
+ my $maxvar; # the current max variable for numerical problems
+ my $minvar; # the current min variable for numerical problems
+ my $stepvar; # the current step variable for numerical problems
+ my $fibtype; # the current fill-in-blank type fro numerical or string
+ my $prompt;
+ my %setvar = (
+ varname => '',
+ action => '',
+ );
+ my $p = HTML::Parser->new
+ (
+ xml_mode => 1,
+ start_h =>
+ [sub {
+ my ($tagname, $attr) = @_;
+ push @state, $tagname;
+ if ("@state" eq "questestinterop section") {
+ $category = $attr->{ident};
+ %{$$catinfo{$category}} = ();
+ $$catinfo{$category}{title} = $attr->{title};
+ }
+ if ("@state" eq "questestinterop section item") {
+ $id = $attr->{ident};
+ push @{$allids}, $id;
+ push(@{$$catinfo{$category}{contents}},$id);
+ %{$$settings{$id}} = ();
+ @{$$settings{$id}{grps}} = ();
+ @{$$settings{$id}{lists}} = ();
+ @{$$settings{$id}{feedback}} = ();
+ %{$$settings{$id}{strings}} = ();
+ %{$$allanswers{$id}} = ();
+ @{$$allanswers{$id}{strings}} = ();
+ $$settings{$id}{title} = $attr->{title};
+ }
+
+# Matching
+ if ("@state" eq "questestinterop section item presentation material mattext") {
+ $$settings{$id}{texttype} = $attr->{texttype};
+ }
+ if ("@state" eq "questestinterop section item presentation response_grp") {
+ $$settings{$id}{class} = 'QUESTION_MATCH';
+ $grp = $attr->{ident};
+ push(@{$$settings{$id}{grps}},$grp);
+ %{$$settings{$id}{$grp}} = ();
+ @{$$allanswers{$id}{$grp}} = ();
+ @{$$settings{$id}{$grp}{correctanswer}} = ();
+ $$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};
+ }
+ if ("@state" eq "questestinterop section item presentation response_grp material mattext") {
+ $$settings{$id}{$grp}{texttype} = $attr->{texttype};
+ }
+ if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label") {
+ $answer_id = $attr->{ident};
+ push(@{$$allanswers{$id}{$grp}},$answer_id);
+ %{$$settings{$id}{$grp}{$answer_id}} = ();
+ $$settings{$id}{$grp}{$answer_id}{texttype} = $attr->{texttype};
+ }
+
+# Multiple choice
+
+ if ("@state" eq "questestinterop section item presentation flow material mattext") {
+ $$settings{$id}{texttype} = $attr->{texttype};
+ }
+ if ("@state" eq "questestinterop section item presentation flow response_lid") {
+ $$settings{$id}{class} = 'QUESTION_MULTIPLEANSWER';
+ $list = $attr->{ident};
+ push(@{$$settings{$id}{lists}},$list);
+ %{$$settings{$id}{$list}} = ();
+ @{$$allanswers{$id}{$list}} = ();
+ @{$$settings{$id}{$list}{correctanswer}} = ();
+ $$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};
+ }
+ if ("@state" eq "questestinterop section item presentation flow response_lid render_choice") {
+ $$settings{$id}{$list}{randomize} = $attr->{shuffle};
+ }
+ if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label") {
+ $answer_id = $attr->{ident};
+ push(@{$$allanswers{$id}{$list}},$answer_id);
+ %{$$settings{$id}{$list}{$answer_id}} = ();
+ }
+ if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {
+ $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
+ }
+
+# Numerical
+ if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
+ $$settings{$id}{texttype} = $attr->{texttype};
+ }
+ if ("@state" eq "questestinterop section item presentation response_num") {
+ $$settings{$id}{class} = 'QUESTION_NUMERICAL';
+ $numid = $attr->{ident};
+ %{$$settings{$id}{$numid}} = ();
+ $$settings{$id}{$numid}{rcardinality} = $attr->{rcardinality};
+ }
+ if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_minvalue webct:x_webct_v01_variable") {
+ $minvar = $attr->{name};
+ $$settings{$id}{$numid}{minvar} = $minvar;
+ }
+ if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_minvalue webct:x_webct_v01_variable") {
+ $maxvar = $attr->{name};
+ $$settings{$id}{$numid}{maxvar} = $maxvar;
+ }
+ if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_decimalnum webct:x_webct_v01_variable") {
+ $stepvar = $attr->{name};
+ $$settings{$id}{$numid}{stepvar} = $stepvar;
+ }
+ if ("@state" eq "questestinterop section item presentation response_num render_fib") {
+ $fibtype = $attr->{fibtype};
+ $prompt = $attr->{prompt};
+ }
+ if ("@state" eq "questestinterop section item presentation response_num render_fib response_label") {
+ $$settings{$id}{$numid}{label} = $attr->{ident};
+ }
+
+# String or Numerical
+ if ("@state" eq "questestinterop section item presentation response_str") {
+ $str_id = $attr->{ident};
+ push(@{$$settings{$id}{str}},$str_id);
+ %{$$settings{$id}{$str_id}} = ();
+ $$settings{$id}{$str_id}{rcardinality} = $attr->{rcardinality};
+ }
+
+ if ("@state" eq "questestinterop section item presentation response_str render_fib") {
+ $fibtype = $attr->{fibtype};
+ }
+ if ("@state" eq "questestinterop section item presentation response_str render_fib response_label") {
+ $label = $attr->{ident};
+ %{$$settings{$id}{$str_id}{$label}} = ();
+ push(@{$$allanswers{$id}{strings}},$label);
+ @{$$settings{$id}{strings}{$label}} = ();
+ $$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
+ }
+
+# Numerical
+ if ("@state" eq "questestinterop section item presentation response_str render_fib") {
+ $fibtype = $attr->{fibtype};
+ $prompt = $attr->{prompt};
+ }
+ if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_formula") {
+ $$settings{$id}{$numid}{formula} = $attr->{ident};
+ }
+ if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anspresentation") {
+ $$settings{$id}{$numid}{digits} = $attr->{digits};
+ $$settings{$id}{$numid}{format} = $attr->{format};
+ }
+ if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") {
+ $$settings{$id}{$numid}{toltype} = $attr->{type};
+ }
+ if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
+ my $unitid = $attr->{ident};
+ %{$$settings{$id}{$numid}{$unitid}} = ();
+ $$settings{$id}{$numid}{$unitid}{value} = $attr->{value};
+ $$settings{$id}{$numid}{$unitid}{space} = $attr->{space};
+ $$settings{$id}{$numid}{$unitid}{case} = $attr->{case};
+ }
+
+# Matching
+ if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
+ $grp = $attr->{respident};
+ }
+ if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar setvar") {
+ $setvar{varname} = $attr->{varname};
+ if ($setvar{varname} eq 'WebCT_Correct') {
+ push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
+ }
+ }
+
+# String
+ if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") {
+ $$settings{$id}{class} = 'QUESTION_FILLINBLANK';
+ $answer_id = $attr->{respident};
+ $$settings{$id}{class} = '';
+ }
+ if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar not") {
+ $$settings{$id}{class} = 'QUESTION_ESSAY';
+ }
+
+
+# Feedback
+
+ if ("@state" eq "questestinterop section item respcondition displayfeedback") {
+ $fdbk = $attr->{linkrefid};
+ push(@{$$settings{$id}{feedback}},$fdbk);
+ $$settings{$id}{$fdbk} = ();
+ $$settings{$id}{$fdbk}{feedbacktype} = $attr->{feedbacktype};
+ }
+ if ("@state" eq "questestinterop section item itemfeedback") {
+ $fdbk = $attr->{ident};
+ $$settings{$id}{$fdbk}{view} = $attr->{view};
+ }
+ if ("@state" eq "questestinterop section item itemfeedback material mattext") {
+ $$settings{$id}{$fdbk}{texttype} = $attr->{texttype};
+ }
+ }, "tagname, attr"],
+ text_h =>
+ [sub {
+ my ($text) = @_;
+ if ("@state" eq "questestinterop section item itemmetadata qmd_itemtype") {
+ $$settings{$id}{itemtype} = $text;
+ }
+
+#Matching
+
+ if ("@state" eq "questestinterop section item presentation material mattext") {
+ $$settings{$id}{text} = $text;
+ }
+ if ("@state" eq "questestinterop section item presentation response_grp material mattext") {
+ $$settings{$id}{$grp}{text} = $text;
+ }
+ if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label material mattext") {
+ $$settings{$id}{$grp}{$answer_id}{text} = $text;
+ }
+
+# Multiple choice
+
+ if ("@state" eq "questestinterop section item presentation flow material mattext") {
+ $$settings{$id}{text} = $text;
+ }
+
+ if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {
+ $$settings{$id}{$list}{$answer_id}{text} = $text;
+ }
+
+# Numerical
+ if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
+ $$settings{$id}{text} = $text;
+ }
+ if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_minvalue webct:x_webct_v01_variable") {
+ $$settings{$id}{$minvar}{min} = $text;
+ }
+ if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_maxvalue webct:x_webct_v01_variable") {
+ $$settings{$id}{$maxvar}{max} = $text;
+ }
+ if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_decimalnum webct:x_webct_v01_variable") {
+ $$settings{$id}{$stepvar}{step} = $text;
+ }
+
+ if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
+ $answer_id = $text;
+ }
+ if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") { # String
+ push(@{$$settings{$id}{strings}{$answer_id}},$text);
+ }
+ if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar setvar") {
+ if ($setvar{varname} eq "answerValue") { # Multiple Choice
+ if ($text =~ m/^\d+$/) {
+ if ($text > 0) {
+ push(@{$$settings{$id}{$list}{correctanswer}}),$answer_id;
+ }
+ }
+ }
+ }
+
+ if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
+ $$settings{$id}{$numid}{$unitid}{text} = $text;
+ }
+
+ if ("@state" eq "questestinterop section item itemfeedback material mattext") {
+ $$settings{$id}{$fdbk}{text} = $text;
+ }
+ }, "dtext"],
+ end_h =>
+ [sub {
+ my ($tagname) = @_;
+ pop @state;
+ }, "tagname"],
+ );
+ $p->unbroken_text(1);
+ $p->parse_file($xmlfile);
+ $p->eof;
+}
+sub process_assessment {
+ my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse) = @_;
+ my @allids = ();
+ my %allanswers = ();
+ my %allchoices = ();
+ my %qzparams = ();
+ my @allquestids = ();
+ my %catinfo = ();
+ my %qzdbsettings = ();
+ my %alldbanswers = ();
+ my %alldbchoices = ();
+ my @alldbquestids = ();
+ my $containerdir;
+ my $newdir;
+ my $randompickflag = 0;
+ my ($cid,$cdom,$cnum);
+ if ($context eq 'DOCS') {
+ $cid = $ENV{'request.course.id'};
+ ($cdom,$cnum) = split/_/,$cid;
+ }
+ my $destresdir = $destdir;
+ if ($context eq 'CSTR') {
+ $destresdir =~ s|/home/$uname/public_html/|/res/$udom/$uname/|;
+ } elsif ($context eq 'DOCS') {
+ $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
+ }
+ if ($cms eq 'bb5') {
+ &parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
+ } elsif ($cms eq 'bb6') {
+ &parse_bb6_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
+ } elsif ($cms eq 'webct4') {
+ unless($$dbparse) {
+ &parse_webct4_questionDB($docroot,\%catinfo,\%qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
+ if (!-e "$destdir/sequences") {
+ mkdir("$destdir/sequences",0755);
+ }
+ my $numcats = 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;
+ $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>|;
+ }
+ if ($numcats == 1) {
+ print $fh qq|
+<link from="1" to="2" index="1"></link>
+<resource id="2" src="" type="finish">\n|;
+ } else {
+ $curr_id = $next_id;
+ $next_id = $curr_id + 1;
+ $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}"|;
+ if ($next_id == $numcats) {
+ print $fh qq| type="finish"></resource>\n|;
+ } else {
+ print $fh qq|></resource>\n|;
+ }
+ }
+ print $fh qq|</map>|;
+ if (!-e "$destdir/problems") {
+ mkdir("$destdir/problems",0755);
+ }
+ if (!-e "$destdir/problems/$seqname") {
+ mkdir("$destdir/problems/$seqname",0755);
+ }
+ my $newdir = "$destdir/problems/$seqname";
+ my $dbcontainerdir;
+ &build_problem_container($seqname,$newdir,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,\$newdir,$cid,$cdom,$cnum);
+ }
+ close($fh);
+ &write_webct4_questions(\@alldbquestids,$context,$settings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum);
+ $$dbparse = 1;
+ }
+ &parse_webct4_quizprops($res,$docroot,$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_assessment($res,$docroot,$container,\@allids);
+ }
my $dirtitle = $$settings{'title'};
$dirtitle =~ s/\W//g;
$dirtitle .= '_'.$res;
@@ -1710,60 +2257,65 @@
mkdir("$destdir/problems/$dirtitle",0755);
}
my $newdir = "$destdir/problems/$dirtitle";
+
+ &build_problem_container($dirtitle,$newdir,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,\$newdir,$cid,$cdom,$cnum);
+ if ($cms eq 'bb5') {
+ &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
+ } elsif ($cms eq 'bb6') {
+ &write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
+ }
+}
+
+sub build_problem_container {
+ my ($dirtitle,$newdir,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,$allids,$udom,$uname,$dirname,$containerdir,$newdir,$cid,$cdom,$cnum) = @_;
my $seqdir = "$destdir/sequences";
my $pagedir = "$destdir/pages";
my $curr_id = 0;
my $next_id = 1;
my $fh;
- my $containerdir;
- if ($container eq 'pool') {
- $containerdir = $seqdir.'/'.$res.'.sequence';
+ if ($container eq 'pool' || $randompickflag || $container eq 'database') {
+ $$containerdir = $seqdir.'/'.$res.'.sequence';
if (!-e "$seqdir") {
mkdir("$seqdir",0770);
}
- open($fh,">$containerdir");
+ open($fh,">$$containerdir");
$$total{seq} ++;
push @{$sequencesfiles},$res.'.sequence';
} else {
- $containerdir = $pagedir.'/'.$res.'.page';
+ $$containerdir = $pagedir.'/'.$res.'.page';
if (!-e "$destdir/pages") {
mkdir("$destdir/pages",0770);
}
- open($fh,">$containerdir");
+ open($fh,">$$containerdir");
$$total{page} ++;
push @{$pagesfiles},$res.'.page';
}
print $fh qq|<map>
|;
my $probsrc = "/res/lib/templates/simpleproblem.problem";
- my ($cid,$cdom,$cnum);
- if ($context eq 'DOCS') {
- $cid = $ENV{'request.course.id'};
- ($cdom,$cnum) = split/_/,$cid;
- }
if ($context eq 'CSTR') {
- $probsrc="/res/$udom/$uname/$dirname/problems/$dirtitle/$allids[0].problem";
+ $probsrc="/res/$udom/$uname/$dirname/problems/$dirtitle/$$allids[0].problem";
}
print $fh qq|<resource id="1" src="$probsrc" type="start" title="question_0001"></resource>|;
- if (@allids == 1) {
+ if (@{$allids} == 1) {
print $fh qq|
<link from="1" to="2" index="1"></link>
<resource id="2" src="" type="finish">\n|;
} else {
- for (my $j=1; $j<@allids; $j++) {
- my $qntitle = $j;
+ for (my $j=1; $j<@{$allids}; $j++) {
+ my $qntitle = $j+1;
while (length($qntitle) <4) {
$qntitle = '0'.$qntitle;
}
$curr_id = $j;
$next_id = $curr_id + 1;
if ($context eq 'CSTR') {
- $probsrc = "/res/$udom/$uname/$dirname/problems/$dirtitle/$allids[$j].problem";
+ $probsrc = "/res/$udom/$uname/$dirname/problems/$dirtitle/$$allids[$j].problem";
}
print $fh qq|
<link from="$curr_id" to="$next_id" index="$curr_id"></link>
<resource id="$next_id" src="$probsrc" title="question_$qntitle"|;
- if ($next_id == @allids) {
+ if ($next_id == @{$allids}) {
print $fh qq| type="finish"></resource>\n|;
} else {
print $fh qq|></resource>|;
@@ -1772,8 +2324,12 @@
}
print $fh qq|</map>|;
close($fh);
+}
+
+sub write_bb5_questions {
+ my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum) = @_;
my $qnum = 0;
- foreach my $id (@allids) {
+ foreach my $id (@{$allids}) {
$qnum ++;
my $output;
my $permcontainer = $containerdir;
@@ -1785,7 +2341,7 @@
$resourcedata{$symb.'text'.$iter} = "";
$resourcedata{$symb.'value'.$iter} = "unused";
$resourcedata{$symb.'position'.$iter} = "random";
- }
+ }
$resourcedata{$symb.'randomize'} = 'yes';
$resourcedata{$symb.'maxfoils'} = 10;
if ($context eq 'CSTR') {
@@ -1800,7 +2356,7 @@
<textfield></textfield>
</essayresponse>
<postanswerdate>
- $$settings{$id}{feedbackcorr}
+ $$settings{$id}{feedbackcorr}
</postanswerdate>
|;
} else {
@@ -1832,7 +2388,7 @@
$resourcedata{$symb.'questiontext'} .= $image.$imglink.$url;
}
if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {
- my $numfoils = @{$allanswers{$id}};
+ my $numfoils = @{$$allanswers{$id}};
if ($context eq 'CSTR') {
$output .= qq|
<radiobuttonresponse max="$numfoils" randomize="yes">
@@ -1843,30 +2399,30 @@
$resourcedata{$symb.'questiontype'} = 'radio';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
- for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
+ for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
my $iter = $k+1;
$output .= " <foil name=\"foil".$k."\" value=\"";
- if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
+ if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
$output .= "true\" location=\"";
$resourcedata{$symb.'value'.$iter} = "true";
} else {
$output .= "false\" location=\"";
$resourcedata{$symb.'value'.$iter} = "false";
}
- if (lc ($allanswers{$id}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {
+ if (lc ($$allanswers{$id}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {
$output .= "bottom\"";
$resourcedata{$symb.'position'.$iter} = "bottom";
} else {
$output .= "random\"";
}
- $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text};
- $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};
+ $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text};
+ $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
my ($ans_image,$ans_link);
- if ( defined($$settings{$id}{$allanswers{$id}[$k]}{image}) ) {
- if ( $$settings{$id}{$allanswers{$id}[$k]}{style} eq 'embed' ) {
- $ans_image .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" /><br />|;
+ if ( defined($$settings{$id}{$$allanswers{$id}[$k]}{image}) ) {
+ if ( $$settings{$id}{$$allanswers{$id}[$k]}{style} eq 'embed' ) {
+ $ans_image .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{$$allanswers{$id}[$k]}{image}" /><br />|;
} else {
- $ans_link .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" />Link to file</a><br/>|;
+ $ans_link .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{$$allanswers{$id}[$k]}{image}" />Link to file</a><br/>|;
}
}
$output .= $ans_image.$ans_link.'<endouttext /></foil>'."\n";
@@ -1880,7 +2436,7 @@
|;
}
} elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {
- my $numfoils = @{$allanswers{$id}};
+ my $numfoils = @{$$allanswers{$id}};
if ($context eq 'CSTR') {
$output .= qq|
<radiobuttonresponse max="$numfoils" randomize="yes">
@@ -1891,18 +2447,18 @@
$resourcedata{$symb.'hiddenparts'} = '!radio';
$resourcedata{$symb.'questiontype'} = 'radio';
}
- for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
+ for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
my $iter = $k+1;
$output .= " <foil name=\"foil".$k."\" value=\"";
- if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
+ if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
$output .= "true\" location=\"random\"";
$resourcedata{$symb.'value'.$iter} = "true";
} else {
$output .= "false\" location=\"random\"";
$resourcedata{$symb.'value'.$iter} = "false";
}
- $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
- $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};
+ $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
+ $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
if ($context eq 'CSTR') {
chomp($output);
@@ -1912,7 +2468,7 @@
|;
}
} elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {
- my $numfoils = @{$allanswers{$id}};
+ my $numfoils = @{$$allanswers{$id}};
if ($context eq 'CSTR') {
$output .= qq|
<optionresponse max="$numfoils" randomize="yes">
@@ -1926,18 +2482,18 @@
$resourcedata{$symb.'questiontype'} = 'option';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
- for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
+ for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
my $iter = $k+1;
$output .= " <foil name=\"foil".$k."\" value=\"";
- if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
+ if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
$output .= "True\"";
$resourcedata{$symb.'value'.$iter} = "True";
} else {
$output .= "False\"";
$resourcedata{$symb.'value'.$iter} = "False";
}
- $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
- $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};
+ $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
+ $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
if ($context eq 'CSTR') {
chomp($output);
@@ -1947,7 +2503,7 @@
|;
}
} elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {
- my $numfoils = @{$allanswers{$id}};
+ my $numfoils = @{$$allanswers{$id}};
my @allorder = ();
if ($context eq 'CSTR') {
$output .= qq|
@@ -1961,14 +2517,14 @@
$resourcedata{$symb.'questiontype'} = 'option';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
- for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
+ for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
if ($context eq 'CSTR') {
- $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
+ $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
} else {
my $iter = $k+1;
- $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};
- if (!grep/^$$settings{$id}{$allanswers{$id}[$k]}{order}$/,@allorder) {
- push @allorder, $$settings{$id}{$allanswers{$id}[$k]}{order};
+ $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
+ if (!grep/^$$settings{$id}{$$allanswers{$id}[$k]}{order}$/,@allorder) {
+ push @allorder, $$settings{$id}{$$allanswers{$id}[$k]}{order};
}
}
}
@@ -1987,8 +2543,8 @@
if ($context eq 'DOCS') {
$numerical = 0;
} else {
- for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
- if ($$settings{$id}{$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {
+ for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
+ if ($$settings{$id}{$$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {
$numerical = 0;
}
}
@@ -1996,18 +2552,18 @@
if ($numerical) {
my $numans;
my $tol;
- if (@{$allanswers{$id}} == 1) {
+ if (@{$$allanswers{$id}} == 1) {
$tol = 5;
- $numans = $$settings{$id}{$allanswers{$id}[0]}{text};
+ $numans = $$settings{$id}{$$allanswers{$id}[0]}{text};
} else {
- my $min = $$settings{$id}{$allanswers{$id}[0]}{text};
- my $max = $$settings{$id}{$allanswers{$id}[0]}{text};
- for (my $k=1; $k<@{$allanswers{$id}}; $k++) {
- if ($$settings{$id}{$allanswers{$id}[$k]}{text} <= $min) {
- $min = $$settings{$id}{$allanswers{$id}[$k]}{text};
+ my $min = $$settings{$id}{$$allanswers{$id}[0]}{text};
+ my $max = $$settings{$id}{$$allanswers{$id}[0]}{text};
+ for (my $k=1; $k<@{$$allanswers{$id}}; $k++) {
+ if ($$settings{$id}{$$allanswers{$id}[$k]}{text} <= $min) {
+ $min = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
- if ($$settings{$id}{$allanswers{$id}[$k]}{text} >= $max) {
- $max = $$settings{$id}{$allanswers{$id}[$k]}{text};
+ if ($$settings{$id}{$$allanswers{$id}[$k]}{text} >= $max) {
+ $max = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
}
$numans = ($max + $min)/2;
@@ -2027,23 +2583,23 @@
if ($context eq 'DOCS') {
$resourcedata{$symb.'hiddenparts'} = '!string';
$resourcedata{$symb.'questiontype'} = 'string';
- $resourcedata{$symb.'maxfoils'} = @{$allanswers{$id}};
+ $resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}};
$resourcedata{$symb.'hiddenparts'} = '!string';
$resourcedata{$symb.'stringtype'} = 'ci';
- $resourcedata{$symb.'stringanswer'} = $$settings{$id}{$allanswers{$id}[0]}{text};
+ $resourcedata{$symb.'stringanswer'} = $$settings{$id}{$$allanswers{$id}[0]}{text};
} else {
- if (@{$allanswers{$id}} == 1) {
+ if (@{$$allanswers{$id}} == 1) {
$output .= qq|
-<stringresponse answer="$$settings{$id}{$allanswers{$id}[0]}{text}" type="ci">
+<stringresponse answer="$$settings{$id}{$$allanswers{$id}[0]}{text}" type="ci">
<textline>
</textline>
</stringresponse>
|;
} else {
my @answertext = ();
- for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
- $$settings{$id}{$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;
- push @answertext, $$settings{$id}{$allanswers{$id}[$k]}{text};
+ for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
+ $$settings{$id}{$$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;
+ push @answertext, $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
my $regexpans = join('|',@answertext);
$regexpans = '/^('.$regexpans.')\b/';
@@ -2070,19 +2626,19 @@
$resourcedata{$symb.'delopt'} = '';
$resourcedata{$symb.'hiddenparts'} = '!option';
$resourcedata{$symb.'questiontype'} = 'option';
- $resourcedata{$symb.'maxfoils'} = @{$allanswers{$id}};
+ $resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}};
}
- for (my $k=0; $k<@{$allchoices{$id}}; $k++) {
+ for (my $k=0; $k<@{$$allchoices{$id}}; $k++) {
if ($context eq 'CSTR') {
$output .= qq|
-<item name="$allchoices{$id}[$k]">
-<startouttext />$$settings{$id}{$allchoices{$id}[$k]}{text}<endouttext />
+<item name="$$allchoices{$id}[$k]">
+<startouttext />$$settings{$id}{$$allchoices{$id}[$k]}{text}<endouttext />
</item>
|;
} else {
- if (!grep/^$$settings{$id}{$allchoices{$id}[$k]}{text}$/,@allmatchers) {
- push @allmatchers, $$settings{$id}{$allchoices{$id}[$k]}{text};
- $matchtext{$allchoices{$id}[$k]} = $$settings{$id}{$allchoices{$id}[$k]}{text};
+ if (!grep/^$$settings{$id}{$$allchoices{$id}[$k]}{text}$/,@allmatchers) {
+ push @allmatchers, $$settings{$id}{$$allchoices{$id}[$k]}{text};
+ $matchtext{$$allchoices{$id}[$k]} = $$settings{$id}{$$allchoices{$id}[$k]}{text};
}
}
}
@@ -2091,17 +2647,17 @@
</itemgroup>
|;
}
- for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
+ for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
if ($context eq 'CSTR') {
$output .= qq|
- <foil location="random" value="$$settings{$id}{$allanswers{$id}[$k]}{choice_id}" name="$allanswers{$id}[$k]">
- <startouttext />$$settings{$id}{$allanswers{$id}[$k]}{text}<endouttext />
+ <foil location="random" value="$$settings{$id}{$$allanswers{$id}[$k]}{choice_id}" name="$$allanswers{$id}[$k]">
+ <startouttext />$$settings{$id}{$$allanswers{$id}[$k]}{text}<endouttext />
</foil>
|;
} else {
my $iter = $k+1;
- $resourcedata{$symb.'value'.$iter} = $matchtext{$$settings{$id}{$allanswers{$id}[$k]}{choice_id}};
- $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};
+ $resourcedata{$symb.'value'.$iter} = $matchtext{$$settings{$id}{$$allanswers{$id}[$k]}{choice_id}};
+ $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
}
if ($context eq 'CSTR') {
@@ -2128,6 +2684,14 @@
}
}
+sub write_webct4_questions {
+ my ($alldbquestids,$context,$settings,$dirname,$alldbanswers,$alldbchoices,$total,$cid,$cdom,$cnum) = @_;
+}
+
+sub write_bb6_questions {
+ my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices) = @_;
+}
+
# ---------------------------------------------------------------- Process Blackboard Announcements
sub process_announce {
my ($res,$docroot,$destdir,$settings,$globalresref,$seqstem,$resrcfiles) = @_;
@@ -2222,8 +2786,7 @@
my $xmlfile = $docroot.'/'.$res.".dat";
my $destresdir = $destdir;
if ($context eq 'CSTR') {
-# $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
- $destresdir =~ s|/home/$user/public_html/|/priv/$user/|;
+ $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
} elsif ($context eq 'DOCS') {
$destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
}
@@ -2643,5 +3206,39 @@
close(FILE);
}
+# ---------------------------------------------------------------- WebCT content
+sub webct4_content {
+ my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
+ if (!open(FILE,">$destdir/resfiles/$res.html")) {
+ &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
+ } else {
+ push(@{$resrcfiles}, "$res.html");
+ my $linktag = '';
+ if (defined($$settings{url})) {
+ $linktag = qq|<a href="$$settings{url}"|;
+ if ($title ne '') {
+ $linktag .= qq|>$title</a>|;
+ } else {
+ $linktag .= qq|>$$settings{url}|;
+ }
+ }
+ print FILE qq|<html>
+<head>
+<title>$title</title>
+</head>
+<body bgcolor='#ffffff'>
+$linktag
+</body>
+</html>|;
+ close(FILE);
+ }
+}
+
+# ---------------------------------------------------------------- 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__
--raeburn1109029667--