--- loncom/imspackages/imsimport.pm 2004/02/10 23:36:32 1.1 +++ 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'; @@ -32,11 +31,28 @@ sub calculate_page($$) { # ---------------------------------------------------------------- Jscript Zero sub jscript_zero { - my ($fullpath,$jsref) = @_; + my ($fullpath,$jsref,$uname,$dom) = @_; my $source = ''; if (exists($ENV{'form.go'}) ) { $source = $ENV{'form.go'}; } + my %crsentry = (); + my $course_list; + my $title_list; + my @crslist = (); + @crslist = &get_ccroles($uname,$dom,\%crsentry); + if (@crslist > 0) { + $crsentry{$crslist[0]} =~ s/("|,)//g; + $title_list = '"'.$crsentry{$crslist[0]}.'"'; + if (@crslist > 1) { + for (my $i=1; $i<@crslist; $i++) { + $crsentry{$crslist[$i]} =~ s/("|,)//g; + $title_list .= ',"'.$crsentry{$crslist[$i]}.'"'; + } + } + } + $course_list = '"'.join('","',@crslist).'"'; + $$jsref = <<"END_OF_ONE"; function verify() { if ((document.forms.dataForm.newdir.value == '') || (!document.forms.dataForm.newdir.value)) { @@ -46,10 +62,10 @@ function verify() { if (document.forms.dataForm.source.selectedIndex == 0) { alert("You must choose the Course Management System from which the IMS package was exported"); return false - } + } return true } - + function nextPage() { if (verify()) { document.forms.dataForm.go.value="NextPage" @@ -80,16 +96,45 @@ function createWin() { newWindow.document.close() newWindow.focus() } + +function setCourse(caller) { + courseID_array = new Array($course_list) + courseTitle_array = new Array($title_list) + var step1Form = document.forms.dataForm + var curVal = step1Form.elements[caller*2+3].options[step1Form.elements[caller*2+3].selectedIndex].value + step1Form.elements[caller*2+4].length = 0 + if (step1Form.elements[caller*2+3].options[step1Form.elements[caller*2+3].selectedIndex].value == "-1") { + step1Form.elements[caller*2+4].options[0] = new Option("<--- Set type ","-1",true,true) + } + else { + if ((step1Form.elements[caller*2+3].selectedIndex == 2 ) || (step1Form.elements[caller*2+3].selectedIndex == 3)) { + step1Form.elements[caller*2+4].options[0] = new Option("Please Select","-1",true,true) + if (courseID_array.length > 0) { + step1Form.elements[caller*2+4].options[0] = new Option("Please Select","-1",true,true) + for (var i=0; iprint(<<"END_OF_ONE"); -

Step 1: Selection of IMS package type and destination directory for the package contents 

