File:
[LON-CAPA] /
loncom /
imspackages /
imsprocessor.pm
Revision
1.48:
download - view:
text,
annotated -
select for diffs
Mon Aug 17 03:52:09 2009 UTC (14 years, 8 months ago) by
raeburn
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
loncapaMITrelate_1,
bz6209-base,
bz6209,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2
- CMS option "ANGEL" changed to "ANGEL 5.5" to emphasize that existing support is for the IMS packages generated by the 5.5 version.
(More recent releases create IMS content packages with different packaging).
# The LearningOnline Network with CAPA
# Processor for IMS Packages
#
# $Id: imsprocessor.pm,v 1.48 2009/08/17 03:52:09 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package Apache::imsprocessor;
use Apache::lonnet;
use Apache::loncleanup;
use Apache::lonlocal;
use LWP::UserAgent;
use HTTP::Request::Common;
use LONCAPA::Configuration;
use strict;
sub ims_config {
my ($areas,$cmsmap,$areaname) = @_;
@{$areas} = ("doc","extlink","announce","staff","board","quiz","survey","pool","users","question");
%{$$cmsmap{bb5}} = (
announce => 'resource/x-bb-announcement',
board => 'resource/x-bb-discussionboard',
doc => 'resource/x-bb-document',
extlink => 'resource/x-bb-externallink',
pool => 'assessment/x-bb-pool',
quiz => 'assessment/x-bb-quiz',
staff => 'resource/x-bb-staffinfo',
survey => 'assessment/x-bb-survey',
users => 'course/x-bb-user',
);
%{$$cmsmap{bb6}} = (
announce => 'resource/x-bb-announcement',
board => 'resource/x-bb-discussionboard',
doc => 'resource/x-bb-document',
extlink => 'resource/x-bb-externallink',
pool => 'assessment/x-bb-qti-pool',
quiz => 'assessment/x-bb-qti-test',
staff => 'resource/x-bb-staffinfo',
survey => 'assessment/x-bb-survey',
users => 'course/x-bb-user',
);
$$cmsmap{bb6}{conference} = 'resource/x-bb-conference';
%{$$cmsmap{angel5}} = (
board => 'BOARD',
extlink => 'LINK',
msg => 'MESSAGE',
quiz => 'QUIZ',
survey => 'FORM',
);
@{$$cmsmap{angel5}{doc}} = ('FILE','PAGE');
%{$$cmsmap{webctce4}} = (
quiz => 'webctquiz',
survey => 'webctsurvey',
doc => 'webcontent'
);
%{$$cmsmap{webctvista4}} = (
question => 'webct.question',
quiz => 'webct.assessment',
survey => 'webctsurvey',
doc => 'webcontent'
);
%{$areaname} = &Apache::lonlocal::texthash (
announce => 'Announcements',
board => 'Discussion Boards',
doc => 'Documents, pages, and folders',
extlink => 'Links to external sites',
pool => 'Question pools',
quiz => 'Quizzes',
question => 'Assessment Questions',
staff => 'Staff information',
survey => 'Surveys',
users => 'Enrollment',
);
}
sub create_tempdir {
my ($context,$pathinfo,$timenow) = @_;
my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
my $tempdir;
if ($context eq 'DOCS') {
$tempdir = $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;
if (!-e "$tempdir") {
mkdir("$tempdir",0770);
}
$tempdir .= '/'.$timenow;
if (!-e "$tempdir") {
mkdir("$tempdir",0770);
}
} elsif ($context eq "CSTR") {
if (!-e "$pathinfo/temp") {
mkdir("$pathinfo/temp",0770);
}
$tempdir = $pathinfo.'/temp';
}
return $tempdir;
}
sub uploadzip {
my ($context,$tempdir,$source) = @_;
my $fname;
if ($context eq 'DOCS') {
$fname=$env{'form.uploadname.filename'};
# Replace Windows backslashes by forward slashes
$fname=~s/\\/\//g;
# Get rid of everything but the actual filename
$fname=~s/^.*\/([^\/]+)$/$1/;
# Replace spaces by underscores
$fname=~s/\s+/\_/g;
# Replace all other weird characters by nothing
$fname=~s/[^\w\.\-]//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);
print $fh $env{'form.uploadname'};
close($fh);
} elsif ($context eq 'CSTR') {
if ($source =~ m/\/([^\/]+)$/) {
$fname = $1;
my $destination = $tempdir.'/'.$fname;
rename($source,$destination);
}
}
return $fname;
}
sub expand_zip {
my ($tempdir,$filename) = @_;
my $zipfile = "$tempdir/$filename";
if (!-e "$zipfile") {
return 'no zip';
}
if ($filename =~ m|\.zip$|i) {
open(OUTPUT, "unzip -o $zipfile -d $tempdir 2> /dev/null |");
close(OUTPUT);
} else {
return 'nozip';
}
if ($filename =~ m|\.zip$|i) {
unlink($zipfile);
}
return 'ok';
}
sub process_manifest {
my ($cms,$tempdir,$resources,$items,$hrefs,$resinfo,$phase,$includedres,$includeditems) = @_;
my %toc = (
bb6 => 'organization',
bb5 => 'tableofcontents',
angel5 => 'organization',
webctce4 => 'organization',
webctvista4 => 'organization'
);
my @seq = "Top";
%{$$items{'Top'}} = (
contentscount => 0,
resnum => 'toplevel',
);
%{$$resources{'toplevel'}} = (
revitm => 'Top'
);
if ($cms eq 'angel5') {
$$resources{'toplevel'}{type} = "FOLDER";
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
$$resources{'toplevel'}{type} = 'resource/x-bb-document';
} else {
$$resources{'toplevel'}{type} = 'webcontent';
}
unless (-e "$tempdir/imsmanifest.xml") {
return 'nomanifest';
}
my $xmlfile = $tempdir.'/imsmanifest.xml';
&parse_manifest($cms,$phase,$tempdir,$xmlfile,\%toc,$includedres,
$includeditems,$items,$resources,$resinfo,$hrefs,\@seq);
return 'ok' ;
}
sub parse_manifest {
my ($cms,$phase,$tempdir,$xmlfile,$toc,$includedres,$includeditems,$items,
$resources,$resinfo,$hrefs,$seq) = @_;
my @state = ();
my $itm = '';
my %contents = ();
my $identifier = '';
my @allidentifiers = ();
my $lastitem;
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
my $start = @state - 3;
if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $$toc{$cms}) ) {
if ($state[-1] eq 'item') {
$itm = $attr->{identifier};
if ($$includeditems{$itm} || $phase ne 'build') {
%{$$items{$itm}} = ();
$$items{$itm}{contentscount} = 0;
@{$$items{$itm}{contents}} = ();
if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webctce4' || $cms eq 'webctvista4') {
$$items{$itm}{resnum} = $attr->{identifierref};
if ($cms eq 'bb5') {
$$items{$itm}{title} = $attr->{title};
}
} elsif ($cms eq 'angel5') {
if ($attr->{identifierref} =~ m/^res(.+)$/) {
$$items{$itm}{resnum} = $1;
}
}
unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {
%{$$resources{$$items{$itm}{resnum}}} = ();
}
$$resources{$$items{$itm}{resnum}}{revitm} = $itm;
if ($start > @{$seq}) {
unless ($lastitem eq '') {
push @{$seq}, $lastitem;
unless ( defined($contents{$$seq[-1]}) ) {
@{$contents{$$seq[-1]}} = ();
}
push @{$contents{$$seq[-1]}},$itm;
$$items{$itm}{parentseq} = $$seq[-1];
}
} elsif ($start < @{$seq}) {
my $diff = @{$seq} - $start;
while ($diff > 0) {
pop @{$seq};
$diff --;
}
if (@{$seq}) {
push @{$contents{$$seq[-1]}}, $itm;
}
} else {
push @{$contents{$$seq[-1]}}, $itm;
}
my $path;
if (@{$seq} > 1) {
$path = join(',',@{$seq});
} elsif (@{$seq} > 0) {
$path = $$seq[0];
}
$$items{$itm}{filepath} = $path;
if ($cms eq 'bb5' || $cms eq 'bb6') {
if ($$items{$itm}{filepath} eq 'Top') {
$$items{$itm}{resnum} = $itm;
$$resources{$$items{$itm}{resnum}}{type} = 'resource/x-bb-document';
$$resources{$$items{$itm}{resnum}}{revitm} = $itm;
$$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';
}
}
$$items{$$seq[-1]}{contentscount} ++;
$$resources{$$items{$itm}{resnum}}{seqref} = $seq;
$lastitem = $itm;
}
}
if ($cms eq 'webctce4') {
if (($state[-1] eq "webct:properties") && (@state > 4)) {
$$items{$itm}{properties} = $attr->{identifierref};
}
}
} elsif ("@state" eq "manifest resources resource" ) {
$identifier = $attr->{identifier};
push(@allidentifiers,$identifier);
if ($$includedres{$identifier} || $phase ne 'build') {
if ($cms eq 'bb5' || $cms eq 'bb6') {
$$resources{$identifier}{file} = $attr->{file};
$$resources{$identifier}{type} = $attr->{type};
} elsif ($cms eq 'webctce4') {
$$resources{$identifier}{type} = $attr->{type};
$$resources{$identifier}{file} = $attr->{href};
} elsif ($cms eq 'webctvista4') {
$$resources{$identifier}{type} = $attr->{type};
$$resources{$identifier}{'webct:coType'} = $attr->{'webct:coType'};
} elsif ($cms eq 'angel5') {
$identifier = substr($identifier,3);
if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
$$resources{$identifier}{file} = $1;
}
}
@{$$hrefs{$identifier}} = ();
}
} 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};
my $currseqref = [];
if ($itm) {
$currseqref =
$$resources{$$items{$itm}{resnum}}{seqref};
}
&parse_manifest($cms,$phase,$tempdir,$manifestfile,
$toc,$includedres,$includeditems,
$items,$resources,$resinfo,
$hrefs,$currseqref);
}
} 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) {
if ($$resources{$ident}{type} eq 'ims_qtiasiv1p2') {
$$resources{$ident}{type} = $attr->{'webct:coType'};
}
}
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "manifest metadata lom general title langstring") {
$$items{'Top'}{title} = $text;
}
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 'angel5' || $cms eq 'bb6' || $cms eq 'webctvista4') {
$$items{$itm}{title} = $text;
}
if ($cms eq 'webctce4') {
$$items{$itm}{title} = $text;
$$items{$itm}{title} =~ s/(<[^>]*>)//g;
}
}
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->parse_file($xmlfile);
$p->eof;
foreach my $itm (keys %contents) {
@{$$items{$itm}{contents}} = @{$contents{$itm}};
}
}
sub get_imports {
my ($includeditems,$items,$resources,$importareas,$itm) = @_;
if (exists($$items{$itm}{resnum})) {
if ($$importareas{$$resources{$$items{$itm}{resnum}}{type}}) {
unless (exists($$includeditems{$itm})) {
$$includeditems{$itm} = 1;
}
}
}
if ($$items{$itm}{contentscount} > 0) {
foreach my $child (@{$$items{$itm}{contents}}) {
&get_imports($includeditems,$items,$resources,$importareas,$child);
}
}
}
sub get_parents {
my ($includeditems,$items,$itm) = @_;
my @pathitems = ();
if ($$items{$itm}{filepath} =~ m/,/) {
@pathitems = split/,/,$$items{$itm}{filepath};
} else {
$pathitems[0] = $$items{$itm}{filepath};
}
foreach (@pathitems) {
$$includeditems{$_} = 1;
}
}
sub target_resources {
my ($resources,$oktypes,$targets) = @_;
foreach my $key (keys %{$resources}) {
if ( defined($$oktypes{$$resources{$key}{type}}) ) {
push @{$targets}, $key;
}
}
return;
}
sub copy_resources {
my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles,$total) = @_;
if ($context eq 'DOCS') {
foreach my $key (sort keys %{$hrefs}) {
if (grep/^$key$/,@{$targets}) {
%{$$url{$key}} = ();
foreach my $file (@{$$hrefs{$key}}) {
my $source = $tempdir.'/'.$key.'/'.$file;
if ($cms eq 'webctce4' || $cms eq 'webctvista4') {
$source = $tempdir.'/'.$file;
}
my $filename = '';
my $fpath = $timenow.'/resfiles/'.$key.'/';
if ($cms eq 'angel5') {
if ($file eq 'pg'.$key.'.htm') {
next;
}
}
$file =~ s-\\-/-g;
my $copyfile = $file;
if ($cms eq 'webctce4' || $cms eq 'webctvista4') {
if ($file =~ m-/my_files/(.+)$-) {
$copyfile = $1;
}
}
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;
if (-e $source) {
$fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$copyfile,$source);
}
}
}
}
}
} elsif ($context eq 'CSTR') {
if (!-e "$destdir/resfiles") {
mkdir("$destdir/resfiles",0770);
}
foreach my $key (sort keys %{$hrefs}) {
if (grep/^$key$/,@{$targets}) {
foreach my $file (@{$$hrefs{$key}}) {
$file =~ s-\\-/-g;
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);
}
my $filepath = $file;
my $front = '';
while ($filepath =~ m-(\w+)/(.+)-) {
$front .= $1.'/';
$filepath = $2;
my $fulldir = "$destdir/resfiles/$key/$front";
chop($fulldir);
if (!-e "$fulldir") {
mkdir("$fulldir",0770);
}
}
my $renameres;
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");
}
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/(.+)$-) {
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;
}
}
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: WebCT4 - renaming failed for file $file");
}
}
} elsif ($file !~ m-/data/(.+)$-) {
&Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
}
}
}
}
}
}
}
sub process_resinfo {
my ($cms,$context,$docroot,$destdir,$items,$resources,$targets,$boards,$announcements,$quizzes,$surveys,$pools,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles,$packages,$hrefs,$pagesfiles,$sequencesfiles,$randompicks) = @_;
my $board_id = time;
my $board_count = 0;
my $dbparse = 0;
my $announce_handling = 'include';
my $longcrs = '';
my %allassessments = ();
my %allquestions = ();
my %qzdbsettings = ();
my %catinfo = ();
if ($crs =~ m/^(\d)(\d)(\d)/) {
$longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
}
if ($context eq 'CSTR') {
if (!-e "$destdir/resfiles") {
mkdir("$destdir/resfiles",0770);
}
}
if ($cms eq 'angel5') {
my $currboard = '';
foreach my $key (sort keys %{$resources}) {
if (grep/^$key$/,@{$targets}) {
if ($$resources{$key}{type} eq "BOARD") {
push @{$boards}, $key;
$$boardnum{$$resources{$key}{revitm}} = $board_count;
$currboard = $key;
@{$$messages{$key}} = ();
$$timestamp[$board_count] = $board_id;
$board_id ++;
$board_count ++;
} elsif ($$resources{$key}{type} eq "MESSAGE") {
push @{$$messages{$currboard}}, $key;
} elsif ($$resources{$key}{type} eq "PAGE" || $$resources{$key}{type} eq "LINK") {
%{$$resinfo{$key}} = ();
&angel_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
} elsif ($$resources{$key}{type} eq "QUIZ") {
%{$$resinfo{$key}} = ();
push @{$quizzes}, $key;
# &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
} elsif ($$resources{$key}{type} eq "FORM") {
%{$$resinfo{$key}} = ();
push @{$surveys}, $key;
# &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
} elsif ($$resources{$key}{type} eq "DROPBOX") {
%{$$resinfo{$key}} = ();
}
}
}
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
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') {
%{$$resinfo{$key}} = ();
&process_content($cms,$key,$context,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$resrcfiles,$packages,$hrefs);
}
} elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") {
%{$$resinfo{$key}} = ();
&process_staff($key,$docroot,$destdir,\%{$$resinfo{$key}},$resrcfiles);
} elsif ($$resources{$key}{type} eq "resource/x-bb-externallink") {
%{$$resinfo{$key}} = ();
&process_link($key,$docroot,$destdir,\%{$$resinfo{$key}},$resrcfiles);
} elsif ($$resources{$key}{type} eq "resource/x-bb-discussionboard") {
%{$$resinfo{$key}} = ();
unless ($db_handling eq 'ignore') {
push @{$boards}, $key;
$$timestamp[$board_count] = $board_id;
&process_db($key,$docroot,$destdir,$board_id,$crs,$cdom,$db_handling,$uname,\%{$$resinfo{$key}},$longcrs);
$board_id ++;
$board_count ++;
}
} elsif ($$resources{$key}{type} =~/assessment\/x\-bb\-(qti\-)?pool/) {
%{$$resinfo{$key}} = ();
&process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
push @{$pools}, $key;
} elsif ($$resources{$key}{type} =~ /assessment\/x\-bb\-(qti\-)?quiz/) {
%{$$resinfo{$key}} = ();
&process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
push @{$quizzes}, $key;
} elsif ($$resources{$key}{type} =~ /assessment\/x\-bb\-(qti\-)?survey/) {
%{$$resinfo{$key}} = ();
&process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
push @{$surveys}, $key;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {
%{$$resinfo{$key}} = ();
push @{$groups}, $key;
&process_group($key,$docroot,$destdir,\%{$$resinfo{$key}});
} elsif ($$resources{$key}{type} eq "resource/x-bb-user") {
%{$$resinfo{$key}} = ();
unless ($user_handling eq 'ignore') {
&process_user($key,$docroot,$destdir,\%{$$resinfo{$key}},$crs,$cdom,$user_handling);
}
} elsif ($$resources{$key}{type} eq "resource/x-bb-announcement") {
unless ($announce_handling eq 'ignore') {
push @{$announcements}, $key;
%{$$resinfo{$key}} = ();
&process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$resinfo,$seqstem,$resrcfiles);
}
}
}
}
if (@{$announcements}) {
$$items{'Top'}{'contentscount'} ++;
}
if (@{$boards}) {
$$items{'Top'}{'contentscount'} ++;
}
if (@{$quizzes}) {
$$items{'Top'}{'contentscount'} ++;
}
if (@{$surveys}) {
$$items{'Top'}{'contentscount'} ++;
}
if (@{$pools}) {
$$items{'Top'}{'contentscount'} ++;
}
} elsif ($cms eq 'webctce4') {
foreach my $key (sort keys %{$resources}) {
if (grep/^$key$/,@{$targets}) {
if ($$resources{$key}{type} eq "webcontent") {
%{$$resinfo{$key}} = ();
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}) {
if (grep/^$key$/,@{$targets}) {
%{$$resinfo{$key}} = ();
if ($$resources{$key}{type} eq 'webct.question') {
$allquestions{$key} = 1;
} elsif ($$resources{$key}{type} eq 'webct.assessment') {
$allassessments{$key} = 1;
}
}
}
if (keys(%allassessments) > 0) {
foreach my $key (sort(keys(%allassessments))) {
&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 (keys(%allquestions) > 0) {
my %catinfo = ();
my @allids = ();
my @allquestids = ();
my %allanswers = ();
my %allchoices = ();
my $containerdir;
my $newdir;
my $cid;
my $randompickflag = 0;
if ($context eq 'DOCS') {
$cid = $env{'request.course.id'};
}
my $destresdir = $destdir;
if ($context eq 'CSTR') {
$destresdir =~ s|/home/$uname/public_html/|/res/$udom/$uname/|;
} elsif ($context eq 'DOCS') {
$destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
}
foreach my $res (sort(keys(%allquestions))) {
my $parent = $allquestions{$res};
&parse_webctvista4_question($res,$docroot,$resources,$hrefs,\%qzdbsettings,\@allquestids,\%allanswers,\%allchoices,$parent,\%catinfo);
}
&build_category_sequences($destdir,\%catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$crs,\%qzdbsettings);
&write_webct4_questions($cms,\@allquestids,$context,\%qzdbsettings,$dirname,\%allanswers,\%allchoices,$total,$cid,$cdom,$crs,$destdir,\%catinfo);
}
}
$$total{'board'} = $board_count;
$$total{'quiz'} = @{$quizzes};
$$total{'surv'} = @{$surveys};
$$total{'pool'} = @{$pools};
}
sub build_structure {
my ($cms,$context,$destdir,$items,$resinfo,$resources,$targets,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$pools,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames,$packages,$includeditems,$randompicks) = @_;
my %flag = ();
my %count = ();
my %pagecontents = ();
my %seqtext = ();
my $topnum = 0;
my $topspecials = @$announcements + @$boards + @$quizzes + @$surveys + @$pools;
if (!-e "$destdir") {
mkdir("$destdir",0755);
}
if (!-e "$destdir/sequences") {
mkdir("$destdir/sequences",0770);
}
if (!-e "$destdir/resfiles") {
mkdir("$destdir/resfiles",0770);
}
if (!-e "$destdir/pages") {
mkdir("$destdir/pages",0770);
}
if (!-e "$destdir/problems") {
mkdir("$destdir/problems",0770);
}
$seqtext{'Top'} = qq|<map>\n|;
%{$$resinfo{$$items{'Top'}{resnum}}} = (
isfolder => 'true',
);
my $srcstem = "";
if ($context eq 'DOCS') {
$srcstem = "/uploaded/$cdom/$crs/$timenow";
} elsif ($context eq 'CSTR') {
$srcstem = "/res/$udom/$uname/$newdir";
}
foreach my $key (sort keys %{$items}) {
if ($$includeditems{$key}) {
%{$flag{$key}} = (
page => 0,
seq => 0,
board => 0,
file => 0,
);
%{$count{$key}} = (
page => -1,
seq => 0,
board => 0,
file => 0,
);
my $src = "";
my $next_id = 2;
my $curr_id = 1;
my $resnum = $$items{$key}{resnum};
my $type = $$resources{$resnum}{type};
my $contentscount = $$items{$key}{'contentscount'};
my $seqtitle = $$items{$key}{'title'};
$seqtitle =~ s|/+|_|g;
$seqtitle =~ s/\s+/_/g;
$seqtitle .= '_'.$key;
if (($cms eq 'angel5' && $type eq "FOLDER") || (($cms eq 'bb5' || $cms eq 'bb6') && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") || ($type eq "resource/x-bb-staffinfo") || ($type eq "resource/x-bb-externallink")) || ($cms eq 'webctce4' && $contentscount > 0)) {
unless (($cms eq 'bb5') && $key eq 'Top') {
$seqtext{$key} = "<map>\n";
}
if ($contentscount == 0) {
if ($key eq 'Top') {
unless ($topspecials) {
$seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>
<link from="$curr_id" to="$next_id" index="$curr_id"></link>
<resource id="$next_id" src="" type="finish"></resource>\n|;
}
} else {
$seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>
<link from="$curr_id" to="$next_id" index="$curr_id"></link>
<resource id="$next_id" src="" type="finish"></resource>\n|;
}
} else {
my $contcount = 0;
if (defined($$items{$key}{contents})) {
$contcount = @{$$items{$key}{contents}};
} else {
&Apache::lonnet::logthis("IMS Import error for item: $key- contents count = $contentscount, but identity of contents not defined.");
}
my $contitem = $$items{$key}{contents}[0];
my $contitemcount = $$items{$contitem}{contentscount};
my ($res,$itm,$type,$file);
if (exists($$items{$contitem}{resnum})) {
$res = $$items{$contitem}{resnum};
$itm = $$resources{$res}{revitm};
$type = $$resources{$res}{type};
$file = $$resources{$res}{file};
}
my $title = $$items{$contitem}{title};
my $packageflag = 0;
if (grep/^$res$/,@{$packages}) {
$packageflag = 1;
}
$src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
unless ($flag{$key}{page} == 1) {
if ($$randompicks{$contitem}) {
$seqtext{$key} .= qq|
<param to="$curr_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>\n|;
}
$seqtext{$key} .= qq|<resource id="$curr_id" src="$src" title="$title" type="start"|;
unless ($flag{$key}{seq} || $flag{$key}{board} || $flag{$key}{file}) {
$flag{$key}{page} = 1;
}
if ($key eq 'Top') {
push @{$topurls}, $src;
push @{$topnames}, $title;
}
}
if ($contcount == 1) {
$seqtext{$key} .= qq|></resource>
<link from="$curr_id" to="$next_id" index="$curr_id"></link>|;
if ($key eq 'Top') {
unless ($topspecials) {
$seqtext{$key} .= qq|
<resource id="$next_id" src="" type="finish"></resource>\n|;
}
} else {
$seqtext{$key} .= qq|
<resource id="$next_id" src="" type="finish"></resource>\n|;
}
} else {
if ($contcount > 2 ) {
for (my $i=1; $i<$contcount-1; $i++) {
my $contitem = $$items{$key}{contents}[$i];
my $contitemcount = $$items{$contitem}{contentscount};
my $res = $$items{$contitem}{resnum};
my $type = $$resources{$res}{type};
my $file = $$resources{$res}{file};
my $title = $$items{$contitem}{title};
my $packageflag = 0;
if (grep/^$res$/,@{$packages}) {
$packageflag = 1;
}
$src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
unless ($flag{$key}{page} == 1) {
$seqtext{$key} .= qq|></resource>
<link from="$curr_id" to="$next_id" index="$curr_id"></link>\n|;
if ($$randompicks{$contitem}) {
$seqtext{$key} .= qq|
<param to="$next_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>|;
}
$seqtext{$key} .= qq|
<resource id="$next_id" src="$src" title="$title"|;
$curr_id ++;
$next_id ++;
unless ($flag{$key}{seq} || $flag{$key}{board} || $flag{$key}{file}) {
$flag{$key}{page} = 1;
}
if ($key eq 'Top') {
push @{$topurls}, $src;
push @{$topnames}, $title;
}
}
}
}
my $contitem = $$items{$key}{contents}[-1];
my $contitemcount = $$items{$contitem}{contentscount};
my $res = $$items{$contitem}{resnum};
my $type = $$resources{$res}{type};
my $file = $$resources{$res}{file};
my $title = $$items{$contitem}{title};
my $packageflag = 0;
if (grep/^$res$/,@{$packages}) {
$packageflag = 1;
}
$src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
if ($flag{$key}{page}) {
if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {
$seqtext{$key} .= qq|></resource>
<link from="$curr_id" index="$curr_id" to="$next_id">
<resource id ="$next_id" src="" |;
}
} else {
$seqtext{$key} .= qq|></resource>
<link from="$curr_id" to="$next_id" index="$curr_id"></link>\n|;
if ($$randompicks{$contitem}) {
$seqtext{$key} .= qq|
<param to="$next_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>\n|;
}
$seqtext{$key} .= qq|
<resource id="$next_id" src="$src" title="$title" |;
if ($key eq 'Top') {
push @{$topurls}, $src;
push @{$topnames}, $title;
}
}
if ($contcount == $$items{$key}{contentscount}) {
$seqtext{$key} .= qq|type="finish"></resource>\n|;
} else {
$curr_id ++;
$next_id ++;
$seqtext{$key} .= qq|></resource>
<link from="$curr_id" to="$next_id" index="$curr_id"></link>\n|;
}
}
}
unless (($cms eq 'bb5') && $key eq 'Top') {
$seqtext{$key} .= "</map>\n";
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);
}
$count{$key}{page} ++;
$$total{page} += $count{$key}{page};
}
$$total{seq} += $count{$key}{seq};
}
}
$topnum += ($count{'Top'}{page} + $count{'Top'}{seq});
if ($cms eq 'bb5' || $cms eq 'bb6') {
if (@{$announcements} > 0) {
&process_specials($context,'announcements',$announcements,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
}
if (@{$boards} > 0) {
&process_specials($context,'boards',$boards,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
}
if (@{$quizzes} > 0) {
&process_specials($context,'quizzes',$quizzes,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
}
if (@{$surveys} > 0) {
&process_specials($context,'surveys',$surveys,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
}
if (@{$pools} > 0) {
&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'} .= "</map>\n";
open(TOPFILE,">$destdir/sequences/Top.sequence");
print TOPFILE $seqtext{'Top'};
close(TOPFILE);
push @{$seqfiles}, 'Top.sequence';
}
my $filestem;
if ($context eq 'DOCS') {
$filestem = "/uploaded/$cdom/$crs/$timenow";
} elsif ($context eq 'CSTR') {
$filestem = "/res/$udom/$uname/$newdir";
}
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";
my $res = $$items{$pagecontents{$key}[$i][0]}{resnum};
my $resource = $filestem.'/resfiles/'.$res.'.html';
if (grep/^$res$/,@{$packages}) {
$resource = $filestem.'/resfiles/'.$res.'./index.html'; # should be entry_point
}
open(PAGEFILE,">$filename");
print PAGEFILE qq|<map>
<resource src="$resource" id="1" type="start" title="$$items{$pagecontents{$key}[$i][0]}{title}"></resource>
<link to="2" index="1" from="1">\n|;
if (@{$pagecontents{$key}[$i]} == 1) {
print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>\n|;
} elsif (@{$pagecontents{$key}[$i]} == 2) {
my $res = $$items{$pagecontents{$key}[$i][1]}{resnum};
my $resource = $filestem.'/resfiles/'.$res.'.html';
if (grep/^$res$/,@{$packages}) {
$resource = $filestem.'/resfiles/'.$res.'./index.html'; # should be entry_point
}
print PAGEFILE qq|<resource src="$resource" id="2" type="finish" title="$$items{$pagecontents{$key}[$i][1]}{title}"></resource>\n|;
} else {
for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {
my $curr_id = $j+1;
my $next_id = $j+2;
my $res = $$items{$pagecontents{$key}[$i][$j]}{resnum};
my $resource = $filestem.'/resfiles/'.$res.'.html';
if (grep/^$res$/,@{$packages}) {
$resource = $filestem.'/resfiles/'.$res.'./index.html'; # entry_point
}
print PAGEFILE qq|<resource src="$resource" id="$curr_id" title="$$items{$pagecontents{$key}[$i][$j]}{title}"></resource>
<link to="$next_id" index="$curr_id" from="$curr_id">\n|;
}
my $final_id = @{$pagecontents{$key}[$i]};
my $res = $$items{$pagecontents{$key}[$i][-1]}{resnum};
my $resource = $filestem.'/resfiles/'.$res.'.html';
if (grep/^$res$/,@{$packages}) {
$resource = $filestem.'/resfiles/'.$res.'./index.html'; # entry_point
}
print PAGEFILE qq|<resource src="$resource" id="$final_id" type="finish" title="$$items{$pagecontents{$key}[$i][-1]}{title}"></resource>\n|;
}
print PAGEFILE "</map>";
close(PAGEFILE);
push @{$pagesfiles}, $key.'_'.$i.'.page';
}
}
}
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 '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} ++;
} elsif ($cms eq 'webctce4' && $randompick) {
$src = $srcstem.'/sequences/'.$res.'.sequence';
$$flag{$key}{page} = 0;
$$flag{$key}{seq} = 1;
$$count{$key}{seq} ++;
} 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 'angel5' && $type eq "FILE") {
foreach my $file (@{$$hrefs{$res}}) {
unless ($file eq 'pg'.$res.'.htm') {
$src = $srcstem.'/resfiles/'.$res.'/'.$file;
}
}
$$flag{$key}{page} = 0;
$$flag{$key}{file} = 1;
} 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.");
} else {
push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
}
} else {
$$count{$key}{page} ++;
$src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page';
@{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");
$$flag{$key}{seq} = 0;
}
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
if ($$flag{$key}{page}) {
push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
} else {
if ($contcount == 1) {
if ($packageflag) {
$src = $srcstem.'/resfiles/'.$res.'/index.html'; # Needs to be entry point
} else {
$src = $srcstem.'/resfiles/'.$res.'.html';
}
} else {
$$count{$key}{page} ++;
$src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page';
@{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");
}
$$flag{$key}{seq} = 0;
}
} elsif ($cms eq 'webctce4') {
if ($type eq 'webctquiz') {
$src = $srcstem.'/pages/'.$res.'.page';
$$count{$key}{page} ++;
$$flag{$key}{seq} = 0;
} else {
if (grep/^$file$/,@{$$hrefs{$res}}) {
my $filename;
if ($file =~ m-/([^/]+)$-) {
$filename = $1;
}
$src = $srcstem.'/resfiles/'.$filename;
} else {
foreach my $file (@{$$hrefs{$res}}) {
my $filename;
if ($file =~ m-/my_files/(.+)$-) {
$filename = $1;
} elsif ($file =~ m-/([^/]+)$-) {
$filename = $1;
}
$src = $srcstem.'/resfiles/'.$filename;
}
}
$$flag{$key}{page} = 0;
$$flag{$key}{file} = 1;
}
}
return $src;
}
# ---------------------------------------------------------------- Process Blackboard specials - announcements, bulletin boards, quizzes and surveys
sub process_specials {
my ($context,$type,$specials,$topnum,$contentscount,$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,$seqtext,$pagesfiles,$seqfiles,$topurls,$topnames) = @_;
my $src = '';
my $specialsrc = '';
my $nextnum = 0;
my $seqstem = '';
if ($context eq 'CSTR') {
$seqstem = "/res/$udom/$uname/$newdir";
} elsif ($context eq 'DOCS') {
$seqstem = '/uploaded/'.$cdom.'/'.$crs.'/'.$timenow;
}
my %seqnames = (
boards => 'bulletinboards',
quizzes => 'quizzes',
surveys => 'surveys',
announcements => 'announcements',
pools => 'pools'
);
my %seqtitles = (
boards => 'Course Discussion Boards',
quizzes => 'Course Quizzes',
surveys => 'Course Surveys',
announcements => 'Course Announcements',
pools => 'Course Question Pools'
);
$$topnum ++;
if ($type eq 'announcements') {
$src = "$seqstem/pages/$seqnames{$type}.page";
} else {
$src = "$seqstem/sequences/$seqnames{$type}.sequence";
}
push @{$topurls}, $src;
push @{$topnames}, $seqtitles{$type};
$$seqtext .= qq|<resource id="$$topnum" src="$src" title="$seqtitles{$type}"|;
$nextnum = $$topnum +1;
if ($$topnum == 1) {
$$seqtext .= qq| type="start"></resource>
<link from="$$topnum" to="$nextnum" index="$$topnum"></link>\n|;
if ($$topnum == $contentscount) {
$$seqtext .= qq|<resource id="$nextnum" src="" type="finish"></resource>\n|;
}
} else {
if ($$topnum == $contentscount) {
$$seqtext .= qq| type="finish"></resource>\n|;
} else {
$$seqtext .= qq|></resource>
<link from="$$topnum" to="$nextnum" index="$$topnum"></link>\n|;
}
}
if ($type eq "announcements") {
push @{$pagesfiles}, "$seqnames{$type}.page";
open(ITEM,">$destdir/pages/$seqnames{$type}.page");
} else {
push @{$seqfiles}, "$seqnames{$type}.sequence";
open(ITEM,">$destdir/sequences/$seqnames{$type}.sequence");
}
if ($type eq 'boards') {
$specialsrc = "/adm/$udom/$uname/$$timestamp[0]/bulletinboard";
} elsif ($type eq 'announcements') {
$specialsrc = "$seqstem/resfiles/$$specials[0].html";
} elsif ($type eq 'pools') {
$specialsrc = "$seqstem/sequences/$$specials[0].sequence";
} else {
$specialsrc = "$seqstem/pages/$$specials[0].page";
}
print ITEM qq|<map>
<resource id="1" src="$specialsrc" title="$$resinfo{$$specials[0]}{title}" type="start"></resource>
<link from="1" to="2" index="1"></link>|;
if (@{$specials} == 1) {
print ITEM qq|
<resource id="2" src="" type="finish"></resource>\n|;
} else {
for (my $i=1; $i<@{$specials}; $i++) {
my $curr = $i+1;
my $next = $i+2;
if ($type eq 'boards') {
$specialsrc = "/adm/$udom/$uname/$$timestamp[$i]/bulletinboard";
} elsif ($type eq 'announcements') {
$specialsrc = "$seqstem/resfiles/$$specials[$i].html";
} else {
$specialsrc = "$seqstem/pages/$$specials[$i].page";
}
print ITEM qq|<resource id="$curr" src="$specialsrc" title="$$resinfo{$$specials[$i]}{title}"|;
if (@{$specials} == $i+1) {
print ITEM qq| type="finish"></resource>\n|;
} else {
print ITEM qq|></resource>
<link from="$curr" to="$next" index="$next">\n|;
}
}
}
print ITEM qq|</map>|;
close(ITEM);
}
# ---------------------------------------------------------------- Process Blackboard users
sub process_user {
my ($res,$docroot,$destdir,$settings,$user_crs,$user_cdom,$user_handling) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my $filecount = 0;
my @state;
my $userid = '';
my $linknum = 0;
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
if ("@state" eq "USERS USER") {
$userid = $attr->{value};
%{$$settings{$userid}} = ();
@{$$settings{$userid}{links}} = ();
} elsif ("@state" eq "USERS USER LOGINID") {
$$settings{$userid}{loginid} = $attr->{value};
} elsif ("@state" eq "USERS USER PASSPHRASE") {
$$settings{$userid}{passphrase} = $attr->{value};
} elsif ("@state" eq "USERS USER STUDENTID" ) {
$$settings{$userid}{studentid} = $attr->{value};
} elsif ("@state" eq "USERS USER NAMES FAMILY" ) {
$$settings{$userid}{family} = $attr->{value};
} elsif ("@state" eq "USERS USER NAMES GIVEN" ) {
$$settings{$userid}{given} = $attr->{value};
} elsif ("@state" eq "USERS USER ADDRESSES BUSINESS DATA EMAIL") {
$$settings{$userid}{email} = $attr->{value};
} elsif ("@state" eq "USERS USER USER_ROLE") {
$$settings{$userid}{user_role} = $attr->{value};
} elsif ("@state" eq "USERS USER FLAGS ISAVAILABLE") {
$$settings{$userid}{isavailable} = $attr->{value};
} elsif ("@state" eq "USERS USER PERSONALPAGE FILELIST IMAGE") {
$$settings{$userid}{image} = $attr->{value};
} elsif ( ($state[-2] eq "LINKLIST") && ($state[-1] eq "LINK") ) {
%{$$settings{$userid}{links}[$linknum]} = ();
$$settings{$userid}{links}[$linknum]{url} = $attr->{value};
$linknum ++;
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "USERS USER PERSONALPAGE TITLE") {
$$settings{$userid}{title} = $text;
} elsif ("@state" eq "USERS USER PERSONALPAGE DESCRIPTION") {
$$settings{$userid}{description} = $text;
} elsif (($state[-2] eq "LINK") && ($state[-1] eq "TITLE")) {
$$settings{$userid}{links}[$linknum]{title} = $text;
} elsif (($state[-3] eq "LINK") && ($state[-2] eq "DESCRIPTION") && ($state[-1] eq "TEXT")) {
$$settings{$userid}{links}[$linknum]{text} = $text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
if ("@state" eq "USERS USER") {
$linknum = 0;
}
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
my $xmlstem = $$configvars{'lonDaemons'}."/tmp/".$user_cdom."_".$user_crs."_";
foreach my $user_id (keys %{$settings}) {
if ($$settings{$user_id}{user_role} eq "s") {
} elsif ($user_handling eq 'enrollall') {
}
}
}
# ---------------------------------------------------------------- Process Blackboard groups
sub process_group {
my ($res,$docroot,$destdir,$settings) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my $filecount = 0;
my @state;
my $grp;
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
if ("@state" eq "GROUPS GROUP") {
$grp = $attr->{id};
}
if ("@state" eq "GROUPS GROUP TITLE") {
$$settings{$grp}{title} = $attr->{value};
} elsif ("@state" eq "GROUPS GROUP FLAGS ISAVAILABLE") {
$$settings{$grp}{isavailable} = $attr->{value};
} elsif ("@state" eq "GROUPS GROUP FLAGS HASCHATROOM") {
$$settings{$grp}{chat} = $attr->{value};
} elsif ("@state" eq "GROUPS GROUP FLAGS HASDISCUSSIONBOARD") {
$$settings{$grp}{discussion} = $attr->{value};
} elsif ("@state" eq "GROUPS GROUP FLAGS HASTRANSFERAREA") {
$$settings{$grp}{transfer} = $attr->{value};
} elsif ("@state" eq "GROUPS GROUP FLAGS ISPUBLIC") {
$$settings{$grp}{public} = $attr->{value};
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "GROUPS DESCRIPTION") {
$$settings{$grp}{description} = $text;
# print "Staff text is $text\n";
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
}
# ---------------------------------------------------------------- Process Blackboard Staff
sub process_staff {
my ($res,$docroot,$destdir,$settings,$resrcfiles) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my $filecount = 0;
my @state;
%{$$settings{name}} = ();
%{$$settings{office}} = ();
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
if ("@state" eq "STAFFINFO TITLE") {
$$settings{title} = $attr->{value};
} elsif ("@state" eq "STAFFINFO BIOGRAPHY TEXTCOLOR") {
$$settings{textcolor} = $attr->{value};
} elsif ("@state" eq "STAFFINFO BIOGRAPHY FLAGS ISHTML") {
$$settings{ishtml} = $attr->{value};
} elsif ("@state" eq "STAFFINFO FLAGS ISAVAILABLE" ) {
$$settings{isavailable} = $attr->{value};
} elsif ("@state" eq "STAFFINFO FLAGS ISFOLDER" ) {
$$settings{isfolder} = $attr->{value};
} elsif ("@state" eq "STAFFINFO POSITION" ) {
$$settings{position} = $attr->{value};
} elsif ("@state" eq "STAFFINFO HOMEPAGE" ) {
$$settings{homepage} = $attr->{value};
} elsif ("@state" eq "STAFFINFO IMAGE") {
$$settings{image} = $attr->{value};
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "STAFFINFO BIOGRAPHY TEXT") {
$$settings{text} = $text;
# print "Staff text is $text\n";
} elsif ("@state" eq "STAFFINFO CONTACT PHONE") {
$$settings{phone} = $text;
} elsif ("@state" eq "STAFFINFO CONTACT EMAIL") {
$$settings{email} = $text;
} elsif ("@state" eq "STAFFINFO CONTACT NAME FORMALTITLE") {
$$settings{name}{formaltitle} = $text;
} elsif ("@state" eq "STAFFINFO CONTACT NAME FAMILY") {
$$settings{name}{family} = $text;
} elsif ("@state" eq "STAFFINFO CONTACT NAME GIVEN") {
$$settings{name}{given} = $text;
} elsif ("@state" eq "STAFFINFO CONTACT OFFICE HOURS") {
$$settings{office}{hours} = $text;
} elsif ("@state" eq "STAFFINFO CONTACT OFFICE ADDRESS") {
$$settings{office}{address} = $text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
my $fontcol = '';
if (defined($$settings{textcolor})) {
$fontcol = qq|color="$$settings{textcolor}"|;
}
if (defined($$settings{text})) {
if ($$settings{ishtml} eq "true") {
$$settings{text} = &HTML::Entities::decode($$settings{text});
}
}
my $staffentry = qq|
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td colspan="2"><hr /><font face="arial,helv" size="3"><b>$$settings{name}{formaltitle} $$settings{name}{given} $$settings{name}{family}</b></font>
</td>
</tr>
<tr>
<td valign="top">
<table width="100% border="0" cols="2" cellpadding="0" cellspacing="0">|;
if ( defined($$settings{email}) && $$settings{email} ne '') {
$staffentry .= qq|
<tr>
<td width="100" valign="top">
<font face="arial" size="2"><b>Email:</b></font>
</td>
<td>
<font face="arial" size="2"><a href="mailto:$$settings{email}">$$settings{email}</a></font>
</td>
</tr>
|;
}
if (defined($$settings{phone}) && $$settings{phone} ne '') {
$staffentry .= qq|
<tr>
<td width="100" valign="top">
<font face="arial" size="2"><b>Phone:</b></font>
</td>
<td>
<font face="arial" size="2">$$settings{phone}</font>
</td>
</tr>
|;
}
if (defined($$settings{office}{address}) && $$settings{office}{address} ne '') {
$staffentry .= qq|
<tr>
<td width="100" valign="top">
<font face="arial" size="2"><b>Address:</b></font>
</td>
<td>
<font face="arial" size="2">$$settings{office}{address}</font>
</td>
</tr>
|;
}
if (defined($$settings{office}{hours}) && $$settings{office}{hours} ne '') {
$staffentry .= qq|
<tr>
<td width="100" valign="top">
<font face="arial" size="2"><b>Office Hours:</b></font>
</td>
<td>
<font face="arial" size="2">$$settings{office}{hours}</font>
</td>
</tr>
|;
}
if ( defined($$settings{homepage}) && $$settings{homepage} ne '') {
$staffentry .= qq|
<tr>
<td width="100" valign="top">
<font face="arial" size="2"><b>Personal Link:</b></font>
</td>
<td>
<font face="arial" size="2"><a href="$$settings{homepage}">$$settings{homepage}</a></font>
</td>
</tr>
|;
}
if (defined($$settings{text}) && $$settings{text} ne '') {
$staffentry .= qq|
<tr>
<td colspan="2">
<font face="arial" size="2" $fontcol><b>Other Information:</b><br/>$$settings{text}</font>
</td>
</tr>
|;
}
$staffentry .= qq|
</table>
</td>
<td align="right" valign="top">
|;
if ( defined($$settings{image}) ) {
$staffentry .= qq|
<img src="$res/$$settings{image}">
|;
}
$staffentry .= qq|
</td>
</tr>
</table>
|;
open(FILE,">$destdir/resfiles/$res.html");
push @{$resrcfiles}, "$res.html";
print FILE qq|<html>
<head>
<title>$$settings{title}</title>
</head>
<body bgcolor='#ffffff'>
$staffentry
</body>
</html>|;
close(FILE);
}
# ---------------------------------------------------------------- Process Blackboard Links
sub process_link {
my ($res,$docroot,$destdir,$settings,$resrcfiles) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my @state = ();
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
if ("@state" eq "EXTERNALLINK TITLE") {
$$settings{title} = $attr->{value};
} elsif ("@state" eq "EXTERNALLINK TEXTCOLOR") {
$$settings{textcolor} = $attr->{value};
} elsif ("@state" eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {
$$settings{ishtml} = $attr->{value};
} elsif ("@state" eq "EXTERNALLINK FLAGS ISAVAILABLE" ) {
$$settings{isavailable} = $attr->{value};
} elsif ("@state" eq "EXTERNALLINK FLAGS LAUNCHINNEWWINDOW" ) {
$$settings{newwindow} = $attr->{value};
} elsif ("@state" eq "EXTERNALLINK FLAGS ISFOLDER" ) {
$$settings{isfolder} = $attr->{value};
} elsif ("@state" eq "EXTERNALLINK POSITION" ) {
$$settings{position} = $attr->{value};
} elsif ("@state" eq "EXTERNALLINK URL" ) {
$$settings{url} = $attr->{value};
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "EXTERNALLINK DESCRIPTION TEXT") {
$$settings{text} = $text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
my $linktag = '';
my $fontcol = '';
if (defined($$settings{textcolor})) {
$fontcol = qq|<font color="$$settings{textcolor}">|;
}
if (defined($$settings{text})) {
if ($$settings{ishtml} eq "true") {
$$settings{text} = &HTML::Entities::decode($$settings{text});
}
}
if (defined($$settings{url}) ) {
$linktag = qq|<a href="$$settings{url}"|;
if ($$settings{newwindow} eq "true") {
$linktag .= qq| target="launch"|;
}
$linktag .= qq|>$$settings{title}</a>|;
}
open(FILE,">$destdir/resfiles/$res.html");
push @{$resrcfiles}, "$res.html";
print FILE qq|<html>
<head>
<title>$$settings{title}</title>
</head>
<body bgcolor='#ffffff'>
$fontcol
$linktag
$$settings{text}
|;
if (defined($$settings{textcolor})) {
print FILE qq|</font>|;
}
print FILE qq|
</body>
</html>|;
close(FILE);
}
# ---------------------------------------------------------------- Process Blackboard Discussion Boards
sub process_db {
my ($res,$docroot,$destdir,$timestamp,$crs,$cdom,$handling,$uname,$settings,$longcrs) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my @state = ();
my @allmsgs = ();
my %msgidx = ();
my %threads; # all threads, keyed by message ID
my $msg_id; # the current message ID
my %message; # the current message being accumulated for $msg_id
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
my $depth = 0;
my @seq = ();
if ("@state" eq "FORUM TITLE") {
$$settings{title} = $attr->{value};
} elsif ("@state" eq "FORUM DESCRIPTION TEXTCOLOR") {
$$settings{textcolor} = $attr->{value};
} elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISHTML") {
$$settings{ishtml} = $attr->{value};
} elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISNEWLINELITERAL") {
$$settings{newline} = $attr->{value};
} elsif ("@state" eq "FORUM POSITION" ) {
$$settings{position} = $attr->{value};
} elsif ("@state" eq "FORUM FLAGS ISREADONLY") {
$$settings{isreadonly} = $attr->{value};
} elsif ("@state" eq "FORUM FLAGS ISAVAILABLE" ) {
$$settings{isavailable} = $attr->{value};
} elsif ("@state" eq "FORUM FLAGS ALLOWANONYMOUSPOSTINGS" ) {
$$settings{allowanon} = $attr->{value};
} elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
if ($state[-1] eq "MSG") {
unless ($msg_id eq '') {
push @{$threads{$msg_id}}, { %message };
$depth = @state - 3;
if ($depth > @seq) {
push @seq, $msg_id;
}
}
if ($depth < @seq) {
pop @seq;
}
$msg_id = $attr->{id};
push @allmsgs, $msg_id;
$msgidx{$msg_id} = @allmsgs;
%message = ();
$message{depth} = $depth;
if ($depth > 0) {
$message{parent} = $seq[-1];
} else {
$message{parent} = "None";
}
} elsif ($state[-1] eq "TITLE") {
$message{title} = $attr->{value};
} elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISHTML" ) ) {
$message{ishtml} = $attr->{value};
} elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISNEWLINELITERAL" ) ) {
$message{newline} = $attr->{value};
} elsif ( ( $state[-2] eq "DATES" ) && ( $state[-1] eq "CREATED" ) ) {
$message{created} = $attr->{value};
} elsif ( $state[@state-2] eq "FLAGS") {
if ($state[@state-1] eq "ISANONYMOUS") {
$message{isanonymous} = $attr->{value};
}
} elsif ( $state[-2] eq "USER" ) {
if ($state[-1] eq "USERID") {
$message{userid} = $attr->{value};
} elsif ($state[@state-1] eq "USERNAME") {
$message{username} = $attr->{value};
} elsif ($state[@state-1] eq "EMAIL") {
$message{email} = $attr->{value};
}
} elsif ( ($state[-2] eq "FILELIST") && ($state[-1] eq "IMAGE") ) {
$message{attachment} = $attr->{value};
}
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "FORUM DESCRIPTION TEXT") {
$$settings{text} = $text;
} elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
if ( ($state[-2] eq "MESSAGETEXT") && ($state[-1] eq "TEXT") ){
$message{text} = $text;
}
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
if ( $state[-1] eq "MESSAGETHREADS" ) {
push @{$threads{$msg_id}}, { %message };
}
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
if (defined($$settings{text})) {
if ($$settings{ishtml} eq "false") {
if ($$settings{isnewline} eq "true") {
$$settings{text} =~ s#\n#<br/>#g;
}
} else {
$$settings{text} = &HTML::Entities::decode($$settings{text});
}
if (defined($$settings{fontcolor}) ) {
$$settings{text} = "<font color=\"".$$settings{textcolor}."\">".$$settings{text}."</font>";
}
}
my $boardname = 'bulletinpage_'.$timestamp;
my %boardinfo = (
'aaa_title' => $$settings{title},
'bbb_content' => $$settings{text},
'ccc_webreferences' => '',
'uploaded.lastmodified' => time,
);
my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);
if ($handling eq 'importall') {
foreach my $msg_id (@allmsgs) {
foreach my $message ( @{$threads{$msg_id}} ) {
my %contrib = (
'sendername' => $$message{userid},
'senderdomain' => $cdom,
'screenname' => '',
'plainname' => $$message{username},
);
unless ($$message{parent} eq 'None') {
$contrib{replyto} = $msgidx{$$message{parent}};
}
if (defined($$message{isanonymous}) ) {
if ($$message{isanonymous} eq 'true') {
$contrib{'anonymous'} = 'true';
}
}
if ( defined($$message{attachment}) ) {
my $url = $$message{attachment};
my $oldurl = $url;
my $newurl = $url;
unless ($url eq '') {
$newurl =~ s/\//_/g;
unless ($longcrs eq '') {
if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles") {
mkdir("/home/httpd/lonUsers/$cdom/$longcrs/userfiles",0755);
}
if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl") {
system("cp $destdir/resfiles/$res/$$message{attachment} /home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl");
}
$contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$newurl;
}
}
}
if (defined($$message{title}) ) {
$contrib{'message'} = $$message{title};
}
if (defined($$message{text})) {
if ($$message{ishtml} eq "false") {
if ($$message{isnewline} eq "true") {
$$message{text} =~ s#\n#<br/>#g;
}
} else {
$$message{text} = &HTML::Entities::decode($$message{text});
}
$contrib{'message'} .= '<br /><br />'.$$message{text};
my $symb = 'bulletin___'.$timestamp.'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$timestamp.'/bulletinboard';
my $postresult = &addposting($symb,\%contrib,$cdom,$crs);
}
}
}
}
}
# ---------------------------------------------------------------- Add Posting to Discussion Board
sub addposting {
my ($symb,$contrib,$cdom,$crs)=@_;
my $status='';
if (($symb) && ($$contrib{message})) {
my $crsdom = $cdom.'_'.$crs;
&Apache::lonnet::store($contrib,$symb,$crsdom,$cdom,$crs);
my %storenewentry=($symb => time);
&Apache::lonnet::put('discussiontimes',\%storenewentry,$cdom,$crs);
}
my %record=&Apache::lonnet::restore('_discussion');
my ($temp)=keys %record;
unless ($temp=~/^error\:/) {
my %newrecord=();
$newrecord{'resource'}=$symb;
$newrecord{'subnumber'}=$record{'subnumber'}+1;
&Apache::lonnet::cstore(\%newrecord,'_discussion');
$status = 'ok';
} else {
$status.='Failed.';
}
return $status;
}
sub parse_bb5_assessment {
my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my @state = ();
my $id; # the current question ID
my $answer_id; # the current answer ID
my %toptag = ( pool => 'POOL',
quiz => 'ASSESSMENT',
survey => 'ASSESSMENT'
);
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
my $depth = 0;
my @seq = ();
my $class;
my $state_str = join(" ",@state);
if ($container eq "pool") {
if ("@state" eq "POOL TITLE") {
$$settings{title} = $attr->{value};
}
} else {
if ("@state" eq "ASSESSMENT TITLE") {
$$settings{title} = $attr->{value};
} elsif ("@state" eq "ASSESSMENT FLAG" ) {
$$settings{isnewline} = $attr->{value};
} elsif ("@state" eq "ASSESSMENT FLAGS ISAVAILABLE") {
$$settings{isavailable} = $attr->{value};
} elsif ("@state" eq "ASSESSMENT FLAGS ISANONYMOUS" ) {
$$settings{isanonymous} = $attr->{id};
} elsif ("@state" eq "ASSESSMENT FLAGS GIVE FEEDBACK" ) {
$$settings{feedback} = $attr->{id};
} elsif ("@state" eq "ASSESSMENT FLAGS SHOWCORRECT" ) {
$$settings{showcorrect} = $attr->{id};
} elsif ("@state" eq "ASSESSMENT FLAGS SHOWRESULTS" ) {
$$settings{showresults} = $attr->{id};
} elsif ("@state" eq "ASSESSMENT FLAGS ALLOWMULTIPLE" ) {
$$settings{allowmultiple} = $attr->{id};
} elsif ("@state" eq "ASSESSMENT ASSESSMENTTYPE" ) {
$$settings{type} = $attr->{id};
}
}
if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {
$id = $attr->{id};
push @{$allids}, $id;
%{$$settings{$id}} = ();
@{$$allanswers{$id}} = ();
$$settings{$id}{class} = $attr->{class};
unless ($container eq "pool") {
$$settings{$id}{points} = $attr->{points};
}
@{$$settings{$id}{correctanswer}} = ();
} elsif ( ($state[0] eq $toptag{$container}) && ($state[-1] =~ m/^QUESTION_(\w+)$/) ) {
$id = $attr->{id};
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") ) {
if ($state[4] eq "ISHTML") {
$$settings{$id}{ishtml} = $attr->{value};
} elsif ($state[4] eq "ISNEWLINELITERAL") {
$$settings{$id}{newline} = $attr->{value};
}
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "IMAGE") ) {
$$settings{$id}{image} = $attr->{value};
$$settings{$id}{style} = $attr->{style};
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "URL") ) {
$$settings{$id}{url} = $attr->{value};
$$settings{$id}{name} = $attr->{name};
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {
$answer_id = $attr->{id};
push @{$$allanswers{$id}},$answer_id;
%{$$settings{$id}{$answer_id}} = ();
$$settings{$id}{$answer_id}{position} = $attr->{position};
if ($$settings{$id}{class} eq 'QUESTION_MATCH') {
$$settings{$id}{$answer_id}{placement} = $attr->{placement};
$$settings{$id}{$answer_id}{type} = 'answer';
}
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {
$answer_id = $attr->{id};
push @{$$allchoices{$id}},$answer_id;
%{$$settings{$id}{$answer_id}} = ();
$$settings{$id}{$answer_id}{position} = $attr->{position};
$$settings{$id}{$answer_id}{placement} = $attr->{placement};
$$settings{$id}{$answer_id}{type} = 'choice';
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") ) {
if ($state[3] eq "IMAGE") {
$$settings{$id}{$answer_id}{image} = $attr->{value};
$$settings{$id}{$answer_id}{style} = $attr->{style};
} elsif ($state[3] eq "URL") {
$$settings{$id}{$answer_id}{url} = $attr->{value};
}
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") ) {
if ($state[3] eq "IMAGE") {
$$settings{$id}{$answer_id}{image} = $attr->{value};
$$settings{$id}{$answer_id}{style} = $attr->{style};
} elsif ($state[3] eq "URL") {
$$settings{$id}{$answer_id}{url} = $attr->{value};
}
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "CORRECTANSWER") ) {
my $corr_answer = $attr->{answer_id};
push @{$$settings{$id}{correctanswer}}, $corr_answer;
my $type = $1;
if ($type eq 'TRUEFALSE') {
$$settings{$id}{$corr_answer}{answer_position} = $attr->{position};
} elsif ($type eq 'ORDER') {
$$settings{$id}{$corr_answer}{order} = $attr->{order};
} elsif ($type eq 'MATCH') {
$$settings{$id}{$corr_answer}{choice_id} = $attr->{choice_id};
}
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
$text =~ s/^\s+//g;
$text =~ s/\s+$//g;
unless ($container eq "pool") {
if ("@state" eq "ASSESSMENT DESCRIPTION TEXT") {
$$settings{description} = $text;
} elsif ("@state" eq "ASSESSMENT INSTRUCTIONS ") {
$$settings{instructions}{text} = $text;
}
}
if ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[-1] eq "TEXT") ) {
unless ($text eq '') {
$$settings{$id}{text} = $text;
}
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[-1] eq "TEXT") ) {
unless ($text eq '') {
$$settings{$id}{$answer_id}{text} = $text;
}
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[-1] eq "TEXT") ) {
unless ($text eq '') {
$$settings{$id}{$answer_id}{text} = $text;
}
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[-1] eq "FEEDBACK_WHEN_CORRECT") ) {
unless ($text eq '') {
$$settings{$id}{feedback_corr} = $text;
}
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[-1] eq "FEEDBACK_WHEN_INCORRECT") ) {
unless ($text eq '') {
$$settings{$id}{feedback_incorr} = $text;
}
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->marked_sections(1);
$p->parse_file($xmlfile);
$p->eof;
}
sub parse_bb6_assessment {
my ($res,$docroot,$container,$settings,$allids) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my @state = ();
my $id; # the current question ID
my $response; # the current response ID
my $foil; # the current foil ID
my $numchoice; # the current right match choice;
my $labelcount; # the current count of choices for a matching item.
my $curr_shuffle;
my $curr_class; # the current question type
my $curr_matchitem;
my $curr_block_type; # the current block type
my $curr_flow; # the current flow class attribute
my $curr_flow_mat; # the current flow_mat class attribute
my $curr_feedback_type; # the current feedback type
my $numorder; # counter for ordering type questions
my $itemfrag = "questestinterop assessment section item";
my $presfrag = "$itemfrag presentation flow flow";
my $blockflow = 'flow';
my $responselid;
my $instructionfrag = "questestinterop assessment presentation_material flow_mat material";
my $feedbackfrag = "$itemfrag itemfeedback";
my $feedback_tag = '';
my $responselid;
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
if ("@state" eq "questestinterop assessment") {
$$settings{title} = $attr->{title};
}
if ("@state" eq "questestinterop assessment rubric flow_mat material mat_extension mat_formattedtext") {
$$settings{description}{texttype} = $attr->{type};
}
if ("@state" eq $presfrag) {
if ($attr->{class} eq 'QUESTION_BLOCK') {
$curr_block_type = 'question';
} elsif ($attr->{class} eq 'RESPONSE_BLOCK') {
$curr_block_type = 'response';
if ($curr_class eq 'Matching') {
$responselid = 'flow response_lid';
} else {
$responselid = 'response_lid';
}
} elsif (($attr->{class} eq 'RIGHT_MATCH_BLOCK')) {
$numchoice = 0;
$curr_block_type = 'rightmatch';
}
}
if ("@state" eq "$presfrag flow") {
if (($curr_block_type =~ /^rightmatch/) && ($attr->{class} eq 'Block')) {
$curr_block_type = 'rightmatch'.$numchoice;
$numchoice ++;
}
}
if ($state[-1] eq 'flow') {
$curr_flow = $attr->{class};
}
if ($state[-1] eq 'flow_mat') {
$curr_flow_mat = $attr->{class};
}
if ("@state" eq "$presfrag $blockflow material mat_extension mat_formattedtext") {
$$settings{$id}{$curr_block_type}{texttype} = $attr->{texttype};
}
if ("@state" eq "$presfrag $blockflow material matapplication") {
$$settings{$id}{$curr_block_type}{image} = $attr->{uri};
$$settings{$id}{$curr_block_type}{style} = $attr->{embedded};
$$settings{$id}{$curr_block_type}{label} = $attr->{label};
}
if ("@state" eq "$presfrag $blockflow material mattext") {
$$settings{$id}{$curr_block_type}{link} = $attr->{uri};
}
if ("@state" eq "$presfrag $responselid") {
$response = $attr->{ident};
$labelcount = 0;
if ($curr_class eq 'Matching') {
push(@{$$settings{$id}{answers}},$response);
%{$$settings{$id}{$response}} = ();
foreach my $key (keys(%{$$settings{$id}{$curr_block_type}})) {
$$settings{$id}{$response}{$key} = $$settings{$id}{$curr_block_type}{$key};
}
%{$$settings{$id}{$curr_block_type}} = ();
}
}
if ("@state" eq "$presfrag $responselid render_choice") {
$curr_shuffle = $attr->{shuffle};
}
if ("@state" eq "$presfrag $responselid render_choice flow_label response_label") {
$foil = $attr->{ident};
%{$$settings{$id}{$foil}} = ();
$$settings{$id}{$foil}{randomize} = $curr_shuffle;
unless ($curr_class eq 'Essay'){
if ($curr_class eq 'Matching') {
push(@{$$settings{$id}{$response}{items}},$foil);
$$settings{$id}{$foil}{order} = $labelcount;
$labelcount ++;
} else {
push(@{$$settings{$id}{answers}},$foil);
@{$$settings{$id}{correctanswer}} = ();
}
}
}
if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material matapplication") {
$$settings{$id}{$foil}{filetype} = $attr->{embedded};
$$settings{$id}{$foil}{label} = $attr->{label};
$$settings{$id}{$foil}{uri} = $attr->{uri};
}
if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mattext") {
$$settings{$id}{$foil}{link} = $attr->{uri};
}
if ("@state" eq "questestinterop assessment section item resprocessing") {
if ($curr_class eq 'Matching') {
$$settings{$id}{allchoices} = $numchoice;
}
}
if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar varequal") {
if ($curr_class eq 'Matching') {
$curr_matchitem = $attr->{respident};
}
}
if ("@state" eq $feedbackfrag) {
$curr_feedback_type = $attr->{ident};
$feedback_tag = "";
}
if ("@state" eq "$feedbackfrag solution") {
$curr_feedback_type = 'solution';
$feedback_tag = "solution solutionmaterial";
}
if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material matapplication") {
$$settings{$id}{$curr_feedback_type.'feedback'}{filetype} = $attr->{'embedded'};
$$settings{$id}{$curr_feedback_type.'feedback'}{label} = $attr->{label};
$$settings{$id}{$curr_feedback_type.'feedback'}{uri} = $attr->{uri};
}
if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material mattext") {
$$settings{$id}{$curr_feedback_type.'feedback'}{link} = $attr->{uri};
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
$text =~ s/^\s+//g;
$text =~ s/\s+$//g;
if ("@state" eq "questestinterop assessment rubric flow_mat material mat_extension mat_formattedtext") {
$$settings{description}{text} = $text;
}
if ("@state" eq "questestinterop assessment rubric flow_mat material mattext") {
$$settings{description}{text} = $text;
}
if ("@state" eq "$instructionfrag mat_extension mat_formattedtext") {
$$settings{instructions}{text} = $text;
}
if ("@state" eq "$instructionfrag mattext") {
$$settings{instructions}{text} = $text;
}
if ("@state" eq "questestinterop assessment section item itemmetadata bbmd_asi_object_id") {
$id = $text;
push @{$allids}, $id;
%{$$settings{$id}} = ();
@{$$settings{$id}{answers}} = ();
%{$$settings{$id}{question}} = ();
%{$$settings{$id}{correctfeedback}} = ();
%{$$settings{$id}{incorrectfeedback}} = ();
%{$$settings{$id}{solutionfeedback}} = ();
}
if ("@state" eq "questestinterop assessment section item itemmetadata bbmd_questiontype") {
$$settings{$id}{class} = $text;
$curr_class = $text;
if ($curr_class eq 'Matching') {
$blockflow = 'flow flow';
} else {
$blockflow = 'flow';
}
}
if ("@state" eq "$presfrag $blockflow material mat_extension mat_formattedtext") {
$$settings{$id}{$curr_block_type}{text} = $text;
}
if ("@state" eq "$presfrag $blockflow material mattext") {
if ($curr_flow eq 'LINK_BLOCK') {
$$settings{$id}{$curr_block_type}{linkname} = $text;
} elsif ($curr_flow eq 'FORMATTED_TEXT_BLOCK') {
$$settings{$id}{$curr_block_type}{text} = $text;
}
}
if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mat_extension mat_formattedtext") {
$$settings{$id}{$foil}{text} = $text;
}
if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mattext") {
if ($curr_flow_mat eq 'LINK_BLOCK') {
$$settings{$id}{$foil}{linkname} = $text;
} else {
$$settings{$id}{$foil}{text} = $text;
}
}
if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar varequal") {
if ($curr_class eq 'Matching') {
$$settings{$id}{$curr_matchitem}{correctanswer} = $text;
} else {
push(@{$$settings{$id}{correctanswer}},$text);
}
}
if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar") {
$numorder = 0;
}
if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar and varequal") {
push(@{$$settings{$id}{correctanswer}},$text);
if ($curr_class eq 'Ordering') {
$numorder ++;
$$settings{$id}{$text}{order} = $numorder;
}
}
if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material mat_extension mat_formattedtext") {
$$settings{$id}{$curr_feedback_type.'feedback'}{text} = $text;
}
if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material mattext") {
$$settings{$id}{$curr_feedback_type.'feedback'}{linkname} = $text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->marked_sections(1);
$p->parse_file($xmlfile);
$p->eof;
return;
}
sub parse_webctvista4_assessment {
my ($res,$docroot,$href,$allids,$qzparams) = @_;
my $xmlfile = $docroot.'/'.$href; #assessment file
my @state = ();
my $id; # the current question ID
my $fieldlabel; # the current qti metadata field label
my $outcome_id; # the current question ID for outcomes conditions
my $pname; # the current outcomes parameter name
my $numids = 0;
%{$$qzparams{$res}} = ();
%{$$qzparams{$res}{weight}} = ();
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
my @seq = ();
if ("@state" eq "questestinterop assessment") {
$$qzparams{$res}{id} = $attr->{'ident'};
$$qzparams{$res}{title} = $attr->{'title'};
}
if ("@state" eq "questestinterop assessment section itemref") {
$id = $attr->{linkrefid};
push(@{$allids},$id);
$numids ++;
}
if ("@state" eq "questestinterop assessment section selection_ordering order") {
$$qzparams{$res}{order_type} = $attr->{order_type};
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "questestinterop assessment qtimetadata qtimetadatafield fieldlabel") {
$fieldlabel = $text;
}
if ("@state" eq "questestinterop assessment qtimetadata qtimetadatafield fieldentry") {
$$qzparams{$res}{$fieldlabel} = $text;
}
if ("@state" eq "questestinterop assessment section outcomes_processing objects_condition outcomes_metadata") {
$outcome_id = $text;
}
if ("@state" eq "questestinterop assessment section outcomes_processing objects_condition objects_parameter") {
if ($pname eq 'qmd_weighting') {
$$qzparams{$res}{weight}{$outcome_id} = $text;
}
}
if ("@state" eq "questestinterop assessment section selection_ordering selection selection_number") {
$$qzparams{$res}{numpick} = $text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
unless(defined($$qzparams{$res}{numpick})) {
$$qzparams{$res}{numpick} = $numids;
}
}
sub parse_webctvista4_question {
my ($res,$docroot,$resources,$hrefs,$settings,$allquestids,$allanswers,$allchoices,$parent,$catinfo) = @_;
my $xmlfile = $docroot.'/'.$$resources{$res}{file};
my %classtypes = (
WCT_Calculated => 'numerical',
WCT_TrueFalse => 'multiplechoice',
WCT_ShortAnswer => 'shortanswer',
WCT_Paragraph => 'paragraph',
WCT_MultipleChoice => 'multiplechoice',
WCT_Matching => 'match',
WCT_JumbledSentence => 'jumbled',
WCT_FillInTheBlank => 'string',
WCT_Combination => 'combination'
);
my @state = ();
my $fieldlabel;
my %questiondata;
my $id; # the current question ID
my $list; # the current list ID for multiple choice questions
my $numid; # the current answer ID for numerical questions
my $grp; # the current group ID for matching questions
my $label; # the current reponse label for string questions
my $str_id; # the current string ID for string questions
my $unitid; # the current unit ID for numerical questions
my $answer_id; # the current answer ID
my $fdbk; # the current feedback ID
my $currvar; # the current variable for numerical problems
my $fibtype; # the current fill-in-blank type for numerical or string
my $prompt;
my $rows;
my $columns;
my $maxchars;
my %setvar = (
varname => '',
action => '',
);
my $currtexttype;
my $jumble_item;
my $numbox = 0;
my %str_answers = ();
my $textlabel;
my $currindex;
my %varinfo = ();
my $formula;
my $jumbnum = 0;
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
if ("@state" eq "questestinterop item") {
$id = $attr->{ident};
push(@{$allquestids},$id);
%{$$settings{$id}} = ();
%{$varinfo{$id}} = ();
@{$$allchoices{$id}} = ();
@{$$settings{$id}{grps}} = ();
@{$$settings{$id}{lists}} = ();
@{$$settings{$id}{feedback}} = ();
@{$$settings{$id}{str}} = ();
%{$$settings{$id}{strings}} = ();
@{$$settings{$id}{numids}} = ();
%{$$allanswers{$id}} = ();
$$settings{$id}{title} = $attr->{title};
}
if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:var") {
$currvar = $attr->{'webct:name'};
%{$varinfo{$id}{$currvar}} = ();
$varinfo{$id}{$currvar}{min} = $attr->{'webct:min'};
$varinfo{$id}{$currvar}{max} = $attr->{'webct:max'};
$varinfo{$id}{$currvar}{precision} = $attr->{'webct:precision'};
}
if ("@state" eq "questestinterop item presentation flow response_num") {
$numid = $attr->{ident};
push(@{$$settings{$id}{numids}},$numid);
%{$$settings{$id}{$numid}} = ();
%{$$settings{$id}{$numid}{vars}} = ();
@{$$settings{$id}{$numid}{units}} = ();
$$settings{$id}{$numid}{rcardinality} = $attr->{rcardinality};
$$settings{$id}{$numid}{formula} = $formula;
foreach my $var (keys(%{$varinfo{$id}})) {
%{$$settings{$id}{$numid}{vars}{$var}} = %{$varinfo{$id}{$var}};
}
}
if ("@state" eq "questestinterop item presentation flow material mat_extension webct:variable") {
$$settings{$id}{text} .= '['.$attr->{'webct:name'}.']';
}
if ("@state" eq "questestinterop item presentation flow material matimage") {
$$settings{$id}{image} = $attr->{uri};
}
if ("@state" eq "questestinterop item presentation flow material mattext") {
$currtexttype = lc($attr->{texttype});
$$settings{$id}{texttype} = $currtexttype;
if ($$settings{$id}{class} eq 'combination') {
if (exists($attr->{label})) {
$textlabel = $attr->{label};
} else {
$textlabel = '';
}
}
}
if ("@state" eq "questestinterop item presentation flow response_lid") {
$list = $attr->{ident};
push(@{$$settings{$id}{lists}},$list);
%{$$settings{$id}{$list}} = ();
@{$$allanswers{$id}{$list}} = ();
@{$$settings{$id}{$list}{correctanswer}} = ();
@{$$settings{$id}{$list}{jumbledtext}} = ();
@{$$settings{$id}{$list}{jumbledtype}} = ();
@{$$settings{$id}{$list}{jumbled}} = ();
$$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};
}
# Jumbled sentence
if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object") {
$$settings{$id}{$list}{orientation} = $attr->{orientation};
}
if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object material mattext") {
$currtexttype = lc($attr->{texttype});
$$settings{$id}{$list}{texttype} = $currtexttype;
}
if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label") {
$jumble_item = $attr->{ident};
}
if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label material mattext") {
$currtexttype = lc($attr->{texttype});
$$settings{$id}{$list}{$jumble_item}{texttype} = $currtexttype;
}
if ("@state" eq "questestinterop item resprocessing respcondition") { # Jumbled
if ($$settings{$id}{class} eq 'jumbled') {
$jumbnum ++;
@{$$settings{$id}{$list}{jumbled}[$jumbnum]} = ();
}
}
if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varequal") { # Jumbled
$currindex = $attr->{index};
}
if ("@state" eq "questestinterop item presentation flow response_lid render_choice") {
$$settings{$id}{$list}{randomize} = $attr->{shuffle};
}
# Multiple Choice, True/False and Combination
if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label") {
$answer_id = $attr->{ident};
push(@{$$allanswers{$id}{$list}},$answer_id);
%{$$settings{$id}{$list}{$answer_id}} = ();
}
# True/False
if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mat_extension webct:localizable_mattext") {
$currtexttype = lc($attr->{texttype});
$$settings{$id}{$list}{$answer_id}{texttype} = $currtexttype;
}
# Multiple Choice and Combination
if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mattext") {
$currtexttype = lc($attr->{texttype});
$$settings{$id}{$list}{$answer_id}{texttype} = $currtexttype;
}
# String, Shortanswer or Paragraph
if (($$settings{$id}{class} eq 'string') ||
($$settings{$id}{class} eq 'shortanswer') ||
($$settings{$id}{class} eq 'paragraph')) {
if ("@state" eq "questestinterop item presentation flow response_str") {
$str_id = $attr->{ident};
%{$$settings{$id}{$str_id}} = ();
push(@{$$settings{$id}{str}},$str_id);
$$settings{$id}{$str_id}{rcardinality} = $attr->{rcardinality};
@{$$settings{$id}{$str_id}{labels}} = ();
%{$$settings{$id}{$str_id}{comparison}} = ();
}
}
if ("@state" eq "questestinterop item presentation flow response_str material mattext") { # string
$currtexttype = lc($attr->{texttype});
$$settings{$id}{$str_id}{texttype} = $currtexttype;
}
if ("@state" eq "questestinterop item presentation flow response_str render_fib") {
$fibtype = $attr->{fibtype};
$prompt = $attr->{prompt};
$rows = $attr->{rows};
$columns = $attr->{columns};
$maxchars = $attr->{maxchars};
}
if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label") {
push(@{$$settings{$id}{$str_id}{labels}},$label);
@{$$settings{$id}{strings}{$str_id}} = ();
%{$$settings{$id}{$str_id}{$label}} = ();
$$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
if ($$settings{$id}{class} eq 'string') {
$$settings{$id}{text} .= '________';
}
}
if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label material mattext") { # Paragraph
$textlabel = $attr->{label};
}
# Matching
if ("@state" eq "questestinterop item presentation flow flow response_grp") {
$grp = $attr->{ident};
push(@{$$settings{$id}{grps}},$grp);
%{$$settings{$id}{$grp}} = ();
@{$$allanswers{$id}{$grp}} = ();
@{$$settings{$id}{$grp}{correctanswer}} = ();
$$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};
}
if ("@state" eq "questestinterop item presentation flow flow response_grp material mattext") {
$currtexttype = lc($attr->{texttype});
$$settings{$id}{$grp}{texttype} = $currtexttype;
}
if ("@state" eq "questestinterop item presentation flow flow response_grp render_choice flow_label response_label") {
$answer_id = $attr->{ident};
push(@{$$allanswers{$id}{$grp}},$answer_id);
%{$$settings{$id}{$grp}{$answer_id}} = ();
$currtexttype = lc($attr->{texttype});
$$settings{$id}{$grp}{$answer_id}{texttype} = $currtexttype;
}
# Multiple choice or combination or string or match
if ("@state" eq "questestinterop item resprocessing respcondition conditionvar varequal") {
if (($$settings{$id}{class} eq 'multiplechoice') ||
($$settings{$id}{class} eq 'combination')) {
$list = $attr->{respident};
} elsif (($$settings{$id}{class} eq 'string') ||
($$settings{$id}{class} eq 'shortanswer')) {
$label = $attr->{respident};
$$settings{$id}{$label}{case} = $attr->{'case'};
} elsif ($$settings{$id}{class} eq 'match') {
$grp = $attr->{respident};
}
}
if ("@state" eq "questestinterop item resprocessing") {
if (($$settings{$id}{class} eq 'string') ||
($$settings{$id}{class} eq 'shortanswer')) {
foreach my $str_id (@{$$settings{$id}{str}}) {
@{$str_answers{$str_id}} = ();
}
}
}
if ("@state" eq "questestinterop item resprocessing respcondition") {
if (($$settings{$id}{class} eq 'string') ||
($$settings{$id}{class} eq 'shortanswer')) {
$numbox ++;
}
}
if ("@state" eq "questestinterop item resprocessing respcondition setvar") {
foreach my $key (keys(%{$attr})) {
$setvar{$key} = $attr->{$key};
}
}
if (($$settings{$id}{class} eq 'string') ||
($$settings{$id}{class} eq 'shortanswer')) {
if (("@state" eq "questestinterop item resprocessing respcondition conditionvar or varsubset") || ("@state" eq "questestinterop item resprocessing respcondition conditionvar varsubset")) {
$str_id = $attr->{respident};
$$settings{$id}{$str_id}{case} = $attr->{case};
}
}
if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varsubset") {
$list = $attr->{respident};
}
# Numerical
if ("@state" eq "questestinterop item resprocessing itemproc_extension webct:calculated_answer") {
$numid = $attr->{respident};
$$settings{$id}{$numid}{toltype} = $attr->{'webct:toleranceType'};
$$settings{$id}{$numid}{tolerance} = $attr->{'webct:tolerance'};
}
if ("@state" eq "questestinterop item resprocessing itemproc_extension unit_eval conditionvar varequal") {
$unitid = $attr->{respident};
%{$$settings{$id}{$numid}{$unitid}} = ();
push(@{$$settings{$id}{$numid}{units}},$unitid);
$$settings{$id}{$numid}{$unitid}{case} = $attr->{case};
}
# Feedback
if ("@state" eq "questestinterop item respcondition displayfeedback") {
$fdbk = $attr->{linkrefid};
push(@{$$settings{$id}{feedback}},$fdbk);
$$settings{$id}{$fdbk} = ();
$$settings{$id}{$fdbk}{feedbacktype} = $attr->{feedbacktype};
}
if ("@state" eq "questestinterop item itemfeedback") {
$fdbk = $attr->{ident};
push(@{$$settings{$id}{feedback}},$fdbk);
$$settings{$id}{$fdbk}{view} = $attr->{view};
}
if ("@state" eq "questestinterop item itemfeedback material mattext") {
$currtexttype = lc($attr->{texttype});
$$settings{$id}{$fdbk}{texttype} = $currtexttype;
}
if ("@state" eq "questestinterop item itemfeedback solution solutionmaterial material mattext") {
$currtexttype = lc($attr->{texttype});
$$settings{$id}{$fdbk}{texttype} = $currtexttype;
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ($currtexttype eq '/text/html') {
$text =~ s#(<img\ssrc=")([^"]+)">#$1../resfiles/$2#g;
}
if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldlabel") {
$fieldlabel = $text;
}
if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldentry") {
$questiondata{$fieldlabel} = $text;
if ($fieldlabel eq 'wct_questiontype') {
$$settings{$id}{class} = $classtypes{$text};
} elsif ($fieldlabel eq 'wct_questioncategory') {
$$settings{$id}{category} = $text;
unless(exists($$catinfo{$text})) {
%{$$catinfo{$text}} = ();
$$catinfo{$text}{title} = $text;
}
push(@{$$catinfo{$text}{contents}},$id);
}
}
if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:formula") {
$formula = $text;
}
if ("@state" eq "questestinterop item presentation flow response_str material mattext") {
$$settings{$id}{$str_id}{text} = $text;
}
if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label material mattext") { # Paragraph
if ($textlabel eq 'PRE_FILL_ANSWER') {
$$settings{$id}{$str_id}{$label}{$textlabel} = $text;
}
}
# Matching
if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mattext") {
$$settings{$id}{$list}{$answer_id}{text} .= $text;
}
# Multiple choice, True/False, Combination
if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mat_extension webct:localizable_mattext") {
$$settings{$id}{$list}{$answer_id}{text} = $text;
}
if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object material mattext") {
push(@{$$settings{$id}{$list}{jumbledtext}},$text);
push(@{$$settings{$id}{$list}{jumbledtype}},'No');
}
if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label material mattext") {
$$settings{$id}{$list}{$jumble_item}{text} = $text;
push(@{$$settings{$id}{$list}{jumbledtext}},$text);
push(@{$$settings{$id}{$list}{jumbledtype}},'Yes');
}
if ("@state" eq "questestinterop item presentation flow material mattext") {
$$settings{$id}{text} .= $text;
if ($$settings{$id}{class} eq 'combination') {
if ($textlabel =~ /^wct_question_label_\d+$/) {
$$settings{$id}{text} .= '<br />';
}
if ($textlabel =~ /^wct_cmc_single_answer\d+$/) {
$$settings{$id}{text} .= '<br />';
}
}
}
# Matching
if ("@state" eq "questestinterop item presentation flow flow response_grp material mattext") {
$$settings{$id}{$grp}{text} = $text;
unless ($text eq '') {
push(@{$$allchoices{$id}},$grp);
}
}
if ("@state" eq "questestinterop item presentation flow flow response_grp render_choice flow_label response_label material mattext") {
$$settings{$id}{$grp}{$answer_id}{text} = $text;
}
# Numerical
if ("@state" eq "questestinterop item resprocessing itemproc_extension unit_eval conditionvar varequal") {
$$settings{$id}{$numid}{$unitid}{text} = $text;
}
if ("@state" eq "questestinterop item resprocessing respcondition conditionvar varequal") {
if (($$settings{$id}{class} eq 'string') ||
($$settings{$id}{class} eq 'shortanswer')) {
unless (grep/^$text$/,@{$str_answers{$str_id}}) {
push(@{$str_answers{$str_id}},$text);
$$settings{$id}{$str_id}{comparison}{$text} = $questiondata{'wct_comparison_type'.$numbox};
}
} else {
$answer_id = $text;
}
}
if (("@state" eq "questestinterop item resprocessing respcondition conditionvar or varsubset") || ("@state" eq "questestinterop item resprocessing respcondition conditionvar varsubset")) { # string
if (($$settings{$id}{class} eq 'string') ||
($$settings{$id}{class} eq 'shortanswer')) {
unless (grep/^$text$/,@{$str_answers{$str_id}}) {
push(@{$str_answers{$str_id}},$text);
$$settings{$id}{$str_id}{comparison}{$text} = $questiondata{'wct_comparison_type'.$numbox};
}
}
}
if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varequal") { # Jumbled
$$settings{$id}{$list}{jumbled}[$jumbnum][$currindex] = $text;
}
if ("@state" eq "questestinterop item resprocessing respcondition setvar") {
if ($setvar{varname} eq "SCORE") { # Multiple Choice, String or Match
if ($text =~ m/^[\d\.]+$/) {
if ($text > 0) {
if (($$settings{$id}{class} eq 'multiplechoice') ||
($$settings{$id}{class} eq 'combination')) {
push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
} elsif (($$settings{$id}{class} eq 'string') ||
($$settings{$id}{class} eq 'shortanswer')) {
foreach my $answer (@{$str_answers{$str_id}}) {
unless (grep/^$answer$/,@{$$settings{$id}{strings}{$str_id}}) {
push(@{$$settings{$id}{strings}{$str_id}},$answer);
}
}
} elsif ($$settings{$id}{class} eq 'match') {
push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
}
}
}
}
}
if ("@state" eq "questestinterop item itemfeedback material mattext") {
$$settings{$id}{$fdbk}{text} = $text;
}
if ("@state" eq "questestinterop item itemfeedback solution solutionmaterial material mattext") {
$$settings{$id}{$fdbk}{text} = $text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
}
sub parse_webct4_assessment {
my ($res,$docroot,$href,$container,$allids) = @_;
my $xmlfile = $docroot.'/'.$href; #quiz file
my @state = ();
my $id; # the current question ID
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
my $depth = 0;
my @seq = ();
if ("@state" eq "questestinterop assessment section itemref") {
$id = $attr->{linkrefid};
push(@{$allids},$id);
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
}
sub parse_webct4_quizprops {
my ($res,$docroot,$href,$container,$qzparams) = @_;
my $xmlfile = $docroot.'/'.$href; #properties file
my @state = ();
%{$$qzparams{$res}} = ();
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ($state[0] eq 'properties' && $state[1] eq 'delivery') {
if ($state[2] eq 'time_available') {
$$qzparams{$res}{opendate} = $text;
} elsif ($state[2] eq 'time_due') {
$$qzparams{$res}{duedate} = $text;
} elsif ($state[3] eq 'max_attempt') {
$$qzparams{$res}{tries} = $text;
} elsif ($state[3] eq 'post_submission') {
$$qzparams{$res}{posts} = $text;
} elsif ($state[3] eq 'method') {
$$qzparams{$res}{method} = $text;
}
} elsif ($state[0] eq 'properties' && $state[1] eq 'processing') {
if ($state[2] eq 'scores' && $state[3] eq 'score') {
$$qzparams{$res}{weight} = $text;
} elsif ($state[2] eq 'selection' && $state[3] eq 'select') {
$$qzparams{$res}{numpick} = $text;
}
} elsif ($state[0] eq 'properties' && $state[1] eq 'result') {
if ($state[2] eq 'display_answer') {
$$qzparams{$res}{showanswer} = $text;
}
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
}
sub parse_webct4_questionDB {
my ($docroot,$href,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;
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
my $list; # the current list ID for multiple choice questions
my $numid; # the current answer ID for numerical questions
my $grp; # the current group ID for matching questions
my $label; # the current reponse label for string questions
my $str_id; # the current string ID for string questions
my $unitid; # the current unit ID for numerical questions
my $answer_id; # the current answer ID
my $fdbk; # the current feedback ID
my $currvar; # the current variable for numerical problems
my $fibtype; # the current fill-in-blank type for numerical or string
my $prompt;
my $boxnum;
my %setvar = (
varname => '',
action => '',
);
my $currtexttype;
my $currimagtype;
my $is_objectbank;
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) {
$is_objectbank = 1;
} else {
push @state, $tagname;
}
if ("@state" eq "questestinterop section") {
$category = $attr->{ident};
%{$$catinfo{$category}} = ();
$$catinfo{$category}{title} = $attr->{title};
}
if ("@state" eq "questestinterop section item") {
$id = $attr->{ident};
push @{$allids}, $id;
push(@{$$catinfo{$category}{contents}},$id);
%{$$settings{$id}} = ();
@{$$allchoices{$id}} = ();
@{$$settings{$id}{grps}} = ();
@{$$settings{$id}{lists}} = ();
@{$$settings{$id}{feedback}} = ();
@{$$settings{$id}{str}} = ();
%{$$settings{$id}{strings}} = ();
@{$$settings{$id}{numids}} = ();
@{$$settings{$id}{boxes}} = ();
%{$$allanswers{$id}} = ();
$$settings{$id}{title} = $attr->{title};
$$settings{$id}{category} = $category;
$boxnum = 0;
}
if ("@state" eq "questestinterop section item presentation material mattext") {
$$settings{$id}{texttype} = $attr->{texttype};
$currtexttype = $attr->{texttype};
}
if ("@state" eq "questestinterop section item presentation material matimage") {
$$settings{$id}{imagtype} = $attr->{imagtype};
$currimagtype = $attr->{imagtype};
$$settings{$id}{uri} = $attr->{uri};
}
# Matching
if ("@state" eq "questestinterop section item presentation response_grp") {
$$settings{$id}{class} = 'match';
$grp = $attr->{ident};
push(@{$$settings{$id}{grps}},$grp);
%{$$settings{$id}{$grp}} = ();
@{$$settings{$id}{$grp}{correctanswer}} = ();
$$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};
}
if ("@state" eq "questestinterop section item presentation response_grp material mattext") {
$$settings{$id}{$grp}{texttype} = $attr->{texttype};
$currtexttype = $attr->{texttype};
}
if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label") {
$answer_id = $attr->{ident};
push(@{$$allanswers{$id}{$grp}},$answer_id);
%{$$settings{$id}{$grp}{$answer_id}} = ();
$$settings{$id}{$grp}{$answer_id}{texttype} = $attr->{texttype};
$currtexttype = $attr->{texttype};
}
# Multiple choice
if ("@state" eq "questestinterop section item presentation flow material mattext") {
$$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};
push(@{$$settings{$id}{lists}},$list);
%{$$settings{$id}{$list}} = ();
@{$$allanswers{$id}{$list}} = ();
@{$$settings{$id}{$list}{correctanswer}} = ();
$$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};
}
if ("@state" eq "questestinterop section item presentation flow response_lid render_choice") {
$$settings{$id}{$list}{randomize} = $attr->{shuffle};
}
if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label") {
$answer_id = $attr->{ident};
push(@{$$allanswers{$id}{$list}},$answer_id);
%{$$settings{$id}{$list}{$answer_id}} = ();
}
if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {
$$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") {
$$settings{$id}{texttype} = $attr->{texttype};
$currtexttype = $attr->{texttype};
}
if ("@state" eq "questestinterop section item presentation response_num") {
$$settings{$id}{class} = 'numerical';
$numid = $attr->{ident};
push(@{$$settings{$id}{numids}},$numid);
%{$$settings{$id}{$numid}} = ();
%{$$settings{$id}{$numid}{vars}} = ();
@{$$settings{$id}{$numid}{units}} = ();
$$settings{$id}{$numid}{rcardinality} = $attr->{rcardinality};
}
if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_minvalue webct:x_webct_v01_variable") {
$currvar = $attr->{name};
%{$$settings{$id}{$numid}{vars}{$currvar}} = ();
}
if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_maxvalue webct:x_webct_v01_variable") {
$currvar = $attr->{name};
}
if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_decimalnum webct:x_webct_v01_variable") {
$currvar = $attr->{name};
}
if ("@state" eq "questestinterop section item presentation response_num render_fib") {
$fibtype = $attr->{fibtype};
$prompt = $attr->{prompt};
}
if ("@state" eq "questestinterop section item presentation response_num render_fib response_label") {
$$settings{$id}{$numid}{label} = $attr->{ident};
}
# String or Numerical
if ("@state" eq "questestinterop section item presentation response_str") {
$str_id = $attr->{ident};
push(@{$$settings{$id}{str}},$str_id);
@{$$settings{$id}{boxes}[$boxnum]} = ();
$boxnum ++;
%{$$settings{$id}{$str_id}} = ();
@{$$settings{$id}{$str_id}{labels}} = ();
$$settings{$id}{$str_id}{rcardinality} = $attr->{rcardinality};
}
if ("@state" eq "questestinterop section item presentation response_str render_fib") {
$fibtype = $attr->{fibtype};
$prompt = $attr->{prompt};
}
if ("@state" eq "questestinterop section item presentation response_str render_fib response_label") {
$label = $attr->{ident};
push(@{$$settings{$id}{$str_id}{labels}},$label);
@{$$settings{$id}{strings}{$label}} = ();
%{$$settings{$id}{$str_id}{$label}} = ();
$$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
}
# Numerical
if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anspresentation") {
$$settings{$id}{$numid}{digits} = $attr->{digits};
$$settings{$id}{$numid}{format} = $attr->{format};
}
if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") {
$$settings{$id}{$numid}{toltype} = $attr->{type};
}
if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
$unitid = $attr->{ident};
%{$$settings{$id}{$numid}{$unitid}} = ();
push(@{$$settings{$id}{$numid}{units}},$unitid);
$$settings{$id}{$numid}{$unitid}{value} = $attr->{value};
$$settings{$id}{$numid}{$unitid}{space} = $attr->{space};
$$settings{$id}{$numid}{$unitid}{case} = $attr->{case};
}
# Matching
if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
if ($$settings{$id}{class} eq 'match') {
unless ($attr->{respident} eq 'WebCT_Incorrect') {
$grp = $attr->{respident};
}
# String
} else {
$label = $attr->{respident};
$$settings{$id}{$label}{case} = $attr->{case};
}
}
if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
foreach my $key (keys(%{$attr})) {
$setvar{$key} = $attr->{$key};
}
if ($setvar{varname} eq 'WebCT_Correct') {
push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
}
}
# String
if ("@state" eq "questestinterop section item resprocessing") {
$boxnum = -1;
}
if ("@state" eq "questestinterop section item resprocessing respcondition") { $boxnum ++;
}
if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") {
$$settings{$id}{class} = 'string';
$label = $attr->{respident};
}
if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar not") {
$$settings{$id}{class} = 'paragraph';
}
# Feedback
if ("@state" eq "questestinterop section item respcondition displayfeedback") {
$fdbk = $attr->{linkrefid};
push(@{$$settings{$id}{feedback}},$fdbk);
$$settings{$id}{$fdbk} = ();
$$settings{$id}{$fdbk}{feedbacktype} = $attr->{feedbacktype};
}
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") {
$$settings{$id}{$fdbk}{texttype} = $attr->{texttype};
$currtexttype = $attr->{texttype};
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ($currtexttype eq '/text/html') {
$text =~ s#(<img\ssrc=")([^"]+)">#$1../resfiles/$2#g;
}
if ("@state" eq "questestinterop section item itemmetadata qmd_itemtype") {
$$settings{$id}{itemtype} = $text;
if ($text eq 'String') {
$$settings{$id}{class} = 'string';
}
}
if ("@state" eq "questestinterop section item presentation material mattext") {
$$settings{$id}{text} = $text;
}
# Matching
if ("@state" eq "questestinterop section item presentation response_grp material mattext") {
$$settings{$id}{$grp}{text} = $text;
unless ($text eq '') {
push(@{$$allchoices{$id}},$grp);
}
}
if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label material mattext") {
$$settings{$id}{$grp}{$answer_id}{text} = $text;
}
# Multiple choice
if ("@state" eq "questestinterop section item presentation flow material mattext") {
$$settings{$id}{text} = $text;
}
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") {
$$settings{$id}{text} = $text;
}
if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_minvalue webct:x_webct_v01_variable") {
$$settings{$id}{$numid}{vars}{$currvar}{min} = $text;
}
if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_maxvalue webct:x_webct_v01_variable") {
$$settings{$id}{$numid}{vars}{$currvar}{max} = $text;
}
if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_decimalnum webct:x_webct_v01_variable") {
$$settings{$id}{$numid}{vars}{$currvar}{dec} = $text;
}
if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_formula") {
$$settings{$id}{$numid}{formula} = $text;
}
if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
if ($$settings{$id}{class} eq 'string') {
unless (grep/^$text$/,@{$$settings{$id}{strings}{$label}}) {
push(@{$$settings{$id}{strings}{$label}},$text);
}
unless (grep/^$text$/,@{$$settings{$id}{boxes}[$boxnum]}) {
push(@{$$settings{$id}{boxes}[$boxnum]},$text);
}
} else {
$answer_id = $text;
}
}
if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") { # String
unless (grep/^$text$/,@{$$settings{$id}{strings}{$label}}) {
push(@{$$settings{$id}{strings}{$label}},$text);
}
unless (grep/^$text$/,@{$$settings{$id}{boxes}[$boxnum]}) {
push(@{$$settings{$id}{boxes}[$boxnum]},$text);
}
}
if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
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") {
$$settings{$id}{$numid}{tolerance} = $text;
}
if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
$$settings{$id}{$numid}{$unitid}{text} = $text;
}
if ("@state" eq "questestinterop section item itemfeedback material mattext") {
$$settings{$id}{$fdbk}{text} = $text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
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}) {
if ($$settings{$id}{class} eq 'string') {
$boxcount = 0;
if (@{$$settings{$id}{boxes}} > 1) {
foreach my $str_id (@{$$settings{$id}{str}}) {
foreach my $label (@{$$settings{$id}{$str_id}{labels}}) {
@{$$settings{$id}{strings}{$label}} = @{$$settings{$id}{boxes}[$boxcount]};
$boxcount ++;
}
}
}
} 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';
}
}
}
}
}
}
}
}
}
}
sub process_assessment {
my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items,$catinfo,$qzdbsettings,$hrefs,$allquestions) = @_;
my @allids = ();
my @allquestids = ();
my %allanswers = ();
my %allchoices = ();
my %qzparams = ();
my %alldbanswers = ();
my %alldbchoices = ();
my @alldbquestids = ();
my $containerdir;
my $newdir;
my $randompickflag = 0;
my ($cid,$cdom,$cnum);
if ($context eq 'DOCS') {
$cid = $env{'request.course.id'};
($cdom,$cnum) = split/_/,$cid;
}
my $destresdir = $destdir;
if ($context eq 'CSTR') {
$destresdir =~ s|/home/$uname/public_html/|/res/$udom/$uname/|;
} elsif ($context eq 'DOCS') {
$destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
}
if ($cms eq 'bb5') {
&parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
} elsif ($cms eq 'bb6') {
&parse_bb6_assessment($res,$docroot,$container,$settings,\@allids);
} elsif ($cms eq 'webctce4') {
unless($$dbparse) {
&parse_webct4_questionDB($docroot,$$resources{$res}{file},$catinfo,$qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
&build_category_sequences($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings);
&write_webct4_questions($cms,\@alldbquestids,$context,$qzdbsettings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);
$$dbparse = 1;
}
&parse_webct4_assessment($res,$docroot,$$resources{$res}{file},$container,\@allids);
&parse_webct4_quizprops($res,$docroot,$$hrefs{$$items{$$resources{$res}{revitm}}{properties}}[0],$container,\%qzparams);
if (exists($qzparams{$res}{numpick})) {
if ($qzparams{$res}{numpick} < @allids) {
$$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
$randompickflag = 1;
}
}
} elsif ($cms eq 'webctvista4') {
unless($$dbparse) {
foreach my $res (sort keys %{$allquestions}) {
my $parent = $$allquestions{$res};
&parse_webctvista4_question($res,$docroot,$resources,$hrefs,$qzdbsettings,\@allquestids,\%allanswers,\%allchoices,$parent,$catinfo);
}
&build_category_sequences($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings);
$$dbparse = 1;
}
&parse_webctvista4_assessment($res,$docroot,$$resources{$res}{file},\@allids,\%qzparams);
if ($qzparams{$res}{numpick} < @allids) {
$$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
$randompickflag = 1;
}
}
my $dirtitle;
unless ($cms eq 'webctce4' || $cms eq 'webctvista4') {
$dirtitle = $$settings{'title'};
$dirtitle =~ s/\s+/_/g;
$dirtitle =~ s/:/_/g;
$dirtitle .= '_'.$res;
if (!-e "$destdir/problems") {
mkdir("$destdir/problems",0755);
}
if (!-e "$destdir/problems/$dirtitle") {
mkdir("$destdir/problems/$dirtitle",0755);
}
$newdir = "$destdir/problems/$dirtitle";
}
if ($cms eq 'webctce4') {
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);
}
if ($cms eq 'bb5') {
&write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot);
} elsif ($cms eq 'bb6') {
&write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot);
} elsif ($cms eq 'webctvista4') {
&write_webct4_questions($cms,\@allquestids,$context,$qzdbsettings,$dirname,\%allanswers,\%allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo,$dirtitle);
}
}
sub build_category_sequences {
my ($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings) = @_;
if (!-e "$destdir/sequences") {
mkdir("$destdir/sequences",0755);
}
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}) {
my $seqname;
if ($cms eq 'webctce4') {
$seqname = $$catinfo{$category}{title}.'_'.$category;
} else {
$seqname = $$catinfo{$category}{title};
}
$seqname =~ s/\s+/_/g;
$seqname =~ s/:/_/g;
push(@{$sequencesfiles},$seqname.'.sequence');
my $catsrc = "$destresdir/sequences/$seqname.sequence";
if ($curr_id == 0) {
print $fh qq|<resource id="1" src="$catsrc" type="start" title="$$catinfo{$category}{title}"></resource>|;
}
if ($numcats == 1) {
print $fh qq|
<link from="1" to="2" index="1"></link>
<resource id="2" src="" type="finish">\n|;
} else {
$curr_id = $next_id;
$next_id = $curr_id + 1;
$catsrc = "$destresdir/sequences/$seqname.sequence";
print $fh qq|
<link from="$curr_id" to="$next_id" index="$curr_id"></link>
<resource id="$next_id" src="$catsrc" title="$$catinfo{$category}{title}"|;
if ($next_id == $numcats) {
print $fh qq| type="finish"></resource>\n|;
} else {
print $fh qq|></resource>\n|;
}
}
print $fh qq|</map>|;
if (!-e "$destdir/problems") {
mkdir("$destdir/problems",0755);
}
if (!-e "$destdir/problems/$seqname") {
mkdir("$destdir/problems/$seqname",0755);
}
$$newdir = "$destdir/problems/$seqname";
my $dbcontainerdir;
&build_problem_container($cms,$seqname,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
}
close($fh);
}
sub build_problem_container {
my ($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,$allids,$udom,$uname,$dirname,$containerdir,$cid,$cdom,$cnum,$catinfo,$settings,$qzparams) = @_;
my $seqdir = "$destdir/sequences";
my $pagedir = "$destdir/pages";
my $curr_id = 0;
my $next_id = 1;
my $fh;
my $mapname = $res;
if ($cms eq 'webctvista4' && ref($$qzparams{$res}) eq 'HASH') {
if ($$qzparams{$res}{title}) {
$mapname = $$qzparams{$res}{title};
$mapname =~ s/\s+/_/g;
}
}
if ($container eq 'pool' || $randompickflag || $container eq 'database') {
$$containerdir = $seqdir.'/'.$mapname.'.sequence';
if (!-e "$seqdir") {
mkdir("$seqdir",0770);
}
open($fh,">$$containerdir");
$$total{seq} ++;
push @{$sequencesfiles},$mapname.'.sequence';
} else {
$$containerdir = $pagedir.'/'.$mapname.'.page';
if (!-e "$destdir/pages") {
mkdir("$destdir/pages",0770);
}
open($fh,">$$containerdir");
$$total{page} ++;
push @{$pagesfiles},$mapname.'.page';
}
print $fh qq|<map>
|;
my %probtitle = ();
my $probsrc = "/res/lib/templates/simpleproblem.problem";
if ($context eq 'CSTR') {
foreach my $id (@{$allids}) {
if (($cms eq 'webctce4') || ($cms eq 'webctvista4')) {
$probtitle{$id} = $$settings{$id}{title};
} else {
$probtitle{$id} = $$settings{title};
}
$probtitle{$id} =~ s/\s+/_/g;
$probtitle{$id} =~ s/:/_/g;
$probtitle{$id} =~ s/\//_/g;
$probtitle{$id} .= '_'.$id;
}
if (($cms eq 'webctce4' && $container ne 'database') ||
($cms eq 'webctvista4')) {
my $probdir;
my $catid = $$settings{$$allids[0]}{category};
if ($catid) {
if ($cms eq 'webctce4') {
$probdir = $$catinfo{$catid}{title}.'_'.$catid;
} else {
$probdir = $$catinfo{$catid}{title};
}
$probdir =~ s/\s+/_/g;
$probdir =~ s/:/_/g;
$probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";
} else {
$probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";
}
} else {
$probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";
}
}
print $fh qq|<resource id="1" src="$probsrc" type="start" title="question_0001"></resource>|;
if (@{$allids} == 1) {
print $fh qq|
<link from="1" to="2" index="1"></link>
<resource id="2" src="" type="finish">\n|;
} else {
for (my $j=1; $j<@{$allids}; $j++) {
my $qntitle = $j+1;
while (length($qntitle) <4) {
$qntitle = '0'.$qntitle;
}
$curr_id = $j;
$next_id = $curr_id + 1;
if ($context eq 'CSTR') {
if (($cms eq 'webctce4' && $container ne 'database') ||
($cms eq 'webctvista4')) {
my $probdir;
my $catid = $$settings{$$allids[$j]}{category};
if ($catid) {
if ($cms eq 'webctce4') {
$probdir = $$catinfo{$catid}{title}.'_'.$catid;
} else {
$probdir = $$catinfo{$catid}{title};
}
$probdir =~ s/\s/_/g;
$probdir =~ s/:/_/g;
$probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";
} else {
$probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
}
} else {
$probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
}
}
print $fh qq|
<link from="$curr_id" to="$next_id" index="$curr_id"></link>
<resource id="$next_id" src="$probsrc" title="question_$qntitle"|;
if ($next_id == @{$allids}) {
print $fh qq| type="finish"></resource>\n|;
} else {
print $fh qq|></resource>|;
}
}
}
print $fh qq|</map>|;
close($fh);
}
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;
if ($context eq 'CSTR') {
$pathstart = '../..';
} else {
$pathstart = $dirname;
}
foreach my $id (@{$allids}) {
if ($$settings{$id}{ishtml} eq 'true') {
$$settings{$id}{text} = &HTML::Entities::decode($$settings{$id}{text});
}
if ($$settings{$id}{text} =~ m#<img src=['"]?(https?://[^\s]+/)([^/\s\'"]+)['"]?[^>]*>#) {
if (&retrieve_image($context,$res,$dirname,$cdom,$cnum,$docroot,$destdir,$1,$2) eq 'ok') {
$$settings{$id}{text} =~ s#(<img src=['"]?)(https?://[^\s]+/)([^/\s'"]+)(['"]?[^>]*>)#$1$pathstart/resfiles/$res/webimages/$3$4#g;
}
}
$$settings{$id}{text} =~ s#(<img src=[^>]+)/*>#$1 />#gi;
$$settings{$id}{text} =~ s#<br>#<br />#g;
$qnum ++;
my $output;
my $permcontainer = $containerdir;
$permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
my %resourcedata = ();
for (my $i=0; $i<10; $i++) {
my $iter = $i+1;
$resourcedata{$symb.'text'.$iter} = "";
$resourcedata{$symb.'value'.$iter} = "unused";
$resourcedata{$symb.'position'.$iter} = "random";
}
$resourcedata{$symb.'randomize'} = 'yes';
$resourcedata{$symb.'maxfoils'} = 10;
if ($context eq 'CSTR') {
$output = qq|<problem>
|;
}
$$total{prob} ++;
if ($$settings{$id}{class} eq "QUESTION_ESSAY") {
if ($context eq 'CSTR') {
$output .= qq|<startouttext />$$settings{$id}{text}<endouttext />
<essayresponse>
<textfield></textfield>
</essayresponse>
<postanswerdate>
$$settings{$id}{feedbackcorr}
</postanswerdate>
|;
} else {
$resourcedata{$symb.'questiontext'} = $$settings{$id}{text};
$resourcedata{$symb.'hiddenparts'} = '!essay';
$resourcedata{$symb.'questiontype'} = 'essay';
}
} else {
if ($context eq 'CSTR') {
$output .= qq|<startouttext />$$settings{$id}{text}\n|;
} else {
$resourcedata{$symb.'questiontext'} = $$settings{$id}{text};
}
my ($image,$imglink,$url);
if ( defined($$settings{$id}{image}) ) {
if ( $$settings{$id}{style} eq 'embed' ) {
$image = qq|<br /><img src="$pathstart/resfiles/$res/$$settings{$id}{image}" /><br />|;
} else {
$imglink = qq|<br /><a href="$pathstart/resfiles/$res/$$settings{$id}{image}">Link to file</a><br />|;
}
}
if ( defined($$settings{$id}{url}) ) {
$url = qq|<br /><a href="$$settings{$id}{url}">$$settings{$id}{name}</a><br />|;
}
if ($context eq 'CSTR') {
$output .= $image.$imglink.$url.'
<endouttext />';
} else {
$resourcedata{$symb.'questiontext'} .= $image.$imglink.$url;
}
if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {
my $numfoils = @{$$allanswers{$id}};
if ($context eq 'CSTR') {
$output .= qq|
<radiobuttonresponse max="$numfoils" randomize="yes">
<foilgroup>
|;
} else {
$resourcedata{$symb.'hiddenparts'} = '!radio';
$resourcedata{$symb.'questiontype'} = 'radio';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
my $iter = $k+1;
$output .= " <foil name=\"foil".$k."\" value=\"";
if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
$output .= "true\" location=\"";
$resourcedata{$symb.'value'.$iter} = "true";
} else {
$output .= "false\" location=\"";
$resourcedata{$symb.'value'.$iter} = "false";
}
if (lc ($$allanswers{$id}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\s(of\s)?the\sabove\.?/) {
$output .= "bottom\"";
$resourcedata{$symb.'position'.$iter} = "bottom";
} else {
$output .= "random\"";
}
$output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text};
$resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
my ($ans_image,$ans_link);
if ( defined($$settings{$id}{$$allanswers{$id}[$k]}{image}) ) {
if ( $$settings{$id}{$$allanswers{$id}[$k]}{style} eq 'embed' ) {
$ans_image .= qq|<br /><img src="$pathstart/resfiles/$res/$$settings{$id}{$$allanswers{$id}[$k]}{image}" /><br />|;
} else {
$ans_link .= qq|<br /><a href="$pathstart/resfiles/$res/$$settings{$id}{$$allanswers{$id}[$k]}{image}" />Link to file</a><br/>|;
}
}
$output .= $ans_image.$ans_link.'<endouttext /></foil>'."\n";
$resourcedata{$symb.'text'.$iter} .= $ans_image.$ans_link;
}
if ($context eq 'CSTR') {
chomp($output);
$output .= qq|
</foilgroup>
</radiobuttonresponse>
|;
}
} elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {
my $numfoils = @{$$allanswers{$id}};
if ($context eq 'CSTR') {
$output .= qq|
<radiobuttonresponse max="$numfoils" randomize="yes">
<foilgroup>
|;
} else {
$resourcedata{$symb.'maxfoils'} = $numfoils;
$resourcedata{$symb.'hiddenparts'} = '!radio';
$resourcedata{$symb.'questiontype'} = 'radio';
}
for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
my $iter = $k+1;
$output .= " <foil name=\"foil".$k."\" value=\"";
if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
$output .= "true\" location=\"random\"";
$resourcedata{$symb.'value'.$iter} = "true";
} else {
$output .= "false\" location=\"random\"";
$resourcedata{$symb.'value'.$iter} = "false";
}
$output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
$resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
if ($context eq 'CSTR') {
chomp($output);
$output .= qq|
</foilgroup>
</radiobuttonresponse>
|;
}
} elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {
my $numfoils = @{$$allanswers{$id}};
if ($context eq 'CSTR') {
$output .= qq|
<optionresponse max="$numfoils" randomize="yes">
<foilgroup options="('True','False')">
|;
} else {
$resourcedata{$symb.'newopt'} = '';
$resourcedata{$symb.'delopt'} = '';
$resourcedata{$symb.'options'} = "('True','False')";
$resourcedata{$symb.'hiddenparts'} = '!option';
$resourcedata{$symb.'questiontype'} = 'option';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
my $iter = $k+1;
$output .= " <foil name=\"foil".$k."\" value=\"";
if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
$output .= "True\"";
$resourcedata{$symb.'value'.$iter} = "True";
} else {
$output .= "False\"";
$resourcedata{$symb.'value'.$iter} = "False";
}
$output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
$resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
if ($context eq 'CSTR') {
chomp($output);
$output .= qq|
</foilgroup>
</optionresponse>
|;
}
} elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {
my $numfoils = @{$$allanswers{$id}};
my @allorder = ();
if ($context eq 'CSTR') {
$output .= qq|
<rankresponse max="$numfoils" randomize="yes">
<foilgroup>
|;
} else {
$resourcedata{$symb.'newopt'} = '';
$resourcedata{$symb.'delopt'} = '';
$resourcedata{$symb.'hiddenparts'} = '!option';
$resourcedata{$symb.'questiontype'} = 'option';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
if ($context eq 'CSTR') {
$output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
} else {
my $iter = $k+1;
$resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
if (!grep/^$$settings{$id}{$$allanswers{$id}[$k]}{order}$/,@allorder) {
push @allorder, $$settings{$id}{$$allanswers{$id}[$k]}{order};
}
}
}
if ($context eq 'CSTR') {
chomp($output);
$output .= qq|
</foilgroup>
</rankresponse>
|;
} else {
@allorder = sort {$a <=> $b} @allorder;
$resourcedata{$symb.'options'} = "('".join("','",@allorder)."')";
}
} elsif ($$settings{$id}{class} eq 'QUESTION_FILLINBLANK') {
my $numerical = 1;
if ($context eq 'DOCS') {
$numerical = 0;
} else {
for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
if ($$settings{$id}{$$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {
$numerical = 0;
}
}
}
if ($numerical) {
my $numans;
my $tol;
if (@{$$allanswers{$id}} == 1) {
$tol = 5;
$numans = $$settings{$id}{$$allanswers{$id}[0]}{text};
} else {
my $min = $$settings{$id}{$$allanswers{$id}[0]}{text};
my $max = $$settings{$id}{$$allanswers{$id}[0]}{text};
for (my $k=1; $k<@{$$allanswers{$id}}; $k++) {
if ($$settings{$id}{$$allanswers{$id}[$k]}{text} <= $min) {
$min = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
if ($$settings{$id}{$$allanswers{$id}[$k]}{text} >= $max) {
$max = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
}
$numans = ($max + $min)/2;
$tol = 100*($max - $min)/($numans*2);
}
if ($context eq 'CSTR') {
$output .= qq|
<numericalresponse answer="$numans">
<responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
<responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
/>
<textline />
</numericalresponse>
|;
}
} else {
if ($context eq 'DOCS') {
$resourcedata{$symb.'hiddenparts'} = '!string';
$resourcedata{$symb.'questiontype'} = 'string';
$resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}};
$resourcedata{$symb.'hiddenparts'} = '!string';
$resourcedata{$symb.'stringtype'} = 'ci';
$resourcedata{$symb.'stringanswer'} = $$settings{$id}{$$allanswers{$id}[0]}{text};
} else {
if (@{$$allanswers{$id}} == 1) {
$output .= qq|
<stringresponse answer="$$settings{$id}{$$allanswers{$id}[0]}{text}" type="ci">
<textline>
</textline>
</stringresponse>
|;
} else {
my @answertext = ();
for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
$$settings{$id}{$$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;
push @answertext, $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
my $regexpans = join('|',@answertext);
$regexpans = '/^('.$regexpans.')\b/';
$output .= qq|
<stringresponse answer="$regexpans" type="re">
<textline>
</textline>
</stringresponse>
|;
}
}
}
} elsif ($$settings{$id}{class} eq "QUESTION_MATCH") {
my @allmatchers = ();
my %matchtext = ();
if ($context eq 'CSTR') {
$output .= qq|
<matchresponse max="10" randomize="yes">
<foilgroup>
<itemgroup>
|;
} else {
$resourcedata{$symb.'newopt'} = '';
$resourcedata{$symb.'delopt'} = '';
$resourcedata{$symb.'hiddenparts'} = '!option';
$resourcedata{$symb.'questiontype'} = 'option';
$resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}};
}
for (my $k=0; $k<@{$$allchoices{$id}}; $k++) {
if ($context eq 'CSTR') {
$output .= qq|
<item name="$$allchoices{$id}[$k]">
<startouttext />$$settings{$id}{$$allchoices{$id}[$k]}{text}<endouttext />
</item>
|;
} else {
if (!grep/^$$settings{$id}{$$allchoices{$id}[$k]}{text}$/,@allmatchers) {
push @allmatchers, $$settings{$id}{$$allchoices{$id}[$k]}{text};
$matchtext{$$allchoices{$id}[$k]} = $$settings{$id}{$$allchoices{$id}[$k]}{text};
}
}
}
if ($context eq 'CSTR') {
$output .= qq|
</itemgroup>
|;
}
for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
if ($context eq 'CSTR') {
$output .= qq|
<foil location="random" value="$$settings{$id}{$$allanswers{$id}[$k]}{choice_id}" name="$$allanswers{$id}[$k]">
<startouttext />$$settings{$id}{$$allanswers{$id}[$k]}{text}<endouttext />
</foil>
|;
} else {
my $iter = $k+1;
$resourcedata{$symb.'value'.$iter} = $matchtext{$$settings{$id}{$$allanswers{$id}[$k]}{choice_id}};
$resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
}
}
if ($context eq 'CSTR') {
$output .= qq|
</foilgroup>
</matchresponse>
|;
} else {
$resourcedata{$symb.'options'} = "('".join("','",@allmatchers)."')";
}
}
}
if ($context eq 'CSTR') {
$output .= qq|</problem>
|;
my $title = $$settings{title};
$title =~ s/\s/_/g;
$title =~ s/\W//g;
$title .= '_'.$id;
open(PROB,">$newdir/$title.problem");
print PROB $output;
close PROB;
} else {
# put %resourcedata;
my $reply=&Apache::lonnet::cput
('resourcedata',\%resourcedata,$cdom,$cnum);
}
}
}
sub write_webct4_questions {
my ($cms,$alldbquestids,$context,$settings,$dirname,$allanswers,$allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo,$dirtitle) = @_;
my $qnum = 0;
foreach my $id (@{$alldbquestids}) {
$qnum ++;
my $output;
my $permcontainer = $destdir.'/sequences/'.$id.'.sequence';
my $allfeedback;
my $questionimage;
foreach my $fdbk (@{$$settings{$id}{feedback}}) {
my $feedback = $$settings{$id}{$fdbk}{text};
if ($feedback ne '') {
if ($$settings{$id}{$fdbk}{texttype} eq 'text/html') {
$feedback = &HTML::Entities::decode($feedback);
}
$allfeedback .= $feedback;
}
}
if ($$settings{$id}{texttype} eq 'text/html') {
if ($$settings{$id}{text}) {
$$settings{$id}{text} = &text_cleanup($$settings{$id}{text});
}
}
if ($$settings{$id}{class} eq 'numerical') {
foreach my $numid (@{$$settings{$id}{numids}}) {
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;
}
}
}
}
$permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
my %resourcedata = ();
for (my $i=0; $i<10; $i++) {
my $iter = $i+1;
$resourcedata{$symb.'text'.$iter} = "";
$resourcedata{$symb.'value'.$iter} = "unused";
$resourcedata{$symb.'position'.$iter} = "random";
}
$resourcedata{$symb.'randomize'} = 'yes';
$resourcedata{$symb.'maxfoils'} = 10;
if ($context eq 'CSTR') {
unless ($$settings{$id}{class} eq 'numerical') {
$output = qq|<problem>
|;
}
}
$$total{prob} ++;
if (exists($$settings{$id}{uri})) {
if ($cms eq 'webctce4') {
if ($$settings{$id}{imagtype} =~ /^image\//) {
$questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
} else {
$questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
}
} elsif ($cms eq 'webctvista4') {
if ($$settings{$id}{uri} =~ /(gif|jpg|png)$/i) {
$questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
$questionimage =~ s#(//+)#/#g;
} else {
$questionimage = '<a href="'.$$settings{$id}{uri}.'" target="exturi" >'.$$settings{$id}{uri}.'</a>';
}
}
}
if ($$settings{$id}{class} eq "paragraph") {
my $pre_fill_answer = $$settings{$id}{PARA}{PARA}{PRE_FILL_ANSWER};
if ($context eq 'CSTR') {
$output .= qq|<startouttext /><p>$$settings{$id}{text}</p>$questionimage<endouttext />
<essayresponse>
<textfield>$pre_fill_answer</textfield>
</essayresponse>
|;
} else {
$resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;
$resourcedata{$symb.'hiddenparts'} = '!essay';
$resourcedata{$symb.'questiontype'} = 'essay';
}
} elsif ($$settings{$id}{class} eq 'jumbled') {
if ($context eq 'CSTR') {
my %foiloptions = ();
foreach my $list (@{$$settings{$id}{lists}}) {
@{$foiloptions{$list}} = ();
my $numalternates = @{$$settings{$id}{$list}{jumbled}} - 1;
my $loopstop = 2; #Hard coded for now, so only one permutation of answers is correct; <or> functionality is needed to support the case where multiple permutations are correct.
for (my $i=1; $i<$loopstop; $i++) {
$foiloptions{$list}[$i] = '(';
for (my $j=@{$$settings{$id}{$list}{jumbled}[$i]}-1; $j>0; $j--) {
my $jumble_item = $$settings{$id}{$list}{jumbled}[$i][$j];
$foiloptions{$list}[$i] .= "'".$$settings{$id}{$list}{$jumble_item}{text}."',";
}
$foiloptions{$list}[$i] =~ s/,$//;
$foiloptions{$list}[$i] .= ')';
my $jnum = 0;
for (my $k=0; $k<@{$$settings{$id}{$list}{jumbledtype}}; $k++) {
if ($$settings{$id}{$list}{jumbledtype}[$k] eq 'No') {
$output .= qq|
<startouttext />
$$settings{$id}{$list}{jumbledtext}[$k]
<endouttext />|;
} elsif ($$settings{$id}{$list}{jumbledtype}[$k] eq 'Yes') {
$jnum ++;
my $jumble_item = $$settings{$id}{$list}{jumbled}[$i][$jnum];
$output .= qq|
<optionresponse max="1" randomize="yes" TeXlayout="horizontal">
<foilgroup options="$foiloptions{$list}[$i]">
<foil location="random" value="$$settings{$id}{$list}{$jumble_item}{text}" name="$jumble_item"></foil>
</foilgroup>
</optionresponse>
|;
}
}
}
if ($numalternates > 0) { # for now alternates are stored in an instructorcomment. In the future these alternates could be moved into the main response area once <or> functionality is available.
$output .= '<instructorcomment>(Not shown to students) '."\n".'The following alternates were imported from the corresponding WebCT Vista 4 jumbled sentence question, but are not included in the LON-CAPA version, because this style of question does not currently support multiple correct solutions.'."\n";
for (my $i=2; $i<@{$$settings{$id}{$list}{jumbled}}; $i++) {
my $altid = $i-1;
my $jnum = 0;
$output .= $altid.'. ';
for (my $k=0; $k<@{$$settings{$id}{$list}{jumbledtype}}; $k++) {
if ($$settings{$id}{$list}{jumbledtype}[$k] eq 'No') {
$output .= "$$settings{$id}{$list}{jumbledtext}[$k]" ;
} elsif ($$settings{$id}{$list}{jumbledtype}[$k] eq 'Yes') {
$jnum ++;
my $jumble_item = $$settings{$id}{$list}{jumbled}[$i][$jnum];
$output .= '['.$$settings{$id}{$list}{$jumble_item}{text}.']';
}
}
$output .= " \n";
}
$output .= '</instructorcomment>';
}
}
}
} else {
if ($context eq 'CSTR') {
$output .= qq|<startouttext /><p>$$settings{$id}{text}</p>$questionimage<endouttext />\n|;
} else {
$resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;
}
if (($$settings{$id}{class} eq 'multiplechoice') ||
($$settings{$id}{class} eq 'combination')) {
foreach my $list (@{$$settings{$id}{lists}}) {
my $numfoils = @{$$allanswers{$id}{$list}};
if ($$settings{$id}{$list}{rcardinality} eq 'Single') {
if ($context eq 'CSTR') {
$output .= qq|
<radiobuttonresponse max="$numfoils" randomize="$$settings{$id}{$list}{randomize}">
<foilgroup>
|;
} else {
$resourcedata{$symb.'hiddenparts'} = '!radio';
$resourcedata{$symb.'questiontype'} = 'radio';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
for (my $k=0; $k<@{$$allanswers{$id}{$list}}; $k++) {
my $iter = $k+1;
$output .= " <foil name=\"foil".$k."\" value=\"";
if (grep/^$$allanswers{$id}{$list}[$k]$/,@{$$settings{$id}{$list}{correctanswer}}) {
$output .= "true\" location=\"";
$resourcedata{$symb.'value'.$iter} = "true";
} else {
$output .= "false\" location=\"";
$resourcedata{$symb.'value'.$iter} = "false";
}
if (lc ($$allanswers{$id}{$list}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\s(of\s)?the\sabove\.?/) {
$output .= "bottom\"";
$resourcedata{$symb.'position'.$iter} = "bottom";
} else {
$output .= "random\"";
}
if ($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{texttype} eq 'text/html') {
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#</?p>##g;
}
$output .= "\><startouttext />".$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
$resourcedata{$symb.'text'.$iter} = $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
$output .= '<endouttext /></foil>'."\n";
}
if ($context eq 'CSTR') {
chomp($output);
$output .= qq|
</foilgroup>
</radiobuttonresponse>
|;
}
} else {
if ($context eq 'CSTR') {
$output .= qq|
<optionresponse max="$numfoils" randomize="yes">
<foilgroup options="('True','False')">
|;
} else {
$resourcedata{$symb.'newopt'} = '';
$resourcedata{$symb.'delopt'} = '';
$resourcedata{$symb.'options'} = "('True','False')";
$resourcedata{$symb.'hiddenparts'} = '!option';
$resourcedata{$symb.'questiontype'} = 'option';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
for (my $k=0; $k<@{$$allanswers{$id}{$list}}; $k++) {
my $iter = $k+1;
$output .= " <foil name=\"foil".$k."\" value=\"";
if (grep/^$$allanswers{$id}{$list}[$k]$/,@{$$settings{$id}{$list}{correctanswer}}) {
$output .= "True\"";
$resourcedata{$symb.'value'.$iter} = "True";
} else {
$output .= "False\"";
$resourcedata{$symb.'value'.$iter} = "False";
}
if ($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{texttype} eq 'text/html') {
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#</?p>##g;
}
$output .= "\><startouttext />".$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text}."<br /><endouttext /></foil>\n";
$resourcedata{$symb.'text'.$iter} = $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
}
if ($context eq 'CSTR') {
chomp($output);
$output .= qq|
</foilgroup>
</optionresponse>
|;
}
}
}
} elsif ($$settings{$id}{class} eq 'match') {
my %allmatchers = ();
my @allmatch = ();
my %matchtext = ();
my $anscount = 0;
my %ansnum = ();
my $maxfoils = 0;
my $test_for_html = 0;
foreach my $grp (@{$$allchoices{$id}}) {
$maxfoils += @{$$settings{$id}{$grp}{correctanswer}};
foreach my $answer_id (@{$$allanswers{$id}{$grp}}) {
if ($$settings{$id}{$grp}{$answer_id}{texttype} eq '/text/html') {
$$settings{$id}{$grp}{$answer_id}{text} = &HTML::Entities::decode($$settings{$id}{$grp}{$answer_id}{text});
$test_for_html = &test_for_html($$settings{$id}{$grp}{$answer_id}{text});
$$settings{$id}{$grp}{$answer_id}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$grp}{$answer_id}{text});
$$settings{$id}{$grp}{$answer_id}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
$$settings{$id}{$grp}{$answer_id}{text} =~ s#</?p>##g;
}
unless (exists($allmatchers{$$settings{$id}{$grp}{$answer_id}{text}})) {
$allmatchers{$$settings{$id}{$grp}{$answer_id}{text}} = $anscount;
$allmatch[$anscount] = $$settings{$id}{$grp}{$answer_id}{text};
$anscount ++;
}
if (grep/^$answer_id$/,@{$$settings{$id}{$grp}{correctanswer}}) {
push(@{$ansnum{$grp}},$allmatchers{$$settings{$id}{$grp}{$answer_id}{text}});
}
}
if ($context eq 'DOCS') {
$matchtext{$ansnum{$grp}[0]} = $allmatch[$ansnum{$grp}[0]-1];
}
}
my $allmatchlist = "('".join("','",@allmatch)."')";
if ($context eq 'CSTR') {
if ($test_for_html) {
$output .= qq|
<matchresponse max="$maxfoils" randomize="yes">
<foilgroup>
<itemgroup>
|;
} else {
$output .= qq|
<optionresponse max="10" randomize="yes">
<foilgroup options="$allmatchlist">
|;
}
} else {
$resourcedata{$symb.'newopt'} = '';
$resourcedata{$symb.'delopt'} = '';
$resourcedata{$symb.'hiddenparts'} = '!option';
$resourcedata{$symb.'questiontype'} = 'option';
$resourcedata{$symb.'maxfoils'} = $maxfoils;
}
my $iter = 0;
foreach my $match (@allmatch) {
$iter ++;
if ($context eq 'CSTR') {
if ($test_for_html) {
$output .= qq|
<item name="ans_$iter">
<startouttext />$match<endouttext />
</item>
|;
}
}
}
if ($context eq 'CSTR') {
if ($test_for_html) {
$output .= qq|
</itemgroup>
|;
}
}
$iter = 0;
for (my $k=0; $k<@{$$allchoices{$id}}; $k++) {
if ($$settings{$id}{$$allchoices{$id}[$k]}{texttype} eq 'text/html') {
$$settings{$id}{$$allchoices{$id}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$$allchoices{$id}[$k]}{text});
$$settings{$id}{$$allchoices{$id}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$$allchoices{$id}[$k]}{text});
$$settings{$id}{$$allchoices{$id}[$k]}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
$$settings{$id}{$$allchoices{$id}[$k]}{text} =~ s#</?p>##g;
}
foreach my $ans (@{$ansnum{$$allchoices{$id}[$k]}}) {
$iter ++;
my $ans_id = $ans + 1;
if ($context eq 'CSTR') {
my $value;
if ($test_for_html) {
$value = 'ans_'.$ans_id;
} else {
$value = $allmatch[$ans];
}
$output .= qq|
<foil location="random" value="$value" name="foil_$iter">
<startouttext />$$settings{$id}{$$allchoices{$id}[$k]}{text}<endouttext />
</foil>
|;
}
}
if ($context eq 'DOCS') {
$resourcedata{$symb.'value'.$iter} = $matchtext{$ansnum{$$allchoices{$id}[$k]}[0]};
$resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allchoices{$id}[0]}{text};
}
}
if ($context eq 'CSTR') {
$output .= qq|
</foilgroup>
|;
if ($test_for_html) {
$output .= qq|
</matchresponse>
|;
} else {
$output .= qq|
</optionresponse>
|;
}
} else {
$resourcedata{$symb.'options'} = "('".join("','",@allmatch)."')";
}
} elsif (($$settings{$id}{class} eq 'string') ||
($$settings{$id}{class} eq 'shortanswer')) {
my $labelnum = 0;
my @str_labels = ();
if ($cms eq 'webctce4') {
foreach my $str_id (@{$$settings{$id}{str}}) {
foreach my $label (@{$$settings{$id}{$str_id}{labels}}) {
push(@str_labels,$label);
}
}
} elsif ($cms eq 'webctvista4') {
@str_labels = @{$$settings{$id}{str}};
}
foreach my $label (@str_labels) {
$labelnum ++;
my $numerical = 1;
if ($context eq 'DOCS') {
$numerical = 0;
} else {
for (my $i=0; $i<@{$$settings{$id}{strings}{$label}}; $i++) {
$$settings{$id}{strings}{$label}[$i] =~ s/^\s+//;
$$settings{$id}{strings}{$label}[$i] =~ s/\s+$//;
if ($$settings{$id}{strings}{$label}[$i] =~ m/([^\-\d\.]|\.\.)/) {
$numerical = 0;
}
}
}
if ($numerical) {
my $numans;
my $tol;
if (@{$$settings{$id}{strings}{$label}} == 1) {
$tol = '5%';
$numans = $$settings{$id}{strings}{$label}[0];
} else {
my $min = $$settings{$id}{strings}{$label}[0];
my $max = $$settings{$id}{strings}{$label}[0];
for (my $k=1; $k<@{$$settings{$id}{strings}{$label}}; $k++) {
if ($$settings{$id}{strings}{$label}[$k] <= $min) {
$min = $$settings{$id}{strings}{$label}[$k];
}
if ($$settings{$id}{strings}{$label}[$k] >= $max) {
$max = $$settings{$id}{strings}{$label}[$k];
}
}
$numans = ($max + $min)/2;
if ($numans == 0) {
my $dev = abs($max - $numans);
if (abs($numans - $min) > $dev) {
$dev = abs($numans - $min);
}
$tol = $dev;
} else {
$tol = 100*($max - $min)/($numans*2);
$tol .= '%';
}
}
if ($context eq 'CSTR') {
if (@{$$settings{$id}{str}} > 1) {
$output .= qq|
<startouttext />$labelnum.<endouttext />
|;
}
$output .= qq|
<numericalresponse answer="$numans">
<responseparam type="tolerance" default="$tol" name="tol" description="Numerical Tolerance" />
<responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
/>
<textline />
</numericalresponse>
<startouttext /><br /><endouttext />
|;
}
} else {
if ($context eq 'DOCS') {
$resourcedata{$symb.'hiddenparts'} = '!string';
$resourcedata{$symb.'questiontype'} = 'string';
$resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}{strings}{$label}};
$resourcedata{$symb.'hiddenparts'} = '!string';
if ($$settings{$id}{$label}{case} eq "No") {
$resourcedata{$symb.'stringtype'} = 'ci';
} elsif ($$settings{$id}{$label}{case} eq "Yes") {
$resourcedata{$symb.'stringtype'} = 'cs';
}
$resourcedata{$symb.'stringanswer'} = $$settings{$id}{strings}{$label}[0];
} else {
if (@{$$settings{$id}{str}} > 1) {
$output .= qq|
<startouttext />$labelnum.<endouttext />
|;
}
if (@{$$settings{$id}{strings}{$label}} == 1) {
my $casetype;
if ($$settings{$id}{$label}{case} eq "No") {
$casetype = 'ci';
} elsif ($$settings{$id}{$label}{case} eq "Yes") {
$casetype = 'cs';
}
$output .= qq|
<stringresponse answer="$$settings{$id}{strings}{$label}[0]" type="$casetype">
<textline>
</textline>
</stringresponse>
<startouttext /><br /><endouttext />
|;
} else {
my @answertext = ();
for (my $k=0; $k<@{$$settings{$id}{strings}{$label}}; $k++) {
$$settings{$id}{strings}{$label}[$k] =~ s/\|/\|/g;
push @answertext, $$settings{$id}{strings}{$label}[$k];
}
my $regexpans = join('|',@answertext);
$regexpans = '/^('.$regexpans.')\b/';
$output .= qq|
<stringresponse answer="$regexpans" type="re">
<textline>
</textline>
</stringresponse>
<startouttext /><br /><endouttext />
|;
}
}
}
}
} elsif ($$settings{$id}{class} eq 'numerical') {
my %mathfns = (
'abs' => 'abs',
'acos' => 'acos',
'asin' => 'asin',
'atan' => 'atan',
'ceil' => 'ceil',
'cos' => 'cos',
'exp' => 'exp',
'fact' => 'factorial',
'floor' => 'floor',
'int' => 'int',
'ln' => 'log',
'log' => 'log',
'max' => 'max',
'min' => 'min',
'round' => 'roundto',
'sin' => 'sin',
'sqrt' => 'sqrt',
'tan' => 'tan',
);
my $scriptblock = qq|
<script type="loncapa/perl">
|;
foreach my $numid (@{$$settings{$id}{numids}}) {
my $formula = $$settings{$id}{$numid}{formula};
my $pattern = join('|',(sort (keys (%mathfns))));
$formula =~ s/($pattern)/\&$mathfns{$1}/g;
foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {
my $decnum = $$settings{$id}{$numid}{vars}{$var}{dec};
my $increment = '0.';
if ($decnum == 0) {
$increment = 1;
} else {
my $deccount = $decnum;
while ($deccount > 1) {
$increment.= '0';
$deccount --;
}
$increment .= '1';
}
if ($cms eq 'webctce4') {
$formula =~ s/{($var)}/(\$$1)/g;
} elsif ($cms eq 'webctvista4') {
$formula =~ s/\[($var)\]/(\$$1)/g;
}
$scriptblock .= qq|
\$$var=&random($$settings{$id}{$numid}{vars}{$var}{min},$$settings{$id}{$numid}{vars}{$var}{max},$increment);
|;
}
$scriptblock .= qq|
\$answervar = $formula;
</script>
|;
if ($context eq 'CSTR') {
$output = "<problem>\n".$scriptblock.$output;
my $ansformat = '';
my $sigfig = '0,15';
if ($$settings{$id}{$numid}{format} eq 'sig') {
$sigfig = $$settings{$id}{$numid}{digits}.','.$$settings{$id}{$numid}{digits};
} elsif ($$settings{$id}{$numid}{format} eq 'dec') {
$ansformat = $$settings{$id}{$numid}{digits}.'f';
}
if ($ansformat) {
$ansformat = 'format="'.$ansformat.'"';
}
my $tolerance = $$settings{$id}{$numid}{tolerance};
if (lc($$settings{$id}{$numid}{toltype}) eq 'percent') {
$tolerance .= '%';
}
my $unit = '';
foreach my $unitid (@{$$settings{$id}{$numid}{units}}) {
$unit .= $$settings{$id}{$numid}{$unitid}{text};
}
my $unitentry = '';
if ($unit ne '') {
$unitentry = 'unit="'.$unit.'"';
}
$output .= qq|
<numericalresponse $unitentry $ansformat answer="\$answervar">
<responseparam type="tolerance" default="$tolerance" name="tol" description="Numerical Tolerance" />
<responseparam name="sig" type="int_range" default="$sigfig" description="Significant Figures"
/>
<textline />
</numericalresponse>
|;
}
}
}
}
if ($context eq 'CSTR') {
my $probdir;
my $catid = $$settings{$id}{category};
if ($catid) {
if ($cms eq 'webctce4') {
$probdir = $$catinfo{$catid}{title}.'_'.$catid;
} else {
$probdir = $$catinfo{$catid}{title};
}
$probdir =~ s/\s/_/g;
$probdir =~ s/://g;
} elsif (defined($dirtitle)) {
$probdir = $dirtitle;
}
if (!-e "$destdir/problems/$probdir") {
mkdir("$destdir/problems/$probdir",0755);
}
if ($allfeedback ne '') {
$output .= qq|
<postanswerdate>
$allfeedback
</postanswerdate>
|;
}
$output .= qq|</problem>
|;
my $title = $$settings{$id}{title};
$title =~ s/\s/_/g;
$title =~ s/:/_/g;
$title =~ s/\//_/g;
$title .= '_'.$id;
open(PROB,">$destdir/problems/$probdir/$title.problem");
print PROB $output;
close PROB;
} else {
# put %resourcedata;
my $reply=&Apache::lonnet::cput
('resourcedata',\%resourcedata,$cdom,$cnum);
}
}
}
sub text_cleanup {
my ($text) = @_;
$text =~ s/(\&)(nbsp|gt|lt)(?!;)/$1$2;$3/gi;
$text = &Apache::loncleanup::htmlclean($text);
$text =~ s#(<img src=["']?)([^>]+?)(/?>)#$1../../resfiles/$2 />#gi;
$text =~ s#<([bh])r>#<$1r />#g;
$text =~ s#<p>#<br /><br />#g;
$text =~ s#</p>##g;
return $text;
}
sub test_for_html {
my ($source) = @_;
my @tags = ();
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname) = @_;
push @tags, $tagname;
}, "tagname"],
);
$p->parse($source);
$p->eof;
return length(@tags);
}
sub write_bb6_questions {
my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
my $qnum = 0;
foreach my $id (@{$allids}) {
my $questiontext = $$settings{$id}{question}{text};
my $question_texttype = $$settings{$id}{question}{texttype};
&process_html(\$questiontext,'bb6',$question_texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
$qnum ++;
my $output;
my $permcontainer = $containerdir;
$permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
my %resourcedata = ();
for (my $i=0; $i<10; $i++) {
my $iter = $i+1;
$resourcedata{$symb.'text'.$iter} = "";
$resourcedata{$symb.'value'.$iter} = "unused";
$resourcedata{$symb.'position'.$iter} = "random";
}
$resourcedata{$symb.'randomize'} = 'yes';
$resourcedata{$symb.'maxfoils'} = 10;
if ($context eq 'CSTR') {
$output = qq|<problem>
|;
}
$$total{prob} ++;
$questiontext .= &add_images_links('question',$context,$settings,$id,$dirname,$res);
if ($$settings{$id}{class} eq "Essay") {
if ($context eq 'CSTR') {
$output .= qq|<startouttext />$questiontext<endouttext />
<essayresponse>
<textfield></textfield>
</essayresponse>
|;
} else {
$resourcedata{$symb.'questiontext'} = $questiontext;
$resourcedata{$symb.'hiddenparts'} = '!essay';
$resourcedata{$symb.'questiontype'} = 'essay';
}
} else {
if ($context eq 'CSTR') {
$output .= qq|<startouttext />$questiontext\n<endouttext />|;
} else {
$resourcedata{$symb.'questiontext'} = $questiontext;
}
my $numfoils = @{$$settings{$id}{answers}};
if (($$settings{$id}{class} eq 'Multiple Choice') ||
($$settings{$id}{class} eq 'True/False')) {
if ($context eq 'CSTR') {
$output .= qq|
<radiobuttonresponse max="$numfoils" randomize="yes">
<foilgroup>
|;
} else {
$resourcedata{$symb.'hiddenparts'} = '!radio';
$resourcedata{$symb.'questiontype'} = 'radio';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
for (my $k=0; $k<$numfoils; $k++) {
my $iter = $k+1;
my $answer_id = $$settings{$id}{answers}[$k];
my $answer_text = $$settings{$id}{$answer_id}{text};
my $texttype = $$settings{$id}{$answer_id}{texttype};
&process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
$answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res);
$output .= " <foil name=\"foil".$k."\" value=\"";
if (grep/^$answer_id$/,@{$$settings{$id}{correctanswer}}) {
$output .= "true\" location=\"";
$resourcedata{$symb.'value'.$iter} = "true";
} else {
$output .= "false\" location=\"";
$resourcedata{$symb.'value'.$iter} = "false";
}
if (lc ($$settings{$id}{$answer_id}{text}) =~ m/^\s?([Aa]ll)|([Nn]one)\s(of\s)?the\sabove\.?/) {
$output .= "bottom\"";
$resourcedata{$symb.'position'.$iter} = "bottom";
} else {
$output .= "random\"";
}
$output .= '\><startouttext />'.$answer_text.
'<endouttext /></foil>'."\n";
$resourcedata{$symb.'text'.$iter} = $answer_text;
}
if ($context eq 'CSTR') {
chomp($output);
$output .= qq|
</foilgroup>
<hintgroup showoncorrect="no">
<radiobuttonhint>
</radiobuttonhint>
<hintpart on="default">
<startouttext/><endouttext />
</hintpart>
</hintgroup>
</radiobuttonresponse>
|;
}
} elsif ($$settings{$id}{class} eq 'Multiple Answer') {
if ($context eq 'CSTR') {
$output .= qq|
<optionresponse max="$numfoils" randomize="yes">
<foilgroup options="('True','False')">
|;
} else {
$resourcedata{$symb.'newopt'} = '';
$resourcedata{$symb.'delopt'} = '';
$resourcedata{$symb.'options'} = "('True','False')";
$resourcedata{$symb.'hiddenparts'} = '!option';
$resourcedata{$symb.'questiontype'} = 'option';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
for (my $k=0; $k<$numfoils; $k++) {
my $iter = $k+1;
my $answer_id = $$settings{$id}{answers}[$k];
my $answer_text = $$settings{$id}{$answer_id}{text};
my $texttype = $$settings{$id}{$answer_id}{texttype};
&process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
$answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res);
$output .= " <foil name=\"foil".$k."\" value=\"";
if (grep/^$answer_id$/,@{$$settings{$id}{correctanswer}}) {
$output .= "True\"";
$resourcedata{$symb.'value'.$iter} = "True";
} else {
$output .= "False\"";
$resourcedata{$symb.'value'.$iter} = "False";
}
$output .= "\><startouttext />".$answer_text."<endouttext /></foil>\n";
$resourcedata{$symb.'text'.$iter} = $answer_text;
}
if ($context eq 'CSTR') {
chomp($output);
$output .= qq|
</foilgroup>
<hintgroup showoncorrect="no">
<optionhint>
</optionhint>
<hintpart on="default">
<startouttext/><endouttext />
</hintpart>
</hintgroup>
</optionresponse>
|;
}
} elsif ($$settings{$id}{class} eq 'Ordering') {
my @allorder = ();
if ($context eq 'CSTR') {
$output .= qq|
<rankresponse max="$numfoils" randomize="yes">
<foilgroup>
|;
} else {
$resourcedata{$symb.'newopt'} = '';
$resourcedata{$symb.'delopt'} = '';
$resourcedata{$symb.'hiddenparts'} = '!option';
$resourcedata{$symb.'questiontype'} = 'option';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
for (my $k=0; $k<$numfoils; $k++) {
my $answer_id = $$settings{$id}{answers}[$k];
my $answer_text = $$settings{$id}{$answer_id}{text};
my $texttype = $$settings{$id}{$answer_id}{texttype};
&process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
$answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res);
my $iter = $k+1;
if ($context eq 'CSTR') {
$output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$answer_id}{order}."\"><startouttext />".$answer_text."<endouttext /></foil>\n";
} else {
$resourcedata{$symb.'text'.$iter} = $answer_text;
$resourcedata{$symb.'value'.$iter} = $$settings{$id}{$answer_id}{order};
if (!grep/^$$settings{$id}{$answer_id}{order}$/,@allorder) {
push(@allorder,$$settings{$id}{$answer_id}{order});
}
}
}
if ($context eq 'CSTR') {
chomp($output);
$output .= qq|
</foilgroup>
</rankresponse>
|;
} else {
@allorder = sort {$a <=> $b} @allorder;
$resourcedata{$symb.'options'} = "('".join("','",@allorder)."')";
}
} elsif ($$settings{$id}{class} eq 'Fill in the Blank') {
my $numerical = 1;
if ($context eq 'DOCS') {
$numerical = 0;
} else {
for (my $k=0; $k<@{$$settings{$id}{correctanswer}}; $k++) {
if ($$settings{$id}{correctanswer}[$k] =~ m/([^\d\.]|\.\.)/) {
$numerical = 0;
}
}
}
if ($numerical) {
my $numans;
my $tol;
if (@{$$settings{$id}{correctanswer}} == 1) {
$tol = 5;
$numans = $$settings{$id}{correctanswer}[0];
} else {
my $min = $$settings{$id}{correctanswer}[0];;
my $max = $min;
for (my $k=1; $k<@{$$settings{$id}{correctanswer}}; $k++) {
if ($$settings{$id}{correctanswer}[$k] <= $min) {
$min = $$settings{$id}{correctanswer}[$k];
}
if ($$settings{$id}{correctanswer}[$k] >= $max) {
$max = $$settings{$id}{correctanswer}[$k];
}
}
$numans = ($max + $min)/2;
$tol = 100*($max - $min)/($numans*2);
$tol = 5;
}
if ($context eq 'CSTR') {
$output .= qq|
<numericalresponse answer="$numans">
<responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
<responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
/>
<textline />
</numericalresponse>
<hintgroup showoncorrect="no">
<numericalhint>
</numericalhint>
<hintpart on="default">
<startouttext/><endouttext />
</hintpart>
</hintgroup>
|;
}
} else {
if ($context eq 'DOCS') {
$resourcedata{$symb.'hiddenparts'} = '!string';
$resourcedata{$symb.'questiontype'} = 'string';
$resourcedata{$symb.'maxfoils'} = 1;
$resourcedata{$symb.'hiddenparts'} = '!string';
$resourcedata{$symb.'stringtype'} = 'ci';
$resourcedata{$symb.'stringanswer'} = $$settings{$id}{correctanswer}[0];
} else {
if (@{$$settings{$id}{correctanswer}} == 1) {
$output .= qq|
<stringresponse answer="$$settings{$id}{correctanswer}[0];" type="ci">
<textline>
</textline>
</stringresponse>
<hintgroup showoncorrect="no">
<stringhint type="cs">
</stringhint>
<hintpart on="default">
<startouttext/><endouttext />
</hintpart>
</hintgroup>
|;
} else {
my @answertext = ();
for (my $k=0; $k<@{$$settings{$id}{correctanswer}}; $k++) {
my $answer_text = $$settings{$id}{correctanswer}[$k];
$answer_text =~ s/\|/\|/g;
push @answertext, $answer_text;
}
my $regexpans = join('|',@answertext);
$regexpans = '/^('.$regexpans.')\b/';
$output .= qq|
<stringresponse answer="$regexpans" type="re">
<textline>
</textline>
</stringresponse>
<hintgroup showoncorrect="no">
<stringhint type="cs">
</stringhint>
<hintpart on="default">
<startouttext/><endouttext />
</hintpart>
</hintgroup>
|;
}
}
}
} elsif ($$settings{$id}{class} eq "Matching") {
my @allmatchers = ();
my %matchtext = ();
if ($context eq 'CSTR') {
$output .= qq|
<matchresponse max="10" randomize="yes">
<foilgroup>
<itemgroup>
|;
} else {
$resourcedata{$symb.'newopt'} = '';
$resourcedata{$symb.'delopt'} = '';
$resourcedata{$symb.'hiddenparts'} = '!option';
$resourcedata{$symb.'questiontype'} = 'option';
$resourcedata{$symb.'maxfoils'} = $numfoils;
}
for (my $k=0; $k<$$settings{$id}{allchoices}; $k++) {
my $choice_id = 'rightmatch'.$k;
my $choice_text = $$settings{$id}{$choice_id}{text};
my $texttype = $$settings{$id}{$choice_id}{texttype};
my $choice_plaintext = &remove_html($choice_text);
&process_html(\$choice_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
$choice_text .= &add_images_links($choice_id,$context,$settings,$id,$dirname,$res);
push(@allmatchers,$choice_plaintext);
if ($context eq 'CSTR') {
$output .= qq|
<item name="$choice_id">
<startouttext />$choice_text<endouttext />
</item>
|;
}
}
if ($context eq 'CSTR') {
$output .= qq|
</itemgroup>
|;
}
for (my $k=0; $k<$numfoils; $k++) {
my $answer_id = $$settings{$id}{answers}[$k];
my $answer_text = $$settings{$id}{$answer_id}{text};
my $texttype = $$settings{$id}{$answer_id}{texttype};
&process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
$answer_text .= &add_images_links($answer_id,$context,$settings,$id,$dirname,$res);
if ($context eq 'CSTR') {
$output .= '
<foil location="random" value="rightmatch'.$$settings{$id}{$$settings{$id}{$answer_id}{correctanswer}}{order}.'" name="'.$answer_id.'">
<startouttext />'.$answer_text.'<endouttext />
</foil>
';
} else {
my $iter = $k+1;
$resourcedata{$symb.'value'.$iter} = "$allmatchers[$$settings{$id}{$$settings{$id}{$answer_id}{correctanswer}}{order}]";
$resourcedata{$symb.'text'.$iter} = $answer_text;
}
}
if ($context eq 'CSTR') {
$output .= qq|
</foilgroup>
</matchresponse>
|;
} else {
$resourcedata{$symb.'options'} = "('".join("','",@allmatchers)."')";
}
}
}
if ($context eq 'CSTR') {
$output .= qq|
<postanswerdate>
$$settings{$id}{solutionfeedback}{text}
</postanswerdate>
</problem>
|;
my $title = $$settings{title};
$title =~ s/\s/_/g;
$title =~ s/\W//g;
$title .= '_'.$id;
open(PROB,">$newdir/$title.problem");
print PROB $output;
close PROB;
} else {
# put %resourcedata;
my $reply=&Apache::lonnet::cput
('resourcedata',\%resourcedata,$cdom,$cnum);
}
}
}
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 $request=new HTTP::Request('GET',$url);
my $response=$ua->request($request);
if ($response->is_success) {
$contents = $response->content;
if (!-e "$docroot/$res") {
mkdir("$docroot/$res",0755);
}
if (!-e "$docroot/$res/webimages") {
mkdir("$docroot/$res/webimages",0755);
}
open(my $fh,">$docroot/$res/webimages/$filename");
print $fh $contents;
close($fh);
if ($context eq 'DOCS') {
my $copyfile = $dirname.'/'.$filename;
my $source = "$docroot/$res/webimages/$filename";
my $fileresult;
if (-e $source) {
$fileresult = &Apache::lonnet::process_coursefile('copy',$cname,$cdom,$copyfile,$source);
}
return $fileresult;
} elsif ($context eq 'CSTR') {
if (!-e "$destdir/resfiles/$res") {
mkdir("$destdir/resfiles/$res",0755);
}
if (!-e "$destdir/resfiles/$res/webimages") {
mkdir("$destdir/resfiles/$res/webimages",0755);
}
rename("$docroot/$res/webimages/$filename","$destdir/resfiles/$res/webimages/$filename");
return 'ok';
}
} else {
return -1;
}
}
# ---------------------------------------------------------------- Process Blackboard Announcements
sub process_announce {
my ($res,$docroot,$destdir,$settings,$globalresref,$seqstem,$resrcfiles) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my @state = ();
my @assess = ();
my $id;
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
if ("@state" eq "ANNOUNCEMENT TITLE") {
$$settings{title} = $attr->{value};
$$settings{startassessment} = ();
} elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISHTML") {
$$settings{ishtml} = $attr->{value};
} elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISNEWLINELITERAL" ) {
$$settings{isnewline} = $attr->{value};
} elsif ("@state" eq "ANNOUNCEMENT ISPERMANENT" ) {
$$settings{ispermanent} = $attr->{value};
} elsif ("@state" eq "ANNOUNCEMENT DATES UPDATED") {
$$settings{dates} = $attr->{value};
} elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT" ) {
$id = $attr->{id};
%{$$settings{startassessment}{$id}} = ();
push @assess,$id;
} elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT ATTRIB" ) {
my $key = $attr->{key};
$$settings{startassessment}{$id}{$key} = $attr->{value};
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "ANNOUNCEMENT DESCRIPTION TEXT") {
$$settings{text} = $text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
if (defined($$settings{text})) {
if ($$settings{ishtml} eq "false") {
if ($$settings{isnewline} eq "true") {
$$settings{text} =~ s#\n#<br/>#g;
}
} else {
$$settings{text} = &HTML::Entities::decode($$settings{text});
}
}
if (@assess > 0) {
foreach my $id (@assess) {
$$settings{text} = "A $$settings{startassessment}{$id}{assessment_type}, entitled $$globalresref{$$settings{startassessment}{$id}{assessment_id}}{title} is available. Click <a href='$seqstem/pages/$$settings{startassessment}{$id}{assessment_id}.page' target='quizpage'>here</a> to enter the page that contains the problems in this assessment.";
}
}
open(FILE,">$destdir/resfiles/$res.html");
push @{$resrcfiles}, "$res.html";
print FILE qq|<html>
<head>
<title>$$settings{title}</title>
</head>
<body bgcolor='#ffffff'>
<table>
<tr>
<td bgcolor='#CCCCFF'>$$settings{title} - announcement date: $$settings{dates}</td>
</tr>
</table>
<br/>
$$settings{text}
|;
print FILE qq|
</body>
</html>|;
close(FILE);
}
# ---------------------------------------------------------------- Process Blackboard Content
sub process_content {
my ($cms,$res,$context,$docroot,$destdir,$settings,$dom,$user,$resrcfiles,$packages,$hrefs) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my $destresdir = $destdir;
if ($context eq 'CSTR') {
$destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
} elsif ($context eq 'DOCS') {
$destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
}
my $filetag = '';
if ($cms eq 'bb5') {
$filetag = 'FILEREF';
} elsif ($cms eq 'bb6') {
$filetag = 'FILE';
}
my $filecount = 0;
my @allrelfiles = ();
my @state;
@{$$settings{files}} = ();
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
if ("@state" eq "CONTENT ") {
%{$$settings{maindata}} = ();
} elsif ("@state" eq "CONTENT TITLECOLOR") {
$$settings{titlecolor} = $attr->{value};
} elsif ("@state" eq "CONTENT MAINDATA TEXTCOLOR") {
$$settings{maindata}{color} = $attr->{value};
} elsif ("@state" eq "CONTENT MAINDATA FLAGS ISHTML") {
$$settings{maindata}{ishtml} = $attr->{value};
} elsif ("@state" eq "CONTENT MAINDATA FLAGS ISNEWLINELITERAL") {
$$settings{maindata}{isnewline} = $attr->{value};
} elsif ("@state" eq "CONTENT BODY TYPE") {
$$settings{maindata}{bodytype} = $attr->{value};
} elsif ("@state" eq "CONTENT FLAGS ISAVAILABLE" ) {
$$settings{isavailable} = $attr->{value};
} elsif ("@state" eq "CONTENT FLAGS ISFOLDER" ) {
$$settings{isfolder} = $attr->{value};
} elsif ("@state" eq "CONTENT FLAGS LAUNCHINNEWWINDOW" ) {
$$settings{newwindow} = $attr->{value};
} elsif ("@state" eq "CONTENT FILES $filetag") {
%{$$settings{files}[$filecount]} = ();
%{$$settings{files}[$filecount]{registry}} = ();
} elsif ("@state" eq "CONTENT FILES FILEREF RELFILE" ) {
$$settings{files}[$filecount]{'relfile'} = $attr->{value};
push @allrelfiles, $attr->{value};
} elsif ("@state" eq "CONTENT FILES $filetag MIMETYPE") {
$$settings{files}[$filecount]{mimetype} = $attr->{value};
} elsif ("@state" eq "CONTENT FILES $filetag CONTENTTYPE") {
$$settings{files}[$filecount]{contenttype} = $attr->{value};
} elsif ("@state" eq "CONTENT FILES $filetag FILEACTION") {
$$settings{files}[$filecount]{fileaction} = $attr->{value};
} elsif ("@state" eq "CONTENT FILES $filetag PACKAGEPARENT") {
$$settings{files}[$filecount]{packageparent} = $attr->{value};
} elsif ("@state" eq "CONTENT FILES $filetag LINKNAME") {
$$settings{files}[$filecount]{linkname} = $attr->{value};
} elsif ("@state" eq "CONTENT FILES $filetag REGISTRY REGISTRYENTRY") {
my $key = $attr->{key};
$$settings{files}[$filecount]{registry}{$key} = $attr->{value};
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "CONTENT TITLE") {
$$settings{title} = $text;
} elsif ( ("@state" eq "CONTENT MAINDATA TEXT") || ("@state" eq "CONTENT BODY TEXT") ) {
$$settings{maindata}{text} = $text;
} elsif ("@state" eq "CONTENT FILES $filetag REFTEXT") {
$$settings{files}[$filecount]{reftext} = $text;
} elsif ("@state" eq "CONTENT FILES FILE NAME" ) {
$$settings{files}[$filecount]{'relfile'} = $text;
push @allrelfiles, $text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
if ("@state" eq "CONTENT FILES $filetag") {
$filecount ++;
}
pop @state;
}, "tagname"],
);
$p->unbroken_text(1);
$p->parse_file($xmlfile);
$p->eof;
my $linktag = '';
my $fontcol = '';
if (@{$$settings{files}} > 0) {
for (my $filecount=0; $filecount<@{$$settings{files}}; $filecount++) {
if ($$settings{files}[$filecount]{'fileaction'} eq 'embed') {
if ( $$settings{files}[$filecount]{reftext} =~ m#<\!\-\-\s_(\d+)\\_\s\-\-\>#) {
my $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"/>|;
$$settings{maindata}{text} =~ s#<\!\-\-\s_/($1)\\_\s\-\-\>#$newtag#;
} elsif ( $$settings{files}[$filecount]{reftext} =~m#^_/(\d+)\\_$# ) {
my $reftag = $1;
my $newtag;
if ($$settings{files}[$filecount]{mimetype} =~ m/^image/) {
$newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
if ( defined($$settings{files}[$filecount]{registry}{alttext}) ) {
$newtag .= qq| alt="$$settings{files}[$filecount]{registry}{alttext}"|;
}
if ( defined($$settings{files}[$filecount]{registry}{alignment}) )
{
$newtag .= qq| align="$$settings{files}[$filecount]{registry}{alignment}"|;
}
if ( defined($$settings{files}[$filecount]{registry}{border}) ) {
$newtag .= qq| border="$$settings{files}[$filecount]{registry}{border}"|;
}
$newtag .= " />";
my $reftext = $$settings{files}[$filecount]{reftext};
my $fname = $$settings{files}[$filecount]{'relfile'};
$$settings{maindata}{text} =~ s/<!\-\-\sCOMMENT\sBLOCK\sFOR\sEMBEDDED\sFILE:\s$fname[\s\n]+DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
# $$settings{maindata}{text} =~ s/DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
$$settings{maindata}{text} =~ s/Move\swhole\scomment\sto\schange\sfile\splacement\swithin\spage\.[\s\n]+//;
$$settings{maindata}{text} =~ s/_\/$reftag\\_/$newtag/;
$$settings{maindata}{text} =~ s/END\sOF\sBLOCK\sON\sNEXT\sLINE[\s\n]+//;
$$settings{maindata}{text} =~ s/\-\->//;
# $$settings{maindata}{text} =~ s/<!\-\-\sCOMMENT\sBLOCK\sFOR\sEMBEDDED\sFILE:\s$fname[\s\n]+DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n\]+_\/$reftag\\_[\s\n]+END\sOF\sBLOCK\sON\sNEXT\sLINE[\s\n\]+\-\->/$newtag/;
# print STDERR $$settings{maindata}{text};
}
} else {
my $filename=$$settings{files}[$filecount]{'relfile'};
my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
$$settings{maindata}{text} =~ s#(src|SRC|value)=("|")$filename("|")#$1="$newfilename"#g;
}
} elsif ($$settings{files}[$filecount]{fileaction} eq 'link') {
unless (($$settings{files}[$filecount]{packageparent} ne '') && (grep/^$$settings{files}[$filecount]{packageparent}$/,@{$$settings{files}}) ) {
$linktag .= qq|<a href="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
if ($$settings{newwindow} eq "true") {
$linktag .= qq| target="$res$filecount"|;
}
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|;
}
} elsif ( ($$settings{files}[$filecount]{fileaction} eq 'PACKAGE') || ($$settings{files}[$filecount]{fileaction} eq 'package') ) {
my $open_package = '';
if ($$settings{files}[$filecount]{'relfile'} =~ m|\.zip$|i) {
$open_package = &expand_zip("$docroot/$res",$$settings{files}[$filecount]{'relfile'});
}
if ($open_package eq 'ok') {
opendir(DIR,"$docroot/$res");
my @dircontents = grep(!/^\./,readdir(DIR));
closedir(DIR);
push @{$resrcfiles}, @dircontents;
@{$$hrefs{$res}} = @dircontents;
push @{$packages}, $res;
}
} elsif ( ($$settings{files}[$filecount]{fileaction} eq 'BROKEN_IMAGE') && ($cms eq 'bb6') ) {
my $filename=$$settings{files}[$filecount]{'relfile'};
my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
$$settings{maindata}{text} =~ s#(src|SRC|value)=("|")$filename("|")#$1="$newfilename"#g;
} elsif ( ($$settings{files}[$filecount]{fileaction} eq 'LINK') && ($cms eq 'bb6') ) {
my $filename=$$settings{files}[$filecount]{'relfile'};
my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
my $filetitle = $$settings{files}[$filecount]{'linkname'};
$$settings{maindata}{text} = '<a href="'.$newfilename.'">'.$filetitle.'</a><br /><br />'. $$settings{maindata}{text};
}
}
}
if (defined($$settings{maindata}{textcolor})) {
$fontcol = qq|<font color="$$settings{maindata}{textcolor}">|;
}
if (defined($$settings{maindata}{text})) {
if ($$settings{maindata}{bodytype} eq "S") {
$$settings{maindata}{text} =~ s#\n#<br/>#g;
}
if ($$settings{maindata}{ishtml} eq "false") {
if ($$settings{maindata}{isnewline} eq "true") {
$$settings{maindata}{text} =~ s#\n#<br/>#g;
}
} else {
# $$settings{maindata}{text} = &HTML::Entities::decode($$settings{maindata}{text});
}
}
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 $htmldoc = 0;
# if ($$settings{maindata}{text} =~ m-<(html|HTML)>.+<\\(html|HTML)-) {
if ($$settings{maindata}{text} =~ m-<(html|HTML)>-) {
$htmldoc = 1;
}
unless ($htmldoc) {
print FILE qq|<html>
<head>
<title>$$settings{title}</title>
</head>
<body bgcolor='#ffffff'>
$fontcol
|;
}
unless ($$settings{title} eq '') {
print FILE qq|$$settings{title}<br/><br/>\n|;
}
print FILE qq|
$$settings{maindata}{text}
$linktag|;
unless ($htmldoc) {
if (defined($$settings{maindata}{textcolor})) {
print FILE qq|</font>|;
}
print FILE qq|
</body>
</html>|;
}
close(FILE);
}
}
sub process_angelboards {
my ($context,$destdir,$boards,$timestamp,$crs,$cdom,$uname,$db_handling,$messages,$items,$resources,$hrefs,$tempdir,$longcrs) = @_;
for (my $i=0; $i<@{$boards}; $i++) {
my %msgidx = ();
my $forumtext = '';
my $boardname = 'bulletinpage_'.$$timestamp[$i];
my $forumfile = $tempdir.'/_assoc/'.$$boards[$i].'/pg'.$$boards[$i].'.htm';
my @state = ();
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "html body div div") {
$forumtext = $text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->parse_file($forumfile);
$p->eof;
my %boardinfo = (
'aaa_title' => $$items{$$resources{$$boards[$i]}{revitm}}{title},
'bbb_content' => $forumtext,
'ccc_webreferences' => '',
'uploaded.lastmodified' => time,
);
my $msgcount = 0;
my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);
if ($db_handling eq 'importall') {
foreach my $msg_id (@{$$messages{$$boards[$i]}}) {
$msgcount ++;
$msgidx{$msg_id} = $msgcount;
my %contrib = (
'sendername' => 'NoName',
'senderdomain' => $cdom,
'screenname' => '',
'message' => $$items{$$resources{$msg_id}{revitm}}{title}
);
unless ( $$items{$$resources{$msg_id}{revitm}}{parentseq} eq $$resources{$$boards[$i]}{revitm} ) {
unless ( $msgidx{$$items{$$items{$$resources{$msg_id}{revitm}}{parentseq}}{resnum}} eq ''){
$contrib{replyto} = $msgidx{$$items{$$items{$$resources{$msg_id}{revitm}}{parentseq}}{resnum}};
}
}
if ( @{$$hrefs{$msg_id}} > 1 ) {
my $newurl = '';
foreach my $file (@{$$hrefs{$msg_id}}) {
unless ($file eq 'pg'.$msg_id.'.htm') {
$newurl = $msg_id.$file;
unless ($longcrs eq '') {
if ($context eq 'CSTR') {
if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles") {
mkdir("/home/httpd/lonUsers/$cdom/$longcrs/userfiles",0755);
}
if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl") {
rename("$destdir/resfiles/$msg_id/$file","/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl");
}
}
$contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$file;
}
}
}
}
my $xmlfile = $tempdir.'/_assoc/'.$msg_id.'/'.$$resources{$msg_id}{file};
&angel_message($msg_id,\%contrib,$xmlfile);
unless ($$resources{$msg_id}{file} eq '') {
unlink($xmlfile);
}
my $symb = 'bulletin___'.$$timestamp[$i].'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$i].'/bulletinboard';
my $postresult = &addposting($symb,\%contrib,$cdom,$crs);
}
}
}
}
# ---------------------------------------------------------------- Process ANGEL message board messages
sub angel_message {
my ($msg_id,$contrib,$xmlfile) = @_;
my @state = ();
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "html body table tr td div small span") {
$$contrib{'plainname'} = $text;
} elsif ("@state" eq "html body div div") {
$$contrib{'message'} .= '<br /><br />'.$text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->parse_file($xmlfile);
$p->eof;
}
# ---------------------------------------------------------------- ANGEL content
sub angel_content {
my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
my $xmlfile = $docroot.'/_assoc/'.$res.'/pg'.$res.'.htm';
my $filecount = 0;
my $firstline;
my $lastline;
my @buffer = ();
my @state;
@{$$settings{links}} = ();
my $p = HTML::Parser->new
(
xml_mode => 1,
start_h =>
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
if ("@state" eq "html body table tr td div small span") {
$$settings{'subtitle'} = $text;
} elsif ("@state" eq "html body div div") {
$$settings{'text'} = $text;
} elsif ("@state" eq "html body div div a") {
push @{$$settings{'links'}}, $text;
}
}, "dtext"],
end_h =>
[sub {
my ($tagname) = @_;
pop @state;
}, "tagname"],
);
$p->parse_file($xmlfile);
$p->eof;
if ($type eq "PAGE") {
open(FILE,"<$xmlfile");
@buffer = <FILE>;
close(FILE);
chomp(@buffer);
$firstline = -1;
$lastline = 0;
for (my $i=0; $i<@buffer; $i++) {
if (($firstline == -1) && ($buffer[$i] =~ m/<div\sclass="normalDiv"><div\sclass="normalSpan">/)) {
$firstline = $i;
$buffer[$i] = substr($buffer[$i],index($buffer[$i],'"normalSpan"')+13);
}
if (($firstline > -1) && ($buffer[$i] =~ m-<p></p></div></div>-)) {
$buffer[$i] = substr($buffer[$i],0,index($buffer[$i],'<p></p></div></div>'));
$lastline = $i;
}
}
}
open(FILE,">$destdir/resfiles/$res.html");
push @{$resrcfiles}, "$res.html";
print FILE qq|<html>
<head>
<title>$title</title>
</head>
<body bgcolor='#ffffff'>
|;
unless ($title eq '') {
print FILE qq|<b>$title</b><br/>\n|;
}
unless ($$settings{subtitle} eq '') {
print FILE qq|$$settings{subtitle}<br/>\n|;
}
print FILE "<br/>\n";
if ($type eq "LINK") {
foreach my $link (@{$$settings{links}}) {
print FILE qq|<a href="$link">$link</a><br/>\n|;
}
} elsif ($type eq "PAGE") {
if ($firstline > -1) {
for (my $i=$firstline; $i<=$lastline; $i++) {
print FILE "$buffer[$i]\n";
}
}
}
print FILE qq|
</body>
</html>|;
close(FILE);
}
# ---------------------------------------------------------------- WebCT 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")) {
&Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
} else {
push(@{$resrcfiles}, "$res.html");
my $linktag = qq|<a href="$$settings{url}"|;
if ($title ne '') {
$linktag .= qq|>$title</a>|;
} else {
$linktag .= qq|>$$settings{url}|;
}
print FILE qq|<html>
<head>
<title>$title</title>
</head>
<body bgcolor='#ffffff'>
$linktag
</body>
</html>|;
close(FILE);
}
}
}
sub process_html {
my ($text,$caller,$html_cond,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir) = @_;
my $pathstart;
if ($context eq 'CSTR') {
$pathstart = '../..';
} else {
$pathstart = $dirname;
}
if ($caller eq 'bb5') {
if ($html_cond eq 'true') {
$$text = &HTML::Entities::decode($$text);
}
} elsif ($caller eq 'bb6') {
if ($html_cond eq 'HTML') {
$$text = &HTML::Entities::decode($$text);
}
}
if ($$text =~ m#<img src=['"]?(https?://[^\s]+/)([^/\s\'"]+)['"]?[^>]*>#) {
if (&retrieve_image($context,$res,$dirname,$cdom,$cnum,$docroot,$destdir,$1,$2) eq 'ok') {
$$text =~ s#(<img src=['"]?)(https?://[^\s]+/)([^/\s'"]+)(['"]?[^>]*>)#$1$pathstart/resfiles/$res/webimages/$3$4#g;
}
}
$$text =~ s#(<img src=[^>]+)/*>#$1 />#gi;
$$text =~ s#<br>#<br />#g;
return;
}
sub add_images_links {
my ($type,$context,$settings,$id,$dirname,$res) = @_;
my ($image,$imglink,$url,$pathstart);
if ($context eq 'CSTR') {
$pathstart = '../..';
} else {
$pathstart = $dirname;
}
if ((defined($$settings{$id}{$type}{image})) && ($$settings{$id}{$type}{image} ne '')) {
if ( $$settings{$id}{$type}{style} eq 'Inline' ) {
$image = qq|<br /><img src="$pathstart/resfiles/$res/$$settings{$id}{$type}{image}" alt="$$settings{$id}{$type}{label}"/><br />|;
} else {
$imglink = qq|<br /><a href="$pathstart/resfiles/$res/$$settings{$id}{$type}{image}">$$settings{$id}{$type}{label}</a><br />|;
}
}
if ((defined($$settings{$id}{$type}{link})) && ($$settings{$id}{$type}{link} ne '' )) {
$url = qq|<br /><a href="$$settings{$id}{$type}{link}">$$settings{$id}{$type}{linkname}</a><br />|;
}
return $image.$imglink.$url;
}
sub remove_html {
my ($choice_text) = @_;
return $choice_text;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to imsprocessor.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / imspackages