--- loncom/imspackages/imsprocessor.pm 2007/09/30 13:20:08 1.41
+++ loncom/imspackages/imsprocessor.pm 2012/12/18 18:54:11 1.51
@@ -1,3 +1,8 @@
+# The LearningOnline Network with CAPA
+# Processor for IMS Packages
+#
+# $Id: imsprocessor.pm,v 1.51 2012/12/18 18:54:11 raeburn Exp $
+#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
@@ -25,6 +30,7 @@ package Apache::imsprocessor;
use Apache::lonnet;
use Apache::loncleanup;
+use Apache::lonlocal;
use LWP::UserAgent;
use HTTP::Request::Common;
use LONCAPA::Configuration;
@@ -56,14 +62,14 @@ sub ims_config {
users => 'course/x-bb-user',
);
$$cmsmap{bb6}{conference} = 'resource/x-bb-conference';
- %{$$cmsmap{angel}} = (
+ %{$$cmsmap{angel5}} = (
board => 'BOARD',
extlink => 'LINK',
msg => 'MESSAGE',
quiz => 'QUIZ',
survey => 'FORM',
);
- @{$$cmsmap{angel}{doc}} = ('FILE','PAGE');
+ @{$$cmsmap{angel5}{doc}} = ('FILE','PAGE');
%{$$cmsmap{webctce4}} = (
quiz => 'webctquiz',
survey => 'webctsurvey',
@@ -75,7 +81,7 @@ sub ims_config {
survey => 'webctsurvey',
doc => 'webcontent'
);
- %{$areaname} = (
+ %{$areaname} = &Apache::lonlocal::texthash (
announce => 'Announcements',
board => 'Discussion Boards',
doc => 'Documents, pages, and folders',
@@ -164,7 +170,7 @@ sub process_manifest {
my %toc = (
bb6 => 'organization',
bb5 => 'tableofcontents',
- angel => 'organization',
+ angel5 => 'organization',
webctce4 => 'organization',
webctvista4 => 'organization'
);
@@ -177,7 +183,7 @@ sub process_manifest {
revitm => 'Top'
);
- if ($cms eq 'angel') {
+ if ($cms eq 'angel5') {
$$resources{'toplevel'}{type} = "FOLDER";
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
$$resources{'toplevel'}{type} = 'resource/x-bb-document';
@@ -224,12 +230,12 @@ sub parse_manifest {
if ($cms eq 'bb5') {
$$items{$itm}{title} = $attr->{title};
}
- } elsif ($cms eq 'angel') {
+ } elsif ($cms eq 'angel5') {
if ($attr->{identifierref} =~ m/^res(.+)$/) {
$$items{$itm}{resnum} = $1;
}
}
- unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {
+ unless (%{$$resources{$$items{$itm}{resnum}}}) {
%{$$resources{$$items{$itm}{resnum}}} = ();
}
$$resources{$$items{$itm}{resnum}}{revitm} = $itm;
@@ -292,7 +298,7 @@ sub parse_manifest {
} elsif ($cms eq 'webctvista4') {
$$resources{$identifier}{type} = $attr->{type};
$$resources{$identifier}{'webct:coType'} = $attr->{'webct:coType'};
- } elsif ($cms eq 'angel') {
+ } elsif ($cms eq 'angel5') {
$identifier = substr($identifier,3);
if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
$$resources{$identifier}{file} = $1;
@@ -308,7 +314,6 @@ sub parse_manifest {
if ($cms eq 'bb5' || $cms eq 'bb6' ||
$cms eq 'webctce4' || $cms eq 'webctvista4') {
push @{$$hrefs{$identifier}},$attr->{href};
-
if ($$resources{$identifier}{type} eq
'webct.manifest') {
my $manifestfile = $tempdir.'/'.$attr->{href};
@@ -322,7 +327,7 @@ sub parse_manifest {
$items,$resources,$resinfo,
$hrefs,$currseqref);
}
- } elsif ($cms eq 'angel') {
+ } elsif ($cms eq 'angel5') {
if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
push @{$$hrefs{$identifier}},$1;
} elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
@@ -346,7 +351,7 @@ sub parse_manifest {
}
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' || $cms eq 'webctvista4') {
+ if ($cms eq 'angel5' || $cms eq 'bb6' || $cms eq 'webctvista4') {
$$items{$itm}{title} = $text;
}
if ($cms eq 'webctce4') {
@@ -409,7 +414,7 @@ sub target_resources {
}
sub copy_resources {
- my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles) = @_;
+ my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles,$total) = @_;
if ($context eq 'DOCS') {
foreach my $key (sort keys %{$hrefs}) {
if (grep/^$key$/,@{$targets}) {
@@ -421,7 +426,7 @@ sub copy_resources {
}
my $filename = '';
my $fpath = $timenow.'/resfiles/'.$key.'/';
- if ($cms eq 'angel') {
+ if ($cms eq 'angel5') {
if ($file eq 'pg'.$key.'.htm') {
next;
}
@@ -451,7 +456,7 @@ sub copy_resources {
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 'angel5' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') || ($cms eq 'bb6')) {
if (!-e "$destdir/resfiles/$key") {
mkdir("$destdir/resfiles/$key",0770);
}
@@ -466,10 +471,18 @@ sub copy_resources {
mkdir("$fulldir",0770);
}
}
- if ($cms eq 'angel') {
- rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
+ my $renameres;
+ if ($cms eq 'angel5') {
+ $renameres = rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
- rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
+ $renameres = rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
+ }
+ if ($renameres) {
+ if (ref($total) eq 'HASH') {
+ $$total{'file'} ++;
+ }
+ } else {
+ &Apache::lonnet::logthis("IMS import error: $cms - renaming failed for file $file");
}
} elsif ($cms eq 'webctce4') {
if ($file =~ m-/my_files/(.+)$-) {
@@ -486,7 +499,14 @@ sub copy_resources {
}
}
if (-e "$tempdir/$file") {
- rename("$tempdir/$file","$destdir/resfiles/$copyfile");
+ my $renameres = rename("$tempdir/$file","$destdir/resfiles/$copyfile");
+ if ($renameres) {
+ if (ref($total) eq 'HASH') {
+ $$total{'file'} ++;
+ }
+ } else {
+ &Apache::lonnet::logthis("IMS import error: WebCT4 - renaming failed for file $file");
+ }
}
} elsif ($file !~ m-/data/(.+)$-) {
&Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
@@ -517,7 +537,7 @@ sub process_resinfo {
mkdir("$destdir/resfiles",0770);
}
}
- if ($cms eq 'angel') {
+ if ($cms eq 'angel5') {
my $currboard = '';
foreach my $key (sort keys %{$resources}) {
if (grep/^$key$/,@{$targets}) {
@@ -620,7 +640,11 @@ sub process_resinfo {
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);
+ if ($$resources{$key}{file} eq 'questiondb.xml') {
+ &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
+ } else {
+ &webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
+ }
} elsif ($$resources{$key}{type} eq "webctquiz") {
&process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
}
@@ -655,10 +679,11 @@ sub process_resinfo {
$cid = $env{'request.course.id'};
}
my $destresdir = $destdir;
+ my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
if ($context eq 'CSTR') {
- $destresdir =~ s|/home/$uname/public_html/|/res/$udom/$uname/|;
+ $destresdir =~ s{^\Q$londocroot/priv/\E}{/res/};
} elsif ($context eq 'DOCS') {
- $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
+ $destresdir =~ s{^\Q$londocroot/userfiles\E}{/uploaded};
}
foreach my $res (sort(keys(%allquestions))) {
my $parent = $allquestions{$res};
@@ -735,8 +760,12 @@ sub build_structure {
my $curr_id = 1;
my $resnum = $$items{$key}{resnum};
my $type = $$resources{$resnum}{type};
- 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 'webctce4' && $contentscount > 0)) {
+ my $contentscount = $$items{$key}{'contentscount'};
+ my $seqtitle = $$items{$key}{'title'};
+ $seqtitle =~ s|/+|_|g;
+ $seqtitle =~ s/\s+/_/g;
+ $seqtitle .= '_'.$key;
+ if (($cms eq 'angel5' && $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 'webctce4' && $contentscount > 0)) {
unless (($cms eq 'bb5') && $key eq 'Top') {
$seqtext{$key} = "<map>\n";
}
@@ -773,7 +802,7 @@ sub build_structure {
if (grep/^$res$/,@{$packages}) {
$packageflag = 1;
}
- $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem});
+ $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
unless ($flag{$key}{page} == 1) {
if ($$randompicks{$contitem}) {
$seqtext{$key} .= qq|
@@ -813,7 +842,7 @@ sub build_structure {
if (grep/^$res$/,@{$packages}) {
$packageflag = 1;
}
- $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem});
+ $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
unless ($flag{$key}{page} == 1) {
$seqtext{$key} .= qq|></resource>
<link from="$curr_id" to="$next_id" index="$curr_id"></link>\n|;
@@ -845,7 +874,7 @@ sub build_structure {
if (grep/^$res$/,@{$packages}) {
$packageflag = 1;
}
- $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem});
+ $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
if ($flag{$key}{page}) {
if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {
@@ -879,10 +908,15 @@ sub build_structure {
}
unless (($cms eq 'bb5') && $key eq 'Top') {
$seqtext{$key} .= "</map>\n";
- open(LOCFILE,">$destdir/sequences/$key.sequence");
+ if ($cms eq 'webctce4' && $key ne 'Top') {
+ push @{$seqfiles}, "$seqtitle.sequence";
+ open(LOCFILE,">$destdir/sequences/$seqtitle.sequence");
+ } else {
+ push @{$seqfiles}, "$key.sequence";
+ open(LOCFILE,">$destdir/sequences/$key.sequence");
+ }
print LOCFILE $seqtext{$key};
close(LOCFILE);
- push @{$seqfiles}, "$key.sequence";
}
$count{$key}{page} ++;
$$total{page} += $count{$key}{page};
@@ -972,10 +1006,16 @@ sub build_structure {
}
sub make_structure {
- my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$randompick) = @_;
+ my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$randompick,$title) = @_;
my $src ='';
- if (($cms eq 'angel' && $type eq 'FOLDER') || (($cms eq 'bb5' || $cms eq 'bb6') && (($$resinfo{$res}{'isfolder'} eq 'true') || $key eq 'Top')) || ($cms eq 'webctce4' && $contitemcount > 0)) {
+ if (($cms eq 'angel5' && $type eq 'FOLDER') || (($cms eq 'bb5' || $cms eq 'bb6') && (($$resinfo{$res}{'isfolder'} eq 'true') || $key eq 'Top')) || ($cms eq 'webctce4' && $contitemcount > 0)) {
$src = $srcstem.'/sequences/'.$contitem.'.sequence';
+ if ($cms eq 'webctce4') {
+ $title =~ s|/+|_|g;
+ $title =~ s/\s+/_/g;
+ $title .= '_'.$contitem;
+ $src = $srcstem.'/sequences/'.$title.'.sequence';
+ }
$$flag{$key}{page} = 0;
$$flag{$key}{seq} = 1;
$$count{$key}{seq} ++;
@@ -984,12 +1024,12 @@ sub make_structure {
$$flag{$key}{page} = 0;
$$flag{$key}{seq} = 1;
$$count{$key}{seq} ++;
- } elsif ($cms eq 'angel' && $type eq 'BOARD') {
+ } elsif ($cms eq 'angel5' && $type eq 'BOARD') {
$src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard';
$$flag{$key}{page} = 0;
$$flag{$key}{board} = 1;
$$count{$key}{board} ++;
- } elsif ($cms eq 'angel' && $type eq "FILE") {
+ } elsif ($cms eq 'angel5' && $type eq "FILE") {
foreach my $file (@{$$hrefs{$res}}) {
unless ($file eq 'pg'.$res.'.htm') {
$src = $srcstem.'/resfiles/'.$res.'/'.$file;
@@ -997,7 +1037,7 @@ sub make_structure {
}
$$flag{$key}{page} = 0;
$$flag{$key}{file} = 1;
- } elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) ) {
+ } elsif ($cms eq 'angel5' && (($type eq "PAGE") || ($type eq "LINK")) ) {
if ($$flag{$key}{page}) {
if ($$count{$key}{page} == -1) {
&Apache::lonnet::logthis("IMS Angel import error in array index for page: value = -1, resource is $key, type is $type.");
@@ -1038,14 +1078,16 @@ sub make_structure {
if ($file =~ m-/([^/]+)$-) {
$filename = $1;
}
- $src = $srcstem.'/resfiles/'.$res.'/'.$filename;
+ $src = $srcstem.'/resfiles/'.$filename;
} else {
foreach my $file (@{$$hrefs{$res}}) {
my $filename;
- if ($file =~ m-/([^/]+)$-) {
+ if ($file =~ m-/my_files/(.+)$-) {
+ $filename = $1;
+ } elsif ($file =~ m-/([^/]+)$-) {
$filename = $1;
}
- $src = $srcstem.'/resfiles/'.$res.'/'.$filename;
+ $src = $srcstem.'/resfiles/'.$filename;
}
}
$$flag{$key}{page} = 0;
@@ -1076,7 +1118,7 @@ sub process_specials {
pools => 'pools'
);
my %seqtitles = (
- boards => 'Course Bulletin Boards',
+ boards => 'Course Discussion Boards',
quizzes => 'Course Quizzes',
surveys => 'Course Surveys',
announcements => 'Course Announcements',
@@ -1417,7 +1459,7 @@ sub process_staff {
<font face="arial" size="2"><b>Office Hours:</b></font>
</td>
<td>
- <font face=arial size=2>$$settings{office}{hours}</font>
+ <font face="arial" size="2">$$settings{office}{hours}</font>
</td>
</tr>
|;
@@ -1739,7 +1781,7 @@ sub process_db {
}
}
-# ---------------------------------------------------------------- Add Posting to Bulletin Board
+# ---------------------------------------------------------------- Add Posting to Discussion Board
sub addposting {
my ($symb,$contrib,$cdom,$crs)=@_;
my $status='';
@@ -2743,8 +2785,13 @@ sub parse_webct4_quizprops {
sub parse_webct4_questionDB {
my ($docroot,$href,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;
- $href =~ s#[^/]+$##;
- my $xmlfile = $docroot.'/'.$href.'questionDB.xml'; #quizDB file
+ my $xmlfile;
+ if ($href eq 'questiondb.xml') {
+ $xmlfile = $docroot.'/'.$href;
+ } else {
+ $href =~ s#[^/]+$##;
+ $xmlfile = $docroot.'/'.$href.'questionDB.xml'; #quizDB file
+ }
my @state = ();
my $category; # the current category ID
my $id; # the current question ID
@@ -2765,14 +2812,19 @@ sub parse_webct4_questionDB {
action => '',
);
my $currtexttype;
- my $currimagtype;
+ my $currimagtype;
+ my $is_objectbank;
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
- push @state, $tagname;
+ if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) {
+ $is_objectbank = 1;
+ } else {
+ push @state, $tagname;
+ }
if ("@state" eq "questestinterop section") {
$category = $attr->{ident};
%{$$catinfo{$category}} = ();
@@ -2861,6 +2913,10 @@ sub parse_webct4_questionDB {
$$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
$currtexttype = $attr->{texttype};
}
+ if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label flow_mat material mattext") {
+ $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
+ $currtexttype = $attr->{texttype};
+ }
# Numerical
if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
@@ -2947,7 +3003,9 @@ sub parse_webct4_questionDB {
}
}
if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
- $setvar{varname} = $attr->{varname};
+ foreach my $key (keys(%{$attr})) {
+ $setvar{$key} = $attr->{$key};
+ }
if ($setvar{varname} eq 'WebCT_Correct') {
push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
}
@@ -2978,6 +3036,7 @@ sub parse_webct4_questionDB {
}
if ("@state" eq "questestinterop section item itemfeedback") {
$fdbk = $attr->{ident};
+ push(@{$$settings{$id}{feedback}},$fdbk);
$$settings{$id}{$fdbk}{view} = $attr->{view};
}
if ("@state" eq "questestinterop section item itemfeedback material mattext") {
@@ -3021,6 +3080,9 @@ sub parse_webct4_questionDB {
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;
}
+ if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label flow_mat 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") {
@@ -3071,6 +3133,14 @@ sub parse_webct4_questionDB {
push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
}
}
+ } elsif ($is_objectbank) { #Multiple Choice WebCT 4.1 D2L objectbank
+ if ($setvar{action} eq "Set") {
+ if ($text =~ /^\d+\.?\d*$/) {
+ if ($text > 0.000000001) {
+ 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_anstolerance") {
@@ -3087,7 +3157,11 @@ sub parse_webct4_questionDB {
end_h =>
[sub {
my ($tagname) = @_;
- pop @state;
+ if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) {
+ $is_objectbank = '';
+ } else {
+ pop @state;
+ }
}, "tagname"],
);
$p->unbroken_text(1);
@@ -3105,6 +3179,22 @@ sub parse_webct4_questionDB {
}
}
}
+ } elsif ($$settings{$id}{class} eq 'multiplechoice') {
+ if (ref($$settings{$id}) eq 'HASH') {
+ foreach my $list (keys(%{$$settings{$id}})) {
+ if (ref($$settings{$id}{$list}) eq 'HASH') {
+ if (defined($$settings{$id}{$list}{rcardinality})) {
+ if ($$settings{$id}{$list}{rcardinality} eq 'Multiple') {
+ if (ref($$settings{$id}{$list}{correctanswer}) eq 'ARRAY') {
+ if (@{$$settings{$id}{$list}{correctanswer}} == 1) {
+ $$settings{$id}{$list}{rcardinality} = 'Single';
+ }
+ }
+ }
+ }
+ }
+ }
+ }
}
}
}
@@ -3128,10 +3218,11 @@ sub process_assessment {
($cdom,$cnum) = split/_/,$cid;
}
my $destresdir = $destdir;
+ my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
if ($context eq 'CSTR') {
- $destresdir =~ s|/home/$uname/public_html/|/res/$udom/$uname/|;
+ $destresdir =~ s{^\Q$londocroot/priv/\E}{/res/};
} elsif ($context eq 'DOCS') {
- $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
+ $destresdir =~ s{^\Q$londocroot/userfiles\E}{/uploaded};
}
if ($cms eq 'bb5') {
&parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
@@ -3183,7 +3274,9 @@ sub process_assessment {
}
if ($cms eq 'webctce4') {
- &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
+ if (@allids > 0 && $allids[0] ne '') {
+ &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
+ }
} else {
&build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings,\%qzparams);
}
@@ -3276,8 +3369,8 @@ sub build_problem_container {
push @{$sequencesfiles},$mapname.'.sequence';
} else {
$$containerdir = $pagedir.'/'.$mapname.'.page';
- if (!-e "$destdir/pages") {
- mkdir("$destdir/pages",0770);
+ if (!-e "$pagedir") {
+ mkdir("$pagedir",0770);
}
open($fh,">$$containerdir");
$$total{page} ++;
@@ -3296,6 +3389,7 @@ sub build_problem_container {
}
$probtitle{$id} =~ s/\s+/_/g;
$probtitle{$id} =~ s/:/_/g;
+ $probtitle{$id} =~ s/\//_/g;
$probtitle{$id} .= '_'.$id;
}
if (($cms eq 'webctce4' && $container ne 'database') ||
@@ -3370,6 +3464,7 @@ sub write_bb5_questions {
my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
my $qnum = 0;
my $pathstart;
+ my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
if ($context eq 'CSTR') {
$pathstart = '../..';
} else {
@@ -3389,7 +3484,7 @@ sub write_bb5_questions {
$qnum ++;
my $output;
my $permcontainer = $containerdir;
- $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
+ $permcontainer =~ s{^\Q$londocroot/userfiles\E}{uploaded};
my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
my %resourcedata = ();
for (my $i=0; $i<10; $i++) {
@@ -3746,6 +3841,7 @@ sub write_bb5_questions {
sub write_webct4_questions {
my ($cms,$alldbquestids,$context,$settings,$dirname,$allanswers,$allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo,$dirtitle) = @_;
+ my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
my $qnum = 0;
foreach my $id (@{$alldbquestids}) {
$qnum ++;
@@ -3755,10 +3851,12 @@ sub write_webct4_questions {
my $questionimage;
foreach my $fdbk (@{$$settings{$id}{feedback}}) {
my $feedback = $$settings{$id}{$fdbk}{text};
- if ($$settings{$id}{$fdbk}{texttype} eq 'text/html') {
- $feedback = &HTML::Entities::decode($feedback);
+ if ($feedback ne '') {
+ if ($$settings{$id}{$fdbk}{texttype} eq 'text/html') {
+ $feedback = &HTML::Entities::decode($feedback);
+ }
+ $allfeedback .= $feedback;
}
- $allfeedback .= $feedback;
}
if ($$settings{$id}{texttype} eq 'text/html') {
if ($$settings{$id}{text}) {
@@ -3776,7 +3874,7 @@ sub write_webct4_questions {
}
}
}
- $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
+ $permcontainer =~ s{\Q$londocroot/userfiles\E}{uploaded};
my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
my %resourcedata = ();
for (my $i=0; $i<10; $i++) {
@@ -3818,9 +3916,6 @@ sub write_webct4_questions {
<essayresponse>
<textfield>$pre_fill_answer</textfield>
</essayresponse>
- <postanswerdate>
- $allfeedback
- </postanswerdate>
|;
} else {
$resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;
@@ -4331,11 +4426,19 @@ $$settings{$id}{$list}{jumbledtext}[$k]
if (!-e "$destdir/problems/$probdir") {
mkdir("$destdir/problems/$probdir",0755);
}
+ if ($allfeedback ne '') {
+ $output .= qq|
+ <postanswerdate>
+ $allfeedback
+ </postanswerdate>
+|;
+ }
$output .= qq|</problem>
|;
my $title = $$settings{$id}{title};
$title =~ s/\s/_/g;
$title =~ s/:/_/g;
+ $title =~ s/\//_/g;
$title .= '_'.$id;
open(PROB,">$destdir/problems/$probdir/$title.problem");
print PROB $output;
@@ -4378,6 +4481,7 @@ sub test_for_html {
sub write_bb6_questions {
my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
+ my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
my $qnum = 0;
foreach my $id (@{$allids}) {
my $questiontext = $$settings{$id}{question}{text};
@@ -4386,7 +4490,7 @@ sub write_bb6_questions {
$qnum ++;
my $output;
my $permcontainer = $containerdir;
- $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
+ $permcontainer =~ s{\Q$londocroot/userfiles\E}{uploaded};
my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
my %resourcedata = ();
for (my $i=0; $i<10; $i++) {
@@ -4880,10 +4984,11 @@ sub process_content {
my ($cms,$res,$context,$docroot,$destdir,$settings,$dom,$user,$resrcfiles,$packages,$hrefs) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my $destresdir = $destdir;
+ my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
if ($context eq 'CSTR') {
- $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
+ $destresdir =~ s{^\Q$londocroot/priv/\E}{/res/};
} elsif ($context eq 'DOCS') {
- $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
+ $destresdir =~ s{^\Q$londocroot/userfiles\E}{/uploaded};
}
my $filetag = '';
if ($cms eq 'bb5') {
@@ -5304,20 +5409,18 @@ sub angel_content {
# ---------------------------------------------------------------- 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 (defined($$settings{url})) {
+ 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 = qq|<a href="$$settings{url}"|;
if ($title ne '') {
$linktag .= qq|>$title</a>|;
} else {
$linktag .= qq|>$$settings{url}|;
}
- }
- print FILE qq|<html>
+ print FILE qq|<html>
<head>
<title>$title</title>
</head>
@@ -5325,7 +5428,8 @@ sub webct4_content {
$linktag
</body>
</html>|;
- close(FILE);
+ close(FILE);
+ }
}
}