@@ -100,10 +145,11 @@ sub display_zero { - @@ -113,44 +159,44 @@ sub display_zero { - - - - - - - - + + + - + Create a directory where you will unpack your IMS package.   - + + + + + + + @@ -158,14 +204,71 @@ Please choose a destination LON-CAPA dir - + - + - +
  +      - Specify the Course Management system used to create the package. + Specify the Course Management system used to create the package.   +
  -Please choose the CMS used to create your IMS content package. -
 
  - +Please choose the CMS used to create your IMS content package.   +
 
 
  +    - Create a directory where you will unpack your IMS package. -
 
  -Please choose a destination LON-CAPA directory in which to store the contents of the IMS package file +Please choose a destination LON-CAPA directory in which to store the contents of the IMS package file. +
 

+    + Indicate how any discussion boards and user data in the package should be handled
  + + + + +
+ + + + +
+ + + + + + + + + + + + + + + + +
Type of dataActionTarget course
  Discussion boards     + +    +    + +    +
  User information     + +    +    + + +    +
+
+
+
  
 If you have created a destination directory you should use the "Next Page" button to complete the process of unpacking your IMS package.If you have created a destination directory, and have made your selections for the disposition of bulletin boards and user information, you should click the 'Convert' button to unpack your IMS package.
@@ -183,10 +286,11 @@ Please choose a destination LON-CAPA dir -
  + + - +
@@ -200,13 +304,13 @@ Please choose a destination LON-CAPA dir END_OF_ONE } -# ---------------------------------------------------------------- Display One - +# ---------------------------------------------------------------- Expand Blackboard 5 imsmanifest sub expand_bb5 { - my ($r,$uname,$udom,$fn,$page) = @_; + 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 = (); @@ -221,6 +325,19 @@ sub expand_bb5 { my %resinfo = (); my $numfolders = 0; my $numpages = 0; + 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") { mkdir "$docroot/temp"; @@ -232,15 +349,19 @@ sub expand_bb5 { 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); + } else { + return 'nozip'; + } + unless (-e "$docroot/temp/imsmanifest.xml") { + return 'nomanifest'; + } my $xmlfile = $docroot.'/temp/imsmanifest.xml'; -# print STDERR "XML file is $xmlfile\n"; my $p = HTML::Parser->new ( xml_mode => 1, @@ -252,57 +373,59 @@ sub expand_bb5 { my $start = $num; my $statestr = ''; foreach (@state) { - $statestr .= "$_ "; + $statestr .= "$_ "; } if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq "tableofcontents") ) { - my $searchstr = "manifest organizations tableofcontents"; - while ($num > 0) { - $searchstr .= " item"; - $num --; - } - if (("@state" eq $searchstr) && (@state > 3)) { - my $itm = $attr->{identifier}; - $resnum{$itm} = $attr->{identifierref}; - $title{$itm} = $attr->{title}; - if ($start > @seq) { - unless ($lastitem eq '') { - push @seq, $lastitem; - unless ( defined($contents{$seq[-1]}) ) { - @{$contents{$seq[-1]}} = (); + my $searchstr = "manifest organizations tableofcontents"; + while ($num > 0) { + $searchstr .= " item"; + $num --; + } + 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; + unless ( defined($contents{$seq[-1]}) ) { + @{$contents{$seq[-1]}} = (); + } + push @{$contents{$seq[-1]}},$itm; + $parentseq{$itm} = $seq[-1]; } - push @{$contents{$seq[-1]}},$itm; - $parentseq{$itm} = $seq[-1]; } + elsif ($start < @seq) { + 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); + } elsif (@seq > 0) { + $path = $seq[0]; + } + $filepath{$itm} = $path; + $contentscount{$seq[-1]} ++; + $lastitem = $itm; } - elsif ($start < @seq) { - 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); - } elsif (@seq > 0) { - $path = $seq[0]; - } - $filepath{$itm} = $path; - $contentscount{$seq[-1]} ++; - $lastitem = $itm; - } } elsif ("@state" eq "manifest resources resource" ) { $identifier = $attr->{identifier}; $base{$identifier} = $attr->{baseurl}; $file{$identifier} = $attr->{file}; $type{$identifier} = $attr->{type}; } elsif ("@state" eq "manifest resources resource file") { - push@{$href{$identifier}},$attr->{href}; + push @{$href{$identifier}},$attr->{href}; } }, "tagname, attr"], text_h => @@ -319,9 +442,8 @@ sub expand_bb5 { $p->parse_file($xmlfile); $p->eof; - my $topnum = 0; my $destdir = $docroot; -# print STDERR "Destdir is $destdir\n"; + my $seqstem ="/res/$udom/$uname/$newdir/sequences"; if (!-e "$destdir") { mkdir("$destdir",0755); } @@ -337,9 +459,6 @@ sub expand_bb5 { if (!-e "$destdir/problems") { mkdir("$destdir/problems",0755); } - open(FILE,">$destdir/sequences/ims_import.sequence"); - print FILE "\n"; - foreach my $key (sort keys %href) { foreach my $file (@{$href{$key}}) { my $filepath = $file; @@ -362,34 +481,64 @@ sub expand_bb5 { &process_content($key,$docroot,$destdir,\%{$resinfo{$key}},$udom,$uname); } elsif ($type{$key} eq "resource/x-bb-staffinfo") { %{$resinfo{$key}} = (); - &process_staff($key,$docroot,$destdir,\%{$resinfo{$key}}); + &process_staff($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}}); } elsif ($type{$key} eq "resource/x-bb-externallink") { %{$resinfo{$key}} = (); - &process_link($key,$docroot,$destdir,\%{$resinfo{$key}}); + &process_link($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}}); } elsif ($type{$key} eq "resource/x-bb-discussionboard") { %{$resinfo{$key}} = (); - &process_db($key,$docroot,$destdir,\%{$resinfo{$key}}); - } elsif ($type{$key} eq "resource/x-bb-announcement") { - %{$resinfo{$key}} = (); - &process_announce($key,$docroot,$destdir,\%{$resinfo{$key}}); + unless ($bb_handling eq 'ignore') { + 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 "assessment/x-bb-pool") { %{$resinfo{$key}} = (); - &process_assessment($key,$docroot,'pool',$dirname,$destdir,\%{$resinfo{$key}}); + &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}}); + &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}}); + &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}} = (); + push @groups, $key; &process_group($key,$docroot,$destdir,\%{$resinfo{$key}}); } elsif ($type{$key} eq "resource/x-bb-user") { %{$resinfo{$key}} = (); - &process_user($key,$docroot,$destdir,\%{$resinfo{$key}}); + 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"; @@ -404,8 +553,11 @@ 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) { -# print STDERR "$key $filepath{$key} $resnum{$key} $title{$key}\n"; $pageflag{$key} = 0; $seqflag{$key} = 0; $seqcount{$key} = 0; @@ -453,7 +605,6 @@ sub expand_bb5 { $areacount = 0; } else { if ($filepath{$key} eq "Top,$areakey") { -# print STDERR "$key $filepath{$key} $resnum{$key} $title{$key}\n"; my $src = ''; if ($areacount == 0) { if ($resinfo{$resnum{$key}}{'isfolder'} eq "true") { @@ -512,16 +663,9 @@ sub expand_bb5 { my $next_id = 1; my $curr_id = 0; if ( (($type{$resnum{$key}} eq "resource/x-bb-document") || ($type{$resnum{$key}} eq "resource/x-bb-staffinfo") || ($type{$resnum{$key}} eq "resource/x-bb-externallink")) && ($resinfo{$resnum{$key}}{'isfolder'} eq "true") ) { -# if ( ($type{$resnum{$key}} eq "resource/x-bb-staffinfo") && ($resinfo{$resnum{$key}}{'isfolder'} eq "true") ) { -# print "$key $filepath{$key} $resnum{$key} $title{$key}\n"; -# print "Folder for item - $key - res - $resnum{$key}\n"; -# print "$key, $contentscount{$key}\n"; -# foreach (@{$contents{$key}}) { -# print "$key, $_\n"; -# } -# print STDERR "Contents Count for $key is $contentscount{$key}\n"; open(LOCFILE,">$destdir/sequences/$key.sequence"); print LOCFILE "\n"; + $totseq ++; if ($contentscount{$key} == 0) { print LOCFILE qq| @@ -603,7 +747,6 @@ sub expand_bb5 { } else { print LOCFILE qq| type="finish">\n|; } - print STDERR "seqcount is $seqcount{$key}, pagecount is $pagecount{$key} for $key\n"; } else { $curr_id ++; $next_id ++; @@ -618,12 +761,37 @@ sub expand_bb5 { } } } + + if ($fileopen) { + if ($areacount == 0) { + print AREAFILE qq| + +\n|; + } elsif ($areacount == 1) { + print AREAFILE qq|\n|; + } else { + print AREAFILE qq|$lastentry\n|; + } + 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); foreach my $key (sort keys %pagecontents) { for (my $i=0; $i<@{$pagecontents{$key}}; $i++) { my $filestem = "/res/$udom/$uname/$newdir"; my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page'; + $totpage ++; open(PAGEFILE,">$filename"); print PAGEFILE qq| @@ -647,11 +815,98 @@ sub expand_bb5 { close(PAGEFILE); } } - system(" rm -r $docroot/temp"); + 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) = @_; + my ($res,$docroot,$destdir,$settings,$user_crs,$user_cdom,$user_handling) = @_; my $xmlfile = $docroot."/temp/".$res.".dat"; my $filecount = 0; my @state; @@ -665,9 +920,9 @@ sub process_user { [sub { my ($tagname, $attr) = @_; push @state, $tagname; - if (@state eq " USERS USER") { + if (@state eq "USERS USER") { $userid = $attr->{value}; - %{$$$settings{$userid}} = (); + %{$$settings{$userid}} = (); @{$$settings{$userid}{links}} = (); } elsif (@state eq "USERS USER LOGINID") { $$settings{$userid}{loginid} = $attr->{value}; @@ -718,8 +973,20 @@ sub process_user { $p->unbroken_text(1); $p->parse_file($xmlfile); $p->eof; + + my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf'); + my $xmlstem = $$configvars{'lonDaemons'}."/tmp/".$user_cdom."_".$user_crs."_"; + + foreach my $user_id (keys %{$settings}) { + if ($$settings{$user_id}{user_role} eq "s") { + + } elsif ($user_handling eq 'enrollall') { + + } + } } +# ---------------------------------------------------------------- Process Blackboard groups sub process_group { my ($res,$docroot,$destdir,$settings) = @_; my $xmlfile = $docroot."/".$res.".dat"; @@ -770,8 +1037,9 @@ sub process_group { $p->eof; } +# ---------------------------------------------------------------- Process Blackboard Staff sub process_staff { - my ($res,$docroot,$destdir,$settings) = @_; + my ($res,$docroot,$dirname,$destdir,$settings) = @_; my $xmlfile = $docroot."/temp/".$res.".dat"; my $filecount = 0; my @state; @@ -787,10 +1055,10 @@ sub process_staff { push @state, $tagname; if (@state eq "STAFFINFO TITLE") { $$settings{title} = $attr->{value}; - } elsif (@state eq "STAFFINFO BIOGRAPHY TEXTCOLOR") { + } elsif (@state eq "STAFFINFO BIOGRAPHY TEXTCOLOR") { $$settings{textcolor} = $attr->{value}; - } elsif (@state eq "STAFFINFO BIOGRAPHY FLAGS ISHTML") { - $$settings{ishtml} = $attr->{value}; + } elsif (@state eq "STAFFINFO BIOGRAPHY FLAGS ISHTML") { + $$settings{ishtml} = $attr->{value}; } elsif ("@state" eq "STAFFINFO FLAGS ISAVAILABLE" ) { $$settings{isavailable} = $attr->{value}; } elsif ("@state" eq "STAFFINFO FLAGS ISFOLDER" ) { @@ -834,179 +1102,436 @@ sub process_staff { $p->unbroken_text(1); $p->parse_file($xmlfile); $p->eof; + + my $fontcol = ''; + if (defined($$settings{textcolor})) { + $fontcol = qq|color="$$settings{textcolor}"|; + } + if (defined($$settings{text})) { + if ($$settings{ishtml} eq "true") { + $$settings{text} = &HTML::Entities::decode($$settings{text}); + } + } + my $staffentry = qq| + + + + + + + + +
$$settings{name}{formaltitle} $$settings{name}{given} $$settings{name}{family} +
+ |; + if ( defined($$settings{email}) && $$settings{email} ne '') { + $staffentry .= qq| + + + + + |; + } + if (defined($$settings{phone}) && $$settings{phone} ne '') { + $staffentry .= qq| + + + + + |; + } + if (defined($$settings{office}{address}) && $$settings{office}{address} ne '') { + $staffentry .= qq| + + + + + |; + } + if (defined($$settings{office}{hours}) && $$settings{office}{hours} ne '') { + $staffentry .= qq| + + + + + |; + } + if ( defined($$settings{homepage}) && $$settings{homepage} ne '') { + $staffentry .= qq| + + + + + |; + } + if (defined($$settings{text}) && $$settings{text} ne '') { + $staffentry .= qq| + + + + |; + } + $staffentry .= qq| +
+ Email: + + $$settings{email} +
+ Phone: + + $$settings{phone} +
+ Address: + + $$settings{office}{address} +
+ Office Hours: + + $$settings{office}{hours} +
+ Personal Link: + + $$settings{homepage} +
+ Other Information:
$$settings{text} +
+ 		+ |; + if ( defined($$settings{image}) ) { + $staffentry .= qq| + + |; + } + $staffentry .= qq| +
+ |; + open(FILE,">$destdir/resfiles/$res.html"); + print FILE qq| + +$$settings{title} + + +$staffentry + +|; + close(FILE); } +# ---------------------------------------------------------------- Process Blackboard Links sub process_link { - my ($res,$docroot,$destdir,$settings) = @_; - my $xmlfile = $docroot."/temp/".$res.".dat"; - my @state = (); - %{$$settings{name}} = (); - %{$$settings{office}} = (); - - my $p = HTML::Parser->new + my ($res,$docroot,$dirname,$destdir,$settings) = @_; + my $xmlfile = $docroot."/temp/".$res.".dat"; + my @state = (); + my $p = HTML::Parser->new ( - xml_mode => 1, - start_h => - [sub { - my ($tagname, $attr) = @_; - push @state, $tagname; - if (@state eq "EXTERNALLINK TITLE") { - $$settings{title} = $attr->{value}; - } elsif (@state eq "EXTERNALLINK TEXTCOLOR") { - $$settings{textcolor} = $attr->{value}; - } elsif (@state eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") { - $$settings{ishtml} = $attr->{value}; - } elsif ("@state" eq "EXTERNALLINKS FLAGS ISAVAILABLE" ) { - $$settings{isavailable} = $attr->{value}; - } elsif ("@state" eq "EXTERNALLINKS FLAGS LAUNCHINNEWWINDOW" ) { - $$settings{newwindow} = $attr->{value}; - } elsif ("@state" eq "EXTERNALLINKS FLAGS ISFOLDER" ) { - $$settings{isfolder} = $attr->{value}; - } elsif ("@state" eq "EXTERNALLINKS POSITION" ) { - $$settings{position} = $attr->{value}; - } elsif ("@state" eq "EXTERNALLINKS URL" ) { - $$settings{url} = $attr->{value}; + xml_mode => 1, + start_h => + [sub { + my ($tagname, $attr) = @_; + push @state, $tagname; + if (@state eq "EXTERNALLINK TITLE") { + $$settings{title} = $attr->{value}; + } elsif (@state eq "EXTERNALLINK TEXTCOLOR") { + $$settings{textcolor} = $attr->{value}; + } elsif (@state eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") { + $$settings{ishtml} = $attr->{value}; + } elsif ("@state" eq "EXTERNALLINK FLAGS ISAVAILABLE" ) { + $$settings{isavailable} = $attr->{value}; + } elsif ("@state" eq "EXTERNALLINK FLAGS LAUNCHINNEWWINDOW" ) { + $$settings{newwindow} = $attr->{value}; + } elsif ("@state" eq "EXTERNALLINK FLAGS ISFOLDER" ) { + $$settings{isfolder} = $attr->{value}; + } elsif ("@state" eq "EXTERNALLINK POSITION" ) { + $$settings{position} = $attr->{value}; + } elsif ("@state" eq "EXTERNALLINK URL" ) { + $$settings{url} = $attr->{value}; + } + }, "tagname, attr"], + text_h => + [sub { + my ($text) = @_; + if ("@state" eq "EXTERNALLINK DESCRIPTION TEXT") { + $$settings{text} = $text; + } + }, "dtext"], + end_h => + [sub { + my ($tagname) = @_; + pop @state; + }, "tagname"], + ); + $p->unbroken_text(1); + $p->parse_file($xmlfile); + $p->eof; + + my $linktag = ''; + my $fontcol = ''; + if (defined($$settings{textcolor})) { + $fontcol = qq||; + } + if (defined($$settings{text})) { + if ($$settings{ishtml} eq "true") { + $$settings{text} = &HTML::Entities::decode($$settings{text}); } - }, "tagname, attr"], - text_h => - [sub { - my ($text) = @_; - if ("@state" eq "EXTERNALLINKS DESCRIPTION TEXT") { - $$settings{text} = $text; + } + + if (defined($$settings{url}) ) { + $linktag = qq| - [sub { - my ($tagname) = @_; - pop @state; - }, "tagname"], - ); - $p->unbroken_text(1); - $p->parse_file($xmlfile); - $p->eof; + $linktag .= qq|>$$settings{title}|; + } + + open(FILE,">$destdir/resfiles/$res.html"); + print FILE qq| + +$$settings{title} + + +$fontcol +$linktag +$$settings{text} +|; + if (defined($$settings{textcolor})) { + print FILE qq||; + } + print FILE qq| + + |; + close(FILE); } +# ---------------------------------------------------------------- Process Blackboard Discussion Boards sub process_db { - my ($res,$docroot,$destdir,$settings) = @_; - my $xmlfile = $docroot."/temp/".$res.".dat"; - my @state = (); - my %threads; # all quotes, keyed by message ID - my $msg_id; # the current message ID - my %message; # the current message being accumulated for $msg_id + my ($res,$docroot,$destdir,$timestamp,$crs,$cdom,$handling,$uname,$settings) = @_; + my $xmlfile = $docroot."/temp/".$res.".dat"; + my @state = (); + my @allmsgs = (); + my %msgidx = (); + my $longcrs = ''; + if ($crs =~ m/^(\d)(\d)(\d)/) { + $longcrs = $1.'/'.$2.'/'.$3.'/'.$crs; + } + 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 - my $p = HTML::Parser->new + my $p = HTML::Parser->new ( - xml_mode => 1, - start_h => - [sub { - my ($tagname, $attr) = @_; - push @state, $tagname; - my $depth = 0; - my @seq = (); - if (@state eq "FORUM TITLE") { - $$settings{title} = $attr->{value}; - } elsif (@state eq "STAFFINFO BIOGRAPHY TEXTCOLOR") { - $$settings{textcolor} = $attr->{value}; - } elsif (@state eq "FORUM DESCRIPTION FLAGS ISHTML") { - $$settings{ishtml} = $attr->{value}; - } elsif (@state eq "FORUM DESCRIPTION FLAGS ISNEWLINELITERAL") { - $$settings{newline} = $attr->{value}; - } elsif ("@state" eq "FORUM POSITION" ) { - $$settings{position} = $attr->{value}; - } elsif ("@state" eq "FORUM FLAGS ISREADONLY") { - $$settings{isavailable} = $attr->{value}; - } elsif ("@state" eq "FORUM FLAGS ISAVAILABLE" ) { - $$settings{isavailable} = $attr->{value}; - } elsif ("@state" eq "FORUM FLAGS ALLOWANONYMOUSPOSTINGS" ) { - $$settings{isfolder} = $attr->{value}; - } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) { - if ($state[@state-1] eq "MSG") { - $depth = @state - 3; - if ($depth > @seq) { - unless ($msg_id eq '') { - push @seq, $msg_id; - } - } - if ($depth < @seq) { - pop @seq; - } - $msg_id = $attr->{value}; - %message = (); - $message{depth} = $depth; - if ($depth > 0) { - $message{parent} = $seq[-1]; - } else { - $message{parent} = "None"; - } - } elsif ($state[@state-1] eq "TITLE") { - $message{title} = $attr->{value}; - } elsif ( ( $state[@state-3] eq "MESSAGETEXT" ) && ( $state[@state-2] eq "FLAGS" ) && ( $state[@state-1] eq "ISHTML" ) ) { - $message{ishtml} = $attr->{value}; - } elsif ( ( $state[@state-3] eq "MESSAGETEXT" ) && ( $state[@state-2] eq "FLAGS" ) && ( $state[@state-1] eq "ISNEWLINELITERAL" ) ) { - $message{newline} = $attr->{value}; - } elsif ( ( $state[@state-2] eq "DATES" ) && ( $state[@state-1] eq "CREATED" ) ) { - $message{created} = $attr->{value}; - } elsif ( $state[@state-2] eq "FLAGS") { - if ($state[@state-1] eq "ISANONYMOUS") { - $message{isanonymous} = $attr->{value}; - } - } elsif ( $state[@state-2] eq "USER" ) { - if ($state[@state-1] eq "USERID") { - $message{userid} = $attr->{value}; - } elsif ($state[@state-1] eq "USERNAME") { - $message{username} = $attr->{value}; - } elsif ($state[@state-1] eq "EMAIL") { - $message{email} = $attr->{value}; - } - } elsif ( ($state[@state-2] eq "FILELIST") && ($state[@state-2] eq "IMAGE") ) { - $message{attachment} = $attr->{value}; + xml_mode => 1, + start_h => + [sub { + my ($tagname, $attr) = @_; + push @state, $tagname; + my $depth = 0; + my @seq = (); + if ("@state" eq "FORUM TITLE") { + $$settings{title} = $attr->{value}; + } elsif ("@state" eq "FORUM DESCRIPTION TEXTCOLOR") { + $$settings{textcolor} = $attr->{value}; + } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISHTML") { + $$settings{ishtml} = $attr->{value}; + } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISNEWLINELITERAL") { + $$settings{newline} = $attr->{value}; + } elsif ("@state" eq "FORUM POSITION" ) { + $$settings{position} = $attr->{value}; + } elsif ("@state" eq "FORUM FLAGS ISREADONLY") { + $$settings{isreadonly} = $attr->{value}; + } elsif ("@state" eq "FORUM FLAGS ISAVAILABLE" ) { + $$settings{isavailable} = $attr->{value}; + } elsif ("@state" eq "FORUM FLAGS ALLOWANONYMOUSPOSTINGS" ) { + $$settings{allowanon} = $attr->{value}; + } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) { + if ($state[-1] eq "MSG") { + unless ($msg_id eq '') { + push @{$threads{$msg_id}}, { %message }; + $depth = @state - 3; + if ($depth > @seq) { + push @seq, $msg_id; + } + } + if ($depth < @seq) { + pop @seq; + } + $msg_id = $attr->{id}; + push @allmsgs, $msg_id; + $msgidx{$msg_id} = @allmsgs; + %message = (); + $message{depth} = $depth; + if ($depth > 0) { + $message{parent} = $seq[-1]; + } else { + $message{parent} = "None"; + } + } elsif ($state[-1] eq "TITLE") { + $message{title} = $attr->{value}; + } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISHTML" ) ) { + $message{ishtml} = $attr->{value}; + } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISNEWLINELITERAL" ) ) { + $message{newline} = $attr->{value}; + } elsif ( ( $state[-2] eq "DATES" ) && ( $state[-1] eq "CREATED" ) ) { + $message{created} = $attr->{value}; + } elsif ( $state[@state-2] eq "FLAGS") { + if ($state[@state-1] eq "ISANONYMOUS") { + $message{isanonymous} = $attr->{value}; + } + } elsif ( $state[-2] eq "USER" ) { + if ($state[-1] eq "USERID") { + $message{userid} = $attr->{value}; + } elsif ($state[@state-1] eq "USERNAME") { + $message{username} = $attr->{value}; + } elsif ($state[@state-1] eq "EMAIL") { + $message{email} = $attr->{value}; + } + } elsif ( ($state[-2] eq "FILELIST") && ($state[-1] eq "IMAGE") ) { + $message{attachment} = $attr->{value}; + } + } + }, "tagname, attr"], + text_h => + [sub { + my ($text) = @_; + if ("@state" eq "FORUM DESCRIPTION TEXT") { + $$settings{text} = $text; + } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) { + if ( ($state[-2] eq "MESSAGETEXT") && ($state[-1] eq "TEXT") ){ + $message{text} = $text; + } + } + }, "dtext"], + end_h => + [sub { + my ($tagname) = @_; + if ( $state[-1] eq "MESSAGETHREADS" ) { + push @{$threads{$msg_id}}, { %message }; + } + pop @state; + }, "tagname"], + ); + $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}); } - }, "tagname, attr"], - text_h => - [sub { - my ($text) = @_; - if ("@state" eq "FORUM DESCRIPTION TEXT") { - $$settings{text} = $text; - } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) { - if ( ($state[@state-2] eq "MESSAGETEXT") && ($state[@state-1] eq "TEXT") ){ - $message{text} = $text; - } + if (defined($$settings{fontcolor}) ) { + $$settings{text} = "".$$settings{text}.""; } - }, "dtext"], - end_h => - [sub { - my ($tagname) = @_; - if ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) { - if ($state[@state-1] eq "MSG") { - push @{$threads{$msg_id}}, { %message }; + } + my $boardname = 'bulletinpage_'.$timestamp; + my %boardinfo = ( + 'aaa_title' => $$settings{title}, + 'bbb_content' => $$settings{text}, + 'ccc_webreferences' => '', + 'uploaded.lastmodified' => time, + ); + + my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs); + if ($handling eq 'importall') { + foreach my $msg_id (@allmsgs) { + foreach my $message ( @{$threads{$msg_id}} ) { + my %contrib = ( + 'sendername' => $$message{userid}, + 'senderdomain' => $cdom, + 'screenname' => '', + 'plainname' => $$message{username}, + ); + unless ($$message{parent} eq 'None') { + $contrib{replyto} = $msgidx{$$message{parent}}; + } + if (defined($$message{isanonymous}) ) { + if ($$message{isanonymous} eq 'true') { + $contrib{'anonymous'} = 'true'; + } + } + if ( defined($$message{attachment}) ) { + my $url = $$message{attachment}; + my $oldurl = $url; + my $newurl = $url; + unless ($url eq '') { + $newurl =~ s/\//_/g; + unless ($longcrs eq '') { + if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles") { + mkdir("/home/httpd/lonUsers/$cdom/$longcrs/userfiles",0755); + } + if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl") { + system("cp $destdir/resfiles/$res/$$message{attachment} /home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl"); + } + $contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$newurl; + } + } + } + if (defined($$message{title}) ) { + $contrib{'message'} = $$message{title}; + } + if (defined($$message{text})) { + if ($$message{ishtml} eq "false") { + if ($$message{isnewline} eq "true") { + $$message{text} =~ s#\n#
#g; + } + } else { + $$message{text} = &HTML::Entities::decode($$message{text}); + } + $contrib{'message'} .= '

