--- loncom/interface/lonfeedback.pm 2004/07/29 22:42:25 1.110 +++ loncom/interface/lonfeedback.pm 2004/08/17 14:27:19 1.116 @@ -1,7 +1,7 @@ # The LearningOnline Network # Feedback # -# $Id: lonfeedback.pm,v 1.110 2004/07/29 22:42:25 raeburn Exp $ +# $Id: lonfeedback.pm,v 1.116 2004/08/17 14:27:19 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -36,7 +36,9 @@ use Apache::loncommon(); use Apache::lontexconvert(); use Apache::lonlocal; # must not have () use Apache::lonhtmlcommon(); +use HTML::LCParser(); use Apache::lonspeller(); +use Cwd; sub discussion_open { my ($status)=@_; @@ -65,8 +67,12 @@ sub discussion_visible { sub list_discussion { my ($mode,$status,$symb)=@_; - my $outputtarget=$ENV{'form.grade_target'}; + if (defined($ENV{'form.export'})) { + if($ENV{'form.export'}) { + $outputtarget = 'export'; + } + } if (not &discussion_visible($status)) { return ''; } my @bgcols = ("#cccccc","#eeeeee"); my $discussiononly=0; @@ -96,12 +102,17 @@ sub list_discussion { # Get discussion display settings for this discussion my $lastkey = $ressymb.'_lastread'; my $showkey = $ressymb.'_showonlyunread'; + my $markkey = $ressymb.'_showonlyunmark', my $visitkey = $ressymb.'_visit'; my $ondispkey = $ressymb.'_markondisp'; my $userpickkey = $ressymb.'_userpick'; - my %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$lastkey,$showkey,$visitkey,$ondispkey,$userpickkey],$ENV{'user.domain'},$ENV{'user.name'}); + my $toggkey = $ressymb.'_readtoggle'; + my $readkey = $ressymb.'_read'; + + my %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$lastkey,$showkey,$markkey,$visitkey,$ondispkey,$userpickkey,$toggkey,$readkey],$ENV{'user.domain'},$ENV{'user.name'}); my %discinfo = (); my $showonlyunread = 0; + my $showunmark = 0; my $markondisp = 0; my $prevread = 0; my $previous = 0; @@ -176,6 +187,10 @@ sub list_discussion { $showonlyunread = $dischash{$showkey}; } + if (defined($dischash{$markkey})) { + $showunmark = $dischash{$markkey}; + } + if (defined($dischash{$visitkey})) { $visit = $dischash{$visitkey}; } @@ -187,15 +202,14 @@ sub list_discussion { my @discussionitems=(); my %shown = (); my @posteridentity=(); - my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + + my $current=0; my $visible=0; my @depth=(); - my @original=(); - my @index=(); - my @replies=(); + my @replies = (); my %alldiscussion=(); + my %imsitems=(); + my %imsfiles=(); my %notshown = (); my %newitem = (); my $maxdepth=0; @@ -205,335 +219,19 @@ sub list_discussion { $ENV{'environment.remote'} eq 'off' ) { $target='target="LONcom"'; } - + my $now = time; $discinfo{$visitkey} = $visit; &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); - - if ($contrib{'version'}) { - my $oldest = $contrib{'1:timestamp'}; - if ($prevread eq '0') { - $prevread = $oldest-1; - } - for (my $id=1;$id<=$contrib{'version'};$id++) { - my $idx=$id; - my $posttime = $contrib{$idx.':timestamp'}; - if ($prevread <= $posttime) { - $newpostsflag = 1; - } - my $hidden=($contrib{'hidden'}=~/\.$idx\./); - my $studenthidden=($contrib{'studenthidden'}=~/\.$idx\./); - my $deleted=($contrib{'deleted'}=~/\.$idx\./); - my $origindex='0.'; - my $numoldver=0; - if ($contrib{$idx.':replyto'}) { - if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) { -# this is a follow-up message - $original[$idx]=$original[$contrib{$idx.':replyto'}]; - $depth[$idx]=$depth[$contrib{$idx.':replyto'}]+1; - $origindex=$index[$contrib{$idx.':replyto'}]; - if ($depth[$idx]>$maxdepth) { $maxdepth=$depth[$idx]; } - } else { - $original[$idx]=0; - $depth[$idx]=0; - } - } else { -# this is an original message - $original[$idx]=0; - $depth[$idx]=0; - } - if ($replies[$depth[$idx]]) { - $replies[$depth[$idx]]++; - } else { - $replies[$depth[$idx]]=1; - } - unless ((($hidden) && (!$seeid)) || ($deleted)) { - $visible++; - if ($contrib{$idx.':history'}) { - if ($contrib{$idx.':history'} =~ /:/) { - my @oldversions = split/:/,$contrib{$idx.':history'}; - $numoldver = @oldversions; - } else { - $numoldver = 1; - } - } - my ($message,$subject); - if ($idx > 0) { - if ($contrib{$idx.':message'} =~ /.*::::\Q$numoldver\E::::(.+?)$/si) { - $message = $1; - } else { - $message = $contrib{$idx.':message'}; - } - } else { - $message=$contrib{$idx.':message'}; - } - my $attachmenturls = $contrib{$idx.':attachmenturl'}; - $message=~s/\n/\
/g; - $message=&Apache::lontexconvert::msgtexconverted($message); - if ($idx > 0) { - if ($contrib{$idx.':subject'} =~ /.*::::\Q$numoldver\E::::(.+?)$/si) { - $subject = $1; - } else { - $subject = $contrib{$idx.':subject'}; - } - } else { - $subject=$contrib{$idx.':subject'}; - } - if (defined($subject)) { - $subject=~s/\n/\
/g; - $subject=&Apache::lontexconvert::msgtexconverted($subject); - } - if ($attachmenturls) { - my @attachments = (); - my %currattach = (); - &extract_attachments($attachmenturls,$idx,$numoldver,\$message,\@attachments,\%currattach); - } - if ($message) { - if ($hidden) { - $message=''.$message.''; - if ($studenthidden) { - $message .='

Deleted by poster (student).'; - } - } - my $screenname=&Apache::loncommon::screenname( - $contrib{$idx.':sendername'}, - $contrib{$idx.':senderdomain'}); - my $plainname=&Apache::loncommon::nickname( - $contrib{$idx.':sendername'}, - $contrib{$idx.':senderdomain'}); - - my $sender=&mt('Anonymous'); -# Set up for sorting by subject - if ($contrib{$idx.':subject'} eq '') { - if (defined($subjectsort{'__No subject'})) { - push @{$subjectsort{'__No subject'}}, $idx; - } else { - @{$subjectsort{'__No subject'}} = ("$idx"); - } - } else { - if (defined($subjectsort{$contrib{$idx.':subject'}})) { - push @{$subjectsort{$contrib{$idx.':subject'}}}, $idx; - } else { - @{$subjectsort{$contrib{$idx.':subject'}}} = ("$idx"); - } - } - if ((!$contrib{$idx.':anonymous'}) || ($seeid)) { - $sender=&Apache::loncommon::aboutmewrapper( - $plainname, - $contrib{$idx.':sendername'}, - $contrib{$idx.':senderdomain'}).' ('. - $contrib{$idx.':sendername'}.' at '. - $contrib{$idx.':senderdomain'}.')'; - if ($contrib{$idx.':anonymous'}) { - $sender.=' ['.&mt('anonymous').'] '. - $screenname; - } -# Set up for sorting by domain, then username - unless (defined($usernamesort{$contrib{$idx.':senderdomain'}})) { - %{$usernamesort{$contrib{$idx.':senderdomain'}}} = (); - } - if (defined($usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}})) { - push @{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}}, $idx; - } else { - @{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}} = ("$idx"); - } -# Set up for sorting by last name, then first name - my %names = &Apache::lonnet::get('environment',['firstname','lastname'], - $contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'}); - my $lastname = $names{'lastname'}; - my $firstname = $names{'firstname'}; - if ($lastname eq '') { - $lastname = '_'; - } - if ($firstname eq '') { - $firstname = '_'; - } - unless (defined($namesort{$lastname})) { - %{$namesort{$lastname}} = (); - } - if (defined($namesort{$lastname}{$firstname})) { - push @{$namesort{$lastname}{$firstname}}, $idx; - } else { - @{$namesort{$lastname}{$firstname}} = ("$idx"); - } - if ($ENV{"course.$cid.allow_discussion_post_editing"} =~ m/yes/i) { - if (($ENV{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($ENV{'user.name'} eq $contrib{$idx.':sendername'})) { - $sender.=' '.&mt('Edit').''; unless ($seeid) { - $sender.=" '; - } - } - } - if ($seeid) { - if ($hidden) { - unless ($studenthidden) { - $sender.=' '.&mt('Make Visible').''; - } - } else { - $sender.=' '.&mt('Hide').''; - } - $sender.=' '.&mt('Delete').''; - } - } else { - if ($screenname) { - $sender=''.$screenname.''; - } -# Set up for sorting by domain, then username for anonymous - unless (defined($usernamesort{'__anon'})) { - %{$usernamesort{'__anon'}} = (); - } - if (defined($usernamesort{'__anon'}{'__anon'})) { - push @{$usernamesort{'__anon'}{'__anon'}}, $idx; - } else { - @{$usernamesort{'__anon'}{'__anon'}} = ("$idx"); - } -# Set up for sorting by last name, then first name for anonymous - unless (defined($namesort{'__anon'})) { - %{$namesort{'__anon'}} = (); - } - if (defined($namesort{'__anon'}{'__anon'})) { - push @{$namesort{'__anon'}{'__anon'}}, $idx; - } else { - @{$namesort{'__anon'}{'__anon'}} = ("$idx"); - } - } - if (&discussion_open($status) && - &Apache::lonnet::allowed('pch', - $ENV{'request.course.id'}. - ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { - $sender.=' '.&mt('Reply').''; - } - my $vgrlink; - if ($viewgrades) { - $vgrlink=&Apache::loncommon::submlink('Submissions', - $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb); - } -#figure out at what position this needs to print - my $thisindex=$idx; - if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) { - $thisindex=$origindex.substr('00'.$replies[$depth[$idx]],-2,2); - } - $alldiscussion{$thisindex}=$idx; - $shown{$idx} = 0; - $index[$idx]=$thisindex; - my $spansize = 2; - if ($showonlyunread && $prevread > $posttime) { - $notshown{$idx} = 1; - } else { -# apply filters - my $uname = $contrib{$idx.':sendername'}; - my $udom = $contrib{$idx.':senderdomain'}; - my $poster = $uname.':'.$udom; - my $rolematch = ''; - my $skiptest = 1; - if ($totposters > 0) { - if (grep/^$poster$/,@posters) { - $shown{$idx} = 1; - } - } else { - if ($rolefilter) { - if ($rolefilter eq 'all') { - $rolematch = '([^:]+)'; - } else { - $rolematch = $rolefilter; - $skiptest = 0; - } - } - if ($sectionpick) { - if ($sectionpick eq 'all') { - $rolematch .= ':([^:]*)'; - } else { - $rolematch .= ':'.$sectionpick; - $skiptest = 0; - } - } - if ($statusfilter) { - if ($statusfilter eq 'all') { - $rolematch .= ':([^:]+)'; - } else { - $rolematch .= ':'.$statusfilter; - $skiptest = 0; - } - } - if ($skiptest) { - $shown{$idx} = 1; - } else { - foreach my $role (@{$roleinfo{$poster}}) { - if ($role =~ m/^$rolematch$/) { - $shown{$idx} = 1; - last; - } - } - } - } - } - unless ($notshown{$idx} == 1) { - if ($prevread > 0 && $prevread <= $posttime) { - $newitem{$idx} = 1; - $discussionitems[$idx] .= ' -

- '; - } else { - $newitem{$idx} = 0; - $discussionitems[$idx] .= ' -

NEW
- '; - } - $discussionitems[$idx] .= ''. - '
   '. - ''.$subject.'  '. - $sender.' '.$vgrlink.' ('. - &Apache::lonlocal::locallocaltime($posttime).')

'.$message.'

'; - if ($contrib{$idx.':history'}) { - my @postversions = (); - $discussionitems[$idx] .= '
'.&mt('This post has been edited by the author.'); - if ($seeid) { - $discussionitems[$idx] .= '  '.&mt('Display all versions').''; - } - $discussionitems[$idx].='
'.&mt('Earlier version(s) were posted on: '); - if ($contrib{$idx.':history'} =~ m/:/) { - @postversions = split/:/,$contrib{$idx.':history'}; - } else { - @postversions = ("$contrib{$idx.':history'}"); - } - for (my $i=0; $i<@postversions; $i++) { - my $version = $i+1; - $discussionitems[$idx] .= ''.$version.'. - '.&Apache::lonlocal::locallocaltime($postversions[$i]).' '; - } - } - } - } - } - } - } + &build_posting_display(\%usernamesort,\%subjectsort,\%namesort,\%notshown,\%newitem,\%dischash,\%shown,\%alldiscussion,\%imsitems,\%imsfiles,\%roleinfo,\@discussionitems,\@replies,\@depth,\@posters,\$maxdepth,\$visible,\$newpostsflag,\$current,$status,$viewgrades,$seeid,$prevread,$sortposts,$ressymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,$rolefilter,$sectionpick,$statusfilter,$toggkey,$outputtarget); my $discussion=''; + my $manifestfile; + my $manifestok=0; + my $tempexport; + my $imsresources; + my $copyresult; my $function = &Apache::loncommon::get_users_function(); my $color = &Apache::loncommon::designparm($function.'.tabbg', @@ -542,22 +240,31 @@ sub list_discussion { 'cuse' => 'Current discussion settings', 'allposts' => 'All posts', 'unread' => 'New posts only', + 'unmark' => 'Unread only', 'ondisp' => 'Once displayed', - 'onmark' => 'Once marked read', + 'onmark' => 'Once marked not NEW', + 'toggoff' => 'Off', + 'toggon' => 'On', 'disa' => 'Posts to be displayed', 'npce' => 'Posts cease to be marked "NEW"', + 'epcb' => 'Each post can be toggled read/unread', 'chgt' => 'Change', 'disp' => 'Display', 'nolo' => 'Not new', + 'togg' => 'Toggle read/unread', ); my $currdisp = $lt{'allposts'}; my $currmark = $lt{'onmark'}; + my $currtogg = $lt{'toggoff'}; my $dispchange = $lt{'unread'}; my $markchange = $lt{'ondisp'}; + my $toggchange = $lt{'toggon'}; my $chglink = '/adm/feedback?modifydisp='.$ressymb; - my $displink = 'onlyunread'; + my $displinkA = 'onlyunread'; + my $displinkB = 'onlyunmark'; my $marklink = 'markondisp'; + my $togglink = 'toggon'; if ($markondisp) { $currmark = $lt{'ondisp'}; @@ -568,10 +275,24 @@ sub list_discussion { if ($showonlyunread) { $currdisp = $lt{'unread'}; $dispchange = $lt{'allposts'}; - $displink = 'allposts'; + $displinkA = 'allposts'; + } + + if ($showunmark) { + $currdisp = $lt{'unmark'}; + $dispchange = $lt{'unmark'}; + $displinkA='allposts'; + $displinkB='onlyunread'; + $showonlyunread = 0; } + + if ($dischash{$toggkey}) { + $currtogg = $lt{'toggon'}; + $toggchange = $lt{'toggoff'}; + $togglink = 'toggoff'; + } - $chglink .= '&changes='.$displink.'_'.$marklink; + $chglink .= '&changes='.$displinkA.'_'.$displinkB.'_'.$marklink.'_'.$togglink; if ($newpostsflag) { $chglink .= '&previous='.$prevread; @@ -579,7 +300,46 @@ sub list_discussion { if ($visible) { # Print the discusssion - if ($outputtarget ne 'tex') { + if ($outputtarget eq 'tex') { + $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'. + '\textbf{DISCUSSIONS}\makebox[2 cm][b]{\hrulefill}'. + '\vskip 0 mm\noindent\textbf{'.$lt{'cuse'}.'}:\vskip 0 mm'. + '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'. + '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}'; + } elsif ($outputtarget eq 'export') { +# Create temporary directory if this is an export + my $now = time; + $tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports'; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } + $tempexport .= '/'.$now; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } + $tempexport .= '/'.$ENV{'user.domain'}.'_'.$ENV{'user.name'}; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } +# open manifest file + my $manifest = '/imsmanifest.xml'; + my $manifestfilename = $tempexport.$manifest; + print STDERR "manifestfilename is $manifestfilename\n"; + if ($manifestfile = Apache::File->new('>'.$manifestfilename)) { + $manifestok=1; + print $manifestfile qq| + + + + + Discussion for $ressymb\n|; + } else { + $discussion .= 'An error occurred opening the manifest file.
'; + } + } else { my $colspan=$maxdepth+1; $discussion.= qq| |; - $discussion.=''; + $discussion.='
'; $discussion .=''; - } else { - $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'. - '\textbf{DISCUSSIONS}\makebox[2 cm][b]{\hrulefill}'. - '\vskip 0 mm\noindent\textbf{'.$lt{'cuse'}.'}:\vskip 0 mm'. - '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'. - '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}'; - } - my $numhidden = keys %notshown; - if ($numhidden > 0) { - my $colspan = $maxdepth+1; - $discussion.="\n".''; } - $discussion .= '">'.&mt('Show all posts').' '.&mt('to display').' '. - $numhidden.' '.&mt('previously viewed posts'). - '
'; } # Choose sort mechanism @@ -679,28 +439,24 @@ sub list_discussion { $sortposts = 'ascdate'; @showposts = (sort { $a <=> $b } keys %alldiscussion); } + my $currdepth = 0; + my $firstidx = $alldiscussion{$showposts[0]}; foreach (@showposts) { - unless (($sortposts eq 'thread') || ($sortposts eq 'ascdate' && $ENV{'environment.threadeddiscussion'})) { + unless (($sortposts eq 'thread') || ($sortposts eq 'ascdate' && $ENV{'environment.threadeddiscussion'}) || ($outputtarget eq 'export')) { $alldiscussion{$_} = $_; } unless ( ($notshown{$alldiscussion{$_}} eq '1') || ($shown{$alldiscussion{$_}} == 0) ) { - if ($outputtarget ne 'tex') { + unless ($outputtarget eq 'tex' && $outputtarget eq 'export') { $discussion.="\n"; - } else { - $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'; } my $thisdepth=$depth[$alldiscussion{$_}]; - if ($outputtarget ne 'tex') { + unless ($outputtarget eq 'tex' || $outputtarget eq 'export') { for (1..$thisdepth) { $discussion.=''; } } my $colspan=$maxdepth-$thisdepth+1; - if ($outputtarget ne 'tex') { - $discussion.=''; - } else { + if ($outputtarget eq 'tex') { #cleanup block $discussionitems[$alldiscussion{$_}]=~s/]*)>/
'. ''; if ($visible>2) { @@ -625,7 +385,7 @@ sub list_discussion { $discussion .= '">'.&mt('Export').'?  '; if ($newpostsflag) { if (!$markondisp) { - $discussion .=''; } @@ -633,24 +393,24 @@ sub list_discussion { $discussion .= ''; } $discussion .= '
'.&mt('Mark new posts as read').'  '; + $discussion .=''.&mt('Mark NEW posts no longer new').'  '; } else { $discussion .= '  
'. + + my $numhidden = keys %notshown; + if ($numhidden > 0) { + my $colspan = $maxdepth+1; + $discussion.="\n".'
'. ''.&mt('Show all posts').' '.&mt('to display').' '. + $numhidden.' '; + if ($showunmark) { + $discussion .= &mt('posts previously marked read'); + } else { + $discussion .= &mt('previously viewed posts'); + } + $discussion .= '
   '. - $discussionitems[$alldiscussion{$_}]. - '
/; $discussionitems[$alldiscussion{$_}]=~s/]*)>]*)>/'; + } } } - if ($outputtarget ne 'tex') { + unless ($outputtarget eq 'tex' || $outputtarget eq 'export') { my $colspan=$maxdepth+1; - $discussion .= < +END + if ($dischash{$toggkey}) { + my $storebutton = &mt('Store read/unread changes'); + $discussion.=''; + } + $discussion .= (<
/; @@ -711,19 +467,51 @@ sub list_discussion { $discussionitems[$alldiscussion{$_}]=~s/<\/td>]*)>/$threadinsert<\/td>/; $discussionitems[$alldiscussion{$_}]=~s/]+)>(Edit|Hide|Delete|Reply|Submissions)<\/a>//g; $discussionitems[$alldiscussion{$_}]=~s/(|<\/b>|<\/a>|]+)>)//g; - - #FIXME xmlparse can't be safely called from inside xmlparse - # due to the global variables that are use, the safe - # space etc. I expect this has unforseen issues that - # need resolving. - - $discussion.=&Apache::lonxml::xmlparse('','tex',$discussionitems[$alldiscussion{$_}]); - } + + $discussionitems[$alldiscussion{$_}]='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.$discussionitems[$alldiscussion{$_}]; + $discussion.=$discussionitems[$alldiscussion{$_}]; + } elsif ($outputtarget eq 'export') { + my $postfilename = $alldiscussion{$_}.'-'.$imsitems{$alldiscussion{$_}}{'timestamp'}.'.html'; + if ($manifestok) { + if (($depth[$alldiscussion{$_}] <= $currdepth) && ($alldiscussion{$_} != $firstidx)) { + print STDERR "depth is $depth[$alldiscussion{$_}], currdepth is $currdepth, idx is $alldiscussion{$_}, firstidx is $firstidx\n"; + print $manifestfile ' '."\n"; + } + $currdepth = $depth[$alldiscussion{$_}]; + print $manifestfile "\n". + ''. + ''.$imsitems{$alldiscussion{$_}}{'title'}.''; + $imsresources .= "\n". + ''. + ''."\n". + $imsfiles{$alldiscussion{$_}}{$imsitems{$alldiscussion{$_}}{'currversion'}}."\n". + ''; + } + my $postingfile; + my $postingfilename = $tempexport.'/'.$postfilename; + if ($postingfile = Apache::File->new('>'.$postingfilename)) { + print $postingfile 'Discussion Post'. + $imsitems{$alldiscussion{$_}}{'title'}.' '. + $imsitems{$alldiscussion{$_}}{'sender'}. + $imsitems{$alldiscussion{$_}}{'timestamp'}.'

