--- loncom/imspackages/imsimport.pm 2004/02/24 15:21:16 1.3 +++ loncom/imspackages/imsimport.pm 2004/02/29 00:55:39 1.4 @@ -1,29 +1,28 @@ package Apache::imsimport; - use strict; - use Apache::Constants qw(:common :http :methods); - use Apache::loncacc; - use Apache::loncommon(); - use Apache::Log(); - use Apache::lonnet; - use HTML::Parser; - use HTML::Entities(); - use Apache::lonlocal; - use Apache::lonupload; - use File::Basename(); +use strict; +use Apache::Constants qw(:common :http :methods); +use Apache::loncacc; +use Apache::loncommon(); +use Apache::Log(); +use Apache::lonnet; +use HTML::Parser; +use HTML::Entities(); +use Apache::lonlocal; +use Apache::lonupload; +use File::Basename(); # ---------------------------------------------------------------- Display Control -sub display_control { -# figure out what page we're on and where we're heading. +sub display_control { # figure out what page we're on and where we're heading. my $page = $ENV{'form.page'}; my $command = $ENV{'form.go'}; my $current_page = &calculate_page($page,$command); return $current_page; } - -# CALCULATE THE CURRENT PAGE + +# ---------------------------------------------------------------- Calculate Page sub calculate_page($$) { my ($prev,$dir) = @_; - return 0 if $prev eq ''; # start with first page + return 0 if $prev eq ''; return $prev + 1 if $dir eq 'NextPage'; return $prev - 1 if $dir eq 'PreviousPage'; return $prev if $dir eq 'ExitPage'; @@ -305,12 +304,13 @@ Please choose a destination LON-CAPA dir END_OF_ONE } -# ---------------------------------------------------------------- Expand bb5 +# ---------------------------------------------------------------- Expand Blackboard 5 imsmanifest sub expand_bb5 { - my ($r,$uname,$udom,$fn,$page,$bb_crs,$bb_cdom,$bb_handling,$users_crs,$users_cdom,$users_handling) = @_; + my ($r,$uname,$udom,$fn,$page,$bb_crs,$bb_cdom,$bb_handling,$users_crs,$users_cdom,$users_handling,$announce_handling) = @_; my @state = (); my @seq = "Top"; my $lastitem; + my %revitm = (); my %resnum = (); my %title = (); my %filepath = (); @@ -328,10 +328,15 @@ sub expand_bb5 { my @timestamp = (); my @boards = (); my @groups = (); + my @announcements = (); + my @quizzes = (); + my @surveys = (); my $board_count = 0; my $board_id = time; my $totseq = 0; my $totpage = 0; + my $totquiz = 0; + my $totsurv = 0; my $totprob = 0; my $docroot = $ENV{'form.newdir'}; if (!-e "$docroot/temp") { @@ -349,8 +354,13 @@ sub expand_bb5 { print "$_
"; } close(OUTPUT); - } + } else { + return 'nozip'; + } + unless (-e "$docroot/temp/imsmanifest.xml") { + return 'nomanifest'; + } my $xmlfile = $docroot.'/temp/imsmanifest.xml'; my $p = HTML::Parser->new ( @@ -374,7 +384,9 @@ sub expand_bb5 { if (("@state" eq $searchstr) && (@state > 3)) { my $itm = $attr->{identifier}; $resnum{$itm} = $attr->{identifierref}; + $revitm{$resnum{$itm}} = $itm; $title{$itm} = $attr->{title}; + $contentscount{$itm} = 0; if ($start > @seq) { unless ($lastitem eq '') { push @seq, $lastitem; @@ -430,8 +442,8 @@ sub expand_bb5 { $p->parse_file($xmlfile); $p->eof; - my $topnum = 0; my $destdir = $docroot; + my $seqstem ="/res/$udom/$uname/$newdir/sequences"; if (!-e "$destdir") { mkdir("$destdir",0755); } @@ -476,28 +488,26 @@ sub expand_bb5 { } elsif ($type{$key} eq "resource/x-bb-discussionboard") { %{$resinfo{$key}} = (); unless ($bb_handling eq 'ignore') { - $contentscount{Top} ++; push @boards, $key; $timestamp[$board_count] = $board_id; &process_db($key,$docroot,$destdir,$board_id,$bb_crs,$bb_cdom,$bb_handling,$uname,\%{$resinfo{$key}}); $board_id ++; $board_count ++; } - } elsif ($type{$key} eq "resource/x-bb-announcement") { - %{$resinfo{$key}} = (); - &process_announce($key,$docroot,$destdir,\%{$resinfo{$key}}); } elsif ($type{$key} eq "assessment/x-bb-pool") { %{$resinfo{$key}} = (); - &process_assessment($key,$docroot,'pool',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob); + &process_assessment($key,$docroot,'pool',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob,$udom,$uname); } elsif ($type{$key} eq "assessment/x-bb-quiz") { %{$resinfo{$key}} = (); - &process_assessment($key,$docroot,'quiz',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob); + &process_assessment($key,$docroot,'quiz',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob,$udom,$uname); + push @quizzes, $key; + } elsif ($type{$key} eq "assessment/x-bb-survey") { %{$resinfo{$key}} = (); - &process_assessment($key,$docroot,'survey',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob); + &process_assessment($key,$docroot,'survey',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob,$udom,$uname); + push @surveys, $key; } elsif ($type{$key} eq "assessment/x-bb-group") { %{$resinfo{$key}} = (); - $contentscount{Top} ++; push @groups, $key; &process_group($key,$docroot,$destdir,\%{$resinfo{$key}}); } elsif ($type{$key} eq "resource/x-bb-user") { @@ -505,9 +515,30 @@ sub expand_bb5 { unless ($users_handling eq 'ignore') { &process_user($key,$docroot,$destdir,\%{$resinfo{$key}},$users_crs,$users_cdom,$users_handling); } + } elsif ($type{$key} eq "resource/x-bb-announcement") { + unless ($announce_handling eq 'ignore') { + push @announcements, $key; + %{$resinfo{$key}} = (); + &process_announce($key,$docroot,$destdir,\%{$resinfo{$key}},\%resinfo,$seqstem,\%revitm); + } } } + if (@announcements) { + $contentscount{Top} ++; + } + if (@boards) { + $contentscount{Top} ++; + } + if (@quizzes) { + $contentscount{Top} ++; + $totquiz = @quizzes; + } + if (@surveys) { + $contentscount{Top} ++; + $totsurv = @surveys; + } + my $topnum = 0; my $nextnum = 0; open(TOPFILE,">$destdir/sequences/ims_import.sequence"); print TOPFILE "\n"; @@ -522,6 +553,10 @@ sub expand_bb5 { my %seqflag = (); my %seqcount = (); + if (@announcements) { + &process_specials('announcements',\@announcements,\$topnum,\%contentscount,$destdir,$udom,$uname,$newdir,\@timestamp,\%resinfo); + } + foreach my $key (sort keys %resnum) { $pageflag{$key} = 0; $seqflag{$key} = 0; @@ -726,46 +761,29 @@ sub expand_bb5 { } } } - if (@boards > 0) { - $topnum ++; - print TOPFILE qq| -\n|; - if ($topnum == $contentscount{'Top'}) { - print TOPFILE qq|\n|; - } - } else { - if ($topnum == $contentscount{'Top'}) { - print TOPFILE qq| type="finish">\n|; - } else { - print TOPFILE qq|> -\n|; - } - } - open(BOARD,">$destdir/sequences/bulletinboards.sequence"); - print BOARD qq| - -|; - if (@boards == 1) { - print BOARD qq| -\n|; + + if ($fileopen) { + if ($areacount == 0) { + print AREAFILE qq| + +\n|; + } elsif ($areacount == 1) { + print AREAFILE qq|\n|; } else { - for (my $i=1; $i<@boards; $i++) { - print BOARD qq|\n|; - } else { - print BOARD qq|> -\n|; - } - } + print AREAFILE qq|$lastentry\n|; } - print BOARD qq||; - close(BOARD); + print AREAFILE "\n"; + close(AREAFILE); + $fileopen = 0; + } + if (@boards > 0) { + &process_specials('boards',\@boards,\$topnum,\%contentscount,$destdir,$udom,$uname,$newdir,\@timestamp,\%resinfo); + } + if (@quizzes) { + &process_specials('quizzes',\@quizzes,\$topnum,\%contentscount,$destdir,$udom,$uname,$newdir,\@timestamp,\%resinfo); + } + if (@surveys) { + &process_specials('surveys',\@surveys,\$topnum,\%contentscount,$destdir,$udom,$uname,$newdir,\@timestamp,\%resinfo); } print TOPFILE ""; close(TOPFILE); @@ -797,11 +815,96 @@ sub expand_bb5 { close(PAGEFILE); } } - system(" rm -r $docroot/temp"); - return($totseq,$totpage,$totprob); + system(" rm -r $docroot/temp"); # Need to add sanity checking + return('ok',$totseq,$totpage,$board_count,$totquiz,$totsurv,$totprob); } +# ---------------------------------------------------------------- Process Blackboard specials - announcements, bulletin boards, quizzes and surveys +sub process_specials { + my ($type,$items,$topnum,$contentscount,$destdir,$udom,$uname,$newdir,$timestamp,$resinfo) = @_; + my $src = ''; + my $itemsrc = ''; + my $nextnum = 0; + my $seqstem = '/res/'.$udom.'/'.$uname.'/'.$newdir; + my %seqnames = ( + boards => 'bulletinboards', + quizzes => 'quizzes', + surveys => 'surveys', + announcements => 'announcements', + ); + my %seqtitles = ( + boards => 'Course Bulletin Boards', + quizzes => 'Course Quizzes', + surveys => 'Course Surveys', + announcements => 'Course Announcements', + ); + $$topnum ++; + if ($type eq 'announcements') { + $src = "$seqstem/pages/$seqnames{$type}.page"; + } else { + $src = "$seqstem/sequences/$seqnames{$type}.sequence"; + } + print TOPFILE qq| +\n|; + if ($$topnum == $$contentscount{'Top'}) { + print TOPFILE qq|\n|; + } + } else { + if ($$topnum == $$contentscount{'Top'}) { + print TOPFILE qq| type="finish">\n|; + } else { + print TOPFILE qq|> +\n|; + } + } + + if ($type eq "announcements") { + open(ITEM,">$destdir/pages/$seqnames{$type}.page"); + } else { + open(ITEM,">$destdir/sequences/$seqnames{$type}.sequence"); + } + + if ($type eq 'boards') { + $itemsrc = "/adm/$udom/$uname/$$timestamp[0]/bulletinboard"; + } elsif ($type eq 'announcements') { + $itemsrc = "/res/$udom/$uname/$newdir/resfiles/$$items[0].html"; + } else { + $itemsrc = "/res/$udom/$uname/$newdir/pages/$$items[0].page"; + } + print ITEM qq| + +|; + if (@{$items} == 1) { + print ITEM qq| +\n|; + } else { + for (my $i=1; $i<@{$items}; $i++) { + my $curr = $i+1; + my $next = $i+2; + if ($type eq 'boards') { + $itemsrc = "/adm/$udom/$uname/$$timestamp[$i]/bulletinboard"; + } elsif ($type eq 'announcements') { + $itemsrc = "/res/$udom/$uname/$newdir/resfiles/$$items[$i].html"; + } else { + $itemsrc = "/res/$udom/$uname/$newdir/pages/$$items[$i].page"; + } + print ITEM qq|\n|; + } else { + print ITEM qq|> +\n|; + } + } + } + print ITEM qq||; + close(ITEM); +} +# ---------------------------------------------------------------- Process Blackboard users sub process_user { my ($res,$docroot,$destdir,$settings,$user_crs,$user_cdom,$user_handling) = @_; my $xmlfile = $docroot."/temp/".$res.".dat"; @@ -883,6 +986,7 @@ sub process_user { } } +# ---------------------------------------------------------------- Process Blackboard groups sub process_group { my ($res,$docroot,$destdir,$settings) = @_; my $xmlfile = $docroot."/".$res.".dat"; @@ -933,6 +1037,7 @@ sub process_group { $p->eof; } +# ---------------------------------------------------------------- Process Blackboard Staff sub process_staff { my ($res,$docroot,$dirname,$destdir,$settings) = @_; my $xmlfile = $docroot."/temp/".$res.".dat"; @@ -1112,6 +1217,7 @@ $staffentry close(FILE); } +# ---------------------------------------------------------------- Process Blackboard Links sub process_link { my ($res,$docroot,$dirname,$destdir,$settings) = @_; my $xmlfile = $docroot."/temp/".$res.".dat"; @@ -1129,22 +1235,22 @@ sub process_link { $$settings{textcolor} = $attr->{value}; } elsif (@state eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") { $$settings{ishtml} = $attr->{value}; - } elsif ("@state" eq "EXTERNALLINKS FLAGS ISAVAILABLE" ) { + } elsif ("@state" eq "EXTERNALLINK FLAGS ISAVAILABLE" ) { $$settings{isavailable} = $attr->{value}; - } elsif ("@state" eq "EXTERNALLINKS FLAGS LAUNCHINNEWWINDOW" ) { + } elsif ("@state" eq "EXTERNALLINK FLAGS LAUNCHINNEWWINDOW" ) { $$settings{newwindow} = $attr->{value}; - } elsif ("@state" eq "EXTERNALLINKS FLAGS ISFOLDER" ) { + } elsif ("@state" eq "EXTERNALLINK FLAGS ISFOLDER" ) { $$settings{isfolder} = $attr->{value}; - } elsif ("@state" eq "EXTERNALLINKS POSITION" ) { + } elsif ("@state" eq "EXTERNALLINK POSITION" ) { $$settings{position} = $attr->{value}; - } elsif ("@state" eq "EXTERNALLINKS URL" ) { + } elsif ("@state" eq "EXTERNALLINK URL" ) { $$settings{url} = $attr->{value}; } }, "tagname, attr"], text_h => [sub { my ($text) = @_; - if ("@state" eq "EXTERNALLINKS DESCRIPTION TEXT") { + if ("@state" eq "EXTERNALLINK DESCRIPTION TEXT") { $$settings{text} = $text; } }, "dtext"], @@ -1196,6 +1302,7 @@ $$settings{text} close(FILE); } +# ---------------------------------------------------------------- Process Blackboard Discussion Boards sub process_db { my ($res,$docroot,$destdir,$timestamp,$crs,$cdom,$handling,$uname,$settings) = @_; my $xmlfile = $docroot."/temp/".$res.".dat"; @@ -1206,7 +1313,7 @@ sub process_db { if ($crs =~ m/^(\d)(\d)(\d)/) { $longcrs = $1.'/'.$2.'/'.$3.'/'.$crs; } - my %threads; # all quotes, keyed by message ID + my %threads; # all threads, keyed by message ID my $msg_id; # the current message ID my %message; # the current message being accumulated for $msg_id @@ -1381,14 +1488,15 @@ sub process_db { } } +# ---------------------------------------------------------------- Add Posting to Bulletin Board sub addposting { my ($symb,$contrib,$cdom,$crs)=@_; my $status=''; if (($symb) && ($$contrib{message})) { - my $crsdom = $cdom.'_'.$crs; - &Apache::lonnet::store($contrib,$symb,$crsdom,$cdom,$crs); - my %storenewentry=($symb => time); - &Apache::lonnet::put('discussiontimes',\%storenewentry,$cdom,$crs); + my $crsdom = $cdom.'_'.$crs; + &Apache::lonnet::store($contrib,$symb,$crsdom,$cdom,$crs); + my %storenewentry=($symb => time); + &Apache::lonnet::put('discussiontimes',\%storenewentry,$cdom,$crs); } my %record=&Apache::lonnet::restore('_discussion'); my ($temp)=keys %record; @@ -1403,24 +1511,27 @@ sub addposting { } return $status; } - +# ---------------------------------------------------------------- Process Blackboard Assessments - pools, quizzes, surveys sub process_assessment { - my ($res,$docroot,$container,$dirname,$destdir,$settings,$totpageref,$totprobref) = @_; - my $xmlfile = $docroot."/temp/".$res.".dat"; + my ($res,$docroot,$container,$dirname,$destdir,$settings,$totpageref,$totprobref,,$udom,$uname) = @_; + my $xmlfile = $docroot."/temp/".$res.".dat"; # print "XML file is $xmlfile\n"; - my @state = (); - my @allids = (); - my %allanswers = (); - my %allchoices = (); - my $id; # the current question ID - my $answer_id; # the current answer ID - my %toptag = ( pool => 'POOL', + my @state = (); + my @allids = (); + my %allanswers = (); + my %allchoices = (); + my $resdir = ''; + if ($docroot =~ m|public_html/(.+)$|) { + $resdir = $1; + } + my $id; # the current question ID + my $answer_id; # the current answer ID + my %toptag = ( pool => 'POOL', quiz => 'ASSESSMENT', survey => 'ASSESSMENT' ); -# print "process_assessment is called, incoming: $res,$docroot,$container,$destdir\n"; - my $p = HTML::Parser->new + my $p = HTML::Parser->new ( xml_mode => 1, start_h => @@ -1431,11 +1542,9 @@ sub process_assessment { my @seq = (); my $class; my $state_str = join(" ",@state); -# print "Current state is $state_str\n"; if ($container eq "pool") { if ("@state" eq "POOL TITLE") { $$settings{title} = $attr->{value}; -# print "Title is $attr->{value}\n"; } } else { if ("@state" eq "ASSESSMENT TITLE") { @@ -1472,10 +1581,12 @@ sub process_assessment { @{$$settings{$id}{correctanswer}} = (); } elsif ( ($state[0] eq $toptag{$container}) && ($state[-1] =~ m/^QUESTION_(\w+)$/) ) { $id = $attr->{id}; - } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") && ($state[4] eq "ISHTML") ) { - $$settings{$id}{html} = $attr->{value}; - } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") && ($state[4] eq "ISNEWLINELITERAL") ) { - $$settings{$id}{newline} = $attr->{value}; + } 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}; + } elsif ($state[4] eq "ISNEWLINELITERAL") { + $$settings{$id}{newline} = $attr->{value}; + } } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "IMAGE") ) { $$settings{$id}{image} = $attr->{value}; $$settings{$id}{style} = $attr->{style}; @@ -1498,20 +1609,23 @@ sub process_assessment { $$settings{$id}{$answer_id}{position} = $attr->{position}; $$settings{$id}{$answer_id}{placement} = $attr->{placement}; $$settings{$id}{$answer_id}{type} = 'choice'; - } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "IMAGE") ) { - $$settings{$id}{$answer_id}{image} = $attr->{value}; - $$settings{$id}{$answer_id}{style} = $attr->{style}; - } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "URL") ) { - $$settings{$id}{$answer_id}{url} = $attr->{value}; - } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "IMAGE") ) { - $$settings{$id}{$answer_id}{image} = $attr->{value}; - $$settings{$id}{$answer_id}{style} = $attr->{style}; - } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "URL") ) { - $$settings{$id}{$answer_id}{url} = $attr->{value}; + } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") ) { + if ($state[3] eq "IMAGE") { + $$settings{$id}{$answer_id}{image} = $attr->{value}; + $$settings{$id}{$answer_id}{style} = $attr->{style}; + } elsif ($state[3] eq "URL") { + $$settings{$id}{$answer_id}{url} = $attr->{value}; + } + } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") ) { + if ($state[3] eq "IMAGE") { + $$settings{$id}{$answer_id}{image} = $attr->{value}; + $$settings{$id}{$answer_id}{style} = $attr->{style}; + } elsif ($state[3] eq "URL") { + $$settings{$id}{$answer_id}{url} = $attr->{value}; + } } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "CORRECTANSWER") ) { my $corr_answer = $attr->{answer_id}; push @{$$settings{$id}{correctanswer}}, $corr_answer; -# print "Answer $corr_answer for question $id is correct\n"; my $type = $1; if ($type eq 'TRUEFALSE') { $$settings{$id}{$corr_answer}{answer_position} = $attr->{position}; @@ -1550,308 +1664,265 @@ sub process_assessment { pop @state; }, "tagname"], ); - $p->unbroken_text(1); - $p->parse_file($xmlfile); - $p->eof; + $p->unbroken_text(1); + $p->parse_file($xmlfile); + $p->eof; - my $dirtitle = $$settings{'title'}; - $dirtitle =~ s/\W//g; - $dirtitle .= '_'.$res; - if (!-e "$destdir/problems/$dirtitle") { - mkdir("$destdir/problems/$dirtitle",0755); - } - my $newdir = "$destdir/problems/$dirtitle"; - my $pagedir = "$destdir/pages"; - my $curr_id = 0; - my $next_id = 0; - unless ($container eq 'pool') { - open(PAGEFILE,">$pagedir/$res.page"); - print PAGEFILE qq| + my $dirtitle = $$settings{'title'}; + $dirtitle =~ s/\W//g; + $dirtitle .= '_'.$res; + if (!-e "$destdir/problems/$dirtitle") { + mkdir("$destdir/problems/$dirtitle",0755); + } + my $newdir = "$destdir/problems/$dirtitle"; + my $pagedir = "$destdir/pages"; + my $curr_id = 0; + my $next_id = 1; + unless ($container eq 'pool') { + open(PAGEFILE,">$pagedir/$res.page"); + print PAGEFILE qq| |; - $$totpageref ++; - } - foreach my $id (@allids) { - $curr_id ++; - $next_id = $curr_id + 1; - if ($curr_id == 0) { - print PAGEFILE qq|\n|; - } else { - print PAGEFILE qq| - -\n|; - } else { - print PAGEFILE qq|>|; - } - } -# print "Current ID is $id, type is $$settings{$id}{class} \n"; - if (@allids == 1) { - print PAGEFILE qq| + $$totpageref ++; + print PAGEFILE qq||; + if (@allids == 1) { + print PAGEFILE qq| + \n|; - } - - my $output = qq| -|; - $$totprobref ++; - if ($$settings{$id}{class} eq "QUESTION_ESSAY") { - $output .= qq|$$settings{$id}{text} - - - - - $$settings{$id}{feedbackcorr} - -|; - } else { - $output .= qq|$$settings{$id}{text}\n|; - if ( defined($$settings{$id}{image}) ) { - if ( $$settings{$id}{style} eq 'embed' ) { - $output .= qq|