'.$$message{text}; + my $symb = 'bulletin___'.$timestamp.'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$timestamp.'/bulletinboard'; + my $postresult = &addposting($symb,\%contrib,$cdom,$crs); + } } } - pop @state; - }, "tagname"], - ); - $p->unbroken_text(1); - $p->parse_file($xmlfile); - $p->eof; + } } +# ---------------------------------------------------------------- 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 %record=&Apache::lonnet::restore('_discussion'); + my ($temp)=keys %record; + unless ($temp=~/^error\:/) { + my %newrecord=(); + $newrecord{'resource'}=$symb; + $newrecord{'subnumber'}=$record{'subnumber'}+1; + &Apache::lonnet::cstore(\%newrecord,'_discussion'); + $status = 'ok'; + } else { + $status.='Failed.'; + } + return $status; +} +# ---------------------------------------------------------------- Process Blackboard Assessments - pools, quizzes, surveys sub process_assessment { - my ($res,$docroot,$container,$dirname,$destdir,$settings) = @_; - 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 => @@ -1017,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") { @@ -1046,7 +1569,9 @@ sub process_assessment { } if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") { $id = $attr->{id}; - push @allids, $id; + unless ($container eq 'pool') { + push @allids, $id; + } %{$$settings{$id}} = (); @{$allanswers{$id}} = (); $$settings{$id}{class} = $attr->{class}; @@ -1056,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}; @@ -1082,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}; @@ -1134,310 +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"; - foreach my $id (@allids) { -# print "Current ID is $id, type is $$settings{$id}{class} \n"; - if ($$settings{$id}{class} eq "QUESTION_ESSAY") { - my $output; - if ($container eq 'pool') { - $output = qq| - $$settings{$id}{text} -|; - } else { - $output = qq| - $$settings{$id}{text} -|; - } - $output .= qq| - - - - - $$settings{$id}{feedbackcorr} - -|; - if ($container eq 'pool') { - $output .= qq| - |; - open(PROB,">$newdir/$id.problem"); - print PROB $output; - close PROB; - } else { - $output .= qq| - |; - open(PROB,">$newdir/$id.problem"); - print PROB $output; - close PROB; - } - } else { - my $output; - if ($container eq 'pool') { - $output = 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| |; - } else { - $output = qq| -|; - } - $output .= qq|$$settings{$id}{text}\n|; - if ( defined($$settings{$id}{image}) ) { - if ( $$settings{$id}{style} eq 'embed' ) { - $output .= qq|

