package Apache::imsprocessor; use Apache::lonnet; use LONCAPA::Configuration; use strict; sub create_tempdir { my ($caller,$pathinfo,$timenow) = @_; my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf'); my $tempdir; if ($caller eq 'DOCS') { $tempdir = $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo; if (!-e "$tempdir") { mkdir("$tempdir",0770); } $tempdir .= '/'.$timenow; if (!-e "$tempdir") { mkdir("$tempdir",0770); } } elsif ($caller eq "CSTR") { if (!-e "$pathinfo/temp") { mkdir("$pathinfo/temp",0770); } $tempdir = $pathinfo.'/temp'; } return $tempdir; } sub expand_zip { my ($tempdir,$filename) = @_; my $zipfile = "$tempdir/$filename"; if ($filename =~ m|\.zip$|i) { open(OUTPUT, "unzip -o $zipfile -d $tempdir 2> /dev/null |"); while () { print "$_
"; } close(OUTPUT); } else { return 'nozip'; } if ($filename =~ m|\.zip$|i) { unlink($zipfile); } return 'ok'; } sub process_manifest { my ($cms,$tempdir,$resources,$items,$hrefs,$resinfo) = @_; my %toc = ( bb5 => 'tableofcontents', angel => 'organization', ); my %contents = (); my @state = (); my $itm = ''; my $identifier = ''; my @seq = "Top"; my $lastitem; %{$$items{'Top'}} = ( contentscount => 0, resnum => 'toplevel', ); %{$$resources{'toplevel'}} = (); if ($cms eq 'angel') { $$resources{'toplevel'}{type} = "FOLDER"; } elsif ($cms eq 'bb5') { $$resources{'toplevel'}{type} = 'resource/x-bb-document'; } unless (-e "$tempdir/imsmanifest.xml") { return 'nomanifest'; } my $xmlfile = $tempdir.'/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 $toc{$cms}) ) { my $searchstr = "manifest organizations $toc{$cms}"; while ($num > 0) { $searchstr .= " item"; $num --; } if (("@state" eq $searchstr) && (@state > 3)) { $itm = $attr->{identifier}; %{$$items{$itm}} = (); $$items{$itm}{contentscount} = 0; if ($cms eq 'bb5') { $$items{$itm}{resnum} = $attr->{identifierref}; $$items{$itm}{title} = $attr->{title}; } elsif ($cms eq 'angel') { if ($attr->{identifierref} =~ m/^res(.+)$/) { $$items{$itm}{resnum} = $1; } } unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) { %{$$resources{$$items{$itm}{resnum}}} = (); } $$resources{$$items{$itm}{resnum}}{revitm} = $itm; if ($start > @seq) { unless ($lastitem eq '') { push @seq, $lastitem; unless ( defined($contents{$seq[-1]}) ) { @{$contents{$seq[-1]}} = (); } push @{$contents{$seq[-1]}},$itm; $$items{$itm}{parentseq} = $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]; } $$items{$itm}{filepath} = $path; if ($cms eq 'bb5') { if ($$items{$itm}{filepath} eq 'Top') { $$items{$itm}{resnum} = $itm; $$resources{$$items{$itm}{resnum}}{type} = 'resource/x-bb-document'; $$resources{$$items{$itm}{resnum}}{revitm} = $itm; $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true'; } } $$items{$seq[-1]}{contentscount} ++; $lastitem = $itm; } } elsif ("@state" eq "manifest resources resource" ) { $identifier = $attr->{identifier}; if ($cms eq 'bb5') { $$resources{$identifier}{file} = $attr->{file}; $$resources{$identifier}{type} = $attr->{type}; } elsif ($cms eq 'angel') { $identifier = substr($identifier,3); if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) { $$resources{$identifier}{file} = $1; } } @{$$hrefs{$identifier}} = (); } elsif ("@state" eq "manifest resources resource file") { if ($cms eq 'bb5') { push @{$$hrefs{$identifier}},$attr->{href}; } elsif ($cms eq 'angel') { if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) { push @{$$hrefs{$identifier}},$1; } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) { $$resources{$identifier}{type} = $1; } } } }, "tagname, attr"], text_h => [sub { my ($text) = @_; }, "dtext"], end_h => [sub { my ($tagname) = @_; pop @state; }, "tagname"], ); $p->parse_file($xmlfile); $p->eof; foreach my $itm (keys %contents) { @{$$items{$itm}{contents}} = @{$contents{$itm}}; } return 'ok' ; } sub target_resources { my ($resources,$oktypes,$targets) = @_; foreach my $key (keys %{$resources}) { if ( defined($$oktypes{$$resources{$key}{type}}) ) { push @{$targets}, $key; } } return; } sub copy_resources { my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$chome,$destdir,$timenow) = @_; if ($context eq 'DOCS') { foreach my $key (sort keys %{$hrefs}) { if (grep/^$key$/,@{$targets}) { %{$$url{$key}} = (); foreach my $file (@{$$hrefs{$key}}) { my $source = $tempdir.'/'.$key.'/'.$file; my $filename = ''; my $fpath = $timenow.'/resfiles/'.$key.'/'; if ($cms eq 'bb5') { if ($file =~ m-/-) { my @items = split/\//,$file; $filename = pop @items; $fpath .= join('/',@items); $fpath .= '/'; } else { $filename = $file; } &Apache::lonnet::userfileupload(undef,'1',$filename,$fpath,$source); } elsif ($cms eq 'angel') { $file =~ s-\\-/-g; unless ($file eq 'pg'.$key.'.htm') { if ($file =~ m-/-) { my @items = split/\//,$file; $filename = pop @items; $fpath = join('/',@items); $fpath .= '/'; } else { $filename = $file; } &Apache::lonnet::userfileupload(undef,'1',$filename,$fpath,$source); } } } } } } elsif ($context eq 'CSTR') { if (!-e "$destdir/resfiles") { mkdir("$destdir/resfiles",0770); } foreach my $key (sort keys %{$hrefs}) { foreach my $file (@{$$hrefs{$key}}) { $file =~ s-\\-/-g; if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') ) { if (!-e "$destdir/resfiles/$key") { mkdir("$destdir/resfiles/$key",0770); } my $filepath = $file; my $front = ''; while ($filepath =~ m-(\w+)/(.+)-) { $front .= $1.'/'; $filepath = $2; my $fulldir = "$destdir/resfiles/$key/$front"; chop($fulldir); if (!-e "$fulldir") { mkdir("$fulldir",0770); } } if ($cms eq 'angel') { rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file"); } elsif ($cms eq 'bb5') { rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file"); } } } } } } sub process_resinfo { my ($cms,$docroot,$destdir,$items,$resources,$boards,$announcements,$quizzes,$surveys,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles) = @_; my $board_id = time; my $board_count = 0; my $announce_handling = 'include'; my $longcrs = ''; if ($crs =~ m/^(\d)(\d)(\d)/) { $longcrs = $1.'/'.$2.'/'.$3.'/'.$crs; } if ($cms eq 'angel') { my $currboard = ''; foreach my $key (sort keys %{$resources}) { if ($$resources{$key}{type} eq "BOARD") { push @{$boards}, $key; $$boardnum{$$resources{$key}{revitm}} = $board_count; $currboard = $key; @{$$messages{$key}} = (); $$timestamp[$board_count] = $board_id; $board_id ++; $board_count ++; } elsif ($$resources{$key}{type} eq "MESSAGE") { push @{$$messages{$currboard}}, $key; } elsif ($$resources{$key}{type} eq "PAGE" || $$resources{$key}{type} eq "LINK") { %{$$resinfo{$key}} = (); &angel_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles); } elsif ($$resources{$key}{type} eq "QUIZ") { %{$$resinfo{$key}} = (); # &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles); } elsif ($$resources{$key}{type} eq "FORM") { %{$$resinfo{$key}} = (); # &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles); } elsif ($$resources{$key}{type} eq "DROPBOX") { %{$$resinfo{$key}} = (); } } } elsif ($cms eq 'bb5') { foreach my $key (sort keys %{$resources}) { if ($$resources{$key}{type} eq "resource/x-bb-document") { %{$$resinfo{$key}} = (); unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') { &process_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$resrcfiles); } } elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") { %{$$resinfo{$key}} = (); &process_staff($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles); } elsif ($$resources{$key}{type} eq "resource/x-bb-externallink") { %{$$resinfo{$key}} = (); &process_link($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles); } elsif ($$resources{$key}{type} eq "resource/x-bb-discussionboard") { %{$$resinfo{$key}} = (); unless ($db_handling eq 'ignore') { push @{$boards}, $key; $$timestamp[$board_count] = $board_id; &process_db($key,$docroot,$destdir,$board_id,$crs,$cdom,$db_handling,$uname,\%{$$resinfo{$key}},$longcrs); $board_id ++; $board_count ++; } } elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") { %{$$resinfo{$key}} = (); &process_assessment($key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname); } elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") { %{$$resinfo{$key}} = (); &process_assessment($key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname); push @{$quizzes}, $key; } elsif ($$resources{$key}{type} eq "assessment/x-bb-survey") { %{$$resinfo{$key}} = (); &process_assessment($key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname); push @{$surveys}, $key; } elsif ($$resources{$key}{type} eq "assessment/x-bb-group") { %{$$resinfo{$key}} = (); push @{$groups}, $key; &process_group($key,$docroot,$destdir,\%{$$resinfo{$key}}); } elsif ($$resources{$key}{type} eq "resource/x-bb-user") { %{$$resinfo{$key}} = (); unless ($user_handling eq 'ignore') { &process_user($key,$docroot,$destdir,\%{$$resinfo{$key}},$crs,$cdom,$user_handling); } } elsif ($$resources{$key}{type} eq "resource/x-bb-announcement") { unless ($announce_handling eq 'ignore') { push @{$announcements}, $key; %{$$resinfo{$key}} = (); &process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$items,$resinfo,$seqstem,$resrcfiles); } } } } $$total{'board'} = $board_count; if (@{$announcements}) { $$items{'Top'}{'contentscount'} ++; } if (@{$boards}) { $$items{'Top'}{'contentscount'} ++; } if (@{$quizzes}) { $$items{'Top'}{'contentscount'} ++; $$total{'quiz'} = @{$quizzes}; } if (@{$surveys}) { $$items{'Top'}{'contentscount'} ++; $$total{'surv'} = @{$surveys}; } } sub build_structure { my ($cms,$context,$destdir,$resinfo,$items,$resources,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames) = @_; my %flag = (); my %count = (); my %pagecontents = (); my %seqtext = (); my $topnum = 0; if (!-e "$destdir") { mkdir("$destdir",0755); } if (!-e "$destdir/sequences") { mkdir("$destdir/sequences",0770); } if (!-e "$destdir/resfiles") { mkdir("$destdir/resfiles",0770); } if (!-e "$destdir/pages") { mkdir("$destdir/pages",0770); } if (!-e "$destdir/problems") { mkdir("$destdir/problems",0770); } $seqtext{'Top'} = qq|\n|; %{$$resinfo{$$items{'Top'}{resnum}}} = ( isfolder => 'true', ); my $srcstem = ""; if ($context eq 'DOCS') { $srcstem = "/uploaded/$cdom/$crs/$timenow"; } elsif ($context eq 'CSTR') { $srcstem = "/res/$udom/$uname/$newdir"; } foreach my $key (sort keys %{$items}) { %{$flag{$key}} = ( page => 0, seq => 0, board => 0, file => 0, ); %{$count{$key}} = ( page => -1, seq => 0, board => 0, file => 0, ); my $src = ""; my $next_id = 2; my $curr_id = 1; my $resnum = $$items{$key}{resnum}; my $type = $$resources{$resnum}{type}; if (($cms eq 'angel' && $type eq "FOLDER") || ($cms eq 'bb5' && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") || ($type eq "resource/x-bb-staffinfo") || ($type eq "resource/x-bb-externallink")) ) { unless ($cms eq 'bb5' && $key eq 'Top') { $seqtext{$key} = "\n"; } if ($$items{$key}{contentscount} == 0) { $seqtext{$key} .= qq| \n|; } else { my $contcount = @{$$items{$key}{contents}}; my $contitem = $$items{$key}{contents}[0]; my $res = $$items{$contitem}{resnum}; my $type = $$resources{$res}{type}; my $title = $$items{$contitem}{title}; $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom); unless ($flag{$key}{page} == 1) { $seqtext{$key} .= qq| \n|; } else { if ($contcount > 2 ) { for (my $i=1; $i<$contcount-1; $i++) { my $contitem = $$items{$key}{contents}[$i]; my $res = $$items{$contitem}{resnum}; my $type = $$resources{$res}{type}; my $title = $$items{$contitem}{title}; $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom); unless ($flag{$key}{page} == 1) { $seqtext{$key} .= qq|> \n|; } else { $curr_id ++; $next_id ++; $seqtext{$key} .= qq|> \n|; } } } unless ($cms eq 'bb5' && $key eq 'Top') { $seqtext{$key} .= "\n"; open(LOCFILE,">$destdir/sequences/$key.sequence"); print LOCFILE $seqtext{$key}; close(LOCFILE); push @{$seqfiles}, "$key.sequence"; } $count{$key}{page} ++; $$total{page} += $count{$key}{page}; } $$total{seq} += $count{$key}{seq}; } $topnum += ($count{'Top'}{page} + $count{'Top'}{seq}); if ($cms eq 'bb5') { if (@{$announcements} > 0) { &process_specials($context,'announcements',$announcements,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames); } if (@{$boards} > 0) { &process_specials($context,'boards',$boards,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames); } if (@{$quizzes} > 0) { &process_specials($context,'quizzes',$quizzes,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames); } if (@{$surveys} > 0) { &process_specials($context,'surveys',$surveys,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames); } $seqtext{'Top'} .= "\n"; open(TOPFILE,">$destdir/sequences/Top.sequence"); print TOPFILE $seqtext{'Top'}; close(TOPFILE); push @{$seqfiles}, 'Top.sequence'; } my $filestem; if ($context eq 'DOCS') { $filestem = "/uploaded/$cdom/$crs"; } elsif ($context eq 'CSTR') { $filestem = "/res/$udom/$uname/$newdir"; } foreach my $key (sort keys %pagecontents) { for (my $i=0; $i<@{$pagecontents{$key}}; $i++) { 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/'.$$items{$pagecontents{$key}[$i][$j]}{resnum}.'.html'; print PAGEFILE qq| \n|; } my $final_id = @{$pagecontents{$key}[$i]}; print PAGEFILE qq|\n|; } print PAGEFILE ""; close(PAGEFILE); push @{$pagesfiles}, $key.'_'.$i.'.page'; } } } sub make_structure { my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom) = @_; my $src =''; if (($cms eq 'angel' && $type eq 'FOLDER') || ($cms eq 'bb5' && ($$resinfo{$res}{'isfolder'} eq 'true') || ($key eq 'Top')) ) { $src = $srcstem.'/sequences/'.$contitem.'.sequence'; $$flag{$key}{page} = 0; $$flag{$key}{seq} = 1; $$count{$key}{seq} ++; } elsif ($cms eq 'angel' && $type eq 'BOARD') { $src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard'; $$flag{$key}{page} = 0; $$flag{$key}{board} = 1; $$count{$key}{board} ++; } elsif ($cms eq 'angel' && $type eq "FILE") { foreach my $file (@{$$hrefs{$res}}) { unless ($file eq 'pg'.$res.'.htm') { $src = $srcstem.'/resfiles/'.$res.'/'.$file; } } $$flag{$key}{page} = 0; $$flag{$key}{file} = 1; } elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) ) { if ($$flag{$key}{page}) { if ($$count{key}{page} == -1) { print STDERR "Array index is -1, we shouldnt be here\n"; } else { push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem; } } else { $$count{$key}{page} ++; $src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page'; @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem"); $$flag{$key}{seq} = 0; } } elsif ($cms eq 'bb5') { if ($$flag{$key}{page}) { push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem; } else { $$count{$key}{page} ++; $src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page'; @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem"); $$flag{$key}{seq} = 0; } } return $src; } # ---------------------------------------------------------------- Process Blackboard specials - announcements, bulletin boards, quizzes and surveys sub process_specials { my ($context,$type,$specials,$topnum,$contentscount,$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,$seqtext,$pagesfiles,$seqfiles,$topurls,$topnames) = @_; my $src = ''; my $specialsrc = ''; my $nextnum = 0; my $seqstem = ''; if ($context eq 'CSTR') { $seqstem = '/res/'.$udom.'/'.$uname.'/'.$newdir; } elsif ($context eq 'DOCS') { $seqstem = '/uploaded/'.$cdom.'/'.$crs.'/'.$timenow; } 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"; } push @{$topurls}, $src; push @{$topnames}, $seqtitles{$type}; $$seqtext .= qq| \n|; if ($$topnum == $contentscount) { $$seqtext .= qq|\n|; } } else { if ($$topnum == $contentscount) { $$seqtext .= qq| type="finish">\n|; } else { $$seqtext .= qq|> \n|; } } if ($type eq "announcements") { push @{$pagesfiles}, "$seqnames{$type}.page"; open(ITEM,">$destdir/pages/$seqnames{$type}.page"); } else { push @{$seqfiles}, "$seqnames{$type}.sequence"; open(ITEM,">$destdir/sequences/$seqnames{$type}.sequence"); } if ($type eq 'boards') { $specialsrc = "/adm/$udom/$uname/$$timestamp[0]/bulletinboard"; } elsif ($type eq 'announcements') { $specialsrc = "$seqstem/resfiles/$$specials[0].html"; } else { $specialsrc = "$seqstem/pages/$$specials[0].page"; } print ITEM qq| |; if (@{$specials} == 1) { print ITEM qq| \n|; } else { for (my $i=1; $i<@{$specials}; $i++) { my $curr = $i+1; my $next = $i+2; if ($type eq 'boards') { $specialsrc = "/adm/$udom/$uname/$$timestamp[$i]/bulletinboard"; } elsif ($type eq 'announcements') { $specialsrc = "$seqstem/resfiles/$$specials[$i].html"; } else { $specialsrc = "$seqstem/pages/$$specials[$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.'/'.$res.".dat"; my $filecount = 0; my @state; my $userid = ''; my $linknum = 0; my $p = HTML::Parser->new ( xml_mode => 1, start_h => [sub { my ($tagname, $attr) = @_; push @state, $tagname; if (@state eq "USERS USER") { $userid = $attr->{value}; %{$$settings{$userid}} = (); @{$$settings{$userid}{links}} = (); } elsif (@state eq "USERS USER LOGINID") { $$settings{$userid}{loginid} = $attr->{value}; } elsif (@state eq "USERS USER PASSPHRASE") { $$settings{$userid}{passphrase} = $attr->{value}; } elsif ("@state" eq "USERS USER STUDENTID" ) { $$settings{$userid}{studentid} = $attr->{value}; } elsif ("@state" eq "USERS USER NAMES FAMILY" ) { $$settings{$userid}{family} = $attr->{value}; } elsif ("@state" eq "USERS USER NAMES GIVEN" ) { $$settings{$userid}{given} = $attr->{value}; } elsif ("@state" eq "USERS USER ADDRESSES BUSINESS DATA EMAIL") { $$settings{$userid}{email} = $attr->{value}; } elsif ("@state" eq "USERS USER USER_ROLE") { $$settings{$userid}{user_role} = $attr->{value}; } elsif ("@state" eq "USERS USER FLAGS ISAVAILABLE") { $$settings{$userid}{isavailable} = $attr->{value}; } elsif ("@state" eq "USERS USER PERSONALPAGE FILELIST IMAGE") { $$settings{$userid}{image} = $attr->{value}; } elsif ( ($state[-2] eq "LINKLIST") && ($state[-1] eq "LINK") ) { %{$$settings{$userid}{links}[$linknum]} = (); $$settings{$userid}{links}[$linknum]{url} = $attr->{value}; $linknum ++; } }, "tagname, attr"], text_h => [sub { my ($text) = @_; if ("@state" eq "USERS USER PERSONALPAGE TITLE") { $$settings{$userid}{title} = $text; } elsif ("@state" eq "USERS USER PERSONALPAGE DESCRIPTION") { $$settings{$userid}{description} = $text; } elsif (($state[-2] eq "LINK") && ($state[-1] eq "TITLE")) { $$settings{$userid}{links}[$linknum]{title} = $text; } elsif (($state[-3] eq "LINK") && ($state[-2] eq "DESCRIPTION") && ($state[-1] eq "TEXT")) { $$settings{$userid}{links}[$linknum]{text} = $text; } }, "dtext"], end_h => [sub { my ($tagname) = @_; if (@state eq "USERS USER") { $linknum = 0; } pop @state; }, "tagname"], ); $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"; my $filecount = 0; my @state; my $grp; my $p = HTML::Parser->new ( xml_mode => 1, start_h => [sub { my ($tagname, $attr) = @_; push @state, $tagname; if (@state eq "GROUPS GROUP") { $grp = $attr->{id}; } if (@state eq "GROUPS GROUP TITLE") { $$settings{$grp}{title} = $attr->{value}; } elsif (@state eq "GROUPS GROUP FLAGS ISAVAILABLE") { $$settings{$grp}{isavailable} = $attr->{value}; } elsif (@state eq "GROUPS GROUP FLAGS HASCHATROOM") { $$settings{$grp}{chat} = $attr->{value}; } elsif ("@state" eq "GROUPS GROUP FLAGS HASDISCUSSIONBOARD") { $$settings{$grp}{discussion} = $attr->{value}; } elsif ("@state" eq "GROUPS GROUP FLAGS HASTRANSFERAREA") { $$settings{$grp}{transfer} = $attr->{value}; } elsif ("@state" eq "GROUPS GROUP FLAGS ISPUBLIC") { $$settings{$grp}{public} = $attr->{value}; } }, "tagname, attr"], text_h => [sub { my ($text) = @_; if ("@state" eq "GROUPS DESCRIPTION") { $$settings{$grp}{description} = $text; # print "Staff text is $text\n"; } }, "dtext"], end_h => [sub { my ($tagname) = @_; pop @state; }, "tagname"], ); $p->unbroken_text(1); $p->parse_file($xmlfile); $p->eof; } # ---------------------------------------------------------------- Process Blackboard Staff sub process_staff { my ($res,$docroot,$dirname,$destdir,$settings,$resrcfiles) = @_; my $xmlfile = $docroot.'/'.$res.".dat"; my $filecount = 0; my @state; %{$$settings{name}} = (); %{$$settings{office}} = (); my $p = HTML::Parser->new ( xml_mode => 1, start_h => [sub { my ($tagname, $attr) = @_; push @state, $tagname; if (@state eq "STAFFINFO TITLE") { $$settings{title} = $attr->{value}; } 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 FLAGS ISAVAILABLE" ) { $$settings{isavailable} = $attr->{value}; } elsif ("@state" eq "STAFFINFO FLAGS ISFOLDER" ) { $$settings{isfolder} = $attr->{value}; } elsif ("@state" eq "STAFFINFO POSITION" ) { $$settings{position} = $attr->{value}; } elsif ("@state" eq "STAFFINFO HOMEPAGE" ) { $$settings{homepage} = $attr->{value}; } elsif ("@state" eq "STAFFINFO IMAGE") { $$settings{image} = $attr->{value}; } }, "tagname, attr"], text_h => [sub { my ($text) = @_; if ("@state" eq "STAFFINFO BIOGRAPHY TEXT") { $$settings{text} = $text; # print "Staff text is $text\n"; } elsif ("@state" eq "STAFFINFO CONTACT PHONE") { $$settings{phone} = $text; } elsif ("@state" eq "STAFFINFO CONTACT EMAIL") { $$settings{email} = $text; } elsif ("@state" eq "STAFFINFO CONTACT NAME FORMALTITLE") { $$settings{name}{formaltitle} = $text; } elsif ("@state" eq "STAFFINFO CONTACT NAME FAMILY") { $$settings{name}{family} = $text; } elsif ("@state" eq "STAFFINFO CONTACT NAME GIVEN") { $$settings{name}{given} = $text; } elsif ("@state" eq "STAFFINFO CONTACT OFFICE HOURS") { $$settings{office}{hours} = $text; } elsif ("@state" eq "STAFFINFO CONTACT OFFICE ADDRESS") { $$settings{office}{address} = $text; } }, "dtext"], end_h => [sub { my ($tagname) = @_; pop @state; }, "tagname"], ); $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"); push @{$resrcfiles}, "$res.html"; print FILE qq| $$settings{title} $staffentry |; close(FILE); } # ---------------------------------------------------------------- Process Blackboard Links sub process_link { my ($res,$docroot,$dirname,$destdir,$settings,$resrcfiles) = @_; my $xmlfile = $docroot.'/'.$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 "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}); } } if (defined($$settings{url}) ) { $linktag = qq|$$settings{title}|; } open(FILE,">$destdir/resfiles/$res.html"); push @{$resrcfiles}, "$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,$timestamp,$crs,$cdom,$handling,$uname,$settings,$longcrs) = @_; my $xmlfile = $docroot.'/'.$res.".dat"; my @state = (); my @allmsgs = (); my %msgidx = (); 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 ( 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}); } if (defined($$settings{fontcolor}) ) { $$settings{text} = "".$$settings{text}.""; } } 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); } } } } } # ---------------------------------------------------------------- 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,$total,$udom,$uname) = @_; my $xmlfile = $docroot.'/'.$res.".dat"; # print "XML file is $xmlfile\n"; 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' ); my $p = HTML::Parser->new ( xml_mode => 1, start_h => [sub { my ($tagname, $attr) = @_; push @state, $tagname; my $depth = 0; my @seq = (); my $class; my $state_str = join(" ",@state); if ($container eq "pool") { if ("@state" eq "POOL TITLE") { $$settings{title} = $attr->{value}; } } else { if ("@state" eq "ASSESSMENT TITLE") { $$settings{title} = $attr->{value}; } elsif ("@state" eq "ASSESSMENT FLAG" ) { $$settings{isnewline} = $attr->{value}; } elsif ("@state" eq "ASSESSMENT FLAGS ISAVAILABLE") { $$settings{isavailable} = $attr->{value}; } elsif ("@state" eq "ASSESSMENT FLAGS ISANONYMOUS" ) { $$settings{isanonymous} = $attr->{id}; } elsif ("@state" eq "ASSESSMENT FLAGS GIVE FEEDBACK" ) { $$settings{feedback} = $attr->{id}; } elsif ("@state" eq "ASSESSMENT FLAGS SHOWCORRECT" ) { $$settings{showcorrect} = $attr->{id}; } elsif ("@state" eq "ASSESSMENT FLAGS SHOWRESULTS" ) { $$settings{showresults} = $attr->{id}; } elsif ("@state" eq "ASSESSMENT FLAGS ALLOWMULTIPLE" ) { $$settings{allowmultiple} = $attr->{id}; } elsif ("@state" eq "ASSESSMENT ASSESSMENTTYPE" ) { $$settings{type} = $attr->{id}; } } if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") { $id = $attr->{id}; unless ($container eq 'pool') { push @allids, $id; } %{$$settings{$id}} = (); @{$allanswers{$id}} = (); $$settings{$id}{class} = $attr->{class}; unless ($container eq "pool") { $$settings{$id}{points} = $attr->{points}; } @{$$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") ) { 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}; } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "URL") ) { $$settings{$id}{url} = $attr->{value}; $$settings{$id}{name} = $attr->{name}; } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) { $answer_id = $attr->{id}; push @{$allanswers{$id}},$answer_id; %{$$settings{$id}{$answer_id}} = (); $$settings{$id}{$answer_id}{position} = $attr->{position}; if ($$settings{$id}{class} eq 'QUESTION_MATCH') { $$settings{$id}{$answer_id}{placement} = $attr->{placement}; $$settings{$id}{$answer_id}{type} = 'answer'; } } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) { $answer_id = $attr->{id}; push @{$allchoices{$id}},$answer_id; %{$$settings{$id}{$answer_id}} = (); $$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") ) { 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; my $type = $1; if ($type eq 'TRUEFALSE') { $$settings{$id}{$corr_answer}{answer_position} = $attr->{position}; } elsif ($type eq 'ORDER') { $$settings{$id}{$corr_answer}{order} = $attr->{order}; } elsif ($type eq 'MATCH') { $$settings{$id}{$corr_answer}{choice_id} = $attr->{choice_id}; } } }, "tagname, attr"], text_h => [sub { my ($text) = @_; unless ($container eq "pool") { if ("@state" eq "ASSESSMENT DESCRIPTION TEXT") { $$settings{description} = $text; } elsif ("@state" eq "ASSESSMENT INSTRUCTIONS ") { $$settings{instructions}{text} = $text; } } if ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "TEXT") ) { $$settings{$id}{text} = $text; } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "TEXT") ) { $$settings{$id}{$answer_id}{text} = $text; } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "TEXT") ) { $$settings{$id}{$answer_id}{text} = $text; } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_CORRECT") ) { $$settings{$id}{feedback_corr} = $text; } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_INCORRECT") ) { $$settings{$id}{feedback_incorr} = $text; } }, "dtext"], end_h => [sub { my ($tagname) = @_; pop @state; }, "tagname"], ); $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 = 1; unless ($container eq 'pool') { open(PAGEFILE,">$pagedir/$res.page"); print PAGEFILE qq| |; $$total{page} ++; print PAGEFILE qq||; if (@allids == 1) { print PAGEFILE qq| \n|; } else { 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); } foreach my $id (@allids) { my $output = qq| |; $$total{problem} ++; 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
|; } } 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| |; } 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| |; } 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| |; } 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}; } } $numans = ($max + $min)/2; $tol = 100*($max - $min)/($numans*2); } $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| |; } } } elsif ($$settings{$id}{class} eq "QUESTION_MATCH") { $output .= qq| |; for (my $k=0; $k<@{$allchoices{$id}}; $k++) { $output .= qq| $$settings{$id}{$allchoices{$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; } } # ---------------------------------------------------------------- Process Blackboard Announcements sub process_announce { my ($res,$docroot,$destdir,$settings,$items,$globalresref,$seqstem,$resrcfiles) = @_; my $xmlfile = $docroot.'/'.$res.".dat"; my @state = (); my @assess = (); my $id; my $p = HTML::Parser->new ( xml_mode => 1, start_h => [sub { my ($tagname, $attr) = @_; push @state, $tagname; if ("@state" eq "ANNOUNCEMENT TITLE") { $$settings{title} = $attr->{value}; $$settings{startassessment} = (); } 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 "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}} = (); push @assess,$id; } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT ATTRIB" ) { my $key = $attr->{key}; $$settings{startassessment}{$id}{$key} = $attr->{value}; } }, "tagname, attr"], text_h => [sub { my ($text) = @_; if ("@state" eq "ANNOUNCEMENT DESCRIPTION TEXT") { $$settings{text} = $text; } }, "dtext"], end_h => [sub { my ($tagname) = @_; 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}); } } 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"); push @{$resrcfiles}, "$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,$resrcfiles) = @_; my $xmlfile = $docroot.'/'.$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 { my ($tagname, $attr) = @_; push @state, $tagname; if (@state eq "CONTENT MAINDATA") { %{$$settings{maindata}} = (); } elsif (@state eq "CONTENT MAINDATA TEXTCOLOR") { $$settings{maindata}{color} = $attr->{value}; } elsif (@state eq "CONTENT MAINDATA FLAGS ISHTML") { $$settings{maindata}{ishtml} = $attr->{value}; } elsif (@state eq "CONTENT MAINDATA FLAGS ISNEWLINELITERAL") { $$settings{maindata}{isnewline} = $attr->{value}; } elsif ("@state" eq "CONTENT FLAGS ISAVAILABLE" ) { $$settings{isavailable} = $attr->{value}; } elsif ("@state" eq "CONTENT FLAGS ISFOLDER" ) { $$settings{isfolder} = $attr->{value}; } elsif ("@state" eq "CONTENT FLAGS LAUNCHINNEWWINDOW" ) { $$settings{newwindow} = $attr->{value}; } 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") { $$settings{files}[$filecount]{contenttype} = $attr->{value}; } elsif ("@state" eq "CONTENT FILES FILEREF FILEACTION") { $$settings{files}[$filecount]{fileaction} = $attr->{value}; } elsif ("@state" eq "CONTENT FILES FILEREF PACKAGEPARENT") { $$settings{files}[$filecount]{packageparent} = $attr->{value}; } elsif ("@state" eq "CONTENT FILES FILEREF LINKNAME") { $$settings{files}[$filecount]{linkname} = $attr->{value}; } elsif ("@state" eq "CONTENT FILES FILEREF REGISTRY REGISTRYENTRY") { my $key = $attr->{key}; $$settings{files}[$filecount]{registry}{$key} = $attr->{value}; } }, "tagname, attr"], text_h => [sub { my ($text) = @_; if ("@state" eq "CONTENT TITLE") { $$settings{title} = $text; } elsif ("@state" eq "CONTENT MAINDATA TEXT") { $$settings{maindata}{text} = $text; } elsif ("@state" eq "CONTENT FILES FILEREF REFTEXT") { $$settings{files}[$filecount]{reftext} = $text; } }, "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}//; # $$settings{maindata}{text} =~ s//$newtag/; # print STDERR $$settings{maindata}{text}; } } else { my $filename=$$settings{files}[$filecount]{'relfile'}; # print "File is $filename\n"; 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') { 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}); } } open(FILE,">$destdir/resfiles/$res.html"); push @{$resrcfiles}, "$res.html"; print FILE qq| $$settings{title} $fontcol |; 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| |; close(FILE); } sub process_angelboards { my ($context,$destdir,$boards,$timestamp,$crs,$cdom,$uname,$db_handling,$messages,$items,$resources,$hrefs,$tempdir,$longcrs) = @_; for (my $i=0; $i<@{$boards}; $i++) { my %msgidx = (); my $forumtext = ''; my $boardname = 'bulletinpage_'.$$timestamp[$i]; my $forumfile = $tempdir.'/_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' => $$items{$$resources{$$boards[$i]}{revitm}}{title}, 'bbb_content' => $forumtext, 'ccc_webreferences' => '', 'uploaded.lastmodified' => time, ); my $msgcount = 0; my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs); # print STDERR "putresult is $putresult for $boardname $cdom $crs\n"; if ($db_handling eq 'importall') { foreach my $msg_id (@{$$messages{$$boards[$i]}}) { $msgcount ++; $msgidx{$msg_id} = $msgcount; my %contrib = ( 'sendername' => 'NoName', 'senderdomain' => $cdom, 'screenname' => '', 'message' => $$items{$$resources{$msg_id}{revitm}}{title} ); unless ( $$items{$$resources{$msg_id}{revitm}}{parentseq} eq $$resources{$$boards[$i]}{revitm} ) { unless ( $msgidx{$$items{$$items{$$resources{$msg_id}{revitm}}{parentseq}}{resnum}} eq ''){ $contrib{replyto} = $msgidx{$$items{$$items{$$resources{$msg_id}{revitm}}{parentseq}}{resnum}}; } } if ( @{$$hrefs{$msg_id}} > 1 ) { my $newurl = ''; foreach my $file (@{$$hrefs{$msg_id}}) { unless ($file eq 'pg'.$msg_id.'.htm') { $newurl = $msg_id.$file; unless ($longcrs eq '') { if ($context eq 'CSTR') { 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") { rename("$destdir/resfiles/$msg_id/$file","/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl"); } } $contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$file; } } } } my $xmlfile = $tempdir.'/_assoc/'.$msg_id.'/'.$$resources{$msg_id}{file}; &angel_message($msg_id,\%contrib,$xmlfile); unless ($$resources{$msg_id}{file} eq '') { unlink($xmlfile); } my $symb = 'bulletin___'.$$timestamp[$i].'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$i].'/bulletinboard'; my $postresult = &addposting($symb,\%contrib,$cdom,$crs); } } } } # ---------------------------------------------------------------- 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; } # ---------------------------------------------------------------- ANGEL content sub angel_content { my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_; my $xmlfile = $docroot.'/_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; } } } open(FILE,">$destdir/resfiles/$res.html"); push @{$resrcfiles}, "$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); } 1; __END__