--- loncom/imspackages/imsprocessor.pm 2008/08/25 13:43:39 1.44
+++ loncom/imspackages/imsprocessor.pm 2017/05/23 03:07:40 1.55
@@ -1,3 +1,8 @@
+# The LearningOnline Network with CAPA
+# Processor for IMS Packages
+#
+# $Id: imsprocessor.pm,v 1.55 2017/05/23 03:07:40 raeburn Exp $
+#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
@@ -26,9 +31,9 @@ package Apache::imsprocessor;
use Apache::lonnet;
use Apache::loncleanup;
use Apache::lonlocal;
-use LWP::UserAgent;
use HTTP::Request::Common;
use LONCAPA::Configuration;
+use LONCAPA::LWPReq;
use strict;
sub ims_config {
@@ -57,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',
@@ -165,7 +170,7 @@ sub process_manifest {
my %toc = (
bb6 => 'organization',
bb5 => 'tableofcontents',
- angel => 'organization',
+ angel5 => 'organization',
webctce4 => 'organization',
webctvista4 => 'organization'
);
@@ -178,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';
@@ -198,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,
@@ -225,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;
@@ -293,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;
@@ -303,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};
@@ -320,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) {
@@ -346,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') {
@@ -355,6 +369,15 @@ sub parse_manifest {
}
}
}
+ if ("@state" eq "manifest webct:ContentObject webct:Name") {
+ if ($cms eq 'webctvista4') {
+ if ($text =~ /,/) {
+ $$resources{$identifier}{title} = (split(/,/,$text))[-1];
+ } else {
+ $$resources{$identifier}{title} = $text;
+ }
+ }
+ }
}, "dtext"],
end_h =>
[sub {
@@ -364,7 +387,7 @@ sub parse_manifest {
);
$p->parse_file($xmlfile);
$p->eof;
- foreach my $itm (keys %contents) {
+ foreach my $itm (keys(%contents)) {
@{$$items{$itm}{contents}} = @{$contents{$itm}};
}
}
@@ -400,18 +423,22 @@ 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}) {
+ foreach my $key (sort(keys(%{$hrefs}))) {
if (grep/^$key$/,@{$targets}) {
%{$$url{$key}} = ();
foreach my $file (@{$$hrefs{$key}}) {
@@ -421,7 +448,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;
}
@@ -433,6 +460,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;
@@ -447,11 +484,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);
}
@@ -467,7 +504,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");
@@ -506,6 +543,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 ($imgtitle =~ /\Q$extension\E/i) {
+ $copyfile = $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");
+ }
+ }
+ }
}
}
}
@@ -532,9 +615,9 @@ sub process_resinfo {
mkdir("$destdir/resfiles",0770);
}
}
- if ($cms eq 'angel') {
+ if ($cms eq 'angel5') {
my $currboard = '';
- foreach my $key (sort keys %{$resources}) {
+ foreach my $key (sort(keys(%{$resources}))) {
if (grep/^$key$/,@{$targets}) {
if ($$resources{$key}{type} eq "BOARD") {
push @{$boards}, $key;
@@ -563,7 +646,7 @@ sub process_resinfo {
}
}
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
- foreach my $key (sort keys %{$resources}) {
+ 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') {
@@ -631,7 +714,7 @@ sub process_resinfo {
$$items{'Top'}{'contentscount'} ++;
}
} elsif ($cms eq 'webctce4') {
- foreach my $key (sort keys %{$resources}) {
+ foreach my $key (sort(keys(%{$resources}))) {
if (grep/^$key$/,@{$targets}) {
if ($$resources{$key}{type} eq "webcontent") {
%{$$resinfo{$key}} = ();
@@ -646,7 +729,7 @@ sub process_resinfo {
}
}
} elsif ($cms eq 'webctvista4') {
- foreach my $key (sort keys %{$resources}) {
+ foreach my $key (sort(keys(%{$resources}))) {
if (grep/^$key$/,@{$targets}) {
%{$$resinfo{$key}} = ();
if ($$resources{$key}{type} eq 'webct.question') {
@@ -674,10 +757,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};
@@ -732,7 +816,7 @@ sub build_structure {
$srcstem = "/res/$udom/$uname/$newdir";
}
- foreach my $key (sort keys %{$items}) {
+ foreach my $key (sort(keys(%{$items}))) {
if ($$includeditems{$key}) {
%{$flag{$key}} = (
page => 0,
@@ -759,7 +843,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";
}
@@ -950,7 +1034,7 @@ sub build_structure {
$filestem = "/res/$udom/$uname/$newdir";
}
- foreach my $key (sort keys %pagecontents) {
+ foreach my $key (sort(keys(%pagecontents))) {
for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {
my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
my $resource = "$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}.html";
@@ -1002,7 +1086,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;
@@ -1018,12 +1102,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;
@@ -1031,7 +1115,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.");
@@ -1112,7 +1196,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',
@@ -1266,7 +1350,7 @@ sub process_user {
my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
my $xmlstem = $$configvars{'lonDaemons'}."/tmp/".$user_cdom."_".$user_crs."_";
- foreach my $user_id (keys %{$settings}) {
+ foreach my $user_id (keys(%{$settings})) {
if ($$settings{$user_id}{user_role} eq "s") {
} elsif ($user_handling eq 'enrollall') {
@@ -1453,7 +1537,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>
|;
@@ -1775,7 +1859,7 @@ sub process_db {
}
}
-# ---------------------------------------------------------------- Add Posting to Bulletin Board
+# ---------------------------------------------------------------- Add Posting to Discussion Board
sub addposting {
my ($symb,$contrib,$cdom,$crs)=@_;
my $status='';
@@ -1786,7 +1870,7 @@ sub addposting {
&Apache::lonnet::put('discussiontimes',\%storenewentry,$cdom,$crs);
}
my %record=&Apache::lonnet::restore('_discussion');
- my ($temp)=keys %record;
+ my ($temp)=keys(%record);
unless ($temp=~/^error\:/) {
my %newrecord=();
$newrecord{'resource'}=$symb;
@@ -2328,6 +2412,7 @@ sub parse_webctvista4_question {
@{$$settings{$id}{numids}} = ();
%{$$allanswers{$id}} = ();
$$settings{$id}{title} = $attr->{title};
+ $$settings{$id}{title} =~ s/\%/pct_/g;
}
if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:var") {
$currvar = $attr->{'webct:name'};
@@ -2352,7 +2437,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") {
@@ -2557,9 +2647,20 @@ sub parse_webctvista4_question {
text_h =>
[sub {
my ($text) = @_;
+ $text =~ s/\s*\&\s*/_and_/g;
if ($currtexttype eq '/text/html') {
$text =~ s#(<img\ssrc=")([^"]+)">#$1../resfiles/$2#g;
}
+ if ("@state" eq "questestinterop item presentation flow material matimage") {
+ my $imagetitle;
+ if ($text =~ /,/) {
+ $imagetitle = (split(/,/,$text))[-1];
+ } else {
+ $imagetitle = $text;
+ }
+ $$settings{$id}{imagetitle} = $imagetitle;
+ push(@{$$resources{$res}{imagetitle}},$imagetitle);
+ }
if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldlabel") {
$fieldlabel = $text;
}
@@ -3162,7 +3263,7 @@ sub parse_webct4_questionDB {
$p->parse_file($xmlfile);
$p->eof;
my $boxcount;
- foreach my $id (keys %{$settings}) {
+ foreach my $id (keys(%{$settings})) {
if ($$settings{$id}{class} eq 'string') {
$boxcount = 0;
if (@{$$settings{$id}{boxes}} > 1) {
@@ -3212,10 +3313,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);
@@ -3238,7 +3340,7 @@ sub process_assessment {
}
} elsif ($cms eq 'webctvista4') {
unless($$dbparse) {
- foreach my $res (sort keys %{$allquestions}) {
+ foreach my $res (sort(keys(%{$allquestions}))) {
my $parent = $$allquestions{$res};
&parse_webctvista4_question($res,$docroot,$resources,$hrefs,$qzdbsettings,\@allquestids,\%allanswers,\%allchoices,$parent,$catinfo);
}
@@ -3287,13 +3389,13 @@ sub build_category_sequences {
if (!-e "$destdir/sequences") {
mkdir("$destdir/sequences",0755);
}
- my $numcats = scalar(keys %{$catinfo});
+ my $numcats = scalar(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}) {
+ foreach my $category (sort(keys(%{$catinfo}))) {
my $seqname;
if ($cms eq 'webctce4') {
$seqname = $$catinfo{$category}{title}.'_'.$category;
@@ -3362,8 +3464,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} ++;
@@ -3383,7 +3485,9 @@ sub build_problem_container {
$probtitle{$id} =~ s/\s+/_/g;
$probtitle{$id} =~ s/:/_/g;
$probtitle{$id} =~ s/\//_/g;
- $probtitle{$id} .= '_'.$id;
+ if ($cms eq 'webctce4') {
+ $probtitle{$id} .= '_'.$id;
+ }
}
if (($cms eq 'webctce4' && $container ne 'database') ||
($cms eq 'webctvista4')) {
@@ -3457,6 +3561,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 {
@@ -3476,7 +3581,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++) {
@@ -3833,6 +3938,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 ++;
@@ -3856,7 +3962,7 @@ sub write_webct4_questions {
}
if ($$settings{$id}{class} eq 'numerical') {
foreach my $numid (@{$$settings{$id}{numids}}) {
- foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {
+ foreach my $var (keys(%{$$settings{$id}{$numid}{vars}})) {
if ($cms eq 'webctce4') {
$$settings{$id}{text} =~ s/{($var)}/\$$1 /g;
} elsif ($cms eq 'webctvista4') {
@@ -3865,7 +3971,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++) {
@@ -3900,6 +4006,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 = '../../resfiles/'.$$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') {
@@ -4336,9 +4449,9 @@ $$settings{$id}{$list}{jumbledtext}[$k]
|;
foreach my $numid (@{$$settings{$id}{numids}}) {
my $formula = $$settings{$id}{$numid}{formula};
- my $pattern = join('|',(sort (keys (%mathfns))));
+ my $pattern = join('|',(sort(keys(%mathfns))));
$formula =~ s/($pattern)/\&$mathfns{$1}/g;
- foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {
+ foreach my $var (keys(%{$$settings{$id}{$numid}{vars}})) {
my $decnum = $$settings{$id}{$numid}{vars}{$var}{dec};
my $increment = '0.';
if ($decnum == 0) {
@@ -4430,7 +4543,6 @@ $$settings{$id}{$list}{jumbledtext}[$k]
$title =~ s/\s/_/g;
$title =~ s/:/_/g;
$title =~ s/\//_/g;
- $title .= '_'.$id;
open(PROB,">$destdir/problems/$probdir/$title.problem");
print PROB $output;
close PROB;
@@ -4472,6 +4584,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};
@@ -4480,7 +4593,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++) {
@@ -4844,9 +4957,9 @@ sub retrieve_image {
my ($context,$res,$dirname,$cdom,$cname,$docroot,$destdir,$urlpath,$filename) = @_;
my $contents;
my $url = $urlpath.$filename;
- my $ua=new LWP::UserAgent;
+ my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
my $request=new HTTP::Request('GET',$url);
- my $response=$ua->request($request);
+ my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request);
if ($response->is_success) {
$contents = $response->content;
if (!-e "$docroot/$res") {
@@ -4974,10 +5087,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') {
@@ -5107,7 +5221,7 @@ sub process_content {
if ($$settings{newwindow} eq "true") {
$linktag .= qq| target="$res$filecount"|;
}
- foreach my $entry (keys %{$$settings{files}[$filecount]{registry}}) {
+ foreach my $entry (keys(%{$$settings{files}[$filecount]{registry}})) {
$linktag .= qq| $entry="$$settings{files}[$filecount]{registry}{$entry}"|;
}
$linktag .= qq|>$$settings{files}[$filecount]{linkname}</a><br/>\n|;