|; + $$totpageref ++; + print PAGEFILE qq||; + if (@allids == 1) { + print PAGEFILE qq| + +\n|; } 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++) { - unless ($$settings{$id}{$allanswers{$id}[$k]}{text} =~ m/^\d+\.?\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| - |; - } - if ($container eq 'pool') { - $output .= qq| - |; - open(PROB,">$newdir/$id.problem"); - print PROB $output; - close PROB; - } else { - $output .= qq| - |; - open(PROB,">$newdir/$id.problem"); - print PROB $output; - close PROB; - } - - } - } -} - - -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 $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 => @@ -1447,16 +1932,18 @@ 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} = (); + %{$$settings{startassessment}{$id}} = (); + push @assess,$id; } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT ATTRIB" ) { my $key = $attr->{key}; $$settings{startassessment}{$id}{$key} = $attr->{value}; @@ -1466,8 +1953,7 @@ sub process_announce { [sub { my ($text) = @_; if ("@state" eq "ANNOUNCEMENT DESCRIPTION TEXT") { - $$settings{maindata}{text} = $text; -# print "TEXT $text\n"; + $$settings{text} = $text; } }, "dtext"], end_h => @@ -1476,24 +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 (@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| + +$$settings{title} + + + + + + +
$$settings{title} - announcement date: $$settings{date}
+
+$$settings{text} +|; + print FILE qq| + + |; + 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") { @@ -1510,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") { @@ -1531,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; @@ -1542,113 +2064,808 @@ 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); +} + +# ---------------------------------------------------------------- Expand ANGEL IMS package +sub expand_angel { + my ($r,$uname,$udom,$fn,$page,$bb_crs,$bb_cdom,$bb_handling) = @_; + my @state = (); + my @seq = "Top"; + my $lastitem; + my $itm = ''; + my %resnum = (); + my %revitm = (); + my %title = (); + my %filepath = (); + my %contentscount = ("Top" => 0); + my %contents = (); + my %parentseq = (); + my %file = (); + my %type = (); + my %href = (); + my $identifier = ''; + 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"; + } + my $newdir = ''; + if ($docroot =~ m|public_html/(.+)$|) { + $newdir = $1; + } + 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); + } + + my $xmlfile = $docroot.'/temp/imsmanifest.xml'; + my $p = HTML::Parser->new + ( + xml_mode => 1, + start_h => + [sub { + my ($tagname, $attr) = @_; + push @state, $tagname; + my $num = @state - 3; + my $start = $num; + my $statestr = ''; + foreach (@state) { + $statestr .= "$_ "; + } + if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq "organization") ) { + my $searchstr = "manifest organizations organization"; + while ($num > 0) { + $searchstr .= " item"; + $num --; + } + if (("@state" eq $searchstr) && (@state > 3)) { + $itm = $attr->{identifier}; + $contentscount{$itm} = 0; + if ($attr->{identifierref} =~ m/^res(.+)$/) { + $resnum{$itm} = $1; + } + $revitm{$resnum{$itm}} = $itm; + if ($start > @seq) { + unless ($lastitem eq '') { + push @seq, $lastitem; + unless ( defined($contents{$seq[-1]}) ) { + @{$contents{$seq[-1]}} = (); + } + push @{$contents{$seq[-1]}},$itm; + $parentseq{$itm} = $seq[-1]; + } + } + elsif ($start < @seq) { + 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); + } elsif (@seq > 0) { + $path = $seq[0]; + } + $filepath{$itm} = $path; + $contentscount{$seq[-1]} ++; + $lastitem = $itm; + } + } elsif ("@state" eq "manifest resources resource" ) { + $identifier = $attr->{identifier}; + $identifier = substr($identifier,3); + if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) { + $file{$identifier} = $1; + } + @{$href{$identifier}} = (); + } elsif ("@state" eq "manifest resources resource file") { + if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) { + push @{$href{$identifier}},$1; + } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) { + $type{$identifier} = $1; + } + } + }, "tagname, attr"], + text_h => + [sub { + my ($text) = @_; + if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq "organization" && $state[-1] eq "title") { + $title{$itm} = $text; + } + }, "dtext"], + end_h => + [sub { + my ($tagname) = @_; + pop @state; + }, "tagname"], + ); + $p->parse_file($xmlfile); + $p->eof; + + my $topnum = 0; + my $destdir = $docroot; + if (!-e "$destdir") { + mkdir("$destdir",0755); + } + if (!-e "$destdir/sequences") { + mkdir("$destdir/sequences",0755); + } + if (!-e "$destdir/resfiles") { + mkdir("$destdir/resfiles",0755); + } + if (!-e "$destdir/pages") { + mkdir("$destdir/pages",0755); + } + if (!-e "$destdir/problems") { + mkdir("$destdir/problems",0755); + } + foreach my $key (sort keys %href) { + foreach my $file (@{$href{$key}}) { + $file =~ s-\\-/-g; + 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); + } + } + 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 DROPBOX IMS + my $currboard = ''; + my @boards = (); + my %messages = (); + my @timestamp = (); + my %boardnum = (); + my $board_id = time; + my $board_count = 0; + foreach my $key (sort keys %type) { + if ($type{$key} eq "BOARD") { + push @boards, $key; + $boardnum{$revitm{$key}} = $board_count ; + $currboard = $key; + @{$messages{$key}} = (); + $timestamp[$board_count] = $board_id; + $board_id ++; + $board_count ++; + } elsif ($type{$key} eq "MESSAGE") { + push @{$messages{$currboard}}, $key; + } 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}} = (); + } + } + + my $longcrs = ''; + if ($bb_crs =~ m/^(\d)(\d)(\d)/) { + $longcrs = $1.'/'.$2.'/'.$3.'/'.$bb_crs; + } + for (my $i=0; $i<@boards; $i++) { + my %msgidx = (); + my $forumtext = ''; + my $boardname = 'bulletinpage_'.$timestamp[$i]; + my $forumfile = $docroot.'/temp/_assoc/'.$boards[$i].'/pg'.$boards[$i].'.htm'; + my @state = (); + 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 div div") { + $forumtext = $text; + } + }, "dtext"], + end_h => + [sub { + my ($tagname) = @_; + pop @state; + }, "tagname"], + ); + $p->parse_file($forumfile); + $p->eof; + + my %boardinfo = ( + 'aaa_title' => $title{$revitm{$boards[$i]}}, + 'bbb_content' => $forumtext, + 'ccc_webreferences' => '', + 'uploaded.lastmodified' => time, + ); + 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' => 'NoName', + 'senderdomain' => $bb_cdom, + 'screenname' => '', + 'message' => $title{$revitm{$msg_id}} + ); + unless ( $parentseq{$revitm{$msg_id}} eq $revitm{$boards[$i]} ) { + 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/$msg_id/$file /home/httpd/lonUsers/$bb_cdom/$longcrs/userfiles/$newurl"); + } + $contrib{attachmenturl} = '/uploaded/'.$bb_cdom.'/'.$bb_crs.'/'.$newurl; + } + } + } + } + my $xmlfile = $docroot.'/temp/_assoc/'.$msg_id.'/'.$file{$msg_id}; + &angel_message($msg_id,\%contrib,$xmlfile); + unless ($file{$msg_id} eq '') { + unlink($xmlfile); + } + my $symb = 'bulletin___'.$timestamp[$i].'___adm/wrapper/adm/'.$bb_cdom.'/'.$uname.'/'.$timestamp[$i].'/bulletinboard'; + my $postresult = &addposting($symb,\%contrib,$bb_cdom,$bb_crs); + } + } + } + + my @resources = sort keys %resnum; + unshift @resources, "Top"; + $resnum{'Top'} = 'toplevel'; + $type{'toplevel'} = "FOLDER"; + + my %pagecount = (); + my %pagecontents = (); + my %pageflag = (); + my %seqflag = (); + my %seqcount = (); + my %boardflag = (); + my %boardcount = (); + my %fileflag = (); + my %filecount = (); + + foreach my $key (@resources) { + $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") { + open(LOCFILE,">$destdir/sequences/$key.sequence"); + print LOCFILE "\n"; + if ($contentscount{$key} == 0) { + print LOCFILE qq| + +\n|; + } else { + if ($type{$resnum{$contents{$key}[0]}} eq "FOLDER") { + $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{$resnum{$contents{$key}[0]}}].'/bulletinboard'; + $pageflag{$key} = 0; + $boardflag{$key} = 1; + $boardcount{$key} ++; + } 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}) { + 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 = $srcstem.'/pages/'.$key.'_'.$pagecount{$key}.'.page'; + @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[0]"); + $seqflag{$key} = 0; + } + } + unless ($pageflag{$key}) { + print LOCFILE qq| + +\n|; + } else { + if ($contentscount{$key} > 2 ) { + for (my $i=1; $i<$contentscount{$key}-1; $i++) { + if ($type{$resnum{$contents{$key}[$i]}} eq "FOLDER") { + $src = $srcstem.'/sequences/'.$contents{$key}[$i].".sequence"; + $pageflag{$key} = 0; + $seqflag{$key} = 1; + $seqcount{$key} ++; + } 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}[$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}) { + 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 = $srcstem.'/pages/'.$key.'_'.$pagecount{$key}.'.page'; + @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$i]"); + $seqflag{$key} = 0; + } + } + unless ($pageflag{$key}) { + $curr_id ++; + $next_id ++; + print LOCFILE qq|> + + + +\n|; + } else { + print LOCFILE qq| type="finish">\n|; + } + } else { + $curr_id ++; + $next_id ++; + print LOCFILE qq|> + +\n|; + } + } + } + print LOCFILE "\n"; + close(LOCFILE); + $pagecount{$key} ++; + $totpage += $pagecount{$key}; + } + $totseq += $seqcount{$key}; + } + + foreach my $key (sort keys %pagecontents) { + for (my $i=0; $i<@{$pagecontents{$key}}; $i++) { + my $filestem = "/res/$udom/$uname/$newdir"; + 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||; + } 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][1]}.'/'.$resnum{$pagecontents{$key}[$i][$j]}.'.html'; + print PAGEFILE qq| +\n|; + } + my $final_id = @{$pagecontents{$key}[$i]}; + print PAGEFILE qq|\n|; + } + print PAGEFILE ""; + close(PAGEFILE); + } + } + 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); + close(FILE); } +# ---------------------------------------------------------------- Process ANGEL message board messages +sub angel_message { + my ($msg_id,$contrib,$xmlfile) = @_; + my @state = (); + 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") { + $$contrib{'plainname'} = $text; + } elsif ("@state" eq "html body div div") { + $$contrib{'message'} .= '

