--- loncom/imspackages/imsprocessor.pm 2004/12/23 18:38:45 1.13
+++ loncom/imspackages/imsprocessor.pm 2005/02/21 23:47:46 1.15
@@ -51,6 +51,11 @@ sub ims_config {
survey => 'FORM',
);
@{$$cmsmap{angel}{doc}} = ('FILE','PAGE');
+ %{$$cmsmap{webct4}} = (
+ quiz => 'webctquiz',
+ survey => 'webctsurvey',
+ doc => 'webcontent'
+ );
%{$areaname} = (
announce => 'Announcements',
board => 'Discussion Boards',
@@ -141,11 +146,12 @@ sub expand_zip {
}
sub process_manifest {
- my ($cms,$tempdir,$resources,$items,$hrefs,$resinfo) = @_;
+ my ($cms,$tempdir,$resources,$items,$hrefs,$resinfo,$phase,$includedres,$includeditems) = @_;
my %toc = (
bb6 => 'organization',
bb5 => 'tableofcontents',
angel => 'organization',
+ webct4 => 'organization',
);
my %contents = ();
my @state = ();
@@ -165,6 +171,8 @@ sub process_manifest {
$$resources{'toplevel'}{type} = "FOLDER";
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
$$resources{'toplevel'}{type} = 'resource/x-bb-document';
+ } else {
+ $$resources{'toplevel'}{type} = 'webcontent';
}
unless (-e "$tempdir/imsmanifest.xml") {
@@ -192,84 +200,88 @@ sub process_manifest {
$num --;
}
if (("@state" eq $searchstr) && (@state > 3)) {
- $itm = $attr->{identifier};
- %{$$items{$itm}} = ();
- $$items{$itm}{contentscount} = 0;
- if ($cms eq 'bb5' || $cms eq 'bb6') {
- $$items{$itm}{resnum} = $attr->{identifierref};
- if ($cms eq 'bb5') {
- $$items{$itm}{title} = $attr->{title};
- }
- } elsif ($cms eq 'angel') {
- if ($attr->{identifierref} =~ m/^res(.+)$/) {
- $$items{$itm}{resnum} = $1;
- }
- }
- unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {
- %{$$resources{$$items{$itm}{resnum}}} = ();
- }
- $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
-
- if ($start > @seq) {
- unless ($lastitem eq '') {
- push @seq, $lastitem;
- unless ( defined($contents{$seq[-1]}) ) {
- @{$contents{$seq[-1]}} = ();
+ $itm = $attr->{identifier};
+ if ($$includeditems{$itm} || $phase ne 'build') {
+ %{$$items{$itm}} = ();
+ $$items{$itm}{contentscount} = 0;
+ if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {
+ $$items{$itm}{resnum} = $attr->{identifierref};
+ if ($cms eq 'bb5') {
+ $$items{$itm}{title} = $attr->{title};
+ }
+ } elsif ($cms eq 'angel') {
+ if ($attr->{identifierref} =~ m/^res(.+)$/) {
+ $$items{$itm}{resnum} = $1;
}
- push @{$contents{$seq[-1]}},$itm;
- $$items{$itm}{parentseq} = $seq[-1];
}
- }
- elsif ($start < @seq) {
- my $diff = @seq - $start;
- while ($diff > 0) {
- pop @seq;
- $diff --;
+ unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {
+ %{$$resources{$$items{$itm}{resnum}}} = ();
}
- if (@seq) {
+ $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
+ if ($start > @seq) {
+ unless ($lastitem eq '') {
+ push @seq, $lastitem;
+ unless ( defined($contents{$seq[-1]}) ) {
+ @{$contents{$seq[-1]}} = ();
+ }
+ push @{$contents{$seq[-1]}},$itm;
+ $$items{$itm}{parentseq} = $seq[-1];
+ }
+ } elsif ($start < @seq) {
+ my $diff = @seq - $start;
+ while ($diff > 0) {
+ pop @seq;
+ $diff --;
+ }
+ if (@seq) {
+ push @{$contents{$seq[-1]}}, $itm;
+ }
+ } else {
push @{$contents{$seq[-1]}}, $itm;
}
- } else {
- push @{$contents{$seq[-1]}}, $itm;
- }
- my $path;
- if (@seq > 1) {
- $path = join(',',@seq);
- } elsif (@seq > 0) {
- $path = $seq[0];
- }
- $$items{$itm}{filepath} = $path;
- if ($cms eq 'bb5' || $cms eq 'bb6') {
- if ($$items{$itm}{filepath} eq 'Top') {
- $$items{$itm}{resnum} = $itm;
- $$resources{$$items{$itm}{resnum}}{type} = 'resource/x-bb-document';
- $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
- $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';
+ my $path;
+ if (@seq > 1) {
+ $path = join(',',@seq);
+ } elsif (@seq > 0) {
+ $path = $seq[0];
}
+ $$items{$itm}{filepath} = $path;
+ if ($cms eq 'bb5' || $cms eq 'bb6') {
+ if ($$items{$itm}{filepath} eq 'Top') {
+ $$items{$itm}{resnum} = $itm;
+ $$resources{$$items{$itm}{resnum}}{type} = 'resource/x-bb-document';
+ $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
+ $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';
+ }
+ }
+ $$items{$seq[-1]}{contentscount} ++;
+ $lastitem = $itm;
}
- $$items{$seq[-1]}{contentscount} ++;
- $lastitem = $itm;
}
} elsif ("@state" eq "manifest resources resource" ) {
$identifier = $attr->{identifier};
- if ($cms eq 'bb5' || $cms eq 'bb6') {
- $$resources{$identifier}{file} = $attr->{file};
- $$resources{$identifier}{type} = $attr->{type};
- } elsif ($cms eq 'angel') {
- $identifier = substr($identifier,3);
- if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
- $$resources{$identifier}{file} = $1;
+ if ($$includedres{$identifier} || $phase ne 'build') {
+ if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {
+ $$resources{$identifier}{file} = $attr->{file};
+ $$resources{$identifier}{type} = $attr->{type};
+ } elsif ($cms eq 'angel') {
+ $identifier = substr($identifier,3);
+ if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
+ $$resources{$identifier}{file} = $1;
+ }
}
+ @{$$hrefs{$identifier}} = ();
}
- @{$$hrefs{$identifier}} = ();
} elsif ("@state" eq "manifest resources resource file") {
- if ($cms eq 'bb5' || $cms eq 'bb6') {
- push @{$$hrefs{$identifier}},$attr->{href};
- } elsif ($cms eq 'angel') {
- if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
- push @{$$hrefs{$identifier}},$1;
- } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
- $$resources{$identifier}{type} = $1;
+ if ($$includedres{$identifier} || $phase ne 'build') {
+ 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\\(.+)$/) {
+ push @{$$hrefs{$identifier}},$1;
+ } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
+ $$resources{$identifier}{type} = $1;
+ }
}
}
}
@@ -277,9 +289,18 @@ sub process_manifest {
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 ($cms eq 'angel' || $cms eq 'bb6') {
- $$items{$itm}{title} = $text;
+ 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"],
@@ -298,6 +319,35 @@ sub process_manifest {
return 'ok' ;
}
+sub get_imports {
+ my ($includeditems,$items,$resources,$importareas,$itm) = @_;
+ if (exists($$items{$itm}{resnum})) {
+ if ($$importareas{$$resources{$$items{$itm}{resnum}}{type}}) {
+ unless (exists($$includeditems{$itm})) {
+ $$includeditems{$itm} = 1;
+ }
+ }
+ }
+ if ($$items{$itm}{contentscount} > 0) {
+ foreach my $child (@{$$items{$itm}{contents}}) {
+ &get_imports($includeditems,$items,$resources,$importareas,$child);
+ }
+ }
+}
+
+sub get_parents {
+ my ($includeditems,$items,$itm) = @_;
+ my @pathitems = ();
+ if ($$items{$itm}{filepath} =~ m/,/) {
+ @pathitems = split/,/,$$items{$itm}{filepath};
+ } else {
+ $pathitems[0] = $$items{$itm}{filepath};
+ }
+ foreach (@pathitems) {
+ $$includeditems{$_} = 1;
+ }
+}
+
sub target_resources {
my ($resources,$oktypes,$targets) = @_;
foreach my $key (keys %{$resources}) {
@@ -316,6 +366,9 @@ sub copy_resources {
%{$$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') {
@@ -324,8 +377,19 @@ sub copy_resources {
}
}
$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);
+ }
+ }
}
}
}
@@ -334,28 +398,39 @@ sub copy_resources {
mkdir("$destdir/resfiles",0770);
}
foreach my $key (sort keys %{$hrefs}) {
- foreach my $file (@{$$hrefs{$key}}) {
- $file =~ s-\\-/-g;
- 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+)/(.+)-) {
- $front .= $1.'/';
- $filepath = $2;
- my $fulldir = "$destdir/resfiles/$key/$front";
- chop($fulldir);
- if (!-e "$fulldir") {
- mkdir("$fulldir",0770);
+ 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 (!-e "$destdir/resfiles/$key") {
+ mkdir("$destdir/resfiles/$key",0770);
+ }
+ my $filepath = $file;
+ my $front = '';
+ while ($filepath =~ m-(\w+)/(.+)-) {
+ $front .= $1.'/';
+ $filepath = $2;
+ my $fulldir = "$destdir/resfiles/$key/$front";
+ chop($fulldir);
+ if (!-e "$fulldir") {
+ mkdir("$fulldir",0770);
+ }
+ }
+ if ($cms eq 'angel') {
+ rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
+ } 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");
+ }
}
- }
- if ($cms eq 'angel') {
- rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
- } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
- rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
}
}
}
@@ -363,48 +438,25 @@ sub copy_resources {
}
}
-sub process_coursefile {
- my ($crs,$cdom,$chome,$file,$source)=@_;
- my $fetchresult = '';
- my $fpath = '';
- my $fname = $file;
- ($fpath,$fname) = ($file =~ m/^(.*)\/([^\/])$/);
- $fpath=$cdom.'/'.$crs.'/'.$fpath;
- my $filepath=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles';
- unless ($fpath eq '') {
- my @parts=split(/\//,$fpath);
- foreach my $part (@parts) {
- $filepath.= '/'.$part;
- if ((-e $filepath)!=1) {
- mkdir($filepath,0777);
- }
- }
- }
- if ($source eq '') {
- $fetchresult eq 'no source file provided';
- } else {
- my $destination = $filepath.'/'.$fname;
- rename($source,$destination);
- $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$cdom.'/'.$crs.'/'.$file,$chome);
- unless ($fetchresult eq 'ok') {
- &Apache::lonnet::logthis('Failed to transfer '.$cdom.'/'.$crs.'/'.$fname.' to host '.$chome.': '.$fetchresult);
- }
- }
- return $fetchresult;
-}
-
sub process_resinfo {
- my ($cms,$context,$docroot,$destdir,$items,$resources,$boards,$announcements,$quizzes,$surveys,$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)/) {
$longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
}
+ if ($context eq 'CSTR') {
+ if (!-e "$destdir/resfiles") {
+ mkdir("$destdir/resfiles",0770);
+ }
+ }
if ($cms eq 'angel') {
my $currboard = '';
foreach my $key (sort keys %{$resources}) {
+ if (grep/^$key$/,@{$targets}) {
if ($$resources{$key}{type} eq "BOARD") {
push @{$boards}, $key;
$$boardnum{$$resources{$key}{revitm}} = $board_count;
@@ -429,9 +481,11 @@ sub process_resinfo {
} elsif ($$resources{$key}{type} eq "DROPBOX") {
%{$$resinfo{$key}} = ();
}
+ }
}
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
foreach my $key (sort keys %{$resources}) {
+ if (grep/^$key$/,@{$targets}) {
if ($$resources{$key}{type} eq "resource/x-bb-document") {
unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') {
%{$$resinfo{$key}} = ();
@@ -454,14 +508,15 @@ sub process_resinfo {
}
} 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}} = ();
@@ -479,6 +534,7 @@ sub process_resinfo {
&process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$resinfo,$seqstem,$resrcfiles);
}
}
+ }
}
if (@{$announcements}) {
$$items{'Top'}{'contentscount'} ++;
@@ -492,20 +548,38 @@ sub process_resinfo {
if (@{$surveys}) {
$$items{'Top'}{'contentscount'} ++;
}
+ 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;
$$total{'quiz'} = @{$quizzes};
$$total{'surv'} = @{$surveys};
+ $$total{'pool'} = @{$pools};
}
sub build_structure {
- my ($cms,$context,$destdir,$items,$resinfo,$resources,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames,$packages) = @_;
+ 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 = ();
my %seqtext = ();
my $topnum = 0;
+ my $topspecials = @$announcements + @$boards + @$quizzes + @$surveys + @$pools;
if (!-e "$destdir") {
mkdir("$destdir",0755);
@@ -537,6 +611,7 @@ sub build_structure {
}
foreach my $key (sort keys %{$items}) {
+ if ($$includeditems{$key}) {
%{$flag{$key}} = (
page => 0,
seq => 0,
@@ -557,25 +632,40 @@ sub build_structure {
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} = "\n";
open(TOPFILE,">$destdir/sequences/Top.sequence");
print TOPFILE $seqtext{'Top'};
@@ -743,9 +849,9 @@ sub build_structure {
}
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;
@@ -793,6 +899,18 @@ sub make_structure {
}
$$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;
}
@@ -815,12 +933,14 @@ sub process_specials {
quizzes => 'quizzes',
surveys => 'surveys',
announcements => 'announcements',
+ pools => 'pools'
);
my %seqtitles = (
boards => 'Course Bulletin Boards',
quizzes => 'Course Quizzes',
surveys => 'Course Surveys',
announcements => 'Course Announcements',
+ pools => 'Course Question Pools'
);
$$topnum ++;
@@ -862,6 +982,8 @@ sub process_specials {
$specialsrc = "/adm/$udom/$uname/$$timestamp[0]/bulletinboard";
} elsif ($type eq 'announcements') {
$specialsrc = "$seqstem/resfiles/$$specials[0].html";
+ } elsif ($type eq 'pools') {
+ $specialsrc = "$seqstem/sequences/$$specials[0].sequence";
} else {
$specialsrc = "$seqstem/pages/$$specials[0].page";
}
@@ -1226,7 +1348,7 @@ sub process_link {
} 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" ) {
@@ -1500,19 +1622,12 @@ sub addposting {
}
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 $resdir = '';
- if ($docroot =~ m|public_html/(.+)$|) {
- $resdir = $1;
- }
my $id; # the current question ID
my $answer_id; # the current answer ID
my %toptag = ( pool => 'POOL',
@@ -1558,9 +1673,9 @@ sub process_assessment {
}
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};
@@ -1582,7 +1697,7 @@ sub process_assessment {
$$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') {
@@ -1591,7 +1706,7 @@ sub process_assessment {
}
} 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};
@@ -1654,7 +1769,484 @@ sub process_assessment {
$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||;
+ }
+ if ($numcats == 1) {
+ print $fh qq|
+
+\n|;
+ } else {
+ $curr_id = $next_id;
+ $next_id = $curr_id + 1;
+ $catsrc = "$destresdir/sequences/$seqname.sequence";
+ print $fh qq|
+
+\n|;
+ } else {
+ print $fh qq|>\n|;
+ }
+ }
+ print $fh qq||;
+ 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;
@@ -1665,60 +2257,65 @@ sub process_assessment {
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||;
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;
@@ -1740,7 +2341,7 @@ sub process_assessment {
$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') {
@@ -1755,7 +2356,7 @@ sub process_assessment {
- $$settings{$id}{feedbackcorr}
+ $$settings{$id}{feedbackcorr}
|;
} else {
@@ -1787,7 +2388,7 @@ sub process_assessment {
$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|
@@ -1798,30 +2399,30 @@ sub process_assessment {
$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 .= " 
|;
+ if ( defined($$settings{$id}{$$allanswers{$id}[$k]}{image}) ) {
+ if ( $$settings{$id}{$$allanswers{$id}[$k]}{style} eq 'embed' ) {
+ $ans_image .= qq|
|;
} else {
- $ans_link .= qq|
Link to file
|;
+ $ans_link .= qq|
Link to file
|;
}
}
$output .= $ans_image.$ans_link.''."\n";
@@ -1835,7 +2436,7 @@ sub process_assessment {
|;
}
} elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {
- my $numfoils = @{$allanswers{$id}};
+ my $numfoils = @{$$allanswers{$id}};
if ($context eq 'CSTR') {
$output .= qq|
@@ -1846,18 +2447,18 @@ sub process_assessment {
$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 .= " \n";
- $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};
+ $output .= "\>".$$settings{$id}{$$allanswers{$id}[$k]}{text}."\n";
+ $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
if ($context eq 'CSTR') {
chomp($output);
@@ -1867,7 +2468,7 @@ sub process_assessment {
|;
}
} elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {
- my $numfoils = @{$allanswers{$id}};
+ my $numfoils = @{$$allanswers{$id}};
if ($context eq 'CSTR') {
$output .= qq|
@@ -1881,18 +2482,18 @@ sub process_assessment {
$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 .= " \n";
- $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};
+ $output .= "\>".$$settings{$id}{$$allanswers{$id}[$k]}{text}."\n";
+ $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
if ($context eq 'CSTR') {
chomp($output);
@@ -1902,7 +2503,7 @@ sub process_assessment {
|;
}
} elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {
- my $numfoils = @{$allanswers{$id}};
+ my $numfoils = @{$$allanswers{$id}};
my @allorder = ();
if ($context eq 'CSTR') {
$output .= qq|
@@ -1916,14 +2517,14 @@ sub process_assessment {
$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 .= " ".$$settings{$id}{$allanswers{$id}[$k]}{text}."\n";
+ $output .= " ".$$settings{$id}{$$allanswers{$id}[$k]}{text}."\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};
}
}
}
@@ -1942,8 +2543,8 @@ sub process_assessment {
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;
}
}
@@ -1951,18 +2552,18 @@ sub process_assessment {
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;
@@ -1982,23 +2583,23 @@ sub process_assessment {
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|
-
+
|;
} 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/';
@@ -2025,19 +2626,19 @@ sub process_assessment {
$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|
--
-$$settings{$id}{$allchoices{$id}[$k]}{text}
+
-
+$$settings{$id}{$$allchoices{$id}[$k]}{text}
|;
} 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};
}
}
}
@@ -2046,17 +2647,17 @@ sub process_assessment {
|;
}
- for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
+ for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
if ($context eq 'CSTR') {
$output .= qq|
-
- $$settings{$id}{$allanswers{$id}[$k]}{text}
+
+ $$settings{$id}{$$allanswers{$id}[$k]}{text}
|;
} 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') {
@@ -2083,6 +2684,14 @@ sub process_assessment {
}
}
+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) = @_;
@@ -2355,37 +2964,40 @@ sub process_content {
}
}
- open(FILE,">$destdir/resfiles/$res.html");
- push @{$resrcfiles}, "$res.html";
- my $htmldoc = 0;
-# if ($$settings{maindata}{text} =~ m-<(html|HTML)>.+<\\(html|HTML)-) {
- if ($$settings{maindata}{text} =~ m-<(html|HTML)>-) {
- $htmldoc = 1;
- }
- unless ($htmldoc) {
- print FILE qq|
+ 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 $htmldoc = 0;
+# if ($$settings{maindata}{text} =~ m-<(html|HTML)>.+<\\(html|HTML)-) {
+ if ($$settings{maindata}{text} =~ m-<(html|HTML)>-) {
+ $htmldoc = 1;
+ }
+ unless ($htmldoc) {
+ print FILE qq|
$$settings{title}
$fontcol
|;
- }
- unless ($$settings{title} eq '') {
- print FILE qq|$$settings{title}
\n|;
- }
- print FILE qq|
-$$settings{maindata}{text}
-$linktag|;
- unless ($htmldoc) {
- if (defined($$settings{maindata}{textcolor})) {
- print FILE qq||;
+ }
+ unless ($$settings{title} eq '') {
+ print FILE qq|$$settings{title}
\n|;
}
print FILE qq|
+$$settings{maindata}{text}
+$linktag|;
+ unless ($htmldoc) {
+ if (defined($$settings{maindata}{textcolor})) {
+ print FILE qq||;
+ }
+ print FILE qq|
|;
+ }
+ close(FILE);
}
- close(FILE);
}
@@ -2594,5 +3206,39 @@ sub angel_content {
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|$title|;
+ } else {
+ $linktag .= qq|>$$settings{url}|;
+ }
+ }
+ print FILE qq|
+
+$title
+
+
+$linktag
+
+|;
+ 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__