--- loncom/imspackages/imsprocessor.pm 2008/08/23 21:08:29 1.43 +++ loncom/imspackages/imsprocessor.pm 2018/05/02 20:01:51 1.54.2.2 @@ -1,3 +1,8 @@ +# The LearningOnline Network with CAPA +# Processor for IMS Packages +# +# $Id: imsprocessor.pm,v 1.54.2.2 2018/05/02 20:01:51 raeburn Exp $ +# # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). @@ -24,6 +29,7 @@ package Apache::imsprocessor; use Apache::lonnet; +use Apache::loncommon; use Apache::loncleanup; use Apache::lonlocal; use LWP::UserAgent; @@ -57,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', @@ -94,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") { @@ -125,11 +134,13 @@ 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 chomp($env{'form.uploadname'}); - open(my $fh,'>'.$tempdir.'/'.$fname); + open(my $fh,'>',"$tempdir/$fname"); print $fh $env{'form.uploadname'}; close($fh); } elsif ($context eq 'CSTR') { @@ -165,7 +176,7 @@ sub process_manifest { my %toc = ( bb6 => 'organization', bb5 => 'tableofcontents', - angel => 'organization', + angel5 => 'organization', webctce4 => 'organization', webctvista4 => 'organization' ); @@ -178,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'; @@ -198,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, @@ -225,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; @@ -293,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; @@ -303,12 +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,$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 +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); } @@ -467,7 +510,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 +549,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 +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; @@ -563,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') { @@ -631,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') { @@ -670,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}; @@ -728,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, @@ -755,7 +849,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} = "\n"; } @@ -900,10 +994,10 @@ sub build_structure { $seqtext{$key} .= "\n"; if ($cms eq 'webctce4' && $key ne 'Top') { push @{$seqfiles}, "$seqtitle.sequence"; - open(LOCFILE,">$destdir/sequences/$seqtitle.sequence"); + open(LOCFILE,'>',"$destdir/sequences/$seqtitle.sequence"); } else { push @{$seqfiles}, "$key.sequence"; - open(LOCFILE,">$destdir/sequences/$key.sequence"); + open(LOCFILE,'>',"$destdir/sequences/$key.sequence"); } print LOCFILE $seqtext{$key}; close(LOCFILE); @@ -933,7 +1027,7 @@ sub build_structure { &process_specials($context,'pools',$pools,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames); } $seqtext{'Top'} .= "\n"; - open(TOPFILE,">$destdir/sequences/Top.sequence"); + open(TOPFILE,'>',"$destdir/sequences/Top.sequence"); print TOPFILE $seqtext{'Top'}; close(TOPFILE); push @{$seqfiles}, 'Top.sequence'; @@ -946,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"; @@ -955,7 +1049,7 @@ sub build_structure { if (grep/^$res$/,@{$packages}) { $resource = $filestem.'/resfiles/'.$res.'./index.html'; # should be entry_point } - open(PAGEFILE,">$filename"); + open(PAGEFILE,'>',$filename); print PAGEFILE qq| \n|; @@ -998,7 +1092,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; @@ -1014,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; @@ -1027,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."); @@ -1108,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', @@ -1144,10 +1238,10 @@ sub process_specials { if ($type eq "announcements") { push @{$pagesfiles}, "$seqnames{$type}.page"; - open(ITEM,">$destdir/pages/$seqnames{$type}.page"); + open(ITEM,'>',"$destdir/pages/$seqnames{$type}.page"); } else { push @{$seqfiles}, "$seqnames{$type}.sequence"; - open(ITEM,">$destdir/sequences/$seqnames{$type}.sequence"); + open(ITEM,'>',"$destdir/sequences/$seqnames{$type}.sequence"); } if ($type eq 'boards') { @@ -1262,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') { @@ -1449,7 +1543,7 @@ sub process_staff { Office Hours: - $$settings{office}{hours} + $$settings{office}{hours} |; @@ -1490,7 +1584,7 @@ sub process_staff { |; - open(FILE,">$destdir/resfiles/$res.html"); + open(FILE,'>',"$destdir/resfiles/$res.html"); push @{$resrcfiles}, "$res.html"; print FILE qq| @@ -1569,7 +1663,7 @@ sub process_link { $linktag .= qq|>$$settings{title}|; } - open(FILE,">$destdir/resfiles/$res.html"); + open(FILE,'>',"$destdir/resfiles/$res.html"); push @{$resrcfiles}, "$res.html"; print FILE qq| @@ -1771,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=''; @@ -1782,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; @@ -2324,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'}; @@ -2348,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") { @@ -2553,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; } @@ -2775,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 @@ -2797,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}} = (); @@ -2893,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") { @@ -2979,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); } @@ -3010,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") { @@ -3053,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") { @@ -3103,6 +3234,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") { @@ -3119,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) { @@ -3137,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'; + } + } + } + } + } + } + } } } } @@ -3160,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); @@ -3186,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); } @@ -3215,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); } @@ -3233,13 +3395,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"); + 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; @@ -3303,15 +3465,15 @@ sub build_problem_container { if (!-e "$seqdir") { mkdir("$seqdir",0770); } - open($fh,">$$containerdir"); + open($fh,'>',$$containerdir); $$total{seq} ++; 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"); + open($fh,'>',$$containerdir); $$total{page} ++; push @{$pagesfiles},$mapname.'.page'; } @@ -3328,7 +3490,10 @@ 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 'webctce4' && $container ne 'database') || ($cms eq 'webctvista4')) { @@ -3402,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 { @@ -3421,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++) { @@ -3765,7 +3931,7 @@ sub write_bb5_questions { $title =~ s/\s/_/g; $title =~ s/\W//g; $title .= '_'.$id; - open(PROB,">$newdir/$title.problem"); + open(PROB,'>',"$newdir/$title.problem"); print PROB $output; close PROB; } else { @@ -3778,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 ++; @@ -3787,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}) { @@ -3799,7 +3968,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') { @@ -3808,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++) { @@ -3843,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') { @@ -3850,9 +4026,6 @@ sub write_webct4_questions { $pre_fill_answer - - $allfeedback - |; } else { $resourcedata{$symb.'questiontext'} = '