|; } else { - $output .= qq|
Link to file
|; + for (my $j=1; $j<@allids; $j++) { + $curr_id = $j; + $next_id = $curr_id + 1; + print PAGEFILE qq| + +\n|; + } else { + print PAGEFILE qq|>|; + } + } } + print PAGEFILE qq||; + close(PAGEFILE); } - if ( defined($$settings{$id}{url}) ) { - $output .= qq|
$$settings{$id}{name}
|; - } - $output .= qq| -|; - if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') { - my $numfoils = @{$allanswers{$id}}; - $output .= qq| - - - |; - for (my $k=0; $k<@{$allanswers{$id}}; $k++) { - $output .= "
|; + foreach my $id (@allids) { + my $output = qq| +|; + $$totprobref ++; + if ($$settings{$id}{class} eq "QUESTION_ESSAY") { + $output .= qq|$$settings{$id}{text} + + + + + $$settings{$id}{feedbackcorr} + +|; + } else { + $output .= qq|$$settings{$id}{text}\n|; + if ( defined($$settings{$id}{image}) ) { + if ( $$settings{$id}{style} eq 'embed' ) { + $output .= qq|

|; } else { - $output .= qq|
Link to file
|; + $output .= qq|
Link to file
|; } } - $output .= qq|\n|; - } - chomp($output); - $output .= qq| - - - |; - } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') { - my $numfoils = @{$allanswers{$id}}; -# print "Number of foils is $numfoils\n"; - $output .= qq| + if ( defined($$settings{$id}{url}) ) { + $output .= qq|
$$settings{$id}{name}
|; + } + $output .= qq| +|; + if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') { + my $numfoils = @{$allanswers{$id}}; + $output .= qq| + + +|; + for (my $k=0; $k<@{$allanswers{$id}}; $k++) { + $output .= "
|; + } else { + $output .= qq|
Link to file
|; + } + } + $output .= qq|\n|; + } + chomp($output); + $output .= qq| + + +|; + } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') { + my $numfoils = @{$allanswers{$id}}; + $output .= qq| - |; - for (my $k=0; $k<@{$allanswers{$id}}; $k++) { - $output .= " \n"; - } - chomp($output); - $output .= qq| +|; + for (my $k=0; $k<@{$allanswers{$id}}; $k++) { + $output .= " \n"; + } + chomp($output); + $output .= qq| - |; - } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') { - my $numfoils = @{$allanswers{$id}}; -# print "Number of foils is $numfoils\n"; - $output .= qq| +|; + } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') { + my $numfoils = @{$allanswers{$id}}; + $output .= qq| - |; - for (my $k=0; $k<@{$allanswers{$id}}; $k++) { - $output .= " \n"; - } - chomp($output); - $output .= qq| +|; + for (my $k=0; $k<@{$allanswers{$id}}; $k++) { + $output .= " \n"; + } + chomp($output); + $output .= qq| - |; - } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') { - my $numfoils = @{$allanswers{$id}}; - $output .= qq| +|; + } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') { + my $numfoils = @{$allanswers{$id}}; + $output .= qq| - |; - for (my $k=0; $k<@{$allanswers{$id}}; $k++) { - $output .= " ".$$settings{$id}{$allanswers{$id}[$k]}{text}."\n"; - } - chomp($output); - $output .= qq| +|; + for (my $k=0; $k<@{$allanswers{$id}}; $k++) { + $output .= " ".$$settings{$id}{$allanswers{$id}[$k]}{text}."\n"; + } + chomp($output); + $output .= qq| - |; - } elsif ($$settings{$id}{class} eq 'QUESTION_FILLINBLANK') { - my $numerical = 1; - for (my $k=0; $k<@{$allanswers{$id}}; $k++) { - if ($$settings{$id}{$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) { - $numerical = 0; - } - } - if ($numerical) { - my $numans; - my $tol; - if (@{$allanswers{$id}} == 1) { - $tol = 5; - $numans = $$settings{$id}{$allanswers{$id}[0]}{text}; - } else { - my $min = $$settings{$id}{$allanswers{$id}[0]}{text}; - my $max = $$settings{$id}{$allanswers{$id}[0]}{text}; - for (my $k=1; $k<@{$allanswers{$id}}; $k++) { - if ($$settings{$id}{$allanswers{$id}[$k]}{text} <= $min) { - $min = $$settings{$id}{$allanswers{$id}[$k]}{text}; - } - if ($$settings{$id}{$allanswers{$id}[$k]}{text} >= $max) { - $max = $$settings{$id}{$allanswers{$id}[$k]}{text}; +|; + } elsif ($$settings{$id}{class} eq 'QUESTION_FILLINBLANK') { + my $numerical = 1; + for (my $k=0; $k<@{$allanswers{$id}}; $k++) { + if ($$settings{$id}{$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) { + $numerical = 0; } } - $numans = ($max + $min)/2; - $tol = 100*($max - $min)/($numans*2); - } - $output .= qq| + if ($numerical) { + my $numans; + my $tol; + if (@{$allanswers{$id}} == 1) { + $tol = 5; + $numans = $$settings{$id}{$allanswers{$id}[0]}{text}; + } else { + my $min = $$settings{$id}{$allanswers{$id}[0]}{text}; + my $max = $$settings{$id}{$allanswers{$id}[0]}{text}; + for (my $k=1; $k<@{$allanswers{$id}}; $k++) { + if ($$settings{$id}{$allanswers{$id}[$k]}{text} <= $min) { + $min = $$settings{$id}{$allanswers{$id}[$k]}{text}; + } + if ($$settings{$id}{$allanswers{$id}[$k]}{text} >= $max) { + $max = $$settings{$id}{$allanswers{$id}[$k]}{text}; + } + } + $numans = ($max + $min)/2; + $tol = 100*($max - $min)/($numans*2); + } + $output .= qq| - |; - } else { - if (@{$allanswers{$id}} == 1) { - $output .= qq| +|; + } else { + if (@{$allanswers{$id}} == 1) { + $output .= qq| - |; - } else { - my @answertext = (); - for (my $k=0; $k<@{$allanswers{$id}}; $k++) { - $$settings{$id}{$allanswers{$id}[$k]}{text} =~ s/\|/\|/g; - push @answertext, $$settings{$id}{$allanswers{$id}[$k]}{text}; - } - my $regexpans = join('|',@answertext); - $regexpans = '/^('.$regexpans.')\b/'; - $output .= qq| +|; + } else { + my @answertext = (); + for (my $k=0; $k<@{$allanswers{$id}}; $k++) { + $$settings{$id}{$allanswers{$id}[$k]}{text} =~ s/\|/\|/g; + push @answertext, $$settings{$id}{$allanswers{$id}[$k]}{text}; + } + my $regexpans = join('|',@answertext); + $regexpans = '/^('.$regexpans.')\b/'; + $output .= qq| - |; - } - } - } elsif ($$settings{$id}{class} eq "QUESTION_MATCH") { - $output .= qq| +|; + } + } + } elsif ($$settings{$id}{class} eq "QUESTION_MATCH") { + $output .= qq| |; - for (my $k=0; $k<@{$allchoices{$id}}; $k++) { - $output .= qq| + for (my $k=0; $k<@{$allchoices{$id}}; $k++) { + $output .= qq| $$settings{$id}{$allchoices{$id}[$k]}{text} - |; - } - $output .= qq| + |; + } + $output .= qq| |; - for (my $k=0; $k<@{$allanswers{$id}}; $k++) { - $output .= qq| - -$$settings{$id}{$allanswers{$id}[$k]}{text} - - |; - } - $output .= qq| + for (my $k=0; $k<@{$allanswers{$id}}; $k++) { + $output .= qq| + + $$settings{$id}{$allanswers{$id}[$k]}{text} + +|; + } + $output .= qq| - |; - } - } - $output .= qq| -|; - open(PROB,">$newdir/$id.problem"); - print PROB $output; - close PROB; - } - unless ($container eq 'pool') { - print PAGEFILE qq||; - close(PAGEFILE); - } -} - - -sub create_ess { - my ($newdir,$qnid,$qsettings,$container) = @_; - my $output; - if ($container eq 'pool') { - $output = qq| - $$qsettings{text} |; - } else { - $output = qq| - $$qsettings{text} -|; - } - $output .= qq| - - - - - $$qsettings{feedbackcorr} - -|; - if ($container eq 'pool') { - $output .= qq| - |; - open(PROB,">$newdir/$qnid.problem"); - print PROB $output; - close PROB; - } else { + } + } $output .= qq| - |; - open(PROB,">$newdir/$qnid.problem"); +|; + open(PROB,">$newdir/$id.problem"); print PROB $output; close PROB; } - return; } +# ---------------------------------------------------------------- Process Blackboard Announcements sub process_announce { - my ($res,$docroot,$destdir,$settings) = @_; - my $xmlfile = $docroot."/temp/".$res.".dat"; - my @state = (); - my @assess = (); - my $id; - my $p = HTML::Parser->new + my ($res,$docroot,$destdir,$settings,$globalresref,$seqstem,$revitmref) = @_; + my $xmlfile = $docroot."/temp/".$res.".dat"; + my @state = (); + my @assess = (); + my $id; + my $p = HTML::Parser->new ( xml_mode => 1, start_h => @@ -1861,13 +1932,14 @@ sub process_announce { if ("@state" eq "ANNOUNCEMENT TITLE") { $$settings{title} = $attr->{value}; $$settings{startassessment} = (); -# print "Title is $$settings{title}\n"; } elsif (@state eq "ANNOUNCEMENT DESCRIPTION FLAGS ISHTML") { $$settings{ishtml} = $attr->{value}; } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISNEWLINELITERAL" ) { $$settings{isnewline} = $attr->{value}; - } elsif ("@state" eq "CONTENT ISPERMANENT" ) { + } elsif ("@state" eq "ANNOUNCEMENT ISPERMANENT" ) { $$settings{ispermanent} = $attr->{value}; + } elsif ("@state" eq "ANNOUNCEMENT DATES UPDATED") { + $$settings{dates} = $attr->{value}; } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT" ) { $id = $attr->{id}; %{$$settings{startassessment}{$id}} = (); @@ -1881,8 +1953,7 @@ sub process_announce { [sub { my ($text) = @_; if ("@state" eq "ANNOUNCEMENT DESCRIPTION TEXT") { - $$settings{text} = $text; -# print "TEXT $text\n"; + $$settings{text} = $text; } }, "dtext"], end_h => @@ -1891,56 +1962,61 @@ sub process_announce { pop @state; }, "tagname"], ); - $p->unbroken_text(1); - $p->parse_file($xmlfile); - $p->eof; + $p->unbroken_text(1); + $p->parse_file($xmlfile); + $p->eof; - if (defined($$settings{text})) { - if ($$settings{ishtml} eq "false") { - if ($$settings{isnewline} eq "true") { - $$settings{text} =~ s#\n#
#g; - } - } else { - $$settings{text} = &HTML::Entities::decode($$settings{text}); - } - } + if (defined($$settings{text})) { + if ($$settings{ishtml} eq "false") { + if ($$settings{isnewline} eq "true") { + $$settings{text} =~ s#\n#
#g; + } + } else { + $$settings{text} = &HTML::Entities::decode($$settings{text}); + } + } - if (@assess > 0) { - foreach my $id (@assess) { - $$settings{text} .= "Please use 'NAV' to locate the link to the folder of problems entitled -"; - foreach my $key (keys %{$$settings{startassessment}{$id}}) { -# print STDERR "Quiz announcement - $id, key: $key, value: $$settings{startassessment}{$id}{$key}\n"; - } - } - } + if (@assess > 0) { + foreach my $id (@assess) { + $$settings{text} = "A $$settings{startassessment}{$id}{assessment_type}, entitled $$globalresref{$$settings{startassessment}{$id}{assessment_id}}{title} is available. Click here to enter the folder the contains the problems in this assessment."; + } + } - open(FILE,">$destdir/resfiles/$res.html"); - print FILE qq| + open(FILE,">$destdir/resfiles/$res.html"); + print FILE qq| $$settings{title} + + + + +
$$settings{title} - announcement date: $$settings{date}
+
$$settings{text} |; - print FILE qq| + print FILE qq| |; - close(FILE); + close(FILE); } +# ---------------------------------------------------------------- Process Blackboard Content sub process_content { - my ($res,$docroot,$destdir,$settings,$dom,$user) = @_; - my $xmlfile = $docroot."/temp/".$res.".dat"; - my $destresdir = $destdir; - $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|; - my $filecount = 0; - my @state; - @{$$settings{files}} = (); - my $p = HTML::Parser->new + my ($res,$docroot,$destdir,$settings,$dom,$user) = @_; + my $xmlfile = $docroot."/temp/".$res.".dat"; + my $destresdir = $destdir; + $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|; + my $filecount = 0; + my @allrelfiles = (); + my @state; + @{$$settings{files}} = (); + my $p = HTML::Parser->new ( - xml_mode => 1, - start_h => - [sub { + xml_mode => 1, + start_h => + [sub { my ($tagname, $attr) = @_; push @state, $tagname; if (@state eq "CONTENT MAINDATA") { @@ -1957,13 +2033,12 @@ sub process_content { $$settings{isfolder} = $attr->{value}; } elsif ("@state" eq "CONTENT FLAGS LAUNCHINNEWWINDOW" ) { $$settings{newwindow} = $attr->{value}; - } elsif ("@state" eq "CONTENT FILES") { -# @{$$settings{files}} = (); } elsif ("@state" eq "CONTENT FILES FILEREF") { %{$$settings{files}[$filecount]} = (); %{$$settings{files}[$filecount]{registry}} = (); } elsif ("@state" eq "CONTENT FILES FILEREF RELFILE" ) { $$settings{files}[$filecount]{'relfile'} = $attr->{value}; + push @allrelfiles, $attr->{value}; } elsif ("@state" eq "CONTENT FILES FILEREF MIMETYPE") { $$settings{files}[$filecount]{mimetype} = $attr->{value}; } elsif ("@state" eq "CONTENT FILES FILEREF CONTENTTYPE") { @@ -1978,9 +2053,9 @@ sub process_content { my $key = $attr->{key}; $$settings{files}[$filecount]{registry}{$key} = $attr->{value}; } - }, "tagname, attr"], - text_h => - [sub { + }, "tagname, attr"], + text_h => + [sub { my ($text) = @_; if ("@state" eq "CONTENT TITLE") { $$settings{title} = $text; @@ -1989,111 +2064,114 @@ sub process_content { } elsif ("@state" eq "CONTENT FILES FILEREF REFTEXT") { $$settings{files}[$filecount]{reftext} = $text; } - }, "dtext"], - end_h => - [sub { + }, "dtext"], + end_h => + [sub { my ($tagname) = @_; if ("@state" eq "CONTENT FILES FILEREF") { $filecount ++; } pop @state; - }, "tagname"], - ); - $p->unbroken_text(1); - $p->parse_file($xmlfile); - $p->eof; - my $linktag = ''; - my $fontcol = ''; - if (@{$$settings{files}} > 0) { - for (my $filecount=0; $filecount<@{$$settings{files}}; $filecount++) { - if ($$settings{files}[$filecount]{'fileaction'} eq 'embed') { - if ( $$settings{files}[$filecount]{reftext} =~ m#<\!\-\-\s_(\d+)\\_\s\-\-\>#) { - my $newtag = qq||; - $$settings{maindata}{text} =~ s#<\!\-\-\s_/($1)\\_\s\-\-\>#$newtag#; - } elsif ( $$settings{files}[$filecount]{reftext} =~m#^_/(\d+)\\_$# ) { - my $reftag = $1; - my $newtag; - if ($$settings{files}[$filecount]{mimetype} =~ m/^image/) { - $newtag = qq|$$settings{files}[$filecount]{registry}{alttext}unbroken_text(1); + $p->parse_file($xmlfile); + $p->eof; + my $linktag = ''; + my $fontcol = ''; + if (@{$$settings{files}} > 0) { + for (my $filecount=0; $filecount<@{$$settings{files}}; $filecount++) { + if ($$settings{files}[$filecount]{'fileaction'} eq 'embed') { + if ( $$settings{files}[$filecount]{reftext} =~ m#<\!\-\-\s_(\d+)\\_\s\-\-\>#) { + my $newtag = qq||; + $$settings{maindata}{text} =~ s#<\!\-\-\s_/($1)\\_\s\-\-\>#$newtag#; + } elsif ( $$settings{files}[$filecount]{reftext} =~m#^_/(\d+)\\_$# ) { + my $reftag = $1; + my $newtag; + if ($$settings{files}[$filecount]{mimetype} =~ m/^image/) { + $newtag = qq|$$settings{files}[$filecount]{registry}{alttext}//; + $$settings{maindata}{text} =~ s/Move\swhole\scomment\sto\schange\sfile\splacement\swithin\spage\.[\s\n]+//; + $$settings{maindata}{text} =~ s/_\/$reftag\\_/$newtag/; + $$settings{maindata}{text} =~ s/END\sOF\sBLOCK\sON\sNEXT\sLINE[\s\n]+//; + $$settings{maindata}{text} =~ s/\-\->//; # $$settings{maindata}{text} =~ s//$newtag/; # print STDERR $$settings{maindata}{text}; - } - } else { - my $filename=$$settings{files}[$filecount]{'relfile'}; + } + } else { + my $filename=$$settings{files}[$filecount]{'relfile'}; # print "File is $filename\n"; - my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"; + my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"; # print "New filename is $newfilename\n"; - $$settings{maindata}{text} =~ s#(src|SRC|value)="$filename"#$1="$newfilename"#g; - } - } elsif ($$settings{files}[$filecount]{fileaction} eq 'link') { - $linktag = qq|$$settings{files}[$filecount]{linkname}|; - } elsif ($$settings{files}[$filecount]{fileaction} eq 'package') { + $$settings{maindata}{text} =~ s#(src|SRC|value)="$filename"#$1="$newfilename"#g; + } + } elsif ($$settings{files}[$filecount]{fileaction} eq 'link') { + unless (($$settings{files}[$filecount]{packageparent} ne '') && (grep/^$$settings{files}[$filecount]{packageparent}$/,@{$$settings{files}}) ) { + $linktag .= qq|$$settings{files}[$filecount]{linkname}
\n|; + } + } elsif ($$settings{files}[$filecount]{fileaction} eq 'package') { # print "Found a package\n"; - } - } - } - if (defined($$settings{maindata}{textcolor})) { - $fontcol = qq||; - } - if (defined($$settings{maindata}{text})) { - if ($$settings{maindata}{ishtml} eq "false") { - if ($$settings{maindata}{isnewline} eq "true") { - $$settings{maindata}{text} =~ s#\n#
#g; - } - } else { - $$settings{maindata}{text} = &HTML::Entities::decode($$settings{maindata}{text}); - } - } + } + } + } + if (defined($$settings{maindata}{textcolor})) { + $fontcol = qq||; + } + if (defined($$settings{maindata}{text})) { + if ($$settings{maindata}{ishtml} eq "false") { + if ($$settings{maindata}{isnewline} eq "true") { + $$settings{maindata}{text} =~ s#\n#
#g; + } + } else { + $$settings{maindata}{text} = &HTML::Entities::decode($$settings{maindata}{text}); + } + } - open(FILE,">$destdir/resfiles/$res.html"); - print FILE qq| + open(FILE,">$destdir/resfiles/$res.html"); + print FILE qq| $$settings{title} $fontcol - |; - unless ($$settings{title} eq '') { - print FILE qq|$$settings{title}

\n|; - } - print FILE qq| +|; + unless ($$settings{title} eq '') { + print FILE qq|$$settings{title}

\n|; + } + print FILE qq| $$settings{maindata}{text} $linktag|; - if (defined($$settings{maindata}{textcolor})) { - print FILE qq||; - } - print FILE qq| + if (defined($$settings{maindata}{textcolor})) { + print FILE qq||; + } + print FILE qq| |; - close(FILE); + close(FILE); } +# ---------------------------------------------------------------- Expand ANGEL IMS package sub expand_angel { my ($r,$uname,$udom,$fn,$page,$bb_crs,$bb_cdom,$bb_handling) = @_; my @state = (); @@ -2114,6 +2192,10 @@ sub expand_angel { my %resinfo = (); my $numfolders = 0; my $numpages = 0; + my $totseq = 0; + my $totpage = 0; + my $totquiz = 0; + my $totsurv = 0; my $docroot = $ENV{'form.newdir'}; if (!-e "$docroot/temp") { mkdir "$docroot/temp"; @@ -2125,11 +2207,11 @@ sub expand_angel { my $dirname = "/res/$udom/$uname/$newdir"; my $zipfile = '/home/'.$uname.'/public_html'.$fn; if ($fn =~ m|\.zip$|i) { - open(OUTPUT, "unzip -o $zipfile -d $docroot/temp 2> /dev/null |"); - while () { - print "$_
"; - } - close(OUTPUT); + open(OUTPUT, "unzip -o $zipfile -d $docroot/temp 2> /dev/null |"); + while () { + print "$_
"; + } + close(OUTPUT); } my $xmlfile = $docroot.'/temp/imsmanifest.xml'; @@ -2144,7 +2226,7 @@ sub expand_angel { my $start = $num; my $statestr = ''; foreach (@state) { - $statestr .= "$_ "; + $statestr .= "$_ "; } if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq "organization") ) { my $searchstr = "manifest organizations organization"; @@ -2154,6 +2236,7 @@ sub expand_angel { } if (("@state" eq $searchstr) && (@state > 3)) { $itm = $attr->{identifier}; + $contentscount{$itm} = 0; if ($attr->{identifierref} =~ m/^res(.+)$/) { $resnum{$itm} = $1; } @@ -2169,22 +2252,22 @@ sub expand_angel { } } elsif ($start < @seq) { - my $diff = @seq - $start; - while ($diff > 0) { - pop @seq; - $diff --; - } - if (@seq) { - push @{$contents{$seq[-1]}}, $itm; - } + my $diff = @seq - $start; + while ($diff > 0) { + pop @seq; + $diff --; + } + if (@seq) { + push @{$contents{$seq[-1]}}, $itm; + } } else { push @{$contents{$seq[-1]}}, $itm; } my $path; if (@seq > 1) { - $path = join(',',@seq); + $path = join(',',@seq); } elsif (@seq > 0) { - $path = $seq[0]; + $path = $seq[0]; } $filepath{$itm} = $path; $contentscount{$seq[-1]} ++; @@ -2240,24 +2323,26 @@ sub expand_angel { } foreach my $key (sort keys %href) { foreach my $file (@{$href{$key}}) { - print STDERR "File is $file, for $key\n"; $file =~ s-\\-/-g; - my $filepath = $file; - if (!-e "$destdir/resfiles/$key") { - mkdir("$destdir/resfiles/$key",0755); + unless ($file eq 'pg'.$key.'.htm') { + if (!-e "$destdir/resfiles/$key") { + mkdir("$destdir/resfiles/$key",0755); + } } + my $filepath = $file; while ($filepath =~ m-(\w+)/(.+)-) { $filepath = $2; if (!-e "$destdir/resfiles/$key/$1") { mkdir("$destdir/resfiles/$key/$1",0755); } } - system("cp $docroot/temp/_assoc/$key/$file $destdir/resfiles/$key/$file"); + unless ($file eq 'pg'.$key.'.htm') { + system("cp $docroot/temp/_assoc/$key/$file $destdir/resfiles/$key/$file"); + } } } - -# ANGEL types FILE FOLDER PAGE LINK MESSAGE FORM QUIZ BOARD +# ANGEL types FILE FOLDER PAGE LINK MESSAGE FORM QUIZ BOARD DROPBOX IMS my $currboard = ''; my @boards = (); my %messages = (); @@ -2276,14 +2361,17 @@ sub expand_angel { $board_count ++; } elsif ($type{$key} eq "MESSAGE") { push @{$messages{$currboard}}, $key; - } elsif ($type{$key} eq "FILE" || $type{$key} eq "FOLDER" || $type{$key} eq "PAGE" || $type{$key} eq "LINK") { + } elsif ($type{$key} eq "PAGE" || $type{$key} eq "LINK") { %{$resinfo{$key}} = (); + &angel_content($key,$docroot,$destdir,\%{$resinfo{$key}},$udom,$uname,$type{$key},$title{$revitm{$key}}); } elsif ($type{$key} eq "QUIZ") { %{$resinfo{$key}} = (); # &angel_assessment($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}}); } elsif ($type{$key} eq "FORM") { %{$resinfo{$key}} = (); # &angel_assessment($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}}); + } elsif ($type{$key} eq "DROPBOX") { + %{$resinfo{$key}} = (); } } @@ -2295,7 +2383,7 @@ sub expand_angel { my %msgidx = (); my $forumtext = ''; my $boardname = 'bulletinpage_'.$timestamp[$i]; - my $forumfile = "$destdir/resfiles/$boards[$i]/$file{$boards[$i]}"; + my $forumfile = $docroot.'/temp/_assoc/'.$boards[$i].'/pg'.$boards[$i].'.htm'; my @state = (); my $p = HTML::Parser->new ( @@ -2318,7 +2406,7 @@ sub expand_angel { pop @state; }, "tagname"], ); - $p->parse_file($xmlfile); + $p->parse_file($forumfile); $p->eof; my %boardinfo = ( @@ -2330,37 +2418,42 @@ sub expand_angel { my $msgcount = 0; my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$bb_cdom,$bb_crs); + print STDERR "putresult is $putresult for $boardname $bb_cdom $bb_crs\n"; if ($bb_handling eq 'importall') { foreach my $msg_id (@{$messages{$boards[$i]}}) { $msgcount ++; $msgidx{$msg_id} = $msgcount; my %contrib = ( - 'sendername' => 'Username not recorded', + 'sendername' => 'NoName', 'senderdomain' => $bb_cdom, 'screenname' => '', 'message' => $title{$revitm{$msg_id}} ); unless ( $parentseq{$revitm{$msg_id}} eq $revitm{$boards[$i]} ) { - $contrib{replyto} = $msgidx{$resnum{$parentseq{$revitm{$msg_id}}}}; + unless ( $msgidx{$resnum{$parentseq{$revitm{$msg_id}}}} eq ''){ + $contrib{replyto} = $msgidx{$resnum{$parentseq{$revitm{$msg_id}}}}; + print STDERR "$msgidx{$resnum{$revitm{$msg_id}}} is replying to $msgidx{$resnum{$parentseq{$revitm{$msg_id}}}}\n"; + } } if ( @{$href{$msg_id}} > 1 ) { my $newurl = ''; foreach my $file (@{$href{$msg_id}}) { unless ($file eq 'pg'.$msg_id.'.htm') { $newurl = $msg_id.$file; + print STDERR "Msg is $msg_id, File is $file, newurl is $newurl\n"; unless ($longcrs eq '') { if (!-e "/home/httpd/lonUsers/$bb_cdom/$longcrs/userfiles") { mkdir("/home/httpd/lonUsers/$bb_cdom/$longcrs/userfiles",0755); } if (!-e "/home/httpd/lonUsers/$bb_cdom/$longcrs/userfiles/$newurl") { - system("cp $destdir/resfiles/$file /home/httpd/lonUsers/$bb_cdom/$longcrs/userfiles/$newurl"); + system("cp $destdir/resfiles/$msg_id/$file /home/httpd/lonUsers/$bb_cdom/$longcrs/userfiles/$newurl"); } $contrib{attachmenturl} = '/uploaded/'.$bb_cdom.'/'.$bb_crs.'/'.$newurl; } } } } - my $xmlfile = "$destdir/resfiles/$msg_id/$file{$msg_id}"; + my $xmlfile = $docroot.'/temp/_assoc/'.$msg_id.'/'.$file{$msg_id}; &angel_message($msg_id,\%contrib,$xmlfile); unless ($file{$msg_id} eq '') { unlink($xmlfile); @@ -2383,16 +2476,20 @@ sub expand_angel { my %seqcount = (); my %boardflag = (); my %boardcount = (); + my %fileflag = (); + my %filecount = (); foreach my $key (@resources) { - print STDERR "Key is $key, resnum is $resnum{$key}, type is $type{$resnum{$key}}\n"; $pageflag{$key} = 0; $seqflag{$key} = 0; $seqcount{$key} = 0; $pagecount{$key} = -1; $boardflag{$key} = 0; $boardcount{$key} = 0; + $fileflag{$key} = 0; + $filecount{$key} = 0; my $src =""; + my $srcstem = "/res/$udom/$uname/$newdir"; my $next_id = 1; my $curr_id = 0; if ($type{$resnum{$key}} eq "FOLDER") { @@ -2404,28 +2501,40 @@ sub expand_angel { \n|; } else { if ($type{$resnum{$contents{$key}[0]}} eq "FOLDER") { - $src = 'sequences/'.$contents{$key}[0].".sequence"; + $src = $srcstem.'/sequences/'.$contents{$key}[0].".sequence"; $pageflag{$key} = 0; $seqflag{$key} = 1; $seqcount{$key} ++; } elsif ($type{$resnum{$contents{$key}[0]}} eq "BOARD") { - $src = "/adm/$bb_cdom/$uname/$timestamp[$boardnum{$key}]/bulletinboard"; + $src = '/adm/'.$bb_cdom.'/'.$uname.'/'.$timestamp[$boardnum{$resnum{$contents{$key}[0]}}].'/bulletinboard'; $pageflag{$key} = 0; $boardflag{$key} = 1; $boardcount{$key} ++; - } elsif ($type{$resnum{$contents{$key}[0]}} ne "MESSAGE") { + } elsif ($type{$resnum{$contents{$key}[0]}} eq "FILE") { + foreach my $file (@{$href{$resnum{$contents{$key}[0]}}}) { + unless ($file eq 'pg'.$resnum{$contents{$key}[0]}.'.htm') { + $src = $srcstem.'/resfiles/'.$resnum{$contents{$key}[0]}.'/'.$file; + } + } + $pageflag{$key} = 0; + $fileflag{$key} = 1; + } elsif ( ($type{$resnum{$contents{$key}[0]}} eq "PAGE") || ($type{$resnum{$contents{$key}[0]}} eq "LINK") ) { if ($pageflag{$key}) { - push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[0]; + if ($pagecount{key} == -1) { + print STDERR "Array index is -1, we shouldnt be here\n"; + } else { + push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[0]; + } } else { $pagecount{$key} ++; - $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page'; + $src = $srcstem.'/pages/'.$key.'_'.$pagecount{$key}.'.page'; @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[0]"); $seqflag{$key} = 0; } } unless ($pageflag{$key}) { - print LOCFILE qq| 2 ) { for (my $i=1; $i<$contentscount{$key}-1; $i++) { if ($type{$resnum{$contents{$key}[$i]}} eq "FOLDER") { - $src = 'sequences/'.$contents{$key}[$i].".sequence"; + $src = $srcstem.'/sequences/'.$contents{$key}[$i].".sequence"; $pageflag{$key} = 0; $seqflag{$key} = 1; $seqcount{$key} ++; - } elsif ($type{$resnum{$contents{$key}[0]}} eq "BOARD") { - $src = "/adm/$bb_cdom/$uname/$timestamp[$boardnum{$key}]/bulletinboard"; + } elsif ($type{$resnum{$contents{$key}[$i]}} eq "BOARD") { + $src = '/adm/'.$bb_cdom.'/'.$uname.'/'.$timestamp[$boardnum{$resnum{$contents{$key}[$i]}}].'/bulletinboard'; $pageflag{$key} = 0; $boardflag{$key} = 1; $boardcount{$key} ++; - } elsif ($type{$resnum{$contents{$key}[0]}} ne "MESSAGE") { + } elsif ($type{$resnum{$contents{$key}[$i]}} eq "FILE") { + foreach my $file (@{$href{$resnum{$contents{$key}[$i]}}}) { + unless ($file eq 'pg'.$resnum{$contents{$key}[$i]}.'.htm') { + $src = $srcstem.'/resfiles/'.$resnum{$contents{$key}[$i]}.'/'.$file; + } + } + $pageflag{$key} = 0; + $fileflag{$key} = 1; + $filecount{$key} ++; + } elsif ( ($type{$resnum{$contents{$key}[$i]}} eq "PAGE") || ($type{$resnum{$contents{$key}[$i]}} eq "LINK") ) { if ($pageflag{$key}) { - push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$i]; + if ($pagecount{$key} == -1) { + print STDERR "array index is -1, we shouldnt be here\n"; + } else { + push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$i]; + } } else { $pagecount{$key} ++; - $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page'; + $src = $srcstem.'/pages/'.$key.'_'.$pagecount{$key}.'.page'; @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$i]"); $seqflag{$key} = 0; } @@ -2461,32 +2583,41 @@ sub expand_angel { $next_id ++; print LOCFILE qq|> - \n|; @@ -2498,13 +2629,16 @@ sub expand_angel { $next_id ++; print LOCFILE qq|> -\n|; +\n|; } } } print LOCFILE "\n"; close(LOCFILE); + $pagecount{$key} ++; + $totpage += $pagecount{$key}; } + $totseq += $seqcount{$key}; } foreach my $key (sort keys %pagecontents) { @@ -2513,30 +2647,121 @@ sub expand_angel { my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page'; open(PAGEFILE,">$filename"); print PAGEFILE qq| - + \n|; if (@{$pagecontents{$key}[$i]} == 1) { print PAGEFILE qq||; } elsif (@{$pagecontents{$key}[$i]} == 2) { - print PAGEFILE qq||; + print PAGEFILE qq||; } else { for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) { my $curr_id = $j+1; my $next_id = $j+2; - my $resource = $filestem.'/resfiles/'.$resnum{$pagecontents{$key}[$i][$j]}.'.html'; + my $resource = $filestem.'/resfiles/'.$resnum{$pagecontents{$key}[$i][1]}.'/'.$resnum{$pagecontents{$key}[$i][$j]}.'.html'; print PAGEFILE qq| \n|; } my $final_id = @{$pagecontents{$key}[$i]}; - print PAGEFILE qq|\n|; + print PAGEFILE qq|\n|; } print PAGEFILE ""; close(PAGEFILE); } } -# system(" rm -r $docroot/temp"); + system(" rm -r $docroot/temp"); # Need to add sanity checking + return('ok',$totseq,$totpage,$board_count); +} + +# ---------------------------------------------------------------- ANGEL content +sub angel_content { + my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title) = @_; + my $xmlfile = $docroot.'/temp/_assoc/'.$res.'/pg'.$res.'.htm'; + my $filecount = 0; + my $firstline; + my $lastline; + my @buffer = (); + my @state; + @{$$settings{links}} = (); + my $p = HTML::Parser->new + ( + xml_mode => 1, + start_h => + [sub { + my ($tagname, $attr) = @_; + push @state, $tagname; + }, "tagname, attr"], + text_h => + [sub { + my ($text) = @_; + if ("@state" eq "html body table tr td div small span") { + $$settings{'subtitle'} = $text; + } elsif ("@state" eq "html body div div") { + $$settings{'text'} = $text; + } elsif ("@state" eq "html body div div a") { + push @{$$settings{'links'}}, $text; + } + }, "dtext"], + end_h => + [sub { + my ($tagname) = @_; + pop @state; + }, "tagname"], + ); + $p->parse_file($xmlfile); + $p->eof; + if ($type eq "PAGE") { + open(FILE,"<$xmlfile"); + @buffer = ; + close(FILE); + chomp(@buffer); + $firstline = -1; + $lastline = 0; + for (my $i=0; $i<@buffer; $i++) { + if (($firstline == -1) && ($buffer[$i] =~ m//)) { + $firstline = $i; + $buffer[$i] = substr($buffer[$i],index($buffer[$i],'"normalSpan"')+13); + } + if (($firstline > -1) && ($buffer[$i] =~ m-

