--- loncom/imspackages/imsprocessor.pm 2006/04/15 16:44:56 1.40
+++ loncom/imspackages/imsprocessor.pm 2017/11/16 18:09:59 1.54.2.1
@@ -1,3 +1,8 @@
+# The LearningOnline Network with CAPA
+# Processor for IMS Packages
+#
+# $Id: imsprocessor.pm,v 1.54.2.1 2017/11/16 18:09:59 raeburn Exp $
+#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
@@ -24,7 +29,9 @@
package Apache::imsprocessor;
use Apache::lonnet;
+use Apache::loncommon;
use Apache::loncleanup;
+use Apache::lonlocal;
use LWP::UserAgent;
use HTTP::Request::Common;
use LONCAPA::Configuration;
@@ -56,14 +63,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 +82,7 @@ sub ims_config {
survey => 'webctsurvey',
doc => 'webcontent'
);
- %{$areaname} = (
+ %{$areaname} = &Apache::lonlocal::texthash (
announce => 'Announcements',
board => 'Discussion Boards',
doc => 'Documents, pages, and folders',
@@ -93,6 +100,9 @@ sub create_tempdir {
my ($context,$pathinfo,$timenow) = @_;
my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
my $tempdir;
+ $pathinfo = &Apache::loncommon::clean_path($pathinfo);
+# Collapse dots
+ $pathinfo =~ s/\.+/./g;
if ($context eq 'DOCS') {
$tempdir = $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;
if (!-e "$tempdir") {
@@ -124,6 +134,8 @@ sub uploadzip {
$fname=~s/\s+/\_/g;
# Replace all other weird characters by nothing
$fname=~s/[^\w\.\-]//g;
+# Collapse dots
+ $fname=~s/\.+/./g;
# See if there is anything left
unless ($fname) { return 'error: no uploaded file'; }
# Save the file
@@ -164,7 +176,7 @@ sub process_manifest {
my %toc = (
bb6 => 'organization',
bb5 => 'tableofcontents',
- angel => 'organization',
+ angel5 => 'organization',
webctce4 => 'organization',
webctvista4 => 'organization'
);
@@ -177,7 +189,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';
@@ -197,13 +209,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,
@@ -224,12 +237,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 +305,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;
@@ -302,13 +315,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 +328,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 +366,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 +375,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 +393,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 +429,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) = @_;
+ 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 +454,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 +466,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 +490,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);
}
@@ -466,10 +509,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,11 +537,64 @@ 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");
}
+ } 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");
+ }
+ }
+ }
}
}
}
@@ -517,9 +621,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;
@@ -548,7 +652,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') {
@@ -616,18 +720,22 @@ 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}} = ();
- &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);
}
}
}
} 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') {
@@ -655,10 +763,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};
@@ -713,7 +822,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,
@@ -735,8 +844,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} = "\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};
@@ -922,7 +1040,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";
@@ -972,10 +1090,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 +1108,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 +1121,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 +1162,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 +1202,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',
@@ -1230,7 +1356,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') {
@@ -1417,7 +1543,7 @@ sub process_staff {
Office Hours:
|
- $$settings{office}{hours}
+ $$settings{office}{hours}
|
|;
@@ -1739,7 +1865,7 @@ sub process_db {
}
}
-# ---------------------------------------------------------------- Add Posting to Bulletin Board
+# ---------------------------------------------------------------- Add Posting to Discussion Board
sub addposting {
my ($symb,$contrib,$cdom,$crs)=@_;
my $status='';
@@ -1750,7 +1876,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;
@@ -2292,6 +2418,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'};
@@ -2316,7 +2443,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") {
@@ -2521,9 +2653,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;
}
@@ -2743,8 +2886,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 +2913,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}} = ();
@@ -2834,6 +2987,12 @@ sub parse_webct4_questionDB {
$$settings{$id}{texttype} = $attr->{texttype};
$currtexttype = $attr->{texttype};
}
+ if ("@state" eq "questestinterop section item presentation flow material matimage") {
+ $$settings{$id}{imagtype} = $attr->{imagtype};
+ $currimagtype = $attr->{imagtype};
+ $$settings{$id}{uri} = $attr->{uri};
+
+ }
if ("@state" eq "questestinterop section item presentation flow response_lid") {
$$settings{$id}{class} = 'multiplechoice';
$list = $attr->{ident};
@@ -2855,6 +3014,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") {
@@ -2941,7 +3104,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);
}
@@ -2972,6 +3137,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") {
@@ -3015,6 +3181,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") {
@@ -3053,12 +3222,26 @@ sub parse_webct4_questionDB {
}
}
if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
- if ($setvar{varname} eq "answerValue") { # Multiple Choice
+ if ($setvar{varname} eq "answerValue") { # Multiple Choice WebCT4.0
if ($text =~ m/^\d+$/) {
if ($text > 0) {
push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
}
}
+ } elsif ($setvar{varname} eq "que_score") { # Multiple Choice WebCT4.1
+ if ($text =~ m/^\d+$/) {
+ if ($text > 0) {
+ 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") {
@@ -3075,14 +3258,18 @@ 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);
$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) {
@@ -3093,6 +3280,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';
+ }
+ }
+ }
+ }
+ }
+ }
+ }
}
}
}
@@ -3116,10 +3319,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);
@@ -3142,7 +3346,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);
}
@@ -3171,7 +3375,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);
}
@@ -3189,15 +3395,15 @@ 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 'webct4ce') {
+ if ($cms eq 'webctce4') {
$seqname = $$catinfo{$category}{title}.'_'.$category;
} else {
$seqname = $$catinfo{$category}{title};
@@ -3264,8 +3470,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} ++;
@@ -3284,14 +3490,17 @@ sub build_problem_container {
}
$probtitle{$id} =~ s/\s+/_/g;
$probtitle{$id} =~ s/:/_/g;
- $probtitle{$id} .= '_'.$id;
+ $probtitle{$id} =~ s/\//_/g;
+ if ($cms eq 'webctce4') {
+ $probtitle{$id} .= '_'.$id;
+ }
}
- if (($cms eq 'webct4ce' && $container ne 'database') ||
+ if (($cms eq 'webctce4' && $container ne 'database') ||
($cms eq 'webctvista4')) {
my $probdir;
my $catid = $$settings{$$allids[0]}{category};
if ($catid) {
- if ($cms eq 'webct4ce') {
+ if ($cms eq 'webctce4') {
$probdir = $$catinfo{$catid}{title}.'_'.$catid;
} else {
$probdir = $$catinfo{$catid}{title};
@@ -3325,7 +3534,7 @@ sub build_problem_container {
my $probdir;
my $catid = $$settings{$$allids[$j]}{category};
if ($catid) {
- if ($cms eq 'webct4ce') {
+ if ($cms eq 'webctce4') {
$probdir = $$catinfo{$catid}{title}.'_'.$catid;
} else {
$probdir = $$catinfo{$catid}{title};
@@ -3358,6 +3567,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 {
@@ -3377,7 +3587,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++) {
@@ -3734,6 +3944,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 ++;
@@ -3743,10 +3954,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}) {
@@ -3755,8 +3968,8 @@ sub write_webct4_questions {
}
if ($$settings{$id}{class} eq 'numerical') {
foreach my $numid (@{$$settings{$id}{numids}}) {
- foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {
- if ($cms eq 'webct4ce') {
+ foreach my $var (keys(%{$$settings{$id}{$numid}{vars}})) {
+ if ($cms eq 'webctce4') {
$$settings{$id}{text} =~ s/{($var)}/\$$1 /g;
} elsif ($cms eq 'webctvista4') {
$$settings{$id}{text} =~ s/\[($var)\]/\$$1 /g;
@@ -3764,7 +3977,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++) {
@@ -3782,8 +3995,9 @@ sub write_webct4_questions {
}
}
$$total{prob} ++;
+
if (exists($$settings{$id}{uri})) {
- if ($cms eq 'webct4ce') {
+ if ($cms eq 'webctce4') {
if ($$settings{$id}{imagtype} =~ /^image\//) {
$questionimage = '
'."\n";
} else {
@@ -3798,6 +4012,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|
|;
+ }
if ($$settings{$id}{class} eq "paragraph") {
my $pre_fill_answer = $$settings{$id}{PARA}{PARA}{PRE_FILL_ANSWER};
if ($context eq 'CSTR') {
@@ -3805,9 +4026,6 @@ sub write_webct4_questions {
$pre_fill_answer
-
- $allfeedback
-
|;
} else {
$resourcedata{$symb.'questiontext'} = ''.$$settings{$id}{text}.'
'.$questionimage;
@@ -4092,7 +4310,7 @@ $$settings{$id}{$list}{jumbledtext}[$k]
($$settings{$id}{class} eq 'shortanswer')) {
my $labelnum = 0;
my @str_labels = ();
- if ($cms eq 'webct4ce') {
+ if ($cms eq 'webctce4') {
foreach my $str_id (@{$$settings{$id}{str}}) {
foreach my $label (@{$$settings{$id}{$str_id}{labels}}) {
push(@str_labels,$label);
@@ -4237,9 +4455,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) {
@@ -4252,7 +4470,7 @@ $$settings{$id}{$list}{jumbledtext}[$k]
}
$increment .= '1';
}
- if ($cms eq 'webct4ce') {
+ if ($cms eq 'webctce4') {
$formula =~ s/{($var)}/(\$$1)/g;
} elsif ($cms eq 'webctvista4') {
$formula =~ s/\[($var)\]/(\$$1)/g;
@@ -4305,7 +4523,7 @@ $$settings{$id}{$list}{jumbledtext}[$k]
my $probdir;
my $catid = $$settings{$id}{category};
if ($catid) {
- if ($cms eq 'webct4ce') {
+ if ($cms eq 'webctce4') {
$probdir = $$catinfo{$catid}{title}.'_'.$catid;
} else {
$probdir = $$catinfo{$catid}{title};
@@ -4318,12 +4536,19 @@ $$settings{$id}{$list}{jumbledtext}[$k]
if (!-e "$destdir/problems/$probdir") {
mkdir("$destdir/problems/$probdir",0755);
}
+ if ($allfeedback ne '') {
+ $output .= qq|
+
+ $allfeedback
+
+|;
+ }
$output .= qq|
|;
my $title = $$settings{$id}{title};
$title =~ s/\s/_/g;
$title =~ s/:/_/g;
- $title .= '_'.$id;
+ $title =~ s/\//_/g;
open(PROB,">$destdir/problems/$probdir/$title.problem");
print PROB $output;
close PROB;
@@ -4365,6 +4590,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};
@@ -4373,7 +4599,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++) {
@@ -4867,10 +5093,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') {
@@ -5000,7 +5227,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}
\n|;
@@ -5291,20 +5518,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|$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|$title|;
} else {
$linktag .= qq|>$$settings{url}|;
}
- }
- print FILE qq|
+ print FILE qq|
$title
@@ -5312,7 +5537,8 @@ sub webct4_content {
$linktag
|;
- close(FILE);
+ close(FILE);
+ }
}
}