--- loncom/imspackages/imsprocessor.pm 2008/08/26 01:35:15 1.45
+++ loncom/imspackages/imsprocessor.pm 2013/07/27 22:04:49 1.52
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Processor for IMS Packages
#
-# $Id: imsprocessor.pm,v 1.45 2008/08/26 01:35:15 www Exp $
+# $Id: imsprocessor.pm,v 1.52 2013/07/27 22:04:49 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -62,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',
@@ -170,7 +170,7 @@ sub process_manifest {
my %toc = (
bb6 => 'organization',
bb5 => 'tableofcontents',
- angel => 'organization',
+ angel5 => 'organization',
webctce4 => 'organization',
webctvista4 => 'organization'
);
@@ -183,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';
@@ -203,13 +203,14 @@ sub process_manifest {
sub parse_manifest {
my ($cms,$phase,$tempdir,$xmlfile,$toc,$includedres,$includeditems,$items,
- $resources,$resinfo,$hrefs,$seq) = @_;
+ $resources,$resinfo,$hrefs,$seq,$requirer) = @_;
my @state = ();
my $itm = '';
my %contents = ();
my $identifier = '';
my @allidentifiers = ();
my $lastitem;
+ my $neededby;
my $p = HTML::Parser->new
(
xml_mode => 1,
@@ -230,12 +231,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;
@@ -298,7 +299,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,12 +309,8 @@ sub parse_manifest {
}
} elsif ("@state" eq "manifest resources resource file") {
if ($$includedres{$identifier} || $phase ne 'build') {
- if ($cms eq 'webctvista4') {
- $$resources{$identifier}{file} = $attr->{href};
- }
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};
@@ -325,15 +322,27 @@ sub parse_manifest {
&parse_manifest($cms,$phase,$tempdir,$manifestfile,
$toc,$includedres,$includeditems,
$items,$resources,$resinfo,
- $hrefs,$currseqref);
+ $hrefs,$currseqref,$neededby);
+ } else {
+ if ($cms eq 'webctvista4') {
+ if ($$resources{$identifier}{type} eq 'ims_qtiasiv1p2') {
+ $neededby = $identifier;
+ } elsif ($$resources{$identifier}{type} eq 'webcontent') {
+ $$resources{$identifier}{usedby} = $requirer;
+ push(@{$$hrefs{$identifier}},$attr->{href});
+ }
+ $$resources{$identifier}{file} = $attr->{href};
+ } else {
+ push(@{$$hrefs{$identifier}},$attr->{href});
+ }
}
- } 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/) {
$$resources{$identifier}{type} = $1;
}
- }
+ }
}
} elsif ("@state" eq "manifest webct:ContentObject") {
foreach my $ident (@allidentifiers) {
@@ -351,7 +360,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') {
@@ -360,6 +369,11 @@ sub parse_manifest {
}
}
}
+ if ("@state" eq "manifest webct:ContentObject webct:Name") {
+ if ($cms eq 'webctvista4') {
+ $$resources{$identifier}{title} = (split(/,/,$text))[-1];
+ }
+ }
}, "dtext"],
end_h =>
[sub {
@@ -405,16 +419,20 @@ sub get_parents {
sub target_resources {
my ($resources,$oktypes,$targets) = @_;
- foreach my $key (keys %{$resources}) {
+ foreach my $key (sort(keys(%{$resources}))) {
if ( defined($$oktypes{$$resources{$key}{type}}) ) {
- push @{$targets}, $key;
+ push(@{$targets},$key);
+ } elsif (defined($$resources{$key}{usedby})) {
+ if (defined($$oktypes{$$resources{$$resources{$key}{usedby}}{type}})) {
+ push(@{$targets},$key);
+ }
}
}
return;
}
sub copy_resources {
- my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles,$total) = @_;
+ my ($context,$cms,$hrefs,$resources,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles,$total) = @_;
if ($context eq 'DOCS') {
foreach my $key (sort keys %{$hrefs}) {
if (grep/^$key$/,@{$targets}) {
@@ -426,7 +444,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;
}
@@ -438,6 +456,16 @@ sub copy_resources {
$copyfile = $1;
}
}
+ if ($cms eq 'webctvista4') {
+ if ($file =~ m{/\QX-WEBCT-VISTA-V0\E/.+([^.]+)$}) {
+ $copyfile = $1;
+ }
+ if ($$resources{$key}{usedby}) {
+ if ($$resources{$$resources{$key}{usedby}}{image} =~ /^\Q$copyfile\E/) {
+ $copyfile = $$resources{$$resources{$key}{usedby}}{image};
+ }
+ }
+ }
unless ((($cms eq 'webctce4') && ($copyfile =~ m/questionDB\.xml$/ || $copyfile =~ m/quiz_QIZ_\d+\.xml$/ || $copyfile =~ m/properties_QIZ_\d+\.xml$/)) || (($cms eq 'webctvista4') && (grep/^$key$/,@{$assessmentfiles}) && $file =~ /\.xml$/)) {
$copyfile = $fpath.$copyfile;
my $fileresult;
@@ -452,11 +480,11 @@ sub copy_resources {
if (!-e "$destdir/resfiles") {
mkdir("$destdir/resfiles",0770);
}
- foreach my $key (sort keys %{$hrefs}) {
+ foreach my $key (sort(keys(%{$hrefs}))) {
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);
}
@@ -472,7 +500,7 @@ sub copy_resources {
}
}
my $renameres;
- if ($cms eq 'angel') {
+ if ($cms eq 'angel5') {
$renameres = rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
$renameres = rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
@@ -511,6 +539,52 @@ sub copy_resources {
} elsif ($file !~ m-/data/(.+)$-) {
&Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
}
+ } elsif ($cms eq 'webctvista4') {
+ if ($file =~ m{^\QX-WEBCT-VISTA-V0\E/(.+)$}) {
+ my $copyfile = $1;
+ if ($copyfile =~ m{^[^/]+/[^/]+}) {
+ my @dirs = split/\//,$copyfile;
+ my $path = "$destdir/resfiles";
+ while (@dirs > 1) {
+ $path .= '/'.$dirs[0];
+ if (!-e "$path") {
+ mkdir("$path",0755);
+ }
+ shift @dirs;
+ }
+ } else {
+ $copyfile =~ s/^[^.]+\.(\d+)_R/$1/;
+ my ($filestem,$extension) = ($copyfile =~ /^(.+)\.(\w+)$/);
+ if ($$resources{$key}{usedby}) {
+ if (ref($$resources{$$resources{$key}{usedby}}{image}) eq 'ARRAY') {
+ for (my $i=0; $i<@{$$resources{$$resources{$key}{usedby}}{image}}; $i++) {
+ my ($img,$imgtitle);
+ $img = $$resources{$$resources{$key}{usedby}}{image}[$i];
+ if (ref($$resources{$$resources{$key}{usedby}}{imagetitle}) eq 'ARRAY') {
+ $imgtitle = $$resources{$$resources{$key}{usedby}}{imagetitle}[$i];
+ }
+ if (($img =~ /^\Q$filestem\E/i) && ($imgtitle =~ /\Q$extension\E/i)) {
+ $copyfile = $img.'_'.$imgtitle;
+ last;
+ } elsif ($img =~ /^\Q$filestem\E/i) {
+ $copyfile = $img.'.'.$extension;
+ last;
+ }
+ }
+ }
+ }
+ }
+ if (-e "$tempdir/$file") {
+ my $renameres = rename("$tempdir/$file","$destdir/resfiles/$copyfile");
+ if ($renameres) {
+ if (ref($total) eq 'HASH') {
+ $$total{'file'} ++;
+ }
+ } else {
+ &Apache::lonnet::logthis("IMS import error: WebCTVista - renaming failed for file $file");
+ }
+ }
+ }
}
}
}
@@ -537,7 +611,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}) {
@@ -679,10 +753,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};
@@ -764,7 +839,7 @@ sub build_structure {
$seqtitle =~ s|/+|_|g;
$seqtitle =~ s/\s+/_/g;
$seqtitle .= '_'.$key;
- 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)) {
+ 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";
}
@@ -1007,7 +1082,7 @@ 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,$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;
@@ -1023,12 +1098,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;
@@ -1036,7 +1111,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.");
@@ -1117,7 +1192,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',
@@ -1458,7 +1533,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>
|;
@@ -1780,7 +1855,7 @@ sub process_db {
}
}
-# ---------------------------------------------------------------- Add Posting to Bulletin Board
+# ---------------------------------------------------------------- Add Posting to Discussion Board
sub addposting {
my ($symb,$contrib,$cdom,$crs)=@_;
my $status='';
@@ -2357,7 +2432,12 @@ sub parse_webctvista4_question {
$$settings{$id}{text} .= '['.$attr->{'webct:name'}.']';
}
if ("@state" eq "questestinterop item presentation flow material matimage") {
- $$settings{$id}{image} = $attr->{uri};
+ if ($attr->{uri} =~ /\QRelativeResourceManager?contentID=\E(\d+)$/) {
+ $$settings{$id}{image} = $1;
+ push(@{$$resources{$res}{image}},$$settings{$id}{image});
+ } else {
+ $$settings{$id}{image} = $attr->{uri};
+ }
}
if ("@state" eq "questestinterop item presentation flow material mattext") {
@@ -2565,6 +2645,11 @@ sub parse_webctvista4_question {
if ($currtexttype eq '/text/html') {
$text =~ s#(<img\ssrc=")([^"]+)">#$1../resfiles/$2#g;
}
+ if ("@state" eq "questestinterop item presentation flow material matimage") {
+ my $imagetitle = (split(/,/,$text))[-1];
+ $$settings{$id}{imagetitle} = $imagetitle;
+ push(@{$$resources{$res}{imagetitle}},$imagetitle);
+ }
if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldlabel") {
$fieldlabel = $text;
}
@@ -3217,10 +3302,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);
@@ -3367,8 +3453,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} ++;
@@ -3462,6 +3548,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 {
@@ -3481,7 +3568,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++) {
@@ -3838,6 +3925,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 ++;
@@ -3870,7 +3958,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++) {
@@ -3905,6 +3993,13 @@ sub write_webct4_questions {
}
}
}
+ if (($cms eq 'webctvista4') && (defined($$settings{$id}{image}))) {
+ my $imgsrc = '../../resfiles/'.$$settings{$id}{image};
+ if (defined($$settings{$id}{imagetitle})) {
+ $imgsrc .= '_'.$$settings{$id}{imagetitle};
+ }
+ $questionimage = qq|<p><img src="$imgsrc" /></p>|;
+ }
if ($$settings{$id}{class} eq "paragraph") {
my $pre_fill_answer = $$settings{$id}{PARA}{PARA}{PRE_FILL_ANSWER};
if ($context eq 'CSTR') {
@@ -4477,6 +4572,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};
@@ -4485,7 +4581,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++) {
@@ -4979,10 +5075,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') {