'.$text; + } + }, "dtext"], + end_h => + [sub { + my ($tagname) = @_; + pop @state; + }, "tagname"], + ); + $p->parse_file($xmlfile); + $p->eof; +} + +# ---------------------------------------------------------------- Get LON-CAPA Course Coordinator roles for this user +sub get_ccroles { + my ($uname,$dom,$crsentry) = @_; + my %roles = (); + unless ($uname eq '') { + %roles = &Apache::lonnet::dump('roles',$dom,$uname); + } + my $iter = 0; + my @codes = (); + my %courses = (); + my @crslist = (); + my %descrip =(); + foreach my $key (keys %roles ) { + if ($key =~ m/^\/(\w+)\/(\w+)_cc$/) { + my $cdom = $1; + my $crs = $2; + my $role_end = 0; + my $role_start = 0; + my $active_chk = 1; + if ( $roles{$key} =~ m/^cc_(\d+)/ ) { + $role_end = $1; + if ( $roles{$key} =~ m/^cc_($role_end)_(\d+)$/ ) + { + $role_start = $2; + } + } + if ($role_start > 0) { + if (time < $role_start) { + $active_chk = 0; + } + } + if ($role_end > 0) { + if (time > $role_end) { + $active_chk = 0; + } + } + if ($active_chk) { + my $currcode = ''; + my %settings = &Apache::lonnet::get('environment',['internal.coursecode','description'],$cdom,$crs); + if (defined($settings{'description'}) ) { + $descrip{$crs} = $settings{'description'}; + } else { + $descrip{$crs} = 'Unknown'; + } + if (defined($settings{'internal.coursecode'}) ) { + $currcode = $settings{'internal.coursecode'}; + if ($currcode eq '') { + $currcode = "____".$iter; + $iter ++; + } + } else { + $currcode = "____".$iter; + $iter ++; + } + unless (grep/^$currcode$/,@codes) { + push @codes,$currcode; + @{$courses{$currcode}} = (); + } + push @{$courses{$currcode}}, $cdom.'/'.$crs; + } + } + } + foreach my $code (sort @codes) { + foreach my $crsdom (@{$courses{$code}}) { + my ($cdom,$crs) = split/\//,$crsdom; + my $showcode = ''; + unless ($code =~m/^____\d+$/) { $showcode = $code; } + $$crsentry{$crsdom} = $showcode.':'.$descrip{$crs}; + push @crslist, $crsdom; + } + } + return @crslist; +} - # ---------------------------------------------------------------- Main Handler sub handler { my $r=shift; @@ -1701,16 +2918,16 @@ sub handler { if ($ENV{'form.phase'} eq 'three') { $current_page = &display_control(); - my @PAGES = ('ChooseDir','Blackboard5','ANGEL','WebCT'); + my @PAGES = ('ChooseDir','Confirmation'); $page_name = $PAGES[$current_page]; if ($page_name eq 'ChooseDir') { - &jscript_zero($fullpath,\$javascript); + &jscript_zero($fullpath,\$javascript,$uname,$udom); } elsif ($page_name eq 'Confirmation') { - &jscript_two(\$javascript,$uname); +# &jscript_two(\$javascript,$uname); } } elsif ($ENV{'form.phase'} eq 'two') { - &jscript_zero($fullpath,\$javascript); + &jscript_zero($fullpath,\$javascript,$uname,$udom); } $r->print("LON-CAPA Construction Space\n"); @@ -1722,16 +2939,52 @@ sub handler { } if ($ENV{'form.phase'} eq 'three') { - &display_zero ($r,$uname,$fn,$current_page) if $page_name eq 'ChooseDir'; - &expand_bb5 ($r,$uname,$udom,$fn,$fullpath,$current_page) if $page_name eq 'Blackboard5'; - &expand_angel ($r,$uname,$udom,$fn,$fullpath,$current_page) if $page_name eq 'ANGEL'; - &expand_webct ($r,$uname,$udom,$fn,$fullpath,$current_page) if $page_name eq 'WebCT'; - + 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'}; + } + if ( defined($ENV{'form.bb_handling'}) ) { + $bb_handling = $ENV{'form.bb_handling'}; + } + my $users_crs = ''; + my $users_cdom = ''; + my $users_handling = ''; + if ( defined($ENV{'form.user_crs'}) ) { + ($users_cdom,$users_crs) = split/\//,$ENV{'form.user_crs'}; + } + if ( defined($ENV{'form.user_handling'}) ) { + $users_handling = $ENV{'form.user_handling'}; + } + 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') { + ($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'; + } + + 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') { my $current_page = 0; - &display_zero($r,$uname,$fn,$current_page); + &display_zero($r,$uname,$fn,$current_page,$fullpath); } } else { &Apache::lonupload::phaseone($r,$fn,$uname,$udom,'imsimport');