--- loncom/imspackages/imsprocessor.pm 2005/07/12 16:05:59 1.22
+++ loncom/imspackages/imsprocessor.pm 2006/03/24 17:16:07 1.33
@@ -44,7 +44,17 @@ sub ims_config {
survey => 'assessment/x-bb-survey',
users => 'course/x-bb-user',
);
- %{$$cmsmap{bb6}} = %{$$cmsmap{bb5}};
+ %{$$cmsmap{bb6}} = (
+ announce => 'resource/x-bb-announcement',
+ board => 'resource/x-bb-discussionboard',
+ doc => 'resource/x-bb-document',
+ extlink => 'resource/x-bb-externallink',
+ pool => 'assessment/x-bb-qti-pool',
+ quiz => 'assessment/x-bb-qti-test',
+ staff => 'resource/x-bb-staffinfo',
+ survey => 'assessment/x-bb-survey',
+ users => 'course/x-bb-user',
+ );
$$cmsmap{bb6}{conference} = 'resource/x-bb-conference';
%{$$cmsmap{angel}} = (
board => 'BOARD',
@@ -355,7 +365,7 @@ sub target_resources {
}
sub copy_resources {
- my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$chome,$destdir,$timenow) = @_;
+ my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow) = @_;
if ($context eq 'DOCS') {
foreach my $key (sort keys %{$hrefs}) {
if (grep/^$key$/,@{$targets}) {
@@ -383,7 +393,7 @@ sub copy_resources {
$copyfile = $fpath.$copyfile;
my $fileresult;
if (-e $source) {
- $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$chome,$copyfile,$source);
+ $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$copyfile,$source);
}
}
}
@@ -501,10 +511,10 @@ sub process_resinfo {
}
} elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") {
%{$$resinfo{$key}} = ();
- &process_staff($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
+ &process_staff($key,$docroot,$destdir,\%{$$resinfo{$key}},$resrcfiles);
} elsif ($$resources{$key}{type} eq "resource/x-bb-externallink") {
%{$$resinfo{$key}} = ();
- &process_link($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
+ &process_link($key,$docroot,$destdir,\%{$$resinfo{$key}},$resrcfiles);
} elsif ($$resources{$key}{type} eq "resource/x-bb-discussionboard") {
%{$$resinfo{$key}} = ();
unless ($db_handling eq 'ignore') {
@@ -514,15 +524,15 @@ sub process_resinfo {
$board_id ++;
$board_count ++;
}
- } elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {
+ } elsif ($$resources{$key}{type} =~/assessment\/x\-bb\-(qti\-)?pool/) {
%{$$resinfo{$key}} = ();
&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") {
+ } elsif ($$resources{$key}{type} =~ /assessment\/x\-bb\-(qti\-)?quiz/) {
%{$$resinfo{$key}} = ();
&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") {
+ } elsif ($$resources{$key}{type} =~ /assessment\/x\-bb\-(qti\-)?survey/) {
%{$$resinfo{$key}} = ();
&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;
@@ -1195,12 +1205,12 @@ sub process_group {
# ---------------------------------------------------------------- Process Blackboard Staff
sub process_staff {
- my ($res,$docroot,$dirname,$destdir,$settings,$resrcfiles) = @_;
+ my ($res,$docroot,$destdir,$settings,$resrcfiles) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my $filecount = 0;
my @state;
%{$$settings{name}} = ();
- %{$$settings{office}} = ();
+ %{$$settings{office}} = ();
my $p = HTML::Parser->new
(
@@ -1353,7 +1363,7 @@ sub process_staff {
|;
if ( defined($$settings{image}) ) {
$staffentry .= qq|
-
+
|;
}
$staffentry .= qq|
@@ -1376,7 +1386,7 @@ $staffentry
# ---------------------------------------------------------------- Process Blackboard Links
sub process_link {
- my ($res,$docroot,$dirname,$destdir,$settings,$resrcfiles) = @_;
+ my ($res,$docroot,$destdir,$settings,$resrcfiles) = @_;
my $xmlfile = $docroot.'/'.$res.".dat";
my @state = ();
my $p = HTML::Parser->new
@@ -1827,8 +1837,238 @@ sub parse_bb5_assessment {
}
sub parse_bb6_assessment {
- my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;
- return;
+ my ($res,$docroot,$container,$settings,$allids) = @_;
+ my $xmlfile = $docroot.'/'.$res.".dat";
+ my @state = ();
+ my $id; # the current question ID
+ my $response; # the current response ID
+ my $foil; # the current foil ID
+ my $numchoice; # the current right match choice;
+ my $labelcount; # the current count of choices for a matching item.
+ my $curr_shuffle;
+ my $curr_class; # the current question type
+ my $curr_matchitem;
+ my $curr_block_type; # the current block type
+ my $curr_flow; # the current flow class attribute
+ my $curr_flow_mat; # the current flow_mat class attribute
+ my $curr_feedback_type; # the current feedback type
+ my $numorder; # counter for ordering type questions
+
+ my $itemfrag = "questestinterop assessment section item";
+ my $presfrag = "$itemfrag presentation flow flow";
+ my $blockflow = 'flow';
+ my $responselid;
+ my $instructionfrag = "questestinterop assessment presentation_material flow_mat material";
+ my $feedbackfrag = "$itemfrag itemfeedback";
+ my $feedback_tag = '';
+ my $responselid;
+ 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") {
+ $$settings{description}{texttype} = $attr->{type};
+ }
+ if ("@state" eq $presfrag) {
+ if ($attr->{class} eq 'QUESTION_BLOCK') {
+ $curr_block_type = 'question';
+ } elsif ($attr->{class} eq 'RESPONSE_BLOCK') {
+ $curr_block_type = 'response';
+ if ($curr_class eq 'Matching') {
+ $responselid = 'flow response_lid';
+ } else {
+ $responselid = 'response_lid';
+ }
+ } elsif (($attr->{class} eq 'RIGHT_MATCH_BLOCK')) {
+ $numchoice = 0;
+ $curr_block_type = 'rightmatch';
+ }
+ }
+ if ("@state" eq "$presfrag flow") {
+ if (($curr_block_type =~ /^rightmatch/) && ($attr->{class} eq 'Block')) {
+ $curr_block_type = 'rightmatch'.$numchoice;
+ $numchoice ++;
+ }
+ }
+ if ($state[-1] eq 'flow') {
+ $curr_flow = $attr->{class};
+ }
+ if ($state[-1] eq 'flow_mat') {
+ $curr_flow_mat = $attr->{class};
+ }
+ if ("@state" eq "$presfrag $blockflow material mat_extension mat_formattedtext") {
+ $$settings{$id}{$curr_block_type}{texttype} = $attr->{texttype};
+ }
+ if ("@state" eq "$presfrag $blockflow 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 "$presfrag $blockflow material mattext") {
+ $$settings{$id}{$curr_block_type}{link} = $attr->{uri};
+ }
+ if ("@state" eq "$presfrag $responselid") {
+ $response = $attr->{ident};
+ $labelcount = 0;
+ if ($curr_class eq 'Matching') {
+ push(@{$$settings{$id}{answers}},$response);
+ %{$$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 "$presfrag $responselid render_choice") {
+ $curr_shuffle = $attr->{shuffle};
+ }
+ if ("@state" eq "$presfrag $responselid render_choice flow_label response_label") {
+ $foil = $attr->{ident};
+ %{$$settings{$id}{$foil}} = ();
+ $$settings{$id}{$foil}{randomize} = $curr_shuffle;
+ unless ($curr_class eq 'Essay'){
+ if ($curr_class eq 'Matching') {
+ push(@{$$settings{$id}{$response}{items}},$foil);
+ $$settings{$id}{$foil}{order} = $labelcount;
+ $labelcount ++;
+ } else {
+ push(@{$$settings{$id}{answers}},$foil);
+ @{$$settings{$id}{correctanswer}} = ();
+ }
+ }
+ }
+ if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material matapplication") {
+ $$settings{$id}{$foil}{filetype} = $attr->{embedded};
+ $$settings{$id}{$foil}{label} = $attr->{label};
+ $$settings{$id}{$foil}{uri} = $attr->{uri};
+ }
+ if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mattext") {
+ $$settings{$id}{$foil}{link} = $attr->{uri};
+ }
+ if ("@state" eq "questestinterop assessment section item resprocessing") {
+ if ($curr_class eq 'Matching') {
+ $$settings{$id}{allchoices} = $numchoice;
+ }
+ }
+ if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar varequal") {
+ if ($curr_class eq 'Matching') {
+ $curr_matchitem = $attr->{respident};
+ }
+ }
+ if ("@state" eq $feedbackfrag) {
+ $curr_feedback_type = $attr->{ident};
+ $feedback_tag = "";
+ }
+ if ("@state" eq "$feedbackfrag solution") {
+ $curr_feedback_type = 'solution';
+ $feedback_tag = "solution solutionmaterial";
+ }
+ if ("@state" eq "$feedbackfrag $feedback_tag 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 "$feedbackfrag $feedback_tag 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} = $text;
+ }
+ if ("@state" eq "questestinterop assessment rubric flow_mat material mattext") {
+ $$settings{description}{text} = $text;
+ }
+ if ("@state" eq "$instructionfrag mat_extension mat_formattedtext") {
+ $$settings{instructions}{text} = $text;
+ }
+ if ("@state" eq "$instructionfrag mattext") {
+ $$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}{answers}} = ();
+ %{$$settings{$id}{question}} = ();
+ %{$$settings{$id}{correctfeedback}} = ();
+ %{$$settings{$id}{incorrectfeedback}} = ();
+ %{$$settings{$id}{solutionfeedback}} = ();
+ }
+ if ("@state" eq "questestinterop assessment section item itemmetadata bbmd_questiontype") {
+ $$settings{$id}{class} = $text;
+ $curr_class = $text;
+ if ($curr_class eq 'Matching') {
+ $blockflow = 'flow flow';
+ } else {
+ $blockflow = 'flow';
+ }
+ }
+ if ("@state" eq "$presfrag $blockflow material mat_extension mat_formattedtext") {
+ $$settings{$id}{$curr_block_type}{text} = $text;
+ }
+ if ("@state" eq "$presfrag $blockflow material mattext") {
+ if ($curr_flow eq 'LINK_BLOCK') {
+ $$settings{$id}{$curr_block_type}{linkname} = $text;
+ } elsif ($curr_flow eq 'FORMATTED_TEXT_BLOCK') {
+ $$settings{$id}{$curr_block_type}{text} = $text;
+ }
+ }
+ if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mat_extension mat_formattedtext") {
+ $$settings{$id}{$foil}{text} = $text;
+ }
+ if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mattext") {
+ if ($curr_flow_mat eq 'LINK_BLOCK') {
+ $$settings{$id}{$foil}{linkname} = $text;
+ } else {
+ $$settings{$id}{$foil}{text} = $text;
+ }
+ }
+ if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar varequal") {
+ if ($curr_class eq 'Matching') {
+ $$settings{$id}{$curr_matchitem}{correctanswer} = $text;
+ } else {
+ push(@{$$settings{$id}{correctanswer}},$text);
+ }
+ }
+ if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar") {
+ $numorder = 0;
+ }
+ if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar and varequal") {
+ push(@{$$settings{$id}{correctanswer}},$text);
+ if ($curr_class eq 'Ordering') {
+ $numorder ++;
+ $$settings{$id}{$text}{order} = $numorder;
+ }
+ }
+ if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material mat_extension mat_formattedtext") {
+ $$settings{$id}{$curr_feedback_type.'feedback'}{text} = $text;
+ }
+ if ("@state" eq "$feedbackfrag $feedback_tag 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 {
@@ -2095,7 +2335,7 @@ sub parse_webct4_questionDB {
$$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") {
- my $unitid = $attr->{ident};
+ $unitid = $attr->{ident};
%{$$settings{$id}{$numid}{$unitid}} = ();
push(@{$$settings{$id}{$numid}{units}},$unitid);
$$settings{$id}{$numid}{$unitid}{value} = $attr->{value};
@@ -2299,7 +2539,7 @@ sub process_assessment {
if ($cms eq 'bb5') {
&parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
} elsif ($cms eq 'bb6') {
- &parse_bb6_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
+ &parse_bb6_assessment($res,$docroot,$container,$settings,\@allids);
} elsif ($cms eq 'webct4') {
unless($$dbparse) {
&parse_webct4_questionDB($docroot,$$resources{$res}{file},$catinfo,$qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
@@ -2384,7 +2624,7 @@ sub process_assessment {
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,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
+ &write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot);
}
}
@@ -2478,13 +2718,19 @@ sub build_problem_container {
sub write_bb5_questions {
my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
my $qnum = 0;
+ my $pathstart;
+ if ($context eq 'CSTR') {
+ $pathstart = '../..';
+ } else {
+ $pathstart = $dirname;
+ }
foreach my $id (@{$allids}) {
if ($$settings{$id}{ishtml} eq 'true') {
$$settings{$id}{text} = &HTML::Entities::decode($$settings{$id}{text});
}
if ($$settings{$id}{text} =~ m#]*>#) {
if (&retrieve_image($context,$res,$dirname,$cdom,$cnum,$docroot,$destdir,$1,$2) eq 'ok') {
- $$settings{$id}{text} =~ s#(]*>)#$1../../resfiles/$res/webimages/$3$4#g;
+ $$settings{$id}{text} =~ s#(]*>)#$1$pathstart/resfiles/$res/webimages/$3$4#g;
}
}
$$settings{$id}{text} =~ s#(]+)/*>#$1 />#gi;
@@ -2532,9 +2778,9 @@ sub write_bb5_questions {
my ($image,$imglink,$url);
if ( defined($$settings{$id}{image}) ) {
if ( $$settings{$id}{style} eq 'embed' ) {
- $image = qq|
|;
+ $image = qq|
|;
} else {
- $imglink = qq|
Link to file
|;
+ $imglink = qq|
Link to file
|;
}
}
if ( defined($$settings{$id}{url}) ) {
@@ -2579,9 +2825,9 @@ sub write_bb5_questions {
my ($ans_image,$ans_link);
if ( defined($$settings{$id}{$$allanswers{$id}[$k]}{image}) ) {
if ( $$settings{$id}{$$allanswers{$id}[$k]}{style} eq 'embed' ) {
- $ans_image .= qq|
|;
+ $ans_image .= qq|
|;
} else {
- $ans_link .= qq|
Link to file
|;
+ $ans_link .= qq|
Link to file
|;
}
}
$output .= $ans_image.$ans_link.'
#
#g; -# $$settings{$id}{text} =~ s#
##; -# $$settings{$id}{text} =~ s###g; $$settings{$id}{text} =~ s##
#g;
$$settings{$id}{text} =~ s#