'.$$settings{$id}{text}.'

'.$questionimage; @@ -4282,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) { @@ -4363,13 +4536,20 @@ $$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; - open(PROB,">$destdir/problems/$probdir/$title.problem"); + $title =~ s/\//_/g; + open(PROB,'>',"$destdir/problems/$probdir/$title.problem"); print PROB $output; close PROB; } else { @@ -4410,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}; @@ -4418,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++) { @@ -4767,7 +4948,7 @@ sub write_bb6_questions { $title =~ s/\s/_/g; $title =~ s/\W//g; $title .= '_'.$id; - open(PROB,">$newdir/$title.problem"); + open(PROB,'>',"$newdir/$title.problem"); print PROB $output; close PROB; } else { @@ -4793,7 +4974,7 @@ sub retrieve_image { if (!-e "$docroot/$res/webimages") { mkdir("$docroot/$res/webimages",0755); } - open(my $fh,">$docroot/$res/webimages/$filename"); + open(my $fh,'>',"$docroot/$res/webimages/$filename"); print $fh $contents; close($fh); if ($context eq 'DOCS') { @@ -4886,7 +5067,7 @@ sub process_announce { } } - open(FILE,">$destdir/resfiles/$res.html"); + open(FILE,'>',"$destdir/resfiles/$res.html"); push @{$resrcfiles}, "$res.html"; print FILE qq| @@ -4912,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') { @@ -5045,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|; @@ -5091,7 +5273,7 @@ sub process_content { } } - if (!open(FILE,">$destdir/resfiles/$res.html")) { + 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"; @@ -5284,7 +5466,7 @@ sub angel_content { $p->parse_file($xmlfile); $p->eof; if ($type eq "PAGE") { - open(FILE,"<$xmlfile"); + open(FILE,'<',$xmlfile); @buffer = ; close(FILE); chomp(@buffer); @@ -5301,7 +5483,7 @@ sub angel_content { } } } - open(FILE,">$destdir/resfiles/$res.html"); + open(FILE,'>',"$destdir/resfiles/$res.html"); push @{$resrcfiles}, "$res.html"; print FILE qq| @@ -5337,7 +5519,7 @@ sub angel_content { sub webct4_content { my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_; if (defined($$settings{url})) { - if (!open(FILE,">$destdir/resfiles/$res.html")) { + 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");