'. + $imsitems{$alldiscussion{$_}}{'message'}.'
'. + $imsitems{$alldiscussion{$_}}{'attach'}.''."\n"; + close($postingfile); + } else { + $discussion .= 'An error occurred opening the export file for posting '.$alldiscussion{$_}.'
'; + } + $copyresult.=&replicate_attachments($imsitems{$alldiscussion{$_}}{'allattachments'},$tempexport); + } else { + $discussion.='		'. $discussionitems[$alldiscussion{$_}]. + '
@@ -734,29 +522,91 @@ sub list_discussion { + '; + '1. '.$lt{'disp'}.' - '.$currdisp.'  2. '.$lt{'nolo'}.' - '.$currmark.''; + if ($dischash{$toggkey}) { + $discussion .= '  3. '.$lt{'togg'}.' - '.$currtogg.''; + } } else { - $discussion .= - ''; + if ($dischash{$toggkey}) { + $discussion .= '1. '.$lt{'disp'}.' - '.$currdisp.' 2. '.$lt{'togg'}.' - '.$currtogg.''; + } else { + $discussion .= + $lt{'disp'}.' - '.$currdisp.''; + } } $discussion .= < + $lt{'chgt'}? +
$lt{'cuse'}:   END if ($newpostsflag) { $discussion .= - '1. '.$lt{'disp'}.' - '.$currdisp.'  2. '.$lt{'nolo'}.' - '.$currmark.''.$lt{'disp'}.' - '.$currdisp.'  - $lt{'chgt'}?
'. + ''."\n". + ''."\n". + '
-

+

END - } + } + if ($outputtarget eq 'export') { + if ($manifestok) { + while ($currdepth > 0) { + print $manifestfile " \n"; + $currdepth --; + } + print $manifestfile qq| + + + + $imsresources + + + |; + close($manifestfile); + +#Create zip file in prtspool + + my $imszipfile = '/prtspool/'. + $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. + time.'_'.rand(1000000000).'.zip'; + # zip can cause an sh launch which can pass along all of %ENV + # which can be too large for /bin/sh to handle + my %oldENV=%ENV; + undef(%ENV); + my $cwd = &getcwd(); + my $imszip = '/home/httpd/'.$imszipfile; + chdir $tempexport; + open(OUTPUT, "zip -r $imszip * 2> /dev/null |"); + close(OUTPUT); + chdir $cwd; + %ENV=%oldENV; + undef(%oldENV); + $discussion .= 'Download the zip file from Discussion Posting Archive
'; + if ($copyresult) { + $discussion .= 'The following errors occurred during export - '.$copyresult; + } + } else { + $discussion .= '
Unfortunately you will not be able to retrieve an archive of the discussion posts at this time, because there was a problem creating a manifest file.
'; + } + return $discussion; + } } if ($discussiononly) { my $now = time; @@ -815,7 +665,7 @@ ENDDISCUSS $discussion.=$newattachmsg; $discussion.=&generate_preview_button(); } - } else { + } else { if (&discussion_open($status) && &Apache::lonnet::allowed('pch', $ENV{'request.course.id'}. @@ -828,7 +678,493 @@ ENDDISCUSS } } } - return $discussion; + return $discussion; +} + +sub build_posting_display { + my ($usernamesort,$subjectsort,$namesort,$notshown,$newitem,$dischash,$shown,$alldiscussion,$imsitems,$imsfiles,$roleinfo,$discussionitems,$replies,$depth,$posters,$maxdepth,$visible,$newpostsflag,$current,$status,$viewgrades,$seeid,$prevread,$sortposts,$ressymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,$rolefilter,$sectionpick,$statusfilter,$toggkey,$outputtarget) = @_; + + my @original=(); + my @index=(); + + my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + + if ($contrib{'version'}) { + my $oldest = $contrib{'1:timestamp'}; + if ($prevread eq '0') { + $prevread = $oldest-1; + } + for (my $id=1;$id<=$contrib{'version'};$id++) { + my $idx=$id; + my $posttime = $contrib{$idx.':timestamp'}; + if ($prevread <= $posttime) { + $$newpostsflag = 1; + } + my $hidden=($contrib{'hidden'}=~/\.$idx\./); + my $studenthidden=($contrib{'studenthidden'}=~/\.$idx\./); + my $deleted=($contrib{'deleted'}=~/\.$idx\./); + my $origindex='0.'; + my $numoldver=0; + if ($contrib{$idx.':replyto'}) { + if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread') || ($outputtarget eq 'export')) { +# this is a follow-up message + $original[$idx]=$original[$contrib{$idx.':replyto'}]; + $$depth[$idx]=$$depth[$contrib{$idx.':replyto'}]+1; + $origindex=$index[$contrib{$idx.':replyto'}]; + if ($$depth[$idx]>$$maxdepth) { $$maxdepth=$$depth[$idx]; } + } else { + $original[$idx]=0; + $$depth[$idx]=0; + } + } else { +# this is an original message + $original[$idx]=0; + $$depth[$idx]=0; + } + if ($$replies[$$depth[$idx]]) { + $$replies[$$depth[$idx]]++; + } else { + $$replies[$$depth[$idx]]=1; + } + unless ((($hidden) && (!$seeid)) || ($deleted)) { + $$visible++; + if ($contrib{$idx.':history'}) { + if ($contrib{$idx.':history'} =~ /:/) { + my @oldversions = split/:/,$contrib{$idx.':history'}; + $numoldver = @oldversions; + } else { + $numoldver = 1; + } + } + $$current = $numoldver; + my %messages = (); + my %subjects = (); + my %attachtxt = (); + my %allattachments = (); + my ($screenname,$plainname); + my $sender = &mt('Anonymous'); + my ($message,$subject,$vgrlink,$ctlink); + &get_post_contents(\%contrib,$idx,$seeid,$outputtarget,\%messages,\%subjects,\%allattachments,\%attachtxt,$imsfiles,\$screenname,\$plainname,$numoldver); + + +# Set up for sorting by subject + unless ($outputtarget eq 'export') { + $message=$messages{$numoldver}; + $message.=$attachtxt{$numoldver}; + $subject=$subjects{$numoldver}; + if ($message) { + if ($hidden) { + $message=''.$message.''; + if ($studenthidden) { + $message .='

Deleted by poster (student).'; + } + } + + if ($subject eq '') { + if (defined($$subjectsort{'__No subject'})) { + push @{$$subjectsort{'__No subject'}}, $idx; + } else { + @{$$subjectsort{'__No subject'}} = ("$idx"); + } + } else { + if (defined($$subjectsort{$subject})) { + push @{$$subjectsort{$subject}}, $idx; + } else { + @{$$subjectsort{$subject}} = ("$idx"); + } + } + if ((!$contrib{$idx.':anonymous'}) || ($seeid)) { + $sender=&Apache::loncommon::aboutmewrapper( + $plainname, + $contrib{$idx.':sendername'}, + $contrib{$idx.':senderdomain'}).' ('. + $contrib{$idx.':sendername'}.' at '. + $contrib{$idx.':senderdomain'}.')'; + if ($contrib{$idx.':anonymous'}) { + $sender.=' ['.&mt('anonymous').'] '. + $screenname; + } + +# Set up for sorting by domain, then username + unless (defined($$usernamesort{$contrib{$idx.':senderdomain'}})) { + %{$$usernamesort{$contrib{$idx.':senderdomain'}}} = (); + } + if (defined($$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}})) { + push @{$$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}}, $idx; + } else { + @{$$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}} = ("$idx"); + } +# Set up for sorting by last name, then first name + my %names = &Apache::lonnet::get('environment', + ['firstname','lastname'],$contrib{$idx.':senderdomain'}, + ,$contrib{$idx.':sendername'}); + my $lastname = $names{'lastname'}; + my $firstname = $names{'firstname'}; + if ($lastname eq '') { + $lastname = '_'; + } + if ($firstname eq '') { + $firstname = '_'; + } + unless (defined($$namesort{$lastname})) { + %{$$namesort{$lastname}} = (); + } + if (defined($$namesort{$lastname}{$firstname})) { + push @{$$namesort{$lastname}{$firstname}}, $idx; + } else { + @{$$namesort{$lastname}{$firstname}} = ("$idx"); + } + if ($ENV{'course.'.$ENV{'request.course.id'}.'.allow_discussion_post_editing'} =~ m/yes/i) { + if (($ENV{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($ENV{'user.name'} eq $contrib{$idx.':sendername'})) { + $sender.=' '.&mt('Edit').''; + unless ($seeid) { + $sender.=" '; + } + } + } + if ($seeid) { + if ($hidden) { + unless ($studenthidden) { + $sender.=' '.&mt('Make Visible').''; + } + } else { + $sender.=' '.&mt('Hide').''; + } + $sender.=' '.&mt('Delete').''; + } + } else { + if ($screenname) { + $sender=''.$screenname.''; + } +# Set up for sorting by domain, then username for anonymous + unless (defined($$usernamesort{'__anon'})) { + %{$$usernamesort{'__anon'}} = (); + } + if (defined($$usernamesort{'__anon'}{'__anon'})) { + push @{$$usernamesort{'__anon'}{'__anon'}}, $idx; + } else { + @{$$usernamesort{'__anon'}{'__anon'}} = ("$idx"); + } +# Set up for sorting by last name, then first name for anonymous + unless (defined($$namesort{'__anon'})) { + %{$$namesort{'__anon'}} = (); + } + if (defined($$namesort{'__anon'}{'__anon'})) { + push @{$$namesort{'__anon'}{'__anon'}}, $idx; + } else { + @{$$namesort{'__anon'}{'__anon'}} = ("$idx"); + } + } + if (&discussion_open($status) && + &Apache::lonnet::allowed('pch', + $ENV{'request.course.id'}. + ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { + $sender.=' '.&mt('Reply').''; + } + if ($viewgrades) { + $vgrlink=&Apache::loncommon::submlink('Submissions', + $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$ressymb); + } + if ($$dischash{$readkey}=~/\.$idx\./) { + $ctlink = ''.&mt('Mark unread').'? '; + } else { + $ctlink = ''.&mt('Mark read').'? '; + } + } +#figure out at what position this needs to print + } + if ($outputtarget eq 'export' || $message) { + my $thisindex=$idx; + if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread') || ($outputtarget eq 'export')) { + $thisindex=$origindex.substr('00'.$$replies[$$depth[$idx]],-2,2); + } + $$alldiscussion{$thisindex}=$idx; + $$shown{$idx} = 0; + $index[$idx]=$thisindex; + } + if ($outputtarget eq 'export') { + %{$$imsitems{$idx}} = (); + $$imsitems{$idx}{'isvisible'}='true'; + if ($hidden) { + $$imsitems{$idx}{'isvisible'}='false'; + } + $$imsitems{$idx}{'title'}=$subjects{$numoldver}; + $$imsitems{$idx}{'message'}=$messages{$numoldver}; + $$imsitems{$idx}{'attach'}=$attachtxt{$numoldver}; + $$imsitems{$idx}{'timestamp'}=$contrib{$idx.':timestamp'}; + $$imsitems{$idx}{'sender'}=$plainname.' ('. + $contrib{$idx.':sendername'}.' at '. + $contrib{$idx.':senderdomain'}.')'; + $$imsitems{$idx}{'isanonymous'}='false'; + if ($contrib{$idx.':anonymous'}) { + $$imsitems{$idx}{'isanonymous'}='true'; + } + $$imsitems{$idx}{'currversion'}=$numoldver; + %{$$imsitems{$idx}{'allattachments'}}=%allattachments; + unless ($messages{$numoldver} eq '' && $attachtxt{$numoldver} eq '') { + $$shown{$idx} = 1; + } + } else { + if ($message) { + my $spansize = 2; + if ($showonlyunread && $prevread > $posttime) { + $$notshown{$idx} = 1; + } elsif ($showunmark && $$dischash{$readkey}=~/\.$idx\./) { + $$notshown{$idx} = 1; + } else { +# apply filters + my $uname = $contrib{$idx.':sendername'}; + my $udom = $contrib{$idx.':senderdomain'}; + my $poster = $uname.':'.$udom; + my $rolematch = ''; + my $skiptest = 1; + if ($totposters > 0) { + if (grep/^$poster$/,@{$posters}) { + $$shown{$idx} = 1; + } + } else { + if ($rolefilter) { + if ($rolefilter eq 'all') { + $rolematch = '([^:]+)'; + } else { + $rolematch = $rolefilter; + $skiptest = 0; + } + } + if ($sectionpick) { + if ($sectionpick eq 'all') { + $rolematch .= ':([^:]*)'; + } else { + $rolematch .= ':'.$sectionpick; + $skiptest = 0; + } + } + if ($statusfilter) { + if ($statusfilter eq 'all') { + $rolematch .= ':([^:]+)'; + } else { + $rolematch .= ':'.$statusfilter; + $skiptest = 0; + } + } + if ($skiptest) { + $$shown{$idx} = 1; + } else { + foreach my $role (@{$$roleinfo{$poster}}) { + if ($role =~ m/^$rolematch$/) { + $$shown{$idx} = 1; + last; + } + } + } + } + } + unless ($$notshown{$idx} == 1) { + if ($prevread > 0 && $prevread <= $posttime) { + $$newitem{$idx} = 1; + $$discussionitems[$idx] .= ' +

+ '; + } else { + $$newitem{$idx} = 0; + $$discussionitems[$idx] .= ' +

NEW
+ '; + } + $$discussionitems[$idx] .= ''; + if ($$dischash{$toggkey}) { + $$discussionitems[$idx].=''; + } + $$discussionitems[$idx].= '
   '. + ''.$subject.'  '. + $sender.' '.$vgrlink.' ('. + &Apache::lonlocal::locallocaltime($posttime).')  '. + $ctlink.'

'. + $message.'

'; + if ($contrib{$idx.':history'}) { + my @postversions = (); + $$discussionitems[$idx] .= &mt('This post has been edited by the author.'); + if ($seeid) { + $$discussionitems[$idx] .= '  '.&mt('Display all versions').''; + } + $$discussionitems[$idx].='
'.&mt('Earlier version(s) were posted on: '); + if ($contrib{$idx.':history'} =~ m/:/) { + @postversions = split/:/,$contrib{$idx.':history'}; + } else { + @postversions = ("$contrib{$idx.':history'}"); + } + for (my $i=0; $i<@postversions; $i++) { + my $version = $i+1; + $$discussionitems[$idx] .= ''.$version.'. - '.&Apache::lonlocal::locallocaltime($postversions[$i]).' '; + } + } + } + } + } + } + } + } +} + +sub get_post_contents { + my ($contrib,$idx,$seeid,$type,$messages,$subjects,$allattachments,$attachtxt,$imsfiles,$screenname,$plainname,$numver) = @_; + my $discussion = ''; + my $start=$numver; + my $end=$numver + 1; + %{$$imsfiles{$idx}}=(); + if ($type eq 'allversions') { + unless($seeid) { + $discussion=&mt('You do not have privileges to view all versions of posts.').&mt('Please select a different role'); + return $discussion; + } + } + $$screenname=&Apache::loncommon::screenname( + $$contrib{$idx.':sendername'}, + $$contrib{$idx.':senderdomain'}); + $$plainname=&Apache::loncommon::nickname( + $$contrib{$idx.':sendername'}, + $$contrib{$idx.':senderdomain'}); + my $sender=&Apache::loncommon::aboutmewrapper( + $$plainname, + $$contrib{$idx.':sendername'}, + $$contrib{$idx.':senderdomain'}).' ('. + $$contrib{$idx.':sendername'}.' at '. + $$contrib{$idx.':senderdomain'}.')'; + my $attachmenturls = $$contrib{$idx.':attachmenturl'}; + my @postversions = (); + if ($type eq 'allversions' || $type eq 'export') { + $start = 0; + if ($$contrib{$idx.':history'}) { + if ($$contrib{$idx.':history'} =~ m/:/) { + @postversions = split/:/,$$contrib{$idx.':history'}; + } else { + @postversions = ("$$contrib{$idx.':history'}"); + } + } + &get_post_versions($messages,$$contrib{$idx.':message'},1); + &get_post_versions($subjects,$$contrib{$idx.':subject'},1); + push @postversions,$$contrib{$idx.':timestamp'}; + $end = @postversions; + } else { + &get_post_versions($messages,$$contrib{$idx.':message'},1,$numver); + &get_post_versions($subjects,$$contrib{$idx.':subject'},1,$numver); + } + + if ($$contrib{$idx.':anonymous'}) { + $sender.=' ['.&mt('anonymous').'] '.$$screenname; + } + if ($type eq 'allversions') { + $discussion=(''.$sender.'
'); + return $discussion; + } else { + return; + } +} + +sub replicate_attachments { + my ($attachrefs,$tempexport) = @_; + my $response; + foreach my $id (keys %{$attachrefs}) { + if ($$attachrefs{$id}{'filename'} =~ m-^/uploaded/([^/]+)/([^/]+)(/feedback)?(/?\d*)/([^/]+)$-) { + my $path = $tempexport; + my $tail = $1.'/'.$2.$4; + my @extras = split/\//,$tail; + my $destination = $tempexport.'/'.$1.'/'.$2.$4.'/'.$5; + if (!-e $destination) { + my $i= 0; + while ($i<@extras) { + $path .= '/'.$extras[$i]; + if (!-e $path) { + mkdir($path,0700); + } + $i ++; + } + my ($content,$rtncode); + print STDERR "File to replicate is $$attachrefs{$id}{'filename'} in $1,$2\n"; + my $uploadreply = &Apache::lonnet::getuploaded('GET',$$attachrefs{$id}{'filename'},$1,$2,$content,$rtncode); + if ($uploadreply eq 'ok') { + my $attachcopy; + if ($attachcopy = Apache::File->new('>'.$destination)) { + print $attachcopy $content; + close($attachcopy); + } else { + $response .= 'Error copying a file attachment to IMS package: '.$!.'
'."\n"; + } + } else { + print STDERR "return code from lonnet was $rtncode\n"; + } + } + } + } } sub mail_screen { @@ -852,7 +1188,7 @@ sub mail_screen { my @currnewattach = (); my @currdelold = (); my @keepold = (); - my @attachments = (); + my %attachments = (); my %currattach = (); my $attachnum = 0; my $anonchk = (< 0) { - if ($contrib{$idx.':message'} =~ /::::\Q$numoldver\E::::(.+?)$/si) { - $message = $1; - } else { - $message = $contrib{$idx.':message'}; - } - } else { - $message=$contrib{$idx.':message'}; + my %msgversions = (); + &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); + $message = $msgversions{$numoldver}; } $message=~s/\n/\
/g; $quote='
'.&Apache::lontexconvert::msgtexconverted($message).'
'; if ($idx > 0) { - if ($contrib{$idx.':subject'} =~ /::::\Q$numoldver\E::::(.+?)$/si) { - $subject = $1; - } else { - $subject = $contrib{$idx.':subject'}; - } - $subject = 'Re: '.$subject; + my %subversions = (); + &get_post_versions(\%subversions,$contrib{$idx.':subject'},1,$numoldver); + $subject = 'Re: '.$subversions{$numoldver}; } $subject = &HTML::Entities::encode($subject,'<>&"'); } else { $attachmenturls = $contrib{$idx.':attachmenturl'}; - if ($contrib{$idx.':message'} =~ /.*::::(\d+)::::(.*?)$/si) { - $numoldver = $1; - $comment = $2; - } else { - $comment = $contrib{$idx.':message'}; - } - $comment = &HTML::Entities::encode($comment,'<>&"'); - if ($contrib{$idx.':subject'} =~ /.*::::\d+::::(.+?)$/si) { - $subject = $1; - } else { - $subject = $contrib{$idx.':subject'}; + if ($idx > 0) { + my %msgversions = (); + &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); + $comment = $msgversions{$numoldver}; + my %subversions = (); + &get_post_versions(\%subversions,$contrib{$idx.':subject'},0,$numoldver); + $subject = $subversions{$numoldver}; } - $subject = &HTML::Entities::encode($subject,'<>&"'); if (defined($contrib{$idx.':replyto'})) { $parentmsg = $contrib{$idx.':replyto'}; } @@ -1077,7 +1409,7 @@ END } if ($ENV{'form.editdisc'}) { if ($attachmenturls) { - &extract_attachments($attachmenturls,$idx,$numoldver,\$attachmsg,\@attachments,\%currattach,\@currdelold); + &extract_attachments($attachmenturls,$idx,$numoldver,\$attachmsg,\%attachments,\%currattach,\@currdelold); $attachnum = scalar(keys %currattach); foreach (keys %currattach) { $r->print(''."\n"); @@ -1137,7 +1469,7 @@ END } sub print_display_options { - my ($r,$symb,$previous,$dispchg,$markchg,$feedurl) = @_; + my ($r,$symb,$previous,$dispchgA,$dispchgB,$markchg,$toggchg,$feedurl) = @_; # backward compatibility (bulletin boards used to be 'wrapped') if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $feedurl=~s|^/adm/wrapper||; @@ -1157,54 +1489,116 @@ sub print_display_options { 'deff' => 'Default for all discussions', 'prca' => 'Preferences can be set for this discussion that determine ....', 'whpo' => 'Which posts are displayed when you display this bulletin board or resource, and', - 'unwh' => 'Under what circumstances posts are identfied as "New."', + 'unwh' => 'Under what circumstances posts are identified as "NEW", and', + 'wipa' => 'Whether individual posts can be marked as read/unread', 'allposts' => 'All posts', 'unread' => 'New posts only', + 'unmark' => 'Posts not marked read', 'ondisp' => 'Once displayed', - 'onmark' => 'Once marked as read', + 'onmark' => 'Once marked not NEW ', + 'toggon' => 'Shown', + 'toggoff' => 'Not shown', 'disa' => 'Posts displayed?', - 'npmr' => 'New posts cease to be identified as "New"?', + 'npmr' => 'New posts cease to be identified as "NEW"?', + 'dotm' => 'Option to mark each post as read/unread?', 'chgt' => 'Change to ', 'mkdf' => 'Set to ', - 'yhni' => 'You have not indicated that you wish to change either of the discussion settings', + 'yhni' => 'You have not indicated that you wish to change any of the discussion settings', 'ywbr' => 'You will be returned to the previous page if you click OK.' ); - my $dispchange = $lt{'unread'}; + my $dispchangeA = $lt{'unread'}; + my $dispchangeB = $lt{'unmark'}; my $markchange = $lt{'ondisp'}; + my $toggchange = $lt{'toggon'}; my $currdisp = $lt{'allposts'}; my $currmark = $lt{'onmark'}; my $discdisp = 'allposts'; my $discmark = 'onmark'; + my $currtogg = $lt{'toggoff'}; + my $disctogg = 'toggoff'; - if ($dispchg eq 'allposts') { - $dispchange = $lt{'allposts'}; + if ($dispchgA eq 'allposts') { + $dispchangeA = $lt{'allposts'}; $currdisp = $lt{'unread'}; $discdisp = 'unread'; } - + if ($markchg eq 'markonread') { $markchange = $lt{'onmark'}; $currmark = $lt{'ondisp'}; $discmark = 'ondisp'; } + + if ($dispchgB eq 'onlyunread') { + $dispchangeB = $lt{'unread'}; + $currdisp = $lt{'unmark'}; + $discdisp = 'unmark'; + } + if ($toggchg eq 'toggoff') { + $toggchange = $lt{'toggoff'}; + $currtogg = $lt{'toggon'}; + $disctogg = 'toggon'; + } $r->print(< $lt{'dido'}