-)) { + $buffer[$i] = substr($buffer[$i],0,index($buffer[$i],'

')); + $lastline = $i; + } + } + } + if (!-e "$destdir/resfiles/$res") { + mkdir("$destdir/resfiles/$res/",0755); + } + open(FILE,">$destdir/resfiles/$res/$res.html"); + print FILE qq| + +$title + + + |; + unless ($title eq '') { + print FILE qq|$title
\n|; + } + unless ($$settings{subtitle} eq '') { + print FILE qq|$$settings{subtitle}
\n|; + } + print FILE "
\n"; + if ($type eq "LINK") { + foreach my $link (@{$$settings{links}}) { + print FILE qq|$link
\n|; + } + } elsif ($type eq "PAGE") { + if ($firstline > -1) { + for (my $i=$firstline; $i<=$lastline; $i++) { + print FILE "$buffer[$i]\n"; + } + } + } + print FILE qq| + + |; + close(FILE); } +# ---------------------------------------------------------------- Process ANGEL message board messages sub angel_message { my ($msg_id,$contrib,$xmlfile) = @_; my @state = (); @@ -2562,11 +2787,12 @@ sub angel_message { my ($tagname) = @_; pop @state; }, "tagname"], - ); - $p->parse_file($xmlfile); - $p->eof; + ); + $p->parse_file($xmlfile); + $p->eof; } +# ---------------------------------------------------------------- Get LON-CAPA Course Coordinator roles for this user sub get_ccroles { my ($uname,$dom,$crsentry) = @_; my %roles = (); @@ -2716,6 +2942,7 @@ sub handler { my $bb_crs = ''; my $bb_cdom = ''; my $bb_handling = ''; + my $announce_handling = 'ok'; my $source = $ENV{'form.source'}; if ( defined($ENV{'form.bb_crs'}) ) { ($bb_cdom,$bb_crs) = split/\//,$ENV{'form.bb_crs'}; @@ -2732,18 +2959,27 @@ sub handler { if ( defined($ENV{'form.user_handling'}) ) { $users_handling = $ENV{'form.user_handling'}; } - my ($totseq,$totpage,$totprob); - print STDERR "Page name is $page_name\n"; + my ($result,$totseq,$totpage,$totprob,$totboard,$totquiz,$totsurv); if ($page_name eq 'ChooseDir') { &display_zero ($r,$uname,$fn,$current_page,$fullpath); } elsif ($page_name eq 'Confirmation') { - ($totseq,$totpage,$totprob) = &expand_bb5 ($r,$uname,$udom,$fn,$current_page,$bb_crs,$bb_cdom,$bb_handling,$users_crs,$users_cdom,$users_handling) if $source eq 'bb5'; - ($totseq,$totpage,$totprob) = &expand_angel ($r,$uname,$udom,$fn,$current_page,$bb_crs,$bb_cdom,$bb_handling) if $source eq 'angel'; + ($result,$totseq,$totpage,$totboard,$totquiz,$totsurv,$totprob) = &expand_bb5 ($r,$uname,$udom,$fn,$current_page,$bb_crs,$bb_cdom,$bb_handling,$users_crs,$users_cdom,$users_handling,$announce_handling) if $source eq 'bb5'; + ($totseq,$totpage,$totboard) = &expand_angel ($result,$uname,$udom,$fn,$current_page,$bb_crs,$bb_cdom,$bb_handling) if $source eq 'angel'; &expand_webct ($r,$uname,$udom,$fn,$current_page) if $source eq 'webct'; } - $r->print("

Step 3: Publish your new LON-CAPA materials

"); - $r->print("Your IMS package has been processed successfully. A total of $totseq sequences, $totpage pages, and $totprob problems have been created.

\n"); - + + if ($result eq 'nozip') { + $r->print("Processing of your IMS package failed, because you did not upload a IMS content package compressed in zip format."); + } elsif ($result eq 'nomanifest') { + $r->print("Processing of your IMS package failed, because the IMS content package did not contain an IMS manifest file ."); + } else { + $r->print("

Step 3: Publish your new LON-CAPA materials

"); + if ($source eq 'bb5') { + $r->print("Your IMS package has been processed successfully. A total of $totseq sequences, $totpage pages, $totboard bulletin boards, $totquiz quizzes, $totsurv surveys and $totprob problems have been created.

\n"); + } elsif ($source eq 'angel') { + $r->print("Your IMS package has been processed successfully. A total of $totseq sequences, $totpage pages, and $totboard bulletin boards have been created.

\n"); + } + } } elsif ($ENV{'form.phase'} eq 'two') { my $flag = &Apache::lonupload::phasetwo($r,$fn,$uname,$udom,'imsimport'); if ($flag eq 'ok') {