loncom/imspackages/imsprocessor.pm - diff

Return to imsprocessor.pm CVS log

Up to [LON-CAPA] / loncom / imspackages

Diff for /loncom/imspackages/imsprocessor.pm between versions 1.36 and 1.52

version 1.36, 2006/04/04 17:42:28	version 1.52, 2013/07/27 22:04:49
Line 1	Line 1
	# The LearningOnline Network with CAPA
	# Processor for IMS Packages
	#
	# $Id$
	#
# Copyright Michigan State University Board of Trustees	# Copyright Michigan State University Board of Trustees
#	#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).	# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
Line 25 package Apache::imsprocessor;	Line 30 package Apache::imsprocessor;

use Apache::lonnet;	use Apache::lonnet;
use Apache::loncleanup;	use Apache::loncleanup;
	use Apache::lonlocal;
use LWP::UserAgent;	use LWP::UserAgent;
use HTTP::Request::Common;	use HTTP::Request::Common;
use LONCAPA::Configuration;	use LONCAPA::Configuration;
Line 56 sub ims_config {	Line 62 sub ims_config {
users => 'course/x-bb-user',	users => 'course/x-bb-user',
);	);
$$cmsmap{bb6}{conference} = 'resource/x-bb-conference';	$$cmsmap{bb6}{conference} = 'resource/x-bb-conference';
%{$$cmsmap{angel}} = (	%{$$cmsmap{angel5}} = (
board => 'BOARD',	board => 'BOARD',
extlink => 'LINK',	extlink => 'LINK',
msg => 'MESSAGE',	msg => 'MESSAGE',
quiz => 'QUIZ',	quiz => 'QUIZ',
survey => 'FORM',	survey => 'FORM',
);	);
@{$$cmsmap{angel}{doc}} = ('FILE','PAGE');	@{$$cmsmap{angel5}{doc}} = ('FILE','PAGE');
%{$$cmsmap{webctce4}} = (	%{$$cmsmap{webctce4}} = (
quiz => 'webctquiz',	quiz => 'webctquiz',
survey => 'webctsurvey',	survey => 'webctsurvey',
Line 75 sub ims_config {	Line 81 sub ims_config {
survey => 'webctsurvey',	survey => 'webctsurvey',
doc => 'webcontent'	doc => 'webcontent'
);	);
%{$areaname} = (	%{$areaname} = &Apache::lonlocal::texthash (
announce => 'Announcements',	announce => 'Announcements',
board => 'Discussion Boards',	board => 'Discussion Boards',
doc => 'Documents, pages, and folders',	doc => 'Documents, pages, and folders',
Line 164 sub process_manifest {	Line 170 sub process_manifest {
my %toc = (	my %toc = (
bb6 => 'organization',	bb6 => 'organization',
bb5 => 'tableofcontents',	bb5 => 'tableofcontents',
angel => 'organization',	angel5 => 'organization',
webctce4 => 'organization',	webctce4 => 'organization',
webctvista4 => 'organization'	webctvista4 => 'organization'
);	);
Line 177 sub process_manifest {	Line 183 sub process_manifest {
revitm => 'Top'	revitm => 'Top'
);	);

if ($cms eq 'angel') {	if ($cms eq 'angel5') {
$$resources{'toplevel'}{type} = "FOLDER";	$$resources{'toplevel'}{type} = "FOLDER";
} elsif ($cms eq 'bb5' \|\| $cms eq 'bb6') {	} elsif ($cms eq 'bb5' \|\| $cms eq 'bb6') {
$$resources{'toplevel'}{type} = 'resource/x-bb-document';	$$resources{'toplevel'}{type} = 'resource/x-bb-document';
Line 197 sub process_manifest {	Line 203 sub process_manifest {

sub parse_manifest {	sub parse_manifest {
my ($cms,$phase,$tempdir,$xmlfile,$toc,$includedres,$includeditems,$items,	my ($cms,$phase,$tempdir,$xmlfile,$toc,$includedres,$includeditems,$items,
$resources,$resinfo,$hrefs,$seq) = @_;	$resources,$resinfo,$hrefs,$seq,$requirer) = @_;
my @state = ();	my @state = ();
my $itm = '';	my $itm = '';
my %contents = ();	my %contents = ();
my $identifier = '';	my $identifier = '';
my @allidentifiers = ();	my @allidentifiers = ();
my $lastitem;	my $lastitem;
	my $neededby;
my $p = HTML::Parser->new	my $p = HTML::Parser->new
(	(
xml_mode => 1,	xml_mode => 1,
Line 224 sub parse_manifest {	Line 231 sub parse_manifest {
if ($cms eq 'bb5') {	if ($cms eq 'bb5') {
$$items{$itm}{title} = $attr->{title};	$$items{$itm}{title} = $attr->{title};
}	}
} elsif ($cms eq 'angel') {	} elsif ($cms eq 'angel5') {
if ($attr->{identifierref} =~ m/^res(.+)$/) {	if ($attr->{identifierref} =~ m/^res(.+)$/) {
$$items{$itm}{resnum} = $1;	$$items{$itm}{resnum} = $1;
}	}
}	}
unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {	unless (%{$$resources{$$items{$itm}{resnum}}}) {
%{$$resources{$$items{$itm}{resnum}}} = ();	%{$$resources{$$items{$itm}{resnum}}} = ();
}	}
$$resources{$$items{$itm}{resnum}}{revitm} = $itm;	$$resources{$$items{$itm}{resnum}}{revitm} = $itm;
Line 292 sub parse_manifest {	Line 299 sub parse_manifest {
} elsif ($cms eq 'webctvista4') {	} elsif ($cms eq 'webctvista4') {
$$resources{$identifier}{type} = $attr->{type};	$$resources{$identifier}{type} = $attr->{type};
$$resources{$identifier}{'webct:coType'} = $attr->{'webct:coType'};	$$resources{$identifier}{'webct:coType'} = $attr->{'webct:coType'};
} elsif ($cms eq 'angel') {	} elsif ($cms eq 'angel5') {
$identifier = substr($identifier,3);	$identifier = substr($identifier,3);
if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {	if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
$$resources{$identifier}{file} = $1;	$$resources{$identifier}{file} = $1;
Line 302 sub parse_manifest {	Line 309 sub parse_manifest {
}	}
} elsif ("@state" eq "manifest resources resource file") {	} elsif ("@state" eq "manifest resources resource file") {
if ($$includedres{$identifier} \|\| $phase ne 'build') {	if ($$includedres{$identifier} \|\| $phase ne 'build') {
if ($cms eq 'webctvista4') {
$$resources{$identifier}{file} = $attr->{href};
}
if ($cms eq 'bb5' \|\| $cms eq 'bb6' \|\|	if ($cms eq 'bb5' \|\| $cms eq 'bb6' \|\|
$cms eq 'webctce4' \|\| $cms eq 'webctvista4') {	$cms eq 'webctce4' \|\| $cms eq 'webctvista4') {
push @{$$hrefs{$identifier}},$attr->{href};

if ($$resources{$identifier}{type} eq	if ($$resources{$identifier}{type} eq
'webct.manifest') {	'webct.manifest') {
my $manifestfile = $tempdir.'/'.$attr->{href};	my $manifestfile = $tempdir.'/'.$attr->{href};
Line 320 sub parse_manifest {	Line 322 sub parse_manifest {
&parse_manifest($cms,$phase,$tempdir,$manifestfile,	&parse_manifest($cms,$phase,$tempdir,$manifestfile,
$toc,$includedres,$includeditems,	$toc,$includedres,$includeditems,
$items,$resources,$resinfo,	$items,$resources,$resinfo,
$hrefs,$currseqref);	$hrefs,$currseqref,$neededby);
	} else {
	if ($cms eq 'webctvista4') {
	if ($$resources{$identifier}{type} eq 'ims_qtiasiv1p2') {
	$neededby = $identifier;
	} elsif ($$resources{$identifier}{type} eq 'webcontent') {
	$$resources{$identifier}{usedby} = $requirer;
	push(@{$$hrefs{$identifier}},$attr->{href});
	}
	$$resources{$identifier}{file} = $attr->{href};
	} else {
	push(@{$$hrefs{$identifier}},$attr->{href});
	}
}	}
} elsif ($cms eq 'angel') {	} elsif ($cms eq 'angel5') {
if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {	if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
push @{$$hrefs{$identifier}},$1;	push @{$$hrefs{$identifier}},$1;
} elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {	} elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
$$resources{$identifier}{type} = $1;	$$resources{$identifier}{type} = $1;
}	}
}	}
}	}
} elsif ("@state" eq "manifest webct:ContentObject") {	} elsif ("@state" eq "manifest webct:ContentObject") {
foreach my $ident (@allidentifiers) {	foreach my $ident (@allidentifiers) {
Line 346 sub parse_manifest {	Line 360 sub parse_manifest {
}	}
if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq $$toc{$cms} && $state[-1] eq "title") {	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 ($$includeditems{$itm} \|\| $phase ne 'build') {
if ($cms eq 'angel' \|\| $cms eq 'bb6' \|\| $cms eq 'webctvista4') {	if ($cms eq 'angel5' \|\| $cms eq 'bb6' \|\| $cms eq 'webctvista4') {
$$items{$itm}{title} = $text;	$$items{$itm}{title} = $text;
}	}
if ($cms eq 'webctce4') {	if ($cms eq 'webctce4') {
Line 355 sub parse_manifest {	Line 369 sub parse_manifest {
}	}
}	}
}	}
	if ("@state" eq "manifest webct:ContentObject webct:Name") {
	if ($cms eq 'webctvista4') {
	$$resources{$identifier}{title} = (split(/,/,$text))[-1];
	}
	}
}, "dtext"],	}, "dtext"],
end_h =>	end_h =>
[sub {	[sub {
Line 400 sub get_parents {	Line 419 sub get_parents {

sub target_resources {	sub target_resources {
my ($resources,$oktypes,$targets) = @_;	my ($resources,$oktypes,$targets) = @_;
foreach my $key (keys %{$resources}) {	foreach my $key (sort(keys(%{$resources}))) {
if ( defined($$oktypes{$$resources{$key}{type}}) ) {	if ( defined($$oktypes{$$resources{$key}{type}}) ) {
push @{$targets}, $key;	push(@{$targets},$key);
	} elsif (defined($$resources{$key}{usedby})) {
	if (defined($$oktypes{$$resources{$$resources{$key}{usedby}}{type}})) {
	push(@{$targets},$key);
	}
}	}
}	}
return;	return;
}	}

sub copy_resources {	sub copy_resources {
my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles) = @_;	my ($context,$cms,$hrefs,$resources,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles,$total) = @_;
if ($context eq 'DOCS') {	if ($context eq 'DOCS') {
foreach my $key (sort keys %{$hrefs}) {	foreach my $key (sort keys %{$hrefs}) {
if (grep/^$key$/,@{$targets}) {	if (grep/^$key$/,@{$targets}) {
Line 421 sub copy_resources {	Line 444 sub copy_resources {
}	}
my $filename = '';	my $filename = '';
my $fpath = $timenow.'/resfiles/'.$key.'/';	my $fpath = $timenow.'/resfiles/'.$key.'/';
if ($cms eq 'angel') {	if ($cms eq 'angel5') {
if ($file eq 'pg'.$key.'.htm') {	if ($file eq 'pg'.$key.'.htm') {
next;	next;
}	}
Line 433 sub copy_resources {	Line 456 sub copy_resources {
$copyfile = $1;	$copyfile = $1;
}	}
}	}
	if ($cms eq 'webctvista4') {
	if ($file =~ m{/\QX-WEBCT-VISTA-V0\E/.+([^.]+)$}) {
	$copyfile = $1;
	}
	if ($$resources{$key}{usedby}) {
	if ($$resources{$$resources{$key}{usedby}}{image} =~ /^\Q$copyfile\E/) {
	$copyfile = $$resources{$$resources{$key}{usedby}}{image};
	}
	}
	}
unless ((($cms eq 'webctce4') && ($copyfile =~ m/questionDB\.xml$/ \|\| $copyfile =~ m/quiz_QIZ_\d+\.xml$/ \|\| $copyfile =~ m/properties_QIZ_\d+\.xml$/)) \|\| (($cms eq 'webctvista4') && (grep/^$key$/,@{$assessmentfiles}) && $file =~ /\.xml$/)) {	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;	$copyfile = $fpath.$copyfile;
my $fileresult;	my $fileresult;
Line 447 sub copy_resources {	Line 480 sub copy_resources {
if (!-e "$destdir/resfiles") {	if (!-e "$destdir/resfiles") {
mkdir("$destdir/resfiles",0770);	mkdir("$destdir/resfiles",0770);
}	}
foreach my $key (sort keys %{$hrefs}) {	foreach my $key (sort(keys(%{$hrefs}))) {
if (grep/^$key$/,@{$targets}) {	if (grep/^$key$/,@{$targets}) {
foreach my $file (@{$$hrefs{$key}}) {	foreach my $file (@{$$hrefs{$key}}) {
$file =~ s-\\-/-g;	$file =~ s-\\-/-g;
if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') \|\| ($cms eq 'bb5') \|\| ($cms eq 'bb6')) {	if ( ($cms eq 'angel5' && $file ne 'pg'.$key.'.htm') \|\| ($cms eq 'bb5') \|\| ($cms eq 'bb6')) {
if (!-e "$destdir/resfiles/$key") {	if (!-e "$destdir/resfiles/$key") {
mkdir("$destdir/resfiles/$key",0770);	mkdir("$destdir/resfiles/$key",0770);
}	}
Line 466 sub copy_resources {	Line 499 sub copy_resources {
mkdir("$fulldir",0770);	mkdir("$fulldir",0770);
}	}
}	}
if ($cms eq 'angel') {	my $renameres;
rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");	if ($cms eq 'angel5') {
	$renameres = rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
} elsif ($cms eq 'bb5' \|\| $cms eq 'bb6') {	} elsif ($cms eq 'bb5' \|\| $cms eq 'bb6') {
rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");	$renameres = rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
	}
	if ($renameres) {
	if (ref($total) eq 'HASH') {
	$$total{'file'} ++;
	}
	} else {
	&Apache::lonnet::logthis("IMS import error: $cms - renaming failed for file $file");
}	}
} elsif ($cms eq 'webctce4') {	} elsif ($cms eq 'webctce4') {
if ($file =~ m-/my_files/(.+)$-) {	if ($file =~ m-/my_files/(.+)$-) {
Line 486 sub copy_resources {	Line 527 sub copy_resources {
}	}
}	}
if (-e "$tempdir/$file") {	if (-e "$tempdir/$file") {
rename("$tempdir/$file","$destdir/resfiles/$copyfile");	my $renameres = rename("$tempdir/$file","$destdir/resfiles/$copyfile");
	if ($renameres) {
	if (ref($total) eq 'HASH') {
	$$total{'file'} ++;
	}
	} else {
	&Apache::lonnet::logthis("IMS import error: WebCT4 - renaming failed for file $file");
	}
}	}
} elsif ($file !~ m-/data/(.+)$-) {	} elsif ($file !~ m-/data/(.+)$-) {
&Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");	&Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
}	}
	} elsif ($cms eq 'webctvista4') {
	if ($file =~ m{^\QX-WEBCT-VISTA-V0\E/(.+)$}) {
	my $copyfile = $1;
	if ($copyfile =~ m{^[^/]+/[^/]+}) {
	my @dirs = split/\//,$copyfile;
	my $path = "$destdir/resfiles";
	while (@dirs > 1) {
	$path .= '/'.$dirs[0];
	if (!-e "$path") {
	mkdir("$path",0755);
	}
	shift @dirs;
	}
	} else {
	$copyfile =~ s/^[^.]+\.(\d+)_R/$1/;
	my ($filestem,$extension) = ($copyfile =~ /^(.+)\.(\w+)$/);
	if ($$resources{$key}{usedby}) {
	if (ref($$resources{$$resources{$key}{usedby}}{image}) eq 'ARRAY') {
	for (my $i=0; $i<@{$$resources{$$resources{$key}{usedby}}{image}}; $i++) {
	my ($img,$imgtitle);
	$img = $$resources{$$resources{$key}{usedby}}{image}[$i];
	if (ref($$resources{$$resources{$key}{usedby}}{imagetitle}) eq 'ARRAY') {
	$imgtitle = $$resources{$$resources{$key}{usedby}}{imagetitle}[$i];
	}
	if (($img =~ /^\Q$filestem\E/i) && ($imgtitle =~ /\Q$extension\E/i)) {
	$copyfile = $img.'_'.$imgtitle;
	last;
	} elsif ($img =~ /^\Q$filestem\E/i) {
	$copyfile = $img.'.'.$extension;
	last;
	}
	}
	}
	}
	}
	if (-e "$tempdir/$file") {
	my $renameres = rename("$tempdir/$file","$destdir/resfiles/$copyfile");
	if ($renameres) {
	if (ref($total) eq 'HASH') {
	$$total{'file'} ++;
	}
	} else {
	&Apache::lonnet::logthis("IMS import error: WebCTVista - renaming failed for file $file");
	}
	}
	}
}	}
}	}
}	}
Line 517 sub process_resinfo {	Line 611 sub process_resinfo {
mkdir("$destdir/resfiles",0770);	mkdir("$destdir/resfiles",0770);
}	}
}	}
if ($cms eq 'angel') {	if ($cms eq 'angel5') {
my $currboard = '';	my $currboard = '';
foreach my $key (sort keys %{$resources}) {	foreach my $key (sort keys %{$resources}) {
if (grep/^$key$/,@{$targets}) {	if (grep/^$key$/,@{$targets}) {
Line 620 sub process_resinfo {	Line 714 sub process_resinfo {
if (grep/^$key$/,@{$targets}) {	if (grep/^$key$/,@{$targets}) {
if ($$resources{$key}{type} eq "webcontent") {	if ($$resources{$key}{type} eq "webcontent") {
%{$$resinfo{$key}} = ();	%{$$resinfo{$key}} = ();
&webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);	if ($$resources{$key}{file} eq 'questiondb.xml') {
	&process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
	} else {
	&webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
	}
} elsif ($$resources{$key}{type} eq "webctquiz") {	} 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);	&process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
}	}
Line 655 sub process_resinfo {	Line 753 sub process_resinfo {
$cid = $env{'request.course.id'};	$cid = $env{'request.course.id'};
}	}
my $destresdir = $destdir;	my $destresdir = $destdir;
	my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
$destresdir =~ s\|/home/$uname/public_html/\|/res/$udom/$uname/\|;	$destresdir =~ s{^\Q$londocroot/priv/\E}{/res/};
} elsif ($context eq 'DOCS') {	} elsif ($context eq 'DOCS') {
$destresdir =~ s\|^/home/httpd/html/userfiles\|/uploaded\|;	$destresdir =~ s{^\Q$londocroot/userfiles\E}{/uploaded};
}	}
foreach my $res (sort(keys(%allquestions))) {	foreach my $res (sort(keys(%allquestions))) {
my $parent = $allquestions{$res};	my $parent = $allquestions{$res};
Line 735 sub build_structure {	Line 834 sub build_structure {
my $curr_id = 1;	my $curr_id = 1;
my $resnum = $$items{$key}{resnum};	my $resnum = $$items{$key}{resnum};
my $type = $$resources{$resnum}{type};	my $type = $$resources{$resnum}{type};
my $contentscount = $$items{$key}{'contentscount'};	my $contentscount = $$items{$key}{'contentscount'};
if (($cms eq 'angel' && $type eq "FOLDER") \|\| (($cms eq 'bb5' \|\| $cms eq 'bb6') && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") \|\| ($type eq "resource/x-bb-staffinfo") \|\| ($type eq "resource/x-bb-externallink")) \|\| ($cms eq 'webctce4' && $contentscount > 0)) {	my $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') {	unless (($cms eq 'bb5') && $key eq 'Top') {
$seqtext{$key} = "<map>\n";	$seqtext{$key} = "<map>\n";
}	}
Line 773 sub build_structure {	Line 876 sub build_structure {
if (grep/^$res$/,@{$packages}) {	if (grep/^$res$/,@{$packages}) {
$packageflag = 1;	$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});	$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) {	unless ($flag{$key}{page} == 1) {
if ($$randompicks{$contitem}) {	if ($$randompicks{$contitem}) {
$seqtext{$key} .= qq\|	$seqtext{$key} .= qq\|
Line 813 sub build_structure {	Line 916 sub build_structure {
if (grep/^$res$/,@{$packages}) {	if (grep/^$res$/,@{$packages}) {
$packageflag = 1;	$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});	$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) {	unless ($flag{$key}{page} == 1) {
$seqtext{$key} .= qq\|></resource>	$seqtext{$key} .= qq\|></resource>
<link from="$curr_id" to="$next_id" index="$curr_id"></link>\n\|;	<link from="$curr_id" to="$next_id" index="$curr_id"></link>\n\|;
Line 845 sub build_structure {	Line 948 sub build_structure {
if (grep/^$res$/,@{$packages}) {	if (grep/^$res$/,@{$packages}) {
$packageflag = 1;	$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});	$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 ($flag{$key}{page}) {
if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {	if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {
Line 879 sub build_structure {	Line 982 sub build_structure {
}	}
unless (($cms eq 'bb5') && $key eq 'Top') {	unless (($cms eq 'bb5') && $key eq 'Top') {
$seqtext{$key} .= "</map>\n";	$seqtext{$key} .= "</map>\n";
open(LOCFILE,">$destdir/sequences/$key.sequence");	if ($cms eq 'webctce4' && $key ne 'Top') {
	push @{$seqfiles}, "$seqtitle.sequence";
	open(LOCFILE,">$destdir/sequences/$seqtitle.sequence");
	} else {
	push @{$seqfiles}, "$key.sequence";
	open(LOCFILE,">$destdir/sequences/$key.sequence");
	}
print LOCFILE $seqtext{$key};	print LOCFILE $seqtext{$key};
close(LOCFILE);	close(LOCFILE);
push @{$seqfiles}, "$key.sequence";
}	}
$count{$key}{page} ++;	$count{$key}{page} ++;
$$total{page} += $count{$key}{page};	$$total{page} += $count{$key}{page};
Line 972 sub build_structure {	Line 1080 sub build_structure {
}	}

sub make_structure {	sub make_structure {
my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$randompick) = @_;	my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$randompick,$title) = @_;
my $src ='';	my $src ='';
if (($cms eq 'angel' && $type eq 'FOLDER') \|\| (($cms eq 'bb5' \|\| $cms eq 'bb6') && (($$resinfo{$res}{'isfolder'} eq 'true') \|\| $key eq 'Top')) \|\| ($cms eq 'webctce4' && $contitemcount > 0)) {	if (($cms eq 'angel5' && $type eq 'FOLDER') \|\| (($cms eq 'bb5' \|\| $cms eq 'bb6') && (($$resinfo{$res}{'isfolder'} eq 'true') \|\| $key eq 'Top')) \|\| ($cms eq 'webctce4' && $contitemcount > 0)) {
$src = $srcstem.'/sequences/'.$contitem.'.sequence';	$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}{page} = 0;
$$flag{$key}{seq} = 1;	$$flag{$key}{seq} = 1;
$$count{$key}{seq} ++;	$$count{$key}{seq} ++;
Line 984 sub make_structure {	Line 1098 sub make_structure {
$$flag{$key}{page} = 0;	$$flag{$key}{page} = 0;
$$flag{$key}{seq} = 1;	$$flag{$key}{seq} = 1;
$$count{$key}{seq} ++;	$$count{$key}{seq} ++;
} elsif ($cms eq 'angel' && $type eq 'BOARD') {	} elsif ($cms eq 'angel5' && $type eq 'BOARD') {
$src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard';	$src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard';
$$flag{$key}{page} = 0;	$$flag{$key}{page} = 0;
$$flag{$key}{board} = 1;	$$flag{$key}{board} = 1;
$$count{$key}{board} ++;	$$count{$key}{board} ++;
} elsif ($cms eq 'angel' && $type eq "FILE") {	} elsif ($cms eq 'angel5' && $type eq "FILE") {
foreach my $file (@{$$hrefs{$res}}) {	foreach my $file (@{$$hrefs{$res}}) {
unless ($file eq 'pg'.$res.'.htm') {	unless ($file eq 'pg'.$res.'.htm') {
$src = $srcstem.'/resfiles/'.$res.'/'.$file;	$src = $srcstem.'/resfiles/'.$res.'/'.$file;
Line 997 sub make_structure {	Line 1111 sub make_structure {
}	}
$$flag{$key}{page} = 0;	$$flag{$key}{page} = 0;
$$flag{$key}{file} = 1;	$$flag{$key}{file} = 1;
} elsif ($cms eq 'angel' && (($type eq "PAGE") \|\| ($type eq "LINK")) ) {	} elsif ($cms eq 'angel5' && (($type eq "PAGE") \|\| ($type eq "LINK")) ) {
if ($$flag{$key}{page}) {	if ($$flag{$key}{page}) {
if ($$count{$key}{page} == -1) {	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.");	&Apache::lonnet::logthis("IMS Angel import error in array index for page: value = -1, resource is $key, type is $type.");
Line 1038 sub make_structure {	Line 1152 sub make_structure {
if ($file =~ m-/([^/]+)$-) {	if ($file =~ m-/([^/]+)$-) {
$filename = $1;	$filename = $1;
}	}
$src = $srcstem.'/resfiles/'.$res.'/'.$filename;	$src = $srcstem.'/resfiles/'.$filename;
} else {	} else {
foreach my $file (@{$$hrefs{$res}}) {	foreach my $file (@{$$hrefs{$res}}) {
my $filename;	my $filename;
if ($file =~ m-/([^/]+)$-) {	if ($file =~ m-/my_files/(.+)$-) {
	$filename = $1;
	} elsif ($file =~ m-/([^/]+)$-) {
$filename = $1;	$filename = $1;
}	}
$src = $srcstem.'/resfiles/'.$res.'/'.$filename;	$src = $srcstem.'/resfiles/'.$filename;
}	}
}	}
$$flag{$key}{page} = 0;	$$flag{$key}{page} = 0;
Line 1076 sub process_specials {	Line 1192 sub process_specials {
pools => 'pools'	pools => 'pools'
);	);
my %seqtitles = (	my %seqtitles = (
boards => 'Course Bulletin Boards',	boards => 'Course Discussion Boards',
quizzes => 'Course Quizzes',	quizzes => 'Course Quizzes',
surveys => 'Course Surveys',	surveys => 'Course Surveys',
announcements => 'Course Announcements',	announcements => 'Course Announcements',
Line 1417 sub process_staff {	Line 1533 sub process_staff {
<font face="arial" size="2"><b>Office Hours:</b></font>	<font face="arial" size="2"><b>Office Hours:</b></font>
</td>	</td>
<td>	<td>
<font face=arial size=2>$$settings{office}{hours}</font>	<font face="arial" size="2">$$settings{office}{hours}</font>
</td>	</td>
</tr>	</tr>
\|;	\|;
Line 1739 sub process_db {	Line 1855 sub process_db {
}	}
}	}

# ---------------------------------------------------------------- Add Posting to Bulletin Board	# ---------------------------------------------------------------- Add Posting to Discussion Board
sub addposting {	sub addposting {
my ($symb,$contrib,$cdom,$crs)=@_;	my ($symb,$contrib,$cdom,$crs)=@_;
my $status='';	my $status='';
Line 2178 sub parse_webctvista4_assessment {	Line 2294 sub parse_webctvista4_assessment {
my ($tagname, $attr) = @_;	my ($tagname, $attr) = @_;
push @state, $tagname;	push @state, $tagname;
my @seq = ();	my @seq = ();
	if ("@state" eq "questestinterop assessment") {
	$$qzparams{$res}{id} = $attr->{'ident'};
	$$qzparams{$res}{title} = $attr->{'title'};
	}
if ("@state" eq "questestinterop assessment section itemref") {	if ("@state" eq "questestinterop assessment section itemref") {
$id = $attr->{linkrefid};	$id = $attr->{linkrefid};
push(@{$allids},$id);	push(@{$allids},$id);
Line 2186 sub parse_webctvista4_assessment {	Line 2306 sub parse_webctvista4_assessment {
if ("@state" eq "questestinterop assessment section selection_ordering order") {	if ("@state" eq "questestinterop assessment section selection_ordering order") {
$$qzparams{$res}{order_type} = $attr->{order_type};	$$qzparams{$res}{order_type} = $attr->{order_type};
}	}

}, "tagname, attr"],	}, "tagname, attr"],
text_h =>	text_h =>
[sub {	[sub {
Line 2267 sub parse_webctvista4_question {	Line 2386 sub parse_webctvista4_question {
my $currindex;	my $currindex;
my %varinfo = ();	my %varinfo = ();
my $formula;	my $formula;
	my $jumbnum = 0;
my $p = HTML::Parser->new	my $p = HTML::Parser->new
(	(
xml_mode => 1,	xml_mode => 1,
Line 2312 sub parse_webctvista4_question {	Line 2432 sub parse_webctvista4_question {
$$settings{$id}{text} .= '['.$attr->{'webct:name'}.']';	$$settings{$id}{text} .= '['.$attr->{'webct:name'}.']';
}	}
if ("@state" eq "questestinterop item presentation flow material matimage") {	if ("@state" eq "questestinterop item presentation flow material matimage") {
$$settings{$id}{image} = $attr->{uri};	if ($attr->{uri} =~ /\QRelativeResourceManager?contentID=\E(\d+)$/) {
	$$settings{$id}{image} = $1;
	push(@{$$resources{$res}{image}},$$settings{$id}{image});
	} else {
	$$settings{$id}{image} = $attr->{uri};
	}
}	}

if ("@state" eq "questestinterop item presentation flow material mattext") {	if ("@state" eq "questestinterop item presentation flow material mattext") {
Line 2332 sub parse_webctvista4_question {	Line 2457 sub parse_webctvista4_question {
%{$$settings{$id}{$list}} = ();	%{$$settings{$id}{$list}} = ();
@{$$allanswers{$id}{$list}} = ();	@{$$allanswers{$id}{$list}} = ();
@{$$settings{$id}{$list}{correctanswer}} = ();	@{$$settings{$id}{$list}{correctanswer}} = ();
	@{$$settings{$id}{$list}{jumbledtext}} = ();
	@{$$settings{$id}{$list}{jumbledtype}} = ();
@{$$settings{$id}{$list}{jumbled}} = ();	@{$$settings{$id}{$list}{jumbled}} = ();
$$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};	$$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};
}	}
Line 2350 sub parse_webctvista4_question {	Line 2477 sub parse_webctvista4_question {
$currtexttype = lc($attr->{texttype});	$currtexttype = lc($attr->{texttype});
$$settings{$id}{$list}{$jumble_item}{texttype} = $currtexttype;	$$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	if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varequal") { # Jumbled
$currindex = $attr->{index};	$currindex = $attr->{index};
}	}
if ("@state" eq "questestinterop item presentation flow response_lid render_choice") {	if ("@state" eq "questestinterop item presentation flow response_lid render_choice") {
$$settings{$id}{$list}{randomize} = $attr->{shuffle};	$$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") {	if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label") {
$answer_id = $attr->{ident};	$answer_id = $attr->{ident};
push(@{$$allanswers{$id}{$list}},$answer_id);	push(@{$$allanswers{$id}{$list}},$answer_id);
Line 2403 sub parse_webctvista4_question {	Line 2538 sub parse_webctvista4_question {
%{$$settings{$id}{$str_id}{$label}} = ();	%{$$settings{$id}{$str_id}{$label}} = ();
$$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;	$$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
if ($$settings{$id}{class} eq 'string') {	if ($$settings{$id}{class} eq 'string') {
$$settings{$id}{text} .= '[blank]';	$$settings{$id}{text} .= '________';
}	}
}	}
if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label material mattext") { # Paragraph	if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label material mattext") { # Paragraph
Line 2414 sub parse_webctvista4_question {	Line 2549 sub parse_webctvista4_question {
$grp = $attr->{ident};	$grp = $attr->{ident};
push(@{$$settings{$id}{grps}},$grp);	push(@{$$settings{$id}{grps}},$grp);
%{$$settings{$id}{$grp}} = ();	%{$$settings{$id}{$grp}} = ();
	@{$$allanswers{$id}{$grp}} = ();
@{$$settings{$id}{$grp}{correctanswer}} = ();	@{$$settings{$id}{$grp}{correctanswer}} = ();
$$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};	$$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};
}	}
Line 2421 sub parse_webctvista4_question {	Line 2557 sub parse_webctvista4_question {
$currtexttype = lc($attr->{texttype});	$currtexttype = lc($attr->{texttype});
$$settings{$id}{$grp}{texttype} = $currtexttype;	$$settings{$id}{$grp}{texttype} = $currtexttype;
}	}
if ("@state" eq "questestinterop item presentation flow flow response_grp render_choice response_label") {	if ("@state" eq "questestinterop item presentation flow flow response_grp render_choice flow_label response_label") {
$answer_id = $attr->{ident};	$answer_id = $attr->{ident};
push(@{$$allanswers{$id}{$grp}},$answer_id);	push(@{$$allanswers{$id}{$grp}},$answer_id);
%{$$settings{$id}{$grp}{$answer_id}} = ();	%{$$settings{$id}{$grp}{$answer_id}} = ();
Line 2436 sub parse_webctvista4_question {	Line 2572 sub parse_webctvista4_question {
} elsif (($$settings{$id}{class} eq 'string') \|\|	} elsif (($$settings{$id}{class} eq 'string') \|\|
($$settings{$id}{class} eq 'shortanswer')) {	($$settings{$id}{class} eq 'shortanswer')) {
$label = $attr->{respident};	$label = $attr->{respident};
	$$settings{$id}{$label}{case} = $attr->{'case'};
} elsif ($$settings{$id}{class} eq 'match') {	} elsif ($$settings{$id}{class} eq 'match') {
$grp = $attr->{respident};	$grp = $attr->{respident};
}	}
Line 2508 sub parse_webctvista4_question {	Line 2645 sub parse_webctvista4_question {
if ($currtexttype eq '/text/html') {	if ($currtexttype eq '/text/html') {
$text =~ s#(<img\ssrc=")([^"]+)">#$1../resfiles/$2#g;	$text =~ s#(<img\ssrc=")([^"]+)">#$1../resfiles/$2#g;
}	}
	if ("@state" eq "questestinterop item presentation flow material matimage") {
	my $imagetitle = (split(/,/,$text))[-1];
	$$settings{$id}{imagetitle} = $imagetitle;
	push(@{$$resources{$res}{imagetitle}},$imagetitle);
	}
if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldlabel") {	if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldlabel") {
$fieldlabel = $text;	$fieldlabel = $text;
}	}
Line 2535 sub parse_webctvista4_question {	Line 2677 sub parse_webctvista4_question {
$$settings{$id}{$str_id}{$label}{$textlabel} = $text;	$$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") {	if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mattext") {
$$settings{$id}{$list}{$answer_id}{text} .= $text;	$$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") {	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;	$$settings{$id}{$list}{$answer_id}{text} = $text;
}	}
if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object material mattext") {	if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object material mattext") {
$$settings{$id}{$list}{text} .= $text;	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") {	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;	$$settings{$id}{$list}{$jumble_item}{text} = $text;
$$settings{$id}{$list}{text} .= $text;	push(@{$$settings{$id}{$list}{jumbledtext}},$text);
	push(@{$$settings{$id}{$list}{jumbledtype}},'Yes');
}	}
if ("@state" eq "questestinterop item presentation flow material mattext") {	if ("@state" eq "questestinterop item presentation flow material mattext") {
$$settings{$id}{text} .= $text;	$$settings{$id}{text} .= $text;
Line 2559 sub parse_webctvista4_question {	Line 2705 sub parse_webctvista4_question {
}	}
}	}
}	}
	# 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") {	if ("@state" eq "questestinterop item resprocessing itemproc_extension unit_eval conditionvar varequal") {
$$settings{$id}{$numid}{$unitid}{text} = $text;	$$settings{$id}{$numid}{$unitid}{text} = $text;
}	}
Line 2582 sub parse_webctvista4_question {	Line 2739 sub parse_webctvista4_question {
}	}
}	}
}	}

if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varequal") { # Jumbled	if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varequal") { # Jumbled
$$settings{$id}{$list}{jumbled}[$currindex] = $text;	$$settings{$id}{$list}{jumbled}[$jumbnum][$currindex] = $text;
}	}
if ("@state" eq "questestinterop item resprocessing respcondition setvar") {	if ("@state" eq "questestinterop item resprocessing respcondition setvar") {
if ($setvar{varname} eq "SCORE") { # Multiple Choice, String or Match	if ($setvar{varname} eq "SCORE") { # Multiple Choice, String or Match
Line 2711 sub parse_webct4_quizprops {	Line 2869 sub parse_webct4_quizprops {

sub parse_webct4_questionDB {	sub parse_webct4_questionDB {
my ($docroot,$href,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;	my ($docroot,$href,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;
$href =~ s#[^/]+$##;	my $xmlfile;
my $xmlfile = $docroot.'/'.$href.'questionDB.xml'; #quizDB file	if ($href eq 'questiondb.xml') {
	$xmlfile = $docroot.'/'.$href;
	} else {
	$href =~ s#[^/]+$##;
	$xmlfile = $docroot.'/'.$href.'questionDB.xml'; #quizDB file
	}
my @state = ();	my @state = ();
my $category; # the current category ID	my $category; # the current category ID
my $id; # the current question ID	my $id; # the current question ID
Line 2733 sub parse_webct4_questionDB {	Line 2896 sub parse_webct4_questionDB {
action => '',	action => '',
);	);
my $currtexttype;	my $currtexttype;
my $currimagtype;	my $currimagtype;
	my $is_objectbank;
my $p = HTML::Parser->new	my $p = HTML::Parser->new
(	(
xml_mode => 1,	xml_mode => 1,
start_h =>	start_h =>
[sub {	[sub {
my ($tagname, $attr) = @_;	my ($tagname, $attr) = @_;
push @state, $tagname;	if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) {
	$is_objectbank = 1;
	} else {
	push @state, $tagname;
	}
if ("@state" eq "questestinterop section") {	if ("@state" eq "questestinterop section") {
$category = $attr->{ident};	$category = $attr->{ident};
%{$$catinfo{$category}} = ();	%{$$catinfo{$category}} = ();
Line 2802 sub parse_webct4_questionDB {	Line 2970 sub parse_webct4_questionDB {
$$settings{$id}{texttype} = $attr->{texttype};	$$settings{$id}{texttype} = $attr->{texttype};
$currtexttype = $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") {	if ("@state" eq "questestinterop section item presentation flow response_lid") {
$$settings{$id}{class} = 'multiplechoice';	$$settings{$id}{class} = 'multiplechoice';
$list = $attr->{ident};	$list = $attr->{ident};
Line 2823 sub parse_webct4_questionDB {	Line 2997 sub parse_webct4_questionDB {
$$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};	$$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
$currtexttype = $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	# Numerical
if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {	if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
Line 2909 sub parse_webct4_questionDB {	Line 3087 sub parse_webct4_questionDB {
}	}
}	}
if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {	if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
$setvar{varname} = $attr->{varname};	foreach my $key (keys(%{$attr})) {
	$setvar{$key} = $attr->{$key};
	}
if ($setvar{varname} eq 'WebCT_Correct') {	if ($setvar{varname} eq 'WebCT_Correct') {
push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);	push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
}	}
Line 2940 sub parse_webct4_questionDB {	Line 3120 sub parse_webct4_questionDB {
}	}
if ("@state" eq "questestinterop section item itemfeedback") {	if ("@state" eq "questestinterop section item itemfeedback") {
$fdbk = $attr->{ident};	$fdbk = $attr->{ident};
	push(@{$$settings{$id}{feedback}},$fdbk);
$$settings{$id}{$fdbk}{view} = $attr->{view};	$$settings{$id}{$fdbk}{view} = $attr->{view};
}	}
if ("@state" eq "questestinterop section item itemfeedback material mattext") {	if ("@state" eq "questestinterop section item itemfeedback material mattext") {
Line 2983 sub parse_webct4_questionDB {	Line 3164 sub parse_webct4_questionDB {
if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {	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;	$$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	# Numerical
if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {	if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
Line 3021 sub parse_webct4_questionDB {	Line 3205 sub parse_webct4_questionDB {
}	}
}	}
if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {	if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
if ($setvar{varname} eq "answerValue") { # Multiple Choice	if ($setvar{varname} eq "answerValue") { # Multiple Choice WebCT4.0
if ($text =~ m/^\d+$/) {	if ($text =~ m/^\d+$/) {
if ($text > 0) {	if ($text > 0) {
push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);	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") {	if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") {
Line 3043 sub parse_webct4_questionDB {	Line 3241 sub parse_webct4_questionDB {
end_h =>	end_h =>
[sub {	[sub {
my ($tagname) = @_;	my ($tagname) = @_;
pop @state;	if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) {
	$is_objectbank = '';
	} else {
	pop @state;
	}
}, "tagname"],	}, "tagname"],
);	);
$p->unbroken_text(1);	$p->unbroken_text(1);
Line 3061 sub parse_webct4_questionDB {	Line 3263 sub parse_webct4_questionDB {
}	}
}	}
}	}
	} elsif ($$settings{$id}{class} eq 'multiplechoice') {
	if (ref($$settings{$id}) eq 'HASH') {
	foreach my $list (keys(%{$$settings{$id}})) {
	if (ref($$settings{$id}{$list}) eq 'HASH') {
	if (defined($$settings{$id}{$list}{rcardinality})) {
	if ($$settings{$id}{$list}{rcardinality} eq 'Multiple') {
	if (ref($$settings{$id}{$list}{correctanswer}) eq 'ARRAY') {
	if (@{$$settings{$id}{$list}{correctanswer}} == 1) {
	$$settings{$id}{$list}{rcardinality} = 'Single';
	}
	}
	}
	}
	}
	}
	}
}	}
}	}
}	}
Line 3084 sub process_assessment {	Line 3302 sub process_assessment {
($cdom,$cnum) = split/_/,$cid;	($cdom,$cnum) = split/_/,$cid;
}	}
my $destresdir = $destdir;	my $destresdir = $destdir;
	my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
$destresdir =~ s\|/home/$uname/public_html/\|/res/$udom/$uname/\|;	$destresdir =~ s{^\Q$londocroot/priv/\E}{/res/};
} elsif ($context eq 'DOCS') {	} elsif ($context eq 'DOCS') {
$destresdir =~ s\|^/home/httpd/html/userfiles\|/uploaded\|;	$destresdir =~ s{^\Q$londocroot/userfiles\E}{/uploaded};
}	}
if ($cms eq 'bb5') {	if ($cms eq 'bb5') {
&parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);	&parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
Line 3112 sub process_assessment {	Line 3331 sub process_assessment {
unless($$dbparse) {	unless($$dbparse) {
foreach my $res (sort keys %{$allquestions}) {	foreach my $res (sort keys %{$allquestions}) {
my $parent = $$allquestions{$res};	my $parent = $$allquestions{$res};
&parse_webctvista4_question($res,$docroot,$resources,$hrefs,$settings,\@allquestids,\%allanswers,\%allchoices,$parent,$catinfo);	&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);	&build_category_sequences($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings);
$$dbparse = 1;	$$dbparse = 1;
}	}
&parse_webctvista4_assessment($res,$docroot,$hrefs,\@allids,\%qzparams);	&parse_webctvista4_assessment($res,$docroot,$$resources{$res}{file},\@allids,\%qzparams);
if ($qzparams{$res}{numpick} < @allids) {	if ($qzparams{$res}{numpick} < @allids) {
$$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};	$$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
$randompickflag = 1;	$randompickflag = 1;
}	}
}	}
my $dirtitle;	my $dirtitle;
unless ($cms eq 'webctce4') {	unless ($cms eq 'webctce4' \|\| $cms eq 'webctvista4') {
$dirtitle = $$settings{'title'};	$dirtitle = $$settings{'title'};
$dirtitle =~ s/\W//g;	$dirtitle =~ s/\s+/_/g;
	$dirtitle =~ s/:/_/g;
$dirtitle .= '_'.$res;	$dirtitle .= '_'.$res;
if (!-e "$destdir/problems") {	if (!-e "$destdir/problems") {
mkdir("$destdir/problems",0755);	mkdir("$destdir/problems",0755);
Line 3138 sub process_assessment {	Line 3358 sub process_assessment {
}	}

if ($cms eq 'webctce4') {	if ($cms eq 'webctce4') {
&build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);	if (@allids > 0 && $allids[0] ne '') {
	&build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
	}
} else {	} else {
&build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$settings);	&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') {	if ($cms eq 'bb5') {
&write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot);	&write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot);
} elsif ($cms eq 'bb6') {	} elsif ($cms eq 'bb6') {
&write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot);	&write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot);
} elsif ($cms eq 'webctvista4') {	} elsif ($cms eq 'webctvista4') {
&write_webct4_questions($cms,\@allquestids,$context,$settings,$dirname,\%allanswers,\%allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);	&write_webct4_questions($cms,\@allquestids,$context,$qzdbsettings,$dirname,\%allanswers,\%allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo,$dirtitle);
}	}
}	}

Line 3163 sub build_category_sequences {	Line 3385 sub build_category_sequences {
open($fh,">$destdir/sequences/question_database.sequence");	open($fh,">$destdir/sequences/question_database.sequence");
push @{$sequencesfiles},'question_database.sequence';	push @{$sequencesfiles},'question_database.sequence';
foreach my $category (sort keys %{$catinfo}) {	foreach my $category (sort keys %{$catinfo}) {
my $seqname = $$catinfo{$category}{title}.'_'.$category;	my $seqname;
$seqname =~ s/\s/_/g;	if ($cms eq 'webctce4') {
$seqname =~ s/\W//g;	$seqname = $$catinfo{$category}{title}.'_'.$category;
	} else {
	$seqname = $$catinfo{$category}{title};
	}
	$seqname =~ s/\s+/_/g;
	$seqname =~ s/:/_/g;
push(@{$sequencesfiles},$seqname.'.sequence');	push(@{$sequencesfiles},$seqname.'.sequence');
my $catsrc = "$destresdir/sequences/$seqname.sequence";	my $catsrc = "$destresdir/sequences/$seqname.sequence";
if ($curr_id == 0) {	if ($curr_id == 0) {
Line 3203 sub build_category_sequences {	Line 3430 sub build_category_sequences {
}	}

sub build_problem_container {	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) = @_;	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 $seqdir = "$destdir/sequences";
my $pagedir = "$destdir/pages";	my $pagedir = "$destdir/pages";
my $curr_id = 0;	my $curr_id = 0;
my $next_id = 1;	my $next_id = 1;
my $fh;	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') {	if ($container eq 'pool' \|\| $randompickflag \|\| $container eq 'database') {
$$containerdir = $seqdir.'/'.$res.'.sequence';	$$containerdir = $seqdir.'/'.$mapname.'.sequence';
if (!-e "$seqdir") {	if (!-e "$seqdir") {
mkdir("$seqdir",0770);	mkdir("$seqdir",0770);
}	}
open($fh,">$$containerdir");	open($fh,">$$containerdir");
$$total{seq} ++;	$$total{seq} ++;
push @{$sequencesfiles},$res.'.sequence';	push @{$sequencesfiles},$mapname.'.sequence';
} else {	} else {
$$containerdir = $pagedir.'/'.$res.'.page';	$$containerdir = $pagedir.'/'.$mapname.'.page';
if (!-e "$destdir/pages") {	if (!-e "$pagedir") {
mkdir("$destdir/pages",0770);	mkdir("$pagedir",0770);
}	}
open($fh,">$$containerdir");	open($fh,">$$containerdir");
$$total{page} ++;	$$total{page} ++;
push @{$pagesfiles},$res.'.page';	push @{$pagesfiles},$mapname.'.page';
}	}
print $fh qq\|<map>	print $fh qq\|<map>
\|;	\|;
Line 3237 sub build_problem_container {	Line 3471 sub build_problem_container {
} else {	} else {
$probtitle{$id} = $$settings{title};	$probtitle{$id} = $$settings{title};
}	}
$probtitle{$id} =~ s/\s/_/g;	$probtitle{$id} =~ s/\s+/_/g;
$probtitle{$id} =~ s/\W//g;	$probtitle{$id} =~ s/:/_/g;
	$probtitle{$id} =~ s/\//_/g;
$probtitle{$id} .= '_'.$id;	$probtitle{$id} .= '_'.$id;
}	}
if ($cms eq 'webctce4' && $container ne 'database') {	if (($cms eq 'webctce4' && $container ne 'database') \|\|
	($cms eq 'webctvista4')) {
	my $probdir;
my $catid = $$settings{$$allids[0]}{category};	my $catid = $$settings{$$allids[0]}{category};
my $probdir = $$catinfo{$catid}{title}.'_'.$catid;	if ($catid) {
$probdir =~ s/\s/_/g;	if ($cms eq 'webctce4') {
$probdir =~ s/\W//g;	$probdir = $$catinfo{$catid}{title}.'_'.$catid;
$probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";	} 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 {	} else {
$probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";	$probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";
}	}
Line 3265 sub build_problem_container {	Line 3510 sub build_problem_container {
$curr_id = $j;	$curr_id = $j;
$next_id = $curr_id + 1;	$next_id = $curr_id + 1;
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
if ($cms eq 'webctce4' && $container ne 'database') {	if (($cms eq 'webctce4' && $container ne 'database') \|\|
	($cms eq 'webctvista4')) {
	my $probdir;
my $catid = $$settings{$$allids[$j]}{category};	my $catid = $$settings{$$allids[$j]}{category};
my $probdir = $$catinfo{$catid}{title}.'_'.$catid;	if ($catid) {
$probdir =~ s/\s/_/g;	if ($cms eq 'webctce4') {
$probdir =~ s/\W//g;	$probdir = $$catinfo{$catid}{title}.'_'.$catid;
$probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";	} 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 {	} else {
$probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";	$probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
}	}
Line 3293 sub write_bb5_questions {	Line 3548 sub write_bb5_questions {
my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;	my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
my $qnum = 0;	my $qnum = 0;
my $pathstart;	my $pathstart;
	my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
$pathstart = '../..';	$pathstart = '../..';
} else {	} else {
Line 3312 sub write_bb5_questions {	Line 3568 sub write_bb5_questions {
$qnum ++;	$qnum ++;
my $output;	my $output;
my $permcontainer = $containerdir;	my $permcontainer = $containerdir;
$permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;	$permcontainer =~ s{^\Q$londocroot/userfiles\E}{uploaded};
my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';	my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
my %resourcedata = ();	my %resourcedata = ();
for (my $i=0; $i<10; $i++) {	for (my $i=0; $i<10; $i++) {
Line 3656 sub write_bb5_questions {	Line 3912 sub write_bb5_questions {
$title =~ s/\s/_/g;	$title =~ s/\s/_/g;
$title =~ s/\W//g;	$title =~ s/\W//g;
$title .= '_'.$id;	$title .= '_'.$id;
open(PROB,">:utf8", "$newdir/$title.problem");	open(PROB,">$newdir/$title.problem");
print PROB $output;	print PROB $output;
close PROB;	close PROB;
} else {	} else {
Line 3668 sub write_bb5_questions {	Line 3924 sub write_bb5_questions {
}	}

sub write_webct4_questions {	sub write_webct4_questions {
my ($cms,$alldbquestids,$context,$settings,$dirname,$allanswers,$allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo) = @_;	my ($cms,$alldbquestids,$context,$settings,$dirname,$allanswers,$allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo,$dirtitle) = @_;
	my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
my $qnum = 0;	my $qnum = 0;
foreach my $id (@{$alldbquestids}) {	foreach my $id (@{$alldbquestids}) {
$qnum ++;	$qnum ++;
Line 3678 sub write_webct4_questions {	Line 3935 sub write_webct4_questions {
my $questionimage;	my $questionimage;
foreach my $fdbk (@{$$settings{$id}{feedback}}) {	foreach my $fdbk (@{$$settings{$id}{feedback}}) {
my $feedback = $$settings{$id}{$fdbk}{text};	my $feedback = $$settings{$id}{$fdbk}{text};
if ($$settings{$id}{$fdbk}{texttype} eq 'text/html') {	if ($feedback ne '') {
$feedback = &HTML::Entities::decode($feedback);	if ($$settings{$id}{$fdbk}{texttype} eq 'text/html') {
	$feedback = &HTML::Entities::decode($feedback);
	}
	$allfeedback .= $feedback;
}	}
$allfeedback .= $feedback;
}	}
if ($$settings{$id}{texttype} eq 'text/html') {	if ($$settings{$id}{texttype} eq 'text/html') {
if ($$settings{$id}{text}) {	if ($$settings{$id}{text}) {
Line 3691 sub write_webct4_questions {	Line 3950 sub write_webct4_questions {
if ($$settings{$id}{class} eq 'numerical') {	if ($$settings{$id}{class} eq 'numerical') {
foreach my $numid (@{$$settings{$id}{numids}}) {	foreach my $numid (@{$$settings{$id}{numids}}) {
foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {	foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {
if ($cms eq 'webct4ce') {	if ($cms eq 'webctce4') {
$$settings{$id}{text} =~ s/{($var)}/\$$1 /g;	$$settings{$id}{text} =~ s/{($var)}/\$$1 /g;
} elsif ($cms eq 'webctvista4') {	} elsif ($cms eq 'webctvista4') {
$$settings{$id}{text} =~ s/\[($var)\]/\$$1 /g;	$$settings{$id}{text} =~ s/\[($var)\]/\$$1 /g;
Line 3699 sub write_webct4_questions {	Line 3958 sub write_webct4_questions {
}	}
}	}
}	}
$permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;	$permcontainer =~ s{\Q$londocroot/userfiles\E}{uploaded};
my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';	my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
my %resourcedata = ();	my %resourcedata = ();
for (my $i=0; $i<10; $i++) {	for (my $i=0; $i<10; $i++) {
Line 3717 sub write_webct4_questions {	Line 3976 sub write_webct4_questions {
}	}
}	}
$$total{prob} ++;	$$total{prob} ++;

if (exists($$settings{$id}{uri})) {	if (exists($$settings{$id}{uri})) {
if ($cms eq 'webct4ce') {	if ($cms eq 'webctce4') {
if ($$settings{$id}{imagtype} =~ /^image\//) {	if ($$settings{$id}{imagtype} =~ /^image\//) {
$questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";	$questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
} else {	} else {
Line 3733 sub write_webct4_questions {	Line 3993 sub write_webct4_questions {
}	}
}	}
}	}
	if (($cms eq 'webctvista4') && (defined($$settings{$id}{image}))) {
	my $imgsrc = '../../resfiles/'.$$settings{$id}{image};
	if (defined($$settings{$id}{imagetitle})) {
	$imgsrc .= '_'.$$settings{$id}{imagetitle};
	}
	$questionimage = qq\|<p><img src="$imgsrc" /></p>\|;
	}
if ($$settings{$id}{class} eq "paragraph") {	if ($$settings{$id}{class} eq "paragraph") {
my $pre_fill_answer = $$settings{$id}{PARA}{PARA}{PRE_FILL_ANSWER};	my $pre_fill_answer = $$settings{$id}{PARA}{PARA}{PRE_FILL_ANSWER};
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
Line 3740 sub write_webct4_questions {	Line 4007 sub write_webct4_questions {
<essayresponse>	<essayresponse>
<textfield>$pre_fill_answer</textfield>	<textfield>$pre_fill_answer</textfield>
</essayresponse>	</essayresponse>
<postanswerdate>
$allfeedback
</postanswerdate>
\|;	\|;
} else {	} else {
$resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;	$resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;
$resourcedata{$symb.'hiddenparts'} = '!essay';	$resourcedata{$symb.'hiddenparts'} = '!essay';
$resourcedata{$symb.'questiontype'} = '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 {	} else {
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
$output .= qq\|<startouttext /><p>$$settings{$id}{text}</p>$questionimage<endouttext />\n\|;	$output .= qq\|<startouttext /><p>$$settings{$id}{text}</p>$questionimage<endouttext />\n\|;
Line 3831 sub write_webct4_questions {	Line 4151 sub write_webct4_questions {
if ($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{texttype} eq 'text/html') {	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} = &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} = &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#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#</?p>##g;	$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#</?p>##g;
}	}
Line 3972 sub write_webct4_questions {	Line 4291 sub write_webct4_questions {
($$settings{$id}{class} eq 'shortanswer')) {	($$settings{$id}{class} eq 'shortanswer')) {
my $labelnum = 0;	my $labelnum = 0;
my @str_labels = ();	my @str_labels = ();
if ($cms eq 'webct4ce') {	if ($cms eq 'webctce4') {
foreach my $str_id (@{$$settings{$id}{str}}) {	foreach my $str_id (@{$$settings{$id}{str}}) {
foreach my $label (@{$$settings{$id}{$str_id}{labels}}) {	foreach my $label (@{$$settings{$id}{$str_id}{labels}}) {
push(@str_labels,$label);	push(@str_labels,$label);
Line 4132 sub write_webct4_questions {	Line 4451 sub write_webct4_questions {
}	}
$increment .= '1';	$increment .= '1';
}	}
if ($cms eq 'webct4ce') {	if ($cms eq 'webctce4') {
$formula =~ s/{($var)}/(\$$1)/g;	$formula =~ s/{($var)}/(\$$1)/g;
} elsif ($cms eq 'webctvista4') {	} elsif ($cms eq 'webctvista4') {
$formula =~ s/\[($var)\]/(\$$1)/g;	$formula =~ s/\[($var)\]/(\$$1)/g;
Line 4182 sub write_webct4_questions {	Line 4501 sub write_webct4_questions {
}	}
}	}
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
	my $probdir;
my $catid = $$settings{$id}{category};	my $catid = $$settings{$id}{category};
my $probdir = $$catinfo{$catid}{title}.'_'.$catid;	if ($catid) {
$probdir =~ s/\s/_/g;	if ($cms eq 'webctce4') {
$probdir =~ s/\W//g;	$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") {	if (!-e "$destdir/problems/$probdir") {
mkdir("$destdir/problems/$probdir",0755);	mkdir("$destdir/problems/$probdir",0755);
}	}
	if ($allfeedback ne '') {
	$output .= qq\|
	<postanswerdate>
	$allfeedback
	</postanswerdate>
	\|;
	}
$output .= qq\|</problem>	$output .= qq\|</problem>
\|;	\|;
my $title = $$settings{$id}{title};	my $title = $$settings{$id}{title};
$title =~ s/\s/_/g;	$title =~ s/\s/_/g;
$title =~ s/\W//g;	$title =~ s/:/_/g;
$title .= '_'.$id;	$title =~ s/\//_/g;
open(PROB,">:utf8", "$destdir/problems/$probdir/$title.problem");	$title .= '_'.$id;
	open(PROB,">$destdir/problems/$probdir/$title.problem");
print PROB $output;	print PROB $output;
close PROB;	close PROB;
} else {	} else {
Line 4236 sub test_for_html {	Line 4572 sub test_for_html {

sub write_bb6_questions {	sub write_bb6_questions {
my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;	my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
	my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
my $qnum = 0;	my $qnum = 0;
foreach my $id (@{$allids}) {	foreach my $id (@{$allids}) {
my $questiontext = $$settings{$id}{question}{text};	my $questiontext = $$settings{$id}{question}{text};
Line 4244 sub write_bb6_questions {	Line 4581 sub write_bb6_questions {
$qnum ++;	$qnum ++;
my $output;	my $output;
my $permcontainer = $containerdir;	my $permcontainer = $containerdir;
$permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;	$permcontainer =~ s{\Q$londocroot/userfiles\E}{uploaded};
my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';	my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
my %resourcedata = ();	my %resourcedata = ();
for (my $i=0; $i<10; $i++) {	for (my $i=0; $i<10; $i++) {
Line 4593 sub write_bb6_questions {	Line 4930 sub write_bb6_questions {
$title =~ s/\s/_/g;	$title =~ s/\s/_/g;
$title =~ s/\W//g;	$title =~ s/\W//g;
$title .= '_'.$id;	$title .= '_'.$id;
open(PROB,">:utf8", "$newdir/$title.problem");	open(PROB,">$newdir/$title.problem");
print PROB $output;	print PROB $output;
close PROB;	close PROB;
} else {	} else {
Line 4738 sub process_content {	Line 5075 sub process_content {
my ($cms,$res,$context,$docroot,$destdir,$settings,$dom,$user,$resrcfiles,$packages,$hrefs) = @_;	my ($cms,$res,$context,$docroot,$destdir,$settings,$dom,$user,$resrcfiles,$packages,$hrefs) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";	my $xmlfile = $docroot.'/'.$res.".dat";
my $destresdir = $destdir;	my $destresdir = $destdir;
	my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
$destresdir =~ s\|/home/$user/public_html/\|/res/$dom/$user/\|;	$destresdir =~ s{^\Q$londocroot/priv/\E}{/res/};
} elsif ($context eq 'DOCS') {	} elsif ($context eq 'DOCS') {
$destresdir =~ s\|^/home/httpd/html/userfiles\|/uploaded\|;	$destresdir =~ s{^\Q$londocroot/userfiles\E}{/uploaded};
}	}
my $filetag = '';	my $filetag = '';
if ($cms eq 'bb5') {	if ($cms eq 'bb5') {
Line 5162 sub angel_content {	Line 5500 sub angel_content {
# ---------------------------------------------------------------- WebCT content	# ---------------------------------------------------------------- WebCT content
sub webct4_content {	sub webct4_content {
my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;	my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
if (!open(FILE,">$destdir/resfiles/$res.html")) {	if (defined($$settings{url})) {
&Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");	if (!open(FILE,">$destdir/resfiles/$res.html")) {
} else {	&Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
push(@{$resrcfiles}, "$res.html");	} else {
my $linktag = '';	push(@{$resrcfiles}, "$res.html");
if (defined($$settings{url})) {	my $linktag = qq\|<a href="$$settings{url}"\|;
$linktag = qq\|<a href="$$settings{url}"\|;
if ($title ne '') {	if ($title ne '') {
$linktag .= qq\|>$title</a>\|;	$linktag .= qq\|>$title</a>\|;
} else {	} else {
$linktag .= qq\|>$$settings{url}\|;	$linktag .= qq\|>$$settings{url}\|;
}	}
}	print FILE qq\|<html>
print FILE qq\|<html>
<head>	<head>
<title>$title</title>	<title>$title</title>
</head>	</head>
Line 5183 sub webct4_content {	Line 5519 sub webct4_content {
$linktag	$linktag
</body>	</body>
</html>\|;	</html>\|;
close(FILE);	close(FILE);
	}
}	}
}	}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.36
changed lines
	Added in v.1.52