--- loncom/imspackages/imsprocessor.pm 2006/04/05 17:33:51 1.37
+++ loncom/imspackages/imsprocessor.pm 2006/04/15 16:44:56 1.40
@@ -2178,6 +2178,10 @@ sub parse_webctvista4_assessment {
my ($tagname, $attr) = @_;
push @state, $tagname;
my @seq = ();
+ if ("@state" eq "questestinterop assessment") {
+ $$qzparams{$res}{id} = $attr->{'ident'};
+ $$qzparams{$res}{title} = $attr->{'title'};
+ }
if ("@state" eq "questestinterop assessment section itemref") {
$id = $attr->{linkrefid};
push(@{$allids},$id);
@@ -2186,7 +2190,6 @@ sub parse_webctvista4_assessment {
if ("@state" eq "questestinterop assessment section selection_ordering order") {
$$qzparams{$res}{order_type} = $attr->{order_type};
}
-
}, "tagname, attr"],
text_h =>
[sub {
@@ -2366,6 +2369,7 @@ sub parse_webctvista4_question {
if ("@state" eq "questestinterop item presentation flow response_lid render_choice") {
$$settings{$id}{$list}{randomize} = $attr->{shuffle};
}
+# Multiple Choice, True/False and Combination
if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label") {
$answer_id = $attr->{ident};
push(@{$$allanswers{$id}{$list}},$answer_id);
@@ -2413,7 +2417,7 @@ sub parse_webctvista4_question {
%{$$settings{$id}{$str_id}{$label}} = ();
$$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
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
@@ -2424,6 +2428,7 @@ sub parse_webctvista4_question {
$grp = $attr->{ident};
push(@{$$settings{$id}{grps}},$grp);
%{$$settings{$id}{$grp}} = ();
+ @{$$allanswers{$id}{$grp}} = ();
@{$$settings{$id}{$grp}{correctanswer}} = ();
$$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};
}
@@ -2431,7 +2436,7 @@ sub parse_webctvista4_question {
$currtexttype = lc($attr->{texttype});
$$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};
push(@{$$allanswers{$id}{$grp}},$answer_id);
%{$$settings{$id}{$grp}{$answer_id}} = ();
@@ -2446,6 +2451,7 @@ sub parse_webctvista4_question {
} elsif (($$settings{$id}{class} eq 'string') ||
($$settings{$id}{class} eq 'shortanswer')) {
$label = $attr->{respident};
+ $$settings{$id}{$label}{case} = $attr->{'case'};
} elsif ($$settings{$id}{class} eq 'match') {
$grp = $attr->{respident};
}
@@ -2545,9 +2551,11 @@ sub parse_webctvista4_question {
$$settings{$id}{$str_id}{$label}{$textlabel} = $text;
}
}
+# Matching
if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mattext") {
$$settings{$id}{$list}{$answer_id}{text} .= $text;
}
+# Multiple choice, True/False, Combination
if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mat_extension webct:localizable_mattext") {
$$settings{$id}{$list}{$answer_id}{text} = $text;
}
@@ -2571,6 +2579,17 @@ sub parse_webctvista4_question {
}
}
}
+# Matching
+ if ("@state" eq "questestinterop item presentation flow flow response_grp material mattext") {
+ $$settings{$id}{$grp}{text} = $text;
+ unless ($text eq '') {
+ push(@{$$allchoices{$id}},$grp);
+ }
+ }
+ if ("@state" eq "questestinterop item presentation flow flow response_grp render_choice flow_label response_label material mattext") {
+ $$settings{$id}{$grp}{$answer_id}{text} = $text;
+ }
+# Numerical
if ("@state" eq "questestinterop item resprocessing itemproc_extension unit_eval conditionvar varequal") {
$$settings{$id}{$numid}{$unitid}{text} = $text;
}
@@ -3125,21 +3144,22 @@ sub process_assessment {
unless($$dbparse) {
foreach my $res (sort keys %{$allquestions}) {
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);
$$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) {
$$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
$randompickflag = 1;
}
}
my $dirtitle;
- unless ($cms eq 'webctce4') {
+ unless ($cms eq 'webctce4' || $cms eq 'webctvista4') {
$dirtitle = $$settings{'title'};
- $dirtitle =~ s/\W//g;
+ $dirtitle =~ s/\s+/_/g;
+ $dirtitle =~ s/:/_/g;
$dirtitle .= '_'.$res;
if (!-e "$destdir/problems") {
mkdir("$destdir/problems",0755);
@@ -3153,14 +3173,14 @@ sub process_assessment {
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);
} 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') {
&write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot);
} elsif ($cms eq 'bb6') {
&write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot);
} elsif ($cms eq 'webctvista4') {
- &write_webct4_questions($cms,\@allquestids,$context,$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);
}
}
@@ -3176,9 +3196,14 @@ sub build_category_sequences {
open($fh,">$destdir/sequences/question_database.sequence");
push @{$sequencesfiles},'question_database.sequence';
foreach my $category (sort keys %{$catinfo}) {
- my $seqname = $$catinfo{$category}{title}.'_'.$category;
- $seqname =~ s/\s/_/g;
- $seqname =~ s/\W//g;
+ my $seqname;
+ if ($cms eq 'webct4ce') {
+ $seqname = $$catinfo{$category}{title}.'_'.$category;
+ } else {
+ $seqname = $$catinfo{$category}{title};
+ }
+ $seqname =~ s/\s+/_/g;
+ $seqname =~ s/:/_/g;
push(@{$sequencesfiles},$seqname.'.sequence');
my $catsrc = "$destresdir/sequences/$seqname.sequence";
if ($curr_id == 0) {
@@ -3216,28 +3241,35 @@ sub build_category_sequences {
}
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 $pagedir = "$destdir/pages";
my $curr_id = 0;
my $next_id = 1;
my $fh;
+ my $mapname = $res;
+ if ($cms eq 'webctvista4' && ref($$qzparams{$res}) eq 'HASH') {
+ if ($$qzparams{$res}{title}) {
+ $mapname = $$qzparams{$res}{title};
+ $mapname =~ s/\s+/_/g;
+ }
+ }
if ($container eq 'pool' || $randompickflag || $container eq 'database') {
- $$containerdir = $seqdir.'/'.$res.'.sequence';
+ $$containerdir = $seqdir.'/'.$mapname.'.sequence';
if (!-e "$seqdir") {
mkdir("$seqdir",0770);
}
open($fh,">$$containerdir");
$$total{seq} ++;
- push @{$sequencesfiles},$res.'.sequence';
+ push @{$sequencesfiles},$mapname.'.sequence';
} else {
- $$containerdir = $pagedir.'/'.$res.'.page';
+ $$containerdir = $pagedir.'/'.$mapname.'.page';
if (!-e "$destdir/pages") {
mkdir("$destdir/pages",0770);
}
open($fh,">$$containerdir");
$$total{page} ++;
- push @{$pagesfiles},$res.'.page';
+ push @{$pagesfiles},$mapname.'.page';
}
print $fh qq|<map>
|;
@@ -3250,16 +3282,26 @@ sub build_problem_container {
} else {
$probtitle{$id} = $$settings{title};
}
- $probtitle{$id} =~ s/\s/_/g;
- $probtitle{$id} =~ s/\W//g;
+ $probtitle{$id} =~ s/\s+/_/g;
+ $probtitle{$id} =~ s/:/_/g;
$probtitle{$id} .= '_'.$id;
}
- if ($cms eq 'webctce4' && $container ne 'database') {
+ if (($cms eq 'webct4ce' && $container ne 'database') ||
+ ($cms eq 'webctvista4')) {
+ my $probdir;
my $catid = $$settings{$$allids[0]}{category};
- my $probdir = $$catinfo{$catid}{title}.'_'.$catid;
- $probdir =~ s/\s/_/g;
- $probdir =~ s/\W//g;
- $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";
+ if ($catid) {
+ if ($cms eq 'webct4ce') {
+ $probdir = $$catinfo{$catid}{title}.'_'.$catid;
+ } else {
+ $probdir = $$catinfo{$catid}{title};
+ }
+ $probdir =~ s/\s+/_/g;
+ $probdir =~ s/:/_/g;
+ $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";
+ } else {
+ $probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";
+ }
} else {
$probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";
}
@@ -3278,12 +3320,22 @@ sub build_problem_container {
$curr_id = $j;
$next_id = $curr_id + 1;
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 $probdir = $$catinfo{$catid}{title}.'_'.$catid;
- $probdir =~ s/\s/_/g;
- $probdir =~ s/\W//g;
- $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";
+ if ($catid) {
+ if ($cms eq 'webct4ce') {
+ $probdir = $$catinfo{$catid}{title}.'_'.$catid;
+ } else {
+ $probdir = $$catinfo{$catid}{title};
+ }
+ $probdir =~ s/\s/_/g;
+ $probdir =~ s/:/_/g;
+ $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";
+ } else {
+ $probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
+ }
} else {
$probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
}
@@ -3669,7 +3721,7 @@ sub write_bb5_questions {
$title =~ s/\s/_/g;
$title =~ s/\W//g;
$title .= '_'.$id;
- open(PROB,">:utf8", "$newdir/$title.problem");
+ open(PROB,">$newdir/$title.problem");
print PROB $output;
close PROB;
} else {
@@ -3681,7 +3733,7 @@ sub write_bb5_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;
foreach my $id (@{$alldbquestids}) {
$qnum ++;
@@ -3900,7 +3952,6 @@ $$settings{$id}{$list}{jumbledtext}[$k]
if ($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{texttype} eq 'text/html') {
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
-
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#</?p>##g;
}
@@ -4251,10 +4302,19 @@ $$settings{$id}{$list}{jumbledtext}[$k]
}
}
if ($context eq 'CSTR') {
+ my $probdir;
my $catid = $$settings{$id}{category};
- my $probdir = $$catinfo{$catid}{title}.'_'.$catid;
- $probdir =~ s/\s/_/g;
- $probdir =~ s/\W//g;
+ if ($catid) {
+ if ($cms eq 'webct4ce') {
+ $probdir = $$catinfo{$catid}{title}.'_'.$catid;
+ } else {
+ $probdir = $$catinfo{$catid}{title};
+ }
+ $probdir =~ s/\s/_/g;
+ $probdir =~ s/://g;
+ } elsif (defined($dirtitle)) {
+ $probdir = $dirtitle;
+ }
if (!-e "$destdir/problems/$probdir") {
mkdir("$destdir/problems/$probdir",0755);
}
@@ -4262,9 +4322,9 @@ $$settings{$id}{$list}{jumbledtext}[$k]
|;
my $title = $$settings{$id}{title};
$title =~ s/\s/_/g;
- $title =~ s/\W//g;
- $title .= '_'.$id;
- open(PROB,">:utf8", "$destdir/problems/$probdir/$title.problem");
+ $title =~ s/:/_/g;
+ $title .= '_'.$id;
+ open(PROB,">$destdir/problems/$probdir/$title.problem");
print PROB $output;
close PROB;
} else {
@@ -4662,7 +4722,7 @@ sub write_bb6_questions {
$title =~ s/\s/_/g;
$title =~ s/\W//g;
$title .= '_'.$id;
- open(PROB,">:utf8", "$newdir/$title.problem");
+ open(PROB,">$newdir/$title.problem");
print PROB $output;
close PROB;
} else {