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.17 and 1.29

version 1.17, 2005/03/23 19:54:27	version 1.29, 2005/10/14 22:28:56
Line 24	Line 24
package Apache::imsprocessor;	package Apache::imsprocessor;

use Apache::lonnet;	use Apache::lonnet;
	use Apache::loncleanup;
	use LWP::UserAgent;
	use HTTP::Request::Common;
use LONCAPA::Configuration;	use LONCAPA::Configuration;
use strict;	use strict;

Line 95 sub uploadzip {	Line 98 sub uploadzip {
my ($context,$tempdir,$source) = @_;	my ($context,$tempdir,$source) = @_;
my $fname;	my $fname;
if ($context eq 'DOCS') {	if ($context eq 'DOCS') {
$fname=$ENV{'form.uploadname.filename'};	$fname=$env{'form.uploadname.filename'};
# Replace Windows backslashes by forward slashes	# Replace Windows backslashes by forward slashes
$fname=~s/\\/\//g;	$fname=~s/\\/\//g;
# Get rid of everything but the actual filename	# Get rid of everything but the actual filename
Line 107 sub uploadzip {	Line 110 sub uploadzip {
# See if there is anything left	# See if there is anything left
unless ($fname) { return 'error: no uploaded file'; }	unless ($fname) { return 'error: no uploaded file'; }
# Save the file	# Save the file
chomp($ENV{'form.uploadname'});	chomp($env{'form.uploadname'});
open(my $fh,'>'.$tempdir.'/'.$fname);	open(my $fh,'>'.$tempdir.'/'.$fname);
print $fh $ENV{'form.uploadname'};	print $fh $env{'form.uploadname'};
close($fh);	close($fh);
} elsif ($context eq 'CSTR') {	} elsif ($context eq 'CSTR') {
if ($source =~ m/\/([^\/]+)$/) {	if ($source =~ m/\/([^\/]+)$/) {
Line 128 sub expand_zip {	Line 131 sub expand_zip {
return 'no zip';	return 'no zip';
}	}
if ($filename =~ m\|\.zip$\|i) {	if ($filename =~ m\|\.zip$\|i) {
# unzip can cause an sh launch which can pass along all of %ENV
# which can be too large for /bin/sh to handle
my %oldENV=%ENV;
undef(%ENV);
open(OUTPUT, "unzip -o $zipfile -d $tempdir 2> /dev/null \|");	open(OUTPUT, "unzip -o $zipfile -d $tempdir 2> /dev/null \|");
close(OUTPUT);	close(OUTPUT);
%ENV=%oldENV;
undef(%oldENV);
} else {	} else {
return 'nozip';	return 'nozip';
}	}
Line 519 sub process_resinfo {	Line 516 sub process_resinfo {
}	}
} elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {	} elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {
%{$$resinfo{$key}} = ();	%{$$resinfo{$key}} = ();
&process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings);	&process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs);
push @{$pools}, $key;	push @{$pools}, $key;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {	} elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {
%{$$resinfo{$key}} = ();	%{$$resinfo{$key}} = ();
&process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings);	&process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs);
push @{$quizzes}, $key;	push @{$quizzes}, $key;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-survey") {	} elsif ($$resources{$key}{type} eq "assessment/x-bb-survey") {
%{$$resinfo{$key}} = ();	%{$$resinfo{$key}} = ();
&process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings);	&process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs);
push @{$surveys}, $key;	push @{$surveys}, $key;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {	} elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {
%{$$resinfo{$key}} = ();	%{$$resinfo{$key}} = ();
Line 569 sub process_resinfo {	Line 566 sub process_resinfo {
%{$$resinfo{$key}} = ();	%{$$resinfo{$key}} = ();
&webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);	&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);	&process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs);
}	}
}	}
}	}
Line 679 sub build_structure {	Line 676 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);	$src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem});
unless ($flag{$key}{page} == 1) {	unless ($flag{$key}{page} == 1) {
	if ($$randompicks{$contitem}) {
	$seqtext{$key} .= qq\|
	<param to="$curr_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>\n\|;
	}
$seqtext{$key} .= qq\|<resource id="$curr_id" src="$src" title="$title" type="start"\|;	$seqtext{$key} .= qq\|<resource id="$curr_id" src="$src" title="$title" type="start"\|;
unless ($flag{$key}{seq} \|\| $flag{$key}{board} \|\| $flag{$key}{file}) {	unless ($flag{$key}{seq} \|\| $flag{$key}{board} \|\| $flag{$key}{file}) {
$flag{$key}{page} = 1;	$flag{$key}{page} = 1;
Line 715 sub build_structure {	Line 716 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);	$src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem});

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>	<link from="$curr_id" to="$next_id" index="$curr_id"></link>\n\|;
	if ($$randompicks{$contitem}) {
	$seqtext{$key} .= qq\|
	<param to="$next_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>\|;
	}
	$seqtext{$key} .= qq\|
<resource id="$next_id" src="$src" title="$title"\|;	<resource id="$next_id" src="$src" title="$title"\|;
$curr_id ++;	$curr_id ++;
$next_id ++;	$next_id ++;
Line 743 sub build_structure {	Line 748 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);	$src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem});

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 753 sub build_structure {	Line 758 sub build_structure {
}	}
} else {	} else {
$seqtext{$key} .= qq\|></resource>	$seqtext{$key} .= qq\|></resource>
<link from="$curr_id" to="$next_id" index="$curr_id"></link>	<link from="$curr_id" to="$next_id" index="$curr_id"></link>\n\|;
	if ($$randompicks{$contitem}) {
	$seqtext{$key} .= qq\|
	<param to="$next_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>\n\|;
	}
	$seqtext{$key} .= qq\|
<resource id="$next_id" src="$src" title="$title" \|;	<resource id="$next_id" src="$src" title="$title" \|;
if ($key eq 'Top') {	if ($key eq 'Top') {
push @{$topurls}, $src;	push @{$topurls}, $src;
Line 865 sub build_structure {	Line 875 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) = @_;	my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$randompick) = @_;
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 'webct4' && $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 'webct4' && $contitemcount > 0)) {
$src = $srcstem.'/sequences/'.$contitem.'.sequence';	$src = $srcstem.'/sequences/'.$contitem.'.sequence';
$$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 'webct4' && $randompick) {
	$src = $srcstem.'/sequences/'.$res.'.sequence';
	$$flag{$key}{page} = 0;
	$$flag{$key}{seq} = 1;
	$$count{$key}{seq} ++;
} elsif ($cms eq 'angel' && $type eq 'BOARD') {	} elsif ($cms eq 'angel' && $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;
Line 918 sub make_structure {	Line 933 sub make_structure {
} elsif ($cms eq 'webct4') {	} elsif ($cms eq 'webct4') {
if ($type eq 'webctquiz') {	if ($type eq 'webctquiz') {
$src = $srcstem.'/pages/'.$res.'.page';	$src = $srcstem.'/pages/'.$res.'.page';
	$$count{$key}{page} ++;
	$$flag{$key}{seq} = 0;
} else {	} else {
if (grep/^$file$/,@{$$hrefs{$res}}) {	if (grep/^$file$/,@{$$hrefs{$res}}) {
my $filename;	my $filename;
Line 1710 sub parse_bb5_assessment {	Line 1727 sub parse_bb5_assessment {
$id = $attr->{id};	$id = $attr->{id};
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") ) {	} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") ) {
if ($state[4] eq "ISHTML") {	if ($state[4] eq "ISHTML") {
$$settings{$id}{html} = $attr->{value};	$$settings{$id}{ishtml} = $attr->{value};
} elsif ($state[4] eq "ISNEWLINELITERAL") {	} elsif ($state[4] eq "ISNEWLINELITERAL") {
$$settings{$id}{newline} = $attr->{value};	$$settings{$id}{newline} = $attr->{value};
}	}
Line 1810 sub parse_bb5_assessment {	Line 1827 sub parse_bb5_assessment {
}	}

sub parse_bb6_assessment {	sub parse_bb6_assessment {
my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;	my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;
return;	my $xmlfile = $docroot.'/'.$res.".dat";
	my @state = ();
	my $id; # the current question ID
	my $list; # the current list ID for multiple choice questions
	my $response; # the current response ID
	my $currtexttype;
	my @curr_block = ();
	my $curr_shuffle;
	my $curr_class;
	my $curr_matchitem;
	my $curr_block_type;
	my $curr_feedback_type;
	my $p = HTML::Parser->new
	(
	xml_mode => 1,
	start_h =>
	[sub {
	my ($tagname, $attr) = @_;
	push @state, $tagname;
	if ("@state" eq "questestinterop assessment") {
	$$settings{title} = $attr->{title};
	}
	if ("@state" eq "questestinterop assessment rubric flow_mat material mat_extension mat_formattedtext") {
	$currtexttype = $attr->{type};
	}
	if ("@state" eq "questestinterop section item presentation flow") {
	$curr_block[0] = $attr->{class};
	if ($curr_block[0] eq 'RESPONSE_BLOCK') {
	$curr_block_type = 'response';
	} elsif ($curr_block[0] eq 'RIGHT_MATCH_BLOCK') {
	$curr_block_type = 'rightmatch';
	}
	}
	if ("@state" eq "questestinterop section item presentation flow flow") {
	$curr_block[1] = $attr->{class};
	if ($curr_block[1] eq 'QUESTION_BLOCK') {
	$curr_block_type = 'question';
	}
	}
	if ("@state" eq "questestinterop section item presentation flow flow flow") {
	$curr_block[2] = $attr->{class};
	}
	if ("@state" eq "questestinterop section item presentation flow flow flow material mat_extension mat_formatted_text") {
	$$settings{$id}{$curr_block_type}{texttype} = $attr->{texttype};
	$currtexttype = $attr->{texttype};
	}
	if ("@state" eq "questestinterop section item presentation flow flow flow material matapplication") {
	$$settings{$id}{$curr_block_type}{image} = $attr->{uri};
	$$settings{$id}{$curr_block_type}{style} = $attr->{embedded};
	$$settings{$id}{$curr_block_type}{label} = $attr->{label};
	}
	if ("@state" eq "questestinterop section item presentation flow flow flow material mattext") {
	$$settings{$id}{$curr_block_type}{link} = $attr->{uri};
	}
	if ("@state" eq "questestinterop section item presentation flow response_lid render_choice") {
	$curr_shuffle = $attr->{shuffle};
	}
	if ("@state" eq "questestinterop section item presentation flow response_lid") { $response = $attr->{ident};
	if ($curr_class eq 'Matching') {
	%{$$settings{$id}{$response}} = ();
	foreach my $key (keys(%{$$settings{$id}{$curr_block_type}})) {
	$$settings{$id}{$response}{$key} = $$settings{$id}{$curr_block_type}{$key};
	}
	%{$$settings{$id}{$curr_block_type}} = ();
	}
	}
	if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow response_label") {
	if (($curr_class eq 'Multiple Choice') \|\| ($curr_class eq 'Multiple Answer') \|\| ($curr_class eq 'Order')) {
	$list = $attr->{ident};
	push(@{$$settings{$id}{lists}},$list);
	$$settings{$id}{$list}{randomize} = $curr_shuffle;
	%{$$settings{$id}{$list}} = ();
	@{$$allanswers{$id}{$list}} = ();
	@{$$settings{$id}{$list}{correctanswer}} = ();
	} elsif ($curr_class eq 'Matching') {
	push(@{$$settings{$id}{$response}{items}},$list);
	}
	}
	if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow response_label flow_mat material matapplication") {
	$$settings{$id}{$list}{filetype} = $attr->{embedded};
	$$settings{$id}{$list}{label} = $attr->{label};
	$$settings{$id}{$list}{uri} = $attr->{uri};
	}
	if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow response_label flow_mat material mattext") {
	$$settings{$id}{$list}{link} = $attr->{uri};
	}
	if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
	if ($curr_class eq 'Matching') {
	$curr_matchitem = $attr->{respident};
	}
	}
	if ("@state" eq "questestinterop section item itemfeedback") {
	$curr_feedback_type = $attr->{ident};
	}
	if ("@state" eq "questestinterop section item itemfeedback flow_mat flow_mat material matapplication") {
	$$settings{$id}{$curr_feedback_type.'feedback'}{filetype} = $attr->{'embedded'};
	$$settings{$id}{$curr_feedback_type.'feedback'}{label} = $attr->{label};
	$$settings{$id}{$curr_feedback_type.'feedback'}{uri} = $attr->{uri};
	}
	if ("@state" eq "questestinterop section item itemfeedback flow_mat flow_mat material mattext") {
	$$settings{$id}{$curr_feedback_type.'feedback'}{link} = $attr->{uri};
	}
	}, "tagname, attr"],
	text_h =>
	[sub {
	my ($text) = @_;
	$text =~ s/^\s+//g;
	$text =~ s/\s+$//g;
	if ("@state" eq "questestinterop assessment rubric flow_mat material mat_extension mat_formattedtext") {
	$$settings{description} = $text;
	} elsif ("@state" eq "questestinterop assessment presentation_material flow_mat material mat_extension mat_formattedtext") {
	$$settings{instructions}{text} = $text;
	}
	if ("@state" eq "questestinterop assessment section item itemmetadata bbmd_asi_object_id") {
	$id = $text;
	push @{$allids}, $id;
	%{$$settings{$id}} = ();
	@{$$settings{$id}{lists}} = ();
	%{$$settings{$id}{question}} = ();
	%{$$settings{$id}{correctfeedback}} = ();
	%{$$settings{$id}{incorrectfeedback}} = ();
	%{$$settings{$id}{solutionfeedback}} = ();
	%{$$settings{$id}{question}} = ();
	%{$$settings{$id}{response}} = ();
	}
	if ("@state" eq "questestinterop assessment section item itemmetadata bbmd_questiontype") {
	$$settings{$id}{class} = $text;
	$curr_class = $text;
	}
	if ("@state" eq "questestinterop assessment section item presentation flow flow flow material mat_extension mat_formatted_text") {
	$$settings{$id}{$curr_block_type}{text} = $text;
	}
	if ("@state" eq "questestinterop section item presentation flow flow flow material mattext") {
	$$settings{$id}{$curr_block_type}{linktext} = $text;
	}
	if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow response_label flow_mat material mat_extension mat_formatted_text") {
	$$settings{$id}{$list}{text} = $text;
	}
	if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow response_label flow_mat material mattext") {
	$$settings{$id}{$list}{linktext} = $text;
	}
	if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
	if ($curr_class eq 'Multiple Choice') {
	$$settings{$id}{$list}{correctanswer}[0] = $text;
	} elsif ($curr_class eq 'True/False') {
	$$settings{$id}{correctanswer} = $text;
	} elsif ($curr_class eq 'Matching') {
	$$settings{$id}{$curr_matchitem}{correctanswer} = $text;
	} elsif ($curr_class eq 'Fill in the Blank') {
	push(@{$$settings{$id}{$list}{correctanswer}},$text);
	}
	}
	if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar and varequal") {
	push(@{$$settings{$id}{$list}{correctanswer}},$text);
	}
	if ("@state" eq "questestinterop section item itemfeedback flow_mat flow_mat material mat_extension mat_formattedtext") {
	$$settings{$id}{$curr_feedback_type.'feedback'}{text} = $text;
	}
	if ("@state" eq "questestinterop section item itemfeedback flow_mat flow_mat material mattext") {
	$$settings{$id}{$curr_feedback_type.'feedback'}{linkname} = $text;
	}
	}, "dtext"],
	end_h =>
	[sub {
	my ($tagname) = @_;
	pop @state;
	}, "tagname"],
	);
	$p->unbroken_text(1);
	$p->marked_sections(1);
	$p->parse_file($xmlfile);
	$p->eof;
	return;
}	}

