--- loncom/imspackages/imsprocessor.pm 2005/03/15 15:25:32 1.16
+++ loncom/imspackages/imsprocessor.pm 2005/07/13 19:56:37 1.24
@@ -24,6 +24,9 @@
package Apache::imsprocessor;
use Apache::lonnet;
+use Apache::loncleanup;
+use LWP::UserAgent;
+use HTTP::Request::Common;
use LONCAPA::Configuration;
use strict;
@@ -95,7 +98,7 @@ sub uploadzip {
my ($context,$tempdir,$source) = @_;
my $fname;
if ($context eq 'DOCS') {
- $fname=$ENV{'form.uploadname.filename'};
+ $fname=$env{'form.uploadname.filename'};
# Replace Windows backslashes by forward slashes
$fname=~s/\\/\//g;
# Get rid of everything but the actual filename
@@ -107,9 +110,9 @@ sub uploadzip {
# See if there is anything left
unless ($fname) { return 'error: no uploaded file'; }
# Save the file
- chomp($ENV{'form.uploadname'});
+ chomp($env{'form.uploadname'});
open(my $fh,'>'.$tempdir.'/'.$fname);
- print $fh $ENV{'form.uploadname'};
+ print $fh $env{'form.uploadname'};
close($fh);
} elsif ($context eq 'CSTR') {
if ($source =~ m/\/([^\/]+)$/) {
@@ -128,14 +131,8 @@ sub expand_zip {
return 'no zip';
}
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 |");
close(OUTPUT);
- %ENV=%oldENV;
- undef(%oldENV);
} else {
return 'nozip';
}
@@ -177,7 +174,7 @@ sub process_manifest {
unless (-e "$tempdir/imsmanifest.xml") {
return 'nomanifest';
- }
+ }
my $xmlfile = $tempdir.'/imsmanifest.xml';
my $p = HTML::Parser->new
@@ -187,19 +184,9 @@ sub process_manifest {
[sub {
my ($tagname, $attr) = @_;
push @state, $tagname;
- my $num = @state - 3;
- my $start = $num;
- my $statestr = '';
- foreach (@state) {
- $statestr .= "$_ ";
- }
+ my $start = @state - 3;
if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $toc{$cms}) ) {
- my $searchstr = "manifest organizations $toc{$cms}";
- while ($num > 0) {
- $searchstr .= " item";
- $num --;
- }
- if (("@state" eq $searchstr) && (@state > 3)) {
+ if ($state[-1] eq 'item') {
$itm = $attr->{identifier};
if ($$includeditems{$itm} || $phase ne 'build') {
%{$$items{$itm}} = ();
@@ -260,7 +247,7 @@ sub process_manifest {
}
}
if ($cms eq 'webct4') {
- if ("@state" eq "$searchstr webct:properties") {
+ if (($state[-1] eq "webct:properties") && (@state > 4)) {
$$items{$itm}{properties} = $attr->{identifierref};
}
}
@@ -392,7 +379,7 @@ sub copy_resources {
$copyfile = $1;
}
}
- unless (($cms eq 'webct4') && ($copyfile eq 'questionDB.xml' || $copyfile =~ m/^quiz_QIZ_\d+\.xml$/)) {
+ unless (($cms eq 'webct4') && ($copyfile =~ m/questionDB\.xml$/ || $copyfile =~ m/quiz_QIZ_\d+\.xml$/ || $copyfile =~ m/properties_QIZ_\d+\.xml$/)) {
$copyfile = $fpath.$copyfile;
my $fileresult;
if (-e $source) {
@@ -447,10 +434,8 @@ sub copy_resources {
if (-e "$tempdir/$file") {
rename("$tempdir/$file","$destdir/resfiles/$copyfile");
}
- } elsif ($file =~ m-/data/(.+)$-) {
- print STDERR "File $file is a WebCT data file \n";
- } else {
- print STDERR "File $file is in unexpected location\n";
+ } elsif ($file !~ m-/data/(.+)$-) {
+ &Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
}
}
}
@@ -466,6 +451,8 @@ sub process_resinfo {
my $dbparse = 0;
my $announce_handling = 'include';
my $longcrs = '';
+ my %qzdbsettings = ();
+ my %catinfo = ();
if ($crs =~ m/^(\d)(\d)(\d)/) {
$longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
}
@@ -529,15 +516,15 @@ sub process_resinfo {
}
} elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {
%{$$resinfo{$key}} = ();
- &process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);
+ &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;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {
%{$$resinfo{$key}} = ();
- &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);
+ &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;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-survey") {
%{$$resinfo{$key}} = ();
- &process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);
+ &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;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {
%{$$resinfo{$key}} = ();
@@ -579,8 +566,7 @@ sub process_resinfo {
%{$$resinfo{$key}} = ();
&webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
} elsif ($$resources{$key}{type} eq "webctquiz") {
-# &webct4_assessment($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
- &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);
+ &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs);
}
}
}
@@ -670,12 +656,11 @@ sub build_structure {
\n|;
}
} else {
- print "key is $key\n";
my $contcount = 0;
if (defined($$items{$key}{contents})) {
$contcount = @{$$items{$key}{contents}};
} else {
- print STDERR "not defined for $key\n";
+ &Apache::lonnet::logthis("IMS Import error for item: $key- contents count = $contentscount, but identity of contents not defined.");
}
my $contitem = $$items{$key}{contents}[0];
my $contitemcount = $$items{$contitem}{contentscount};
@@ -691,8 +676,12 @@ sub build_structure {
if (grep/^$res$/,@{$packages}) {
$packageflag = 1;
}
- $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount);
+ $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) {
+ if ($$randompicks{$contitem}) {
+ $seqtext{$key} .= qq|
+\n|;
+ }
$seqtext{$key} .= qq|
-
+\n|;
+ if ($$randompicks{$contitem}) {
+ $seqtext{$key} .= qq|
+|;
+ }
+ $seqtext{$key} .= qq|
-
+\n|;
+ if ($$randompicks{$contitem}) {
+ $seqtext{$key} .= qq|
+\n|;
+ }
+ $seqtext{$key} .= qq|
0)) {
$src = $srcstem.'/sequences/'.$contitem.'.sequence';
$$flag{$key}{page} = 0;
$$flag{$key}{seq} = 1;
$$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') {
$src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard';
$$flag{$key}{page} = 0;
@@ -900,7 +903,7 @@ sub make_structure {
} elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) ) {
if ($$flag{$key}{page}) {
if ($$count{$key}{page} == -1) {
- print STDERR "Array index is -1, we shouldnt be here, key is $key, type is $type\n";
+ &Apache::lonnet::logthis("IMS Angel import error in array index for page: value = -1, resource is $key, type is $type.");
} else {
push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
}
@@ -928,7 +931,11 @@ sub make_structure {
$$flag{$key}{seq} = 0;
}
} elsif ($cms eq 'webct4') {
- unless ($type eq 'webctquiz') {
+ if ($type eq 'webctquiz') {
+ $src = $srcstem.'/pages/'.$res.'.page';
+ $$count{$key}{page} ++;
+ $$flag{$key}{seq} = 0;
+ } else {
if (grep/^$file$/,@{$$hrefs{$res}}) {
my $filename;
if ($file =~ m-/([^/]+)$-) {
@@ -1720,7 +1727,7 @@ sub parse_bb5_assessment {
$id = $attr->{id};
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") ) {
if ($state[4] eq "ISHTML") {
- $$settings{$id}{html} = $attr->{value};
+ $$settings{$id}{ishtml} = $attr->{value};
} elsif ($state[4] eq "ISNEWLINELITERAL") {
$$settings{$id}{newline} = $attr->{value};
}
@@ -1827,7 +1834,6 @@ sub parse_bb6_assessment {
sub parse_webct4_assessment {
my ($res,$docroot,$href,$container,$allids) = @_;
my $xmlfile = $docroot.'/'.$href; #quiz file
- print STDERR "quiz file -- XML file is $xmlfile\n";
my @state = ();
my $id; # the current question ID
my $p = HTML::Parser->new
@@ -1862,7 +1868,6 @@ sub parse_webct4_assessment {
sub parse_webct4_quizprops {
my ($res,$docroot,$href,$container,$qzparams) = @_;
my $xmlfile = $docroot.'/'.$href; #properties file
- print STDERR "props file -- XML file is $xmlfile\n";
my @state = ();
%{$$qzparams{$res}} = ();
my $p = HTML::Parser->new
@@ -1872,15 +1877,6 @@ sub parse_webct4_quizprops {
[sub {
my ($tagname, $attr) = @_;
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"],
text_h =>
[sub {
@@ -1889,15 +1885,23 @@ sub parse_webct4_quizprops {
if ($state[2] eq 'time_available') {
$$qzparams{$res}{opendate} = $text;
} elsif ($state[2] eq 'time_due') {
- $$qzparams{$res}{opendate} = $text;
+ $$qzparams{$res}{duedate} = $text;
} elsif ($state[3] eq 'max_attempt') {
$$qzparams{$res}{tries} = $text;
} elsif ($state[3] eq 'post_submission') {
$$qzparams{$res}{posts} = $text;
+ } elsif ($state[3] eq 'method') {
+ $$qzparams{$res}{method} = $text;
+ }
+ } elsif ($state[0] eq 'properties' && $state[1] eq 'processing') {
+ if ($state[2] eq 'scores' && $state[3] eq 'score') {
+ $$qzparams{$res}{weight} = $text;
+ } elsif ($state[2] eq 'selection' && $state[3] eq 'select') {
+ $$qzparams{$res}{numpick} = $text;
}
} elsif ($state[0] eq 'properties' && $state[1] eq 'result') {
if ($state[2] eq 'display_answer') {
- $$qzparams{$res}{answerdate} = $text;
+ $$qzparams{$res}{showanswer} = $text;
}
}
}, "dtext"],
@@ -2269,14 +2273,12 @@ sub parse_webct4_questionDB {
}
sub process_assessment {
- my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items) = @_;
+ my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items,$catinfo,$qzdbsettings,$hrefs) = @_;
my @allids = ();
my %allanswers = ();
my %allchoices = ();
my %qzparams = ();
my @allquestids = ();
- my %catinfo = ();
- my %qzdbsettings = ();
my %alldbanswers = ();
my %alldbchoices = ();
my @alldbquestids = ();
@@ -2285,7 +2287,7 @@ sub process_assessment {
my $randompickflag = 0;
my ($cid,$cdom,$cnum);
if ($context eq 'DOCS') {
- $cid = $ENV{'request.course.id'};
+ $cid = $env{'request.course.id'};
($cdom,$cnum) = split/_/,$cid;
}
my $destresdir = $destdir;
@@ -2300,24 +2302,24 @@ sub process_assessment {
&parse_bb6_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
} elsif ($cms eq 'webct4') {
unless($$dbparse) {
- &parse_webct4_questionDB($docroot,$$resources{$res}{file},\%catinfo,\%qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
+ &parse_webct4_questionDB($docroot,$$resources{$res}{file},$catinfo,$qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
if (!-e "$destdir/sequences") {
mkdir("$destdir/sequences",0755);
}
- my $numcats = scalar(keys %catinfo);
+ my $numcats = scalar(keys %{$catinfo});
my $curr_id = 0;
my $next_id = 1;
my $fh;
open($fh,">$destdir/sequences/question_database.sequence");
push @{$sequencesfiles},'question_database.sequence';
- foreach my $category (sort keys %catinfo) {
- my $seqname = $catinfo{$category}{title}.'_'.$category;
+ foreach my $category (sort keys %{$catinfo}) {
+ my $seqname = $$catinfo{$category}{title}.'_'.$category;
$seqname =~ s/\s/_/g;
$seqname =~ s/\W//g;
push(@{$sequencesfiles},$seqname.'.sequence');
my $catsrc = "$destresdir/sequences/$seqname.sequence";
if ($curr_id == 0) {
- print $fh qq||;
+ print $fh qq||;
}
if ($numcats == 1) {
print $fh qq|
@@ -2329,7 +2331,7 @@ sub process_assessment {
$catsrc = "$destresdir/sequences/$seqname.sequence";
print $fh qq|
-\n|;
} else {
@@ -2343,22 +2345,20 @@ sub process_assessment {
if (!-e "$destdir/problems/$seqname") {
mkdir("$destdir/problems/$seqname",0755);
}
- my $newdir = "$destdir/problems/$seqname";
+ $newdir = "$destdir/problems/$seqname";
my $dbcontainerdir;
- &build_problem_container($cms,$seqname,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,$cid,$cdom,$cnum,\%catinfo,\%qzdbsettings);
+ &build_problem_container($cms,$seqname,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
}
close($fh);
- &write_webct4_questions(\@alldbquestids,$context,\%qzdbsettings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum,$destdir,\%catinfo);
+ &write_webct4_questions(\@alldbquestids,$context,$qzdbsettings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);
$$dbparse = 1;
}
&parse_webct4_assessment($res,$docroot,$$resources{$res}{file},$container,\@allids);
- &parse_webct4_quizprops($res,$docroot,$$resources{$$items{$$resources{$res}{revitm}}{properties}}{file},$container,\%qzparams);
- foreach (sort keys %qzparams) {
- if (exists($qzparams{$res}{numpick})) {
- if ($qzparams{$res}{numpick} < @allids) {
- $$randompicks{$res} = $qzparams{$res}{numpick};
- $randompickflag = 1;
- }
+ &parse_webct4_quizprops($res,$docroot,$$hrefs{$$items{$$resources{$res}{revitm}}{properties}}[0],$container,\%qzparams);
+ if (exists($qzparams{$res}{numpick})) {
+ if ($qzparams{$res}{numpick} < @allids) {
+ $$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
+ $randompickflag = 1;
}
}
}
@@ -2373,14 +2373,18 @@ sub process_assessment {
if (!-e "$destdir/problems/$dirtitle") {
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') {
- &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') {
- &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);
}
}
@@ -2410,16 +2414,27 @@ sub build_problem_container {
}
print $fh qq|
##;
# $$settings{$id}{text} =~ s###g;
$$settings{$id}{text} =~ s##
#g;
- $$settings{$id}{text} =~ s#<\\p>##g;
+ $$settings{$id}{text} =~ s#
##g;
}
if ($$settings{$id}{class} eq 'numerical') {
foreach my $numid (@{$$settings{$id}{numids}}) {
@@ -2864,8 +2893,10 @@ sub write_webct4_questions {
$resourcedata{$symb.'randomize'} = 'yes';
$resourcedata{$symb.'maxfoils'} = 10;
if ($context eq 'CSTR') {
- $output = qq|
+ unless ($$settings{$id}{class} eq 'numerical') {
+ $output = qq|
|;
+ }
}
$$total{prob} ++;
if (exists($$settings{$id}{uri})) {
@@ -2926,7 +2957,7 @@ sub write_webct4_questions {
}
if ($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{texttype} eq 'text/html') {
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
- $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &Apache::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#(]+)>#$1../../resfiles/$2 />#gi;
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#?p>##g;
@@ -3000,7 +3031,7 @@ sub write_webct4_questions {
$$settings{$id}{$grp}{$answer_id}{text} = &HTML::Entities::decode($$settings{$id}{$grp}{$answer_id}{text});
$test_for_html = &test_for_html($$settings{$id}{$grp}{$answer_id}{text});
- $$settings{$id}{$grp}{$answer_id}{text} = &Apache::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#(]+)>#$1../../resfiles/$2 />#gi;
$$settings{$id}{$$allchoices{$id}[$k]}{text} =~ s#?p>##g;
}
@@ -3220,11 +3251,34 @@ sub write_webct4_questions {
}
}
} 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|
|;
if ($context eq 'CSTR') {
- $output = $scriptblock.$output;
+ $output = "\n".$scriptblock.$output;
my $ansformat = '';
my $sigfig = '0,15';
if ($$settings{$id}{$numid}{format} eq 'sig') {
@@ -3328,7 +3380,49 @@ sub test_for_html {
}
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
@@ -3873,11 +3967,5 @@ $linktag
}
}
-# ---------------------------------------------------------------- WebCT assessments
-sub webct4_assessment {
- my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
- print STDERR "webct assessment detected - $res, $docroot, $destdir, $type,$title\n";
-}
-
1;
__END__