--- loncom/imspackages/imsprocessor.pm 2006/04/04 17:42:28 1.36
+++ loncom/imspackages/imsprocessor.pm 2008/08/23 17:47:44 1.42
@@ -25,6 +25,7 @@ package Apache::imsprocessor;
use Apache::lonnet;
use Apache::loncleanup;
+use Apache::lonlocal;
use LWP::UserAgent;
use HTTP::Request::Common;
use LONCAPA::Configuration;
@@ -75,7 +76,7 @@ sub ims_config {
survey => 'webctsurvey',
doc => 'webcontent'
);
- %{$areaname} = (
+ %{$areaname} = &Apache::lonlocal::texthash (
announce => 'Announcements',
board => 'Discussion Boards',
doc => 'Documents, pages, and folders',
@@ -308,7 +309,6 @@ sub parse_manifest {
if ($cms eq 'bb5' || $cms eq 'bb6' ||
$cms eq 'webctce4' || $cms eq 'webctvista4') {
push @{$$hrefs{$identifier}},$attr->{href};
-
if ($$resources{$identifier}{type} eq
'webct.manifest') {
my $manifestfile = $tempdir.'/'.$attr->{href};
@@ -466,10 +466,14 @@ sub copy_resources {
mkdir("$fulldir",0770);
}
}
+ my $renameres;
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') {
- rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
+ $renameres = rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
+ }
+ if (!$renameres) {
+ &Apache::lonnet::logthis("IMS import error: $cms - renaming failed for file $file");
}
} elsif ($cms eq 'webctce4') {
if ($file =~ m-/my_files/(.+)$-) {
@@ -486,7 +490,10 @@ sub copy_resources {
}
}
if (-e "$tempdir/$file") {
- rename("$tempdir/$file","$destdir/resfiles/$copyfile");
+ my $renameres = rename("$tempdir/$file","$destdir/resfiles/$copyfile");
+ if (!$renameres) {
+ &Apache::lonnet::logthis("IMS import error: WebCT4 - renaming failed for file $file");
+ }
}
} elsif ($file !~ m-/data/(.+)$-) {
&Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
@@ -735,7 +742,11 @@ sub build_structure {
my $curr_id = 1;
my $resnum = $$items{$key}{resnum};
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)) {
unless (($cms eq 'bb5') && $key eq 'Top') {
$seqtext{$key} = "\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};
close(LOCFILE);
- push @{$seqfiles}, "$key.sequence";
}
$count{$key}{page} ++;
$$total{page} += $count{$key}{page};
@@ -972,10 +988,16 @@ sub build_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 ='';
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';
+ if ($cms eq 'webctce4') {
+ $title =~ s|/+|_|g;
+ $title =~ s/\s+/_/g;
+ $title .= '_'.$contitem;
+ $src = $srcstem.'/sequences/'.$title.'.sequence';
+ }
$$flag{$key}{page} = 0;
$$flag{$key}{seq} = 1;
$$count{$key}{seq} ++;
@@ -1038,14 +1060,16 @@ sub make_structure {
if ($file =~ m-/([^/]+)$-) {
$filename = $1;
}
- $src = $srcstem.'/resfiles/'.$res.'/'.$filename;
+ $src = $srcstem.'/resfiles/'.$filename;
} else {
foreach my $file (@{$$hrefs{$res}}) {
my $filename;
- if ($file =~ m-/([^/]+)$-) {
+ if ($file =~ m-/my_files/(.+)$-) {
+ $filename = $1;
+ } elsif ($file =~ m-/([^/]+)$-) {
$filename = $1;
}
- $src = $srcstem.'/resfiles/'.$res.'/'.$filename;
+ $src = $srcstem.'/resfiles/'.$filename;
}
}
$$flag{$key}{page} = 0;
@@ -2178,6 +2202,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 +2214,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 {
@@ -2267,6 +2294,7 @@ sub parse_webctvista4_question {
my $currindex;
my %varinfo = ();
my $formula;
+ my $jumbnum = 0;
my $p = HTML::Parser->new
(
xml_mode => 1,
@@ -2332,6 +2360,8 @@ sub parse_webctvista4_question {
%{$$settings{$id}{$list}} = ();
@{$$allanswers{$id}{$list}} = ();
@{$$settings{$id}{$list}{correctanswer}} = ();
+ @{$$settings{$id}{$list}{jumbledtext}} = ();
+ @{$$settings{$id}{$list}{jumbledtype}} = ();
@{$$settings{$id}{$list}{jumbled}} = ();
$$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};
}
@@ -2350,12 +2380,20 @@ sub parse_webctvista4_question {
$currtexttype = lc($attr->{texttype});
$$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
$currindex = $attr->{index};
}
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);
@@ -2403,7 +2441,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
@@ -2414,6 +2452,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};
}
@@ -2421,7 +2460,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}} = ();
@@ -2436,6 +2475,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};
}
@@ -2535,18 +2575,22 @@ 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;
}
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") {
$$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") {
$$settings{$id}{text} .= $text;
@@ -2559,6 +2603,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;
}
@@ -2582,8 +2637,9 @@ sub parse_webctvista4_question {
}
}
}
+
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 ($setvar{varname} eq "SCORE") { # Multiple Choice, String or Match
@@ -2802,6 +2858,12 @@ sub parse_webct4_questionDB {
$$settings{$id}{texttype} = $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") {
$$settings{$id}{class} = 'multiplechoice';
$list = $attr->{ident};
@@ -3021,12 +3083,18 @@ sub parse_webct4_questionDB {
}
}
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 > 0) {
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);
+ }
+ }
}
}
if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") {
@@ -3112,21 +3180,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);
@@ -3140,14 +3209,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);
}
}
@@ -3163,9 +3232,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 'webctce4') {
+ $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) {
@@ -3203,28 +3277,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|