sub parse_webct4_assessment {	sub parse_webct4_assessment {
Line 1860 sub parse_webct4_quizprops {	Line 2049 sub parse_webct4_quizprops {
[sub {	[sub {
my ($tagname, $attr) = @_;	my ($tagname, $attr) = @_;
push @state, $tagname;	push @state, $tagname;
my $depth = 0;
my @seq = ();
if ($state[0] eq 'properties' && $state[1] eq 'processing') {
if ($state[2] eq 'scores' && $state[3] eq 'score') {
$$qzparams{$res}{weight} = $attr->{linkrefid};
} elsif ($state[2] eq 'selection' && $state[3] eq 'select') {
$$qzparams{$res}{numpick} = $attr->{linkrefid};
}
}
}, "tagname, attr"],	}, "tagname, attr"],
text_h =>	text_h =>
[sub {	[sub {
Line 1877 sub parse_webct4_quizprops {	Line 2057 sub parse_webct4_quizprops {
if ($state[2] eq 'time_available') {	if ($state[2] eq 'time_available') {
$$qzparams{$res}{opendate} = $text;	$$qzparams{$res}{opendate} = $text;
} elsif ($state[2] eq 'time_due') {	} elsif ($state[2] eq 'time_due') {
$$qzparams{$res}{opendate} = $text;	$$qzparams{$res}{duedate} = $text;
} elsif ($state[3] eq 'max_attempt') {	} elsif ($state[3] eq 'max_attempt') {
$$qzparams{$res}{tries} = $text;	$$qzparams{$res}{tries} = $text;
} elsif ($state[3] eq 'post_submission') {	} elsif ($state[3] eq 'post_submission') {
$$qzparams{$res}{posts} = $text;	$$qzparams{$res}{posts} = $text;
	} elsif ($state[3] eq 'method') {
	$$qzparams{$res}{method} = $text;
	}
	} elsif ($state[0] eq 'properties' && $state[1] eq 'processing') {
	if ($state[2] eq 'scores' && $state[3] eq 'score') {
	$$qzparams{$res}{weight} = $text;
	} elsif ($state[2] eq 'selection' && $state[3] eq 'select') {
	$$qzparams{$res}{numpick} = $text;
}	}
} elsif ($state[0] eq 'properties' && $state[1] eq 'result') {	} elsif ($state[0] eq 'properties' && $state[1] eq 'result') {
if ($state[2] eq 'display_answer') {	if ($state[2] eq 'display_answer') {
$$qzparams{$res}{answerdate} = $text;	$$qzparams{$res}{showanswer} = $text;
}	}
}	}
}, "dtext"],	}, "dtext"],
Line 2079 sub parse_webct4_questionDB {	Line 2267 sub parse_webct4_questionDB {
$$settings{$id}{$numid}{toltype} = $attr->{type};	$$settings{$id}{$numid}{toltype} = $attr->{type};
}	}
if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {	if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
my $unitid = $attr->{ident};	$unitid = $attr->{ident};
%{$$settings{$id}{$numid}{$unitid}} = ();	%{$$settings{$id}{$numid}{$unitid}} = ();
push(@{$$settings{$id}{$numid}{units}},$unitid);	push(@{$$settings{$id}{$numid}{units}},$unitid);
$$settings{$id}{$numid}{$unitid}{value} = $attr->{value};	$$settings{$id}{$numid}{$unitid}{value} = $attr->{value};
Line 2257 sub parse_webct4_questionDB {	Line 2445 sub parse_webct4_questionDB {
}	}

sub process_assessment {	sub process_assessment {
my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items,$catinfo,$qzdbsettings) = @_;	my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items,$catinfo,$qzdbsettings,$hrefs) = @_;
my @allids = ();	my @allids = ();
my %allanswers = ();	my %allanswers = ();
my %allchoices = ();	my %allchoices = ();
Line 2271 sub process_assessment {	Line 2459 sub process_assessment {
my $randompickflag = 0;	my $randompickflag = 0;
my ($cid,$cdom,$cnum);	my ($cid,$cdom,$cnum);
if ($context eq 'DOCS') {	if ($context eq 'DOCS') {
$cid = $ENV{'request.course.id'};	$cid = $env{'request.course.id'};
($cdom,$cnum) = split/_/,$cid;	($cdom,$cnum) = split/_/,$cid;
}	}
my $destresdir = $destdir;	my $destresdir = $destdir;
Line 2329 sub process_assessment {	Line 2517 sub process_assessment {
if (!-e "$destdir/problems/$seqname") {	if (!-e "$destdir/problems/$seqname") {
mkdir("$destdir/problems/$seqname",0755);	mkdir("$destdir/problems/$seqname",0755);
}	}
my $newdir = "$destdir/problems/$seqname";	$newdir = "$destdir/problems/$seqname";
my $dbcontainerdir;	my $dbcontainerdir;
&build_problem_container($cms,$seqname,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);	&build_problem_container($cms,$seqname,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
}	}
Line 2338 sub process_assessment {	Line 2526 sub process_assessment {
$$dbparse = 1;	$$dbparse = 1;
}	}
&parse_webct4_assessment($res,$docroot,$$resources{$res}{file},$container,\@allids);	&parse_webct4_assessment($res,$docroot,$$resources{$res}{file},$container,\@allids);
&parse_webct4_quizprops($res,$docroot,$$resources{$$items{$$resources{$res}{revitm}}{properties}}{file},$container,\%qzparams);	&parse_webct4_quizprops($res,$docroot,$$hrefs{$$items{$$resources{$res}{revitm}}{properties}}[0],$container,\%qzparams);
foreach (sort keys %qzparams) {	if (exists($qzparams{$res}{numpick})) {
if (exists($qzparams{$res}{numpick})) {	if ($qzparams{$res}{numpick} < @allids) {
if ($qzparams{$res}{numpick} < @allids) {	$$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
$$randompicks{$res} = $qzparams{$res}{numpick};	$randompickflag = 1;
$randompickflag = 1;
}
}	}
}	}
}	}
Line 2359 sub process_assessment {	Line 2545 sub process_assessment {
if (!-e "$destdir/problems/$dirtitle") {	if (!-e "$destdir/problems/$dirtitle") {
mkdir("$destdir/problems/$dirtitle",0755);	mkdir("$destdir/problems/$dirtitle",0755);
}	}
my $newdir = "$destdir/problems/$dirtitle";	$newdir = "$destdir/problems/$dirtitle";
}	}

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

Line 2400 sub build_problem_container {	Line 2590 sub build_problem_container {
my $probsrc = "/res/lib/templates/simpleproblem.problem";	my $probsrc = "/res/lib/templates/simpleproblem.problem";
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
foreach my $id (@{$allids}) {	foreach my $id (@{$allids}) {
$probtitle{$id} = $$settings{$id}{title};	if ($cms eq 'webct4') {
	$probtitle{$id} = $$settings{$id}{title};
	} else {
	$probtitle{$id} = $$settings{title};
	}
$probtitle{$id} =~ s/\s/_/g;	$probtitle{$id} =~ s/\s/_/g;
$probtitle{$id} =~ s/\W//g;	$probtitle{$id} =~ s/\W//g;
$probtitle{$id} .= '_'.$id;	$probtitle{$id} .= '_'.$id;
Line 2412 sub build_problem_container {	Line 2606 sub build_problem_container {
$probdir =~ s/\W//g;	$probdir =~ s/\W//g;
$probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";	$probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";
} else {	} else {
$probsrc="$dirname/problems/$dirtitle/$$allids[0].problem";	$probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";
}	}
}	}
print $fh qq\|<resource id="1" src="$probsrc" type="start" title="question_0001"></resource>\|;	print $fh qq\|<resource id="1" src="$probsrc" type="start" title="question_0001"></resource>\|;
Line 2436 sub build_problem_container {	Line 2630 sub build_problem_container {
$probdir =~ s/\W//g;	$probdir =~ s/\W//g;
$probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";	$probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";
} else {	} else {
$probsrc = "$dirname/problems/$dirtitle/$$allids[$j].problem";	$probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
}	}
}	}
print $fh qq\|	print $fh qq\|
Line 2454 sub build_problem_container {	Line 2648 sub build_problem_container {
}	}

sub write_bb5_questions {	sub write_bb5_questions {
my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum) = @_;	my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
my $qnum = 0;	my $qnum = 0;
foreach my $id (@{$allids}) {	foreach my $id (@{$allids}) {
	if ($$settings{$id}{ishtml} eq 'true') {
	$$settings{$id}{text} = &HTML::Entities::decode($$settings{$id}{text});
	}
	if ($$settings{$id}{text} =~ m#<img src=['"]?(https?://[^\s]+/)([^/\s\'"]+)['"]?[^>]*>#) {
	if (&retrieve_image($context,$res,$dirname,$cdom,$cnum,$docroot,$destdir,$1,$2) eq 'ok') {
	$$settings{$id}{text} =~ s#(<img src=['"]?)(https?://[^\s]+/)([^/\s'"]+)(['"]?[^>]*>)#$1../../resfiles/$res/webimages/$3$4#g;
	}
	}
	$$settings{$id}{text} =~ s#(<img src=[^>]+)/*>#$1 />#gi;
	$$settings{$id}{text} =~ s#<br>#<br />#g;
$qnum ++;	$qnum ++;
my $output;	my $output;
my $permcontainer = $containerdir;	my $permcontainer = $containerdir;
Line 2800 sub write_bb5_questions {	Line 3004 sub write_bb5_questions {
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
$output .= qq\|</problem>	$output .= qq\|</problem>
\|;	\|;
open(PROB,">$newdir/problems/$id.problem");	my $title = $$settings{title};
	$title =~ s/\s/_/g;
	$title =~ s/\W//g;
	$title .= '_'.$id;
	open(PROB,">:utf8", "$newdir/$title.problem");
print PROB $output;	print PROB $output;
close PROB;	close PROB;
} else {	} else {
Line 2828 sub write_webct4_questions {	Line 3036 sub write_webct4_questions {
$allfeedback .= $feedback;	$allfeedback .= $feedback;
}	}
if ($$settings{$id}{texttype} eq 'text/html') {	if ($$settings{$id}{texttype} eq 'text/html') {
$$settings{$id}{text} = &HTML::Entities::decode($$settings{$id}{text});	$$settings{$id}{text} =~ s/(\&)(nbsp\|gt\|lt)(?!;)/$1$2;$3/gi;
$$settings{$id}{text} = &Apache::lonxml::htmlclean($$settings{$id}{text});	$$settings{$id}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{text});
$$settings{$id}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;	$$settings{$id}{text} =~ s#(<img src=["']?)([^>]+?)(/?>)#$1../../resfiles/$2 />#gi;
$$settings{$id}{text} =~ s#<hr>#<hr />#g;	$$settings{$id}{text} =~ s#<([bh])r>#<$1r />#g;
# $$settings{$id}{text} =~ s#<p>#</p><p>#g;
# $$settings{$id}{text} =~ s#</p></p>#</p>#;
# $$settings{$id}{text} =~ s#<p></p>##g;
$$settings{$id}{text} =~ s#<p>#<br /><br />#g;	$$settings{$id}{text} =~ s#<p>#<br /><br />#g;
$$settings{$id}{text} =~ s#<\\p>##g;	$$settings{$id}{text} =~ s#</p>##g;
}	}
if ($$settings{$id}{class} eq 'numerical') {	if ($$settings{$id}{class} eq 'numerical') {
foreach my $numid (@{$$settings{$id}{numids}}) {	foreach my $numid (@{$$settings{$id}{numids}}) {
Line 2857 sub write_webct4_questions {	Line 3062 sub write_webct4_questions {
$resourcedata{$symb.'randomize'} = 'yes';	$resourcedata{$symb.'randomize'} = 'yes';
$resourcedata{$symb.'maxfoils'} = 10;	$resourcedata{$symb.'maxfoils'} = 10;
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
$output = qq\|<problem>	unless ($$settings{$id}{class} eq 'numerical') {
	$output = qq\|<problem>
\|;	\|;
	}
}	}
$$total{prob} ++;	$$total{prob} ++;
if (exists($$settings{$id}{uri})) {	if (exists($$settings{$id}{uri})) {
Line 2919 sub write_webct4_questions {	Line 3126 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::lonxml::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 2961 sub write_webct4_questions {	Line 3168 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::lonxml::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 2993 sub write_webct4_questions {	Line 3200 sub write_webct4_questions {

$$settings{$id}{$grp}{$answer_id}{text} = &HTML::Entities::decode($$settings{$id}{$grp}{$answer_id}{text});	$$settings{$id}{$grp}{$answer_id}{text} = &HTML::Entities::decode($$settings{$id}{$grp}{$answer_id}{text});
$test_for_html = &test_for_html($$settings{$id}{$grp}{$answer_id}{text});	$test_for_html = &test_for_html($$settings{$id}{$grp}{$answer_id}{text});
$$settings{$id}{$grp}{$answer_id}{text} = &Apache::lonxml::chtmlclean($$settings{$id}{$grp}{$answer_id}{text});	$$settings{$id}{$grp}{$answer_id}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$grp}{$answer_id}{text});
$$settings{$id}{$grp}{$answer_id}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;	$$settings{$id}{$grp}{$answer_id}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
$$settings{$id}{$grp}{$answer_id}{text} =~ s#</?p>##g;	$$settings{$id}{$grp}{$answer_id}{text} =~ s#</?p>##g;
}	}
Line 3022 sub write_webct4_questions {	Line 3229 sub write_webct4_questions {
} else {	} else {
$output .= qq\|	$output .= qq\|
<optionresponse max="10" randomize="yes">	<optionresponse max="10" randomize="yes">
<foilgroup options=$allmatchlist>	<foilgroup options="$allmatchlist">
\|;	\|;
}	}
} else {	} else {
Line 3056 sub write_webct4_questions {	Line 3263 sub write_webct4_questions {
for (my $k=0; $k<@{$$allchoices{$id}}; $k++) {	for (my $k=0; $k<@{$$allchoices{$id}}; $k++) {
if ($$settings{$id}{$$allchoices{$id}[$k]}{texttype} eq 'text/html') {	if ($$settings{$id}{$$allchoices{$id}[$k]}{texttype} eq 'text/html') {
$$settings{$id}{$$allchoices{$id}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$$allchoices{$id}[$k]}{text});	$$settings{$id}{$$allchoices{$id}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$$allchoices{$id}[$k]}{text});
$$settings{$id}{$$allchoices{$id}[$k]}{text} = &Apache::lonxml::htmlclean($$settings{$id}{$$allchoices{$id}[$k]}{text});	$$settings{$id}{$$allchoices{$id}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$$allchoices{$id}[$k]}{text});
$$settings{$id}{$$allchoices{$id}[$k]}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;	$$settings{$id}{$$allchoices{$id}[$k]}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
$$settings{$id}{$$allchoices{$id}[$k]}{text} =~ s#</?p>##g;	$$settings{$id}{$$allchoices{$id}[$k]}{text} =~ s#</?p>##g;
}	}
Line 3213 sub write_webct4_questions {	Line 3420 sub write_webct4_questions {
}	}
}	}
} elsif ($$settings{$id}{class} eq 'numerical') {	} elsif ($$settings{$id}{class} eq 'numerical') {
	my %mathfns = (
	'abs' => 'abs',
	'acos' => 'acos',
	'asin' => 'asin',
	'atan' => 'atan',
	'ceil' => 'ceil',
	'cos' => 'cos',
	'exp' => 'exp',
	'fact' => 'factorial',
	'floor' => 'floor',
	'int' => 'int',
	'ln' => 'log',
	'log' => 'log',
	'max' => 'max',
	'min' => 'min',
	'round' => 'roundto',
	'sin' => 'sin',
	'sqrt' => 'sqrt',
	'tan' => 'tan',
	);

my $scriptblock = qq\|	my $scriptblock = qq\|
<script type="loncapa/perl">	<script type="loncapa/perl">
\|;	\|;
foreach my $numid (@{$$settings{$id}{numids}}) {	foreach my $numid (@{$$settings{$id}{numids}}) {
my $formula = $$settings{$id}{$numid}{formula};	my $formula = $$settings{$id}{$numid}{formula};
	my $pattern = join('\|',(sort (keys (%mathfns))));
	$formula =~ s/($pattern)/\&$mathfns{$1}/g;
foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {	foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {
my $decnum = $$settings{$id}{$numid}{vars}{$var}{dec};	my $decnum = $$settings{$id}{$numid}{vars}{$var}{dec};
my $increment = '0.';	my $increment = '0.';
Line 3231 sub write_webct4_questions {	Line 3461 sub write_webct4_questions {
}	}
$increment .= '1';	$increment .= '1';
}	}
$formula =~ s/{($var)}/\$$1/g;	$formula =~ s/{($var)}/(\$$1)/g;
$formula =~ s/ln$?([^$])\)?/ &log($1) /g;
$formula =~ s/sqrt/\&sqrt/g;
$scriptblock .= qq\|	$scriptblock .= qq\|
\$$var=&random($$settings{$id}{$numid}{vars}{$var}{min},$$settings{$id}{$numid}{vars}{$var}{max},$increment);	\$$var=&random($$settings{$id}{$numid}{vars}{$var}{min},$$settings{$id}{$numid}{vars}{$var}{max},$increment);
\|;	\|;
Line 3243 sub write_webct4_questions {	Line 3471 sub write_webct4_questions {
</script>	</script>
\|;	\|;
if ($context eq 'CSTR') {	if ($context eq 'CSTR') {
$output = $scriptblock.$output;	$output = "<problem>\n".$scriptblock.$output;
my $ansformat = '';	my $ansformat = '';
my $sigfig = '0,15';	my $sigfig = '0,15';
if ($$settings{$id}{$numid}{format} eq 'sig') {	if ($$settings{$id}{$numid}{format} eq 'sig') {
Line 3264 sub write_webct4_questions {	Line 3492 sub write_webct4_questions {
}	}
my $unitentry = '';	my $unitentry = '';
if ($unit ne '') {	if ($unit ne '') {
$unitentry = 'unit='.$unit;	$unitentry = 'unit="'.$unit.'"';
}	}
$output .= qq\|	$output .= qq\|
<numericalresponse $unitentry $ansformat answer="\$answervar">	<numericalresponse $unitentry $ansformat answer="\$answervar">
Line 3321 sub test_for_html {	Line 3549 sub test_for_html {
}	}

sub write_bb6_questions {	sub write_bb6_questions {
my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices) = @_;	my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices) = @_;
	}

	sub retrieve_image {
	my ($context,$res,$dirname,$cdom,$cname,$docroot,$destdir,$urlpath,$filename) = @_;
	my $contents;
	my $url = $urlpath.$filename;
	my $ua=new LWP::UserAgent;
	my $request=new HTTP::Request('GET',$url);
	my $response=$ua->request($request);
	if ($response->is_success) {
	$contents = $response->content;
	if (!-e "$docroot/$res") {
	mkdir("$docroot/$res",0755);
	}
	if (!-e "$docroot/$res/webimages") {
	mkdir("$docroot/$res/webimages",0755);
	}
	open(my $fh,">$docroot/$res/webimages/$filename");
	print $fh $contents;
	close($fh);
	if ($context eq 'DOCS') {
	my $chome = &Apache::lonnet::homeserver($cname,$cdom);
	my $copyfile = $dirname.'/'.$filename;
	my $source = "$docroot/$res/webimages/$filename";
	my $fileresult;
	if (-e $source) {
	$fileresult = &Apache::lonnet::process_coursefile('copy',$cname,$cdom,$chome,$copyfile,$source);
	}
	return $fileresult;
	} elsif ($context eq 'CSTR') {
	if (!-e "$destdir/resfiles/$res") {
	mkdir("$destdir/resfiles/$res",0755);
	}
	if (!-e "$destdir/resfiles/$res/webimages") {
	mkdir("$destdir/resfiles/$res/webimages",0755);
	}
	rename("$docroot/$res/webimages/$filename","$destdir/resfiles/$res/webimages/$filename");
	return 'ok';
	}
	} else {
	return -1;
	}
}	}

# ---------------------------------------------------------------- Process Blackboard Announcements	# ---------------------------------------------------------------- Process Blackboard Announcements

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

Removed from v.1.17
changed lines
	Added in v.1.29