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.35 and 1.46

version 1.35, 2006/04/04 08:16:41	version 1.46, 2009/04/23 17:33:50
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 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 308 sub parse_manifest {	Line 314 sub parse_manifest {
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};	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 409 sub target_resources {	Line 414 sub target_resources {
}	}

sub copy_resources {	sub copy_resources {
my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles) = @_;	my ($context,$cms,$hrefs,$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 466 sub copy_resources {	Line 471 sub copy_resources {
mkdir("$fulldir",0770);	mkdir("$fulldir",0770);
}	}
}	}
	my $renameres;
if ($cms eq 'angel') {	if ($cms eq 'angel') {
rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");	$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 499 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");
Line 620 sub process_resinfo {	Line 640 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 735 sub build_structure {	Line 759 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'};
	my $seqtitle = $$items{$key}{'title'};
	$seqtitle =~ s\|/+\|_\|g;
	$seqtitle =~ s/\s+/_/g;
	$seqtitle .= '_'.$key;
if (($cms eq 'angel' && $type eq "FOLDER") \|\| (($cms eq 'bb5' \|\| $cms eq 'bb6') && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") \|\| ($type eq "resource/x-bb-staffinfo") \|\| ($type eq "resource/x-bb-externallink")) \|\| ($cms eq 'webctce4' && $contentscount > 0)) {	if (($cms eq '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)) {
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 801 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 841 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 873 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 907 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 1005 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 'angel' && $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 1038 sub make_structure {	Line 1077 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 1417 sub process_staff {	Line 1458 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 2178 sub parse_webctvista4_assessment {	Line 2219 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 2231 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 2263 sub parse_webctvista4_question {	Line 2307 sub parse_webctvista4_question {
my $jumble_item;	my $jumble_item;
my $numbox = 0;	my $numbox = 0;
my %str_answers = ();	my %str_answers = ();
my $currtextlabel;
my $textlabel;	my $textlabel;
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 2333 sub parse_webctvista4_question {	Line 2377 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 2351 sub parse_webctvista4_question {	Line 2397 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 2372 sub parse_webctvista4_question {	Line 2426 sub parse_webctvista4_question {
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") {
$currtexttype = lc($attr->{texttype});	$currtexttype = lc($attr->{texttype});
$$settings{$id}{$list}{$answer_id}{texttype} = $currtexttype;	$$settings{$id}{$list}{$answer_id}{texttype} = $currtexttype;
if ($$settings{$id}{class} eq 'combination') {
$currtextlabel = $attr->{label};
}
}	}

# String, Shortanswer or Paragraph	# String, Shortanswer or Paragraph
Line 2407 sub parse_webctvista4_question {	Line 2458 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 2418 sub parse_webctvista4_question {	Line 2469 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 2425 sub parse_webctvista4_question {	Line 2477 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 2440 sub parse_webctvista4_question {	Line 2492 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 2539 sub parse_webctvista4_question {	Line 2592 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;
if ($$settings{$id}{class} eq 'combination') {
if ($currtextlabel =~ /^wct_mc_answer_text\d+_\d+$/) {
$$settings{$id}{$list}{$answer_id}{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;
if ($$settings{$id}{class} eq 'combination') {	if ($$settings{$id}{class} eq 'combination') {
if ($textlabel =~ /^wct_question_label_\d+$/) {	if ($textlabel =~ /^wct_question_label_\d+$/) {
$$settings{$id}{$text} .= '<br />';	$$settings{$id}{text} .= '<br />';
}	}
if ($textlabel =~ /^wct_cmc_single_answer_\d+$/) {	if ($textlabel =~ /^wct_cmc_single_answer\d+$/) {
$$settings{$id}{$text} .= '<br />';	$$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") {	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 2591 sub parse_webctvista4_question {	Line 2654 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 2720 sub parse_webct4_quizprops {	Line 2784 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 2742 sub parse_webct4_questionDB {	Line 2811 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 2811 sub parse_webct4_questionDB {	Line 2885 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 2832 sub parse_webct4_questionDB {	Line 2912 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 2918 sub parse_webct4_questionDB {	Line 3002 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 2949 sub parse_webct4_questionDB {	Line 3035 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 2992 sub parse_webct4_questionDB {	Line 3079 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 3030 sub parse_webct4_questionDB {	Line 3120 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 3052 sub parse_webct4_questionDB {	Line 3156 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 3070 sub parse_webct4_questionDB {	Line 3178 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 3121 sub process_assessment {	Line 3245 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 3147 sub process_assessment {	Line 3272 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 3172 sub build_category_sequences {	Line 3299 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 3212 sub build_category_sequences {	Line 3344 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 "$destdir/pages") {
mkdir("$destdir/pages",0770);	mkdir("$destdir/pages",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 3246 sub build_problem_container {	Line 3385 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 3274 sub build_problem_container {	Line 3424 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 3665 sub write_bb5_questions {	Line 3825 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 3677 sub write_bb5_questions {	Line 3837 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 $qnum = 0;	my $qnum = 0;
foreach my $id (@{$alldbquestids}) {	foreach my $id (@{$alldbquestids}) {
$qnum ++;	$qnum ++;
Line 3687 sub write_webct4_questions {	Line 3847 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 3700 sub write_webct4_questions {	Line 3862 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 3726 sub write_webct4_questions {	Line 3888 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 3749 sub write_webct4_questions {	Line 3912 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\|;
} else {	} else {
$resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;	$resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;
}	}
if ($$settings{$id}{class} eq 'multiplechoice') {	if (($$settings{$id}{class} eq 'multiplechoice') \|\|
	($$settings{$id}{class} eq 'combination')) {
foreach my $list (@{$$settings{$id}{lists}}) {	foreach my $list (@{$$settings{$id}{lists}}) {
my $numfoils = @{$$allanswers{$id}{$list}};	my $numfoils = @{$$allanswers{$id}{$list}};
if ($$settings{$id}{$list}{rcardinality} eq 'Single') {	if ($$settings{$id}{$list}{rcardinality} eq 'Single') {
Line 3839 sub write_webct4_questions {	Line 4056 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 3980 sub write_webct4_questions {	Line 4196 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 4140 sub write_webct4_questions {	Line 4356 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 4190 sub write_webct4_questions {	Line 4406 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 4601 sub write_bb6_questions {	Line 4834 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 5170 sub angel_content {	Line 5403 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 5191 sub webct4_content {	Line 5422 sub webct4_content {
$linktag	$linktag
</body>	</body>
</html>\|;	</html>\|;
close(FILE);	close(FILE);
	}
}	}
}	}

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

Removed from v.1.35
changed lines
	Added in v.1.46