[LON-CAPA-cvs] cvs: loncom /interface lonfeedback.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Tue, 17 Aug 2004 14:27:19 -0000
This is a MIME encoded message
--raeburn1092752839
Content-Type: text/plain
raeburn Tue Aug 17 10:27:19 2004 EDT
Modified files:
/loncom/interface lonfeedback.pm
Log:
Moved construction of display of each discussion posting to subroutines (build_posting_display, get_post_contents, get_post_versions, get_post_attachments). Added support for export of postings to IMS package (still needs additional work).
--raeburn1092752839
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20040817102719.txt"
Index: loncom/interface/lonfeedback.pm
diff -u loncom/interface/lonfeedback.pm:1.115 loncom/interface/lonfeedback.pm:1.116
--- loncom/interface/lonfeedback.pm:1.115 Tue Aug 10 14:25:53 2004
+++ loncom/interface/lonfeedback.pm Tue Aug 17 10:27:19 2004
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Feedback
#
-# $Id: lonfeedback.pm,v 1.115 2004/08/10 18:25:53 sakharuk Exp $
+# $Id: lonfeedback.pm,v 1.116 2004/08/17 14:27:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -38,6 +38,7 @@
use Apache::lonhtmlcommon();
use HTML::LCParser();
use Apache::lonspeller();
+use Cwd;
sub discussion_open {
my ($status)=@_;
@@ -67,6 +68,11 @@
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;
@@ -196,15 +202,14 @@
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;
@@ -219,346 +224,14 @@
$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'} =~ /^<version num="0">/) {
- my %versions = ();
- &get_post_versions(\%versions,$contrib{$idx.':message'},$numoldver);
- $message = &HTML::Entities::decode($versions{$numoldver});
- } else {
- $message = $contrib{$idx.':message'};
- }
- } else {
- $message=$contrib{$idx.':message'};
- }
- my $attachmenturls = $contrib{$idx.':attachmenturl'};
- $message=~s/\n/\<br \/\>/g;
- $message=&Apache::lontexconvert::msgtexconverted($message);
- if ($idx > 0) {
- if ($contrib{$idx.':subject'} =~ /^<version num="0"/) {
- my %versions = ();
- &get_post_versions(\%versions,$contrib{$idx.':subject'},$numoldver);
- $subject = &HTML::Entities::decode($versions{$numoldver});
- } else {
- $subject = $contrib{$idx.':subject'};
- }
- } else {
- $subject=$contrib{$idx.':subject'};
- }
- if (defined($subject)) {
- $subject=~s/\n/\<br \/\>/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='<font color="#888888">'.$message.'</font>';
- if ($studenthidden) {
- $message .='<br /><br />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.=' <a href="/adm/feedback?editdisc='.
- $ressymb.':::'.$idx;
- if ($newpostsflag) {
- $sender .= '&previous='.$prevread;
- }
- $sender .= '" '.$target.'>'.&mt('Edit').'</a>'; unless ($seeid) {
- $sender.=" <a href=\"javascript:studentdelete('$ressymb','$idx','$newpostsflag','$prevread')";
- $sender .= '">'.&mt('Delete').'</a>';
- }
- }
- }
- if ($seeid) {
- if ($hidden) {
- unless ($studenthidden) {
- $sender.=' <a href="/adm/feedback?unhide='.
- $ressymb.':::'.$idx;
- if ($newpostsflag) {
- $sender .= '&previous='.$prevread;
- }
- $sender .= '">'.&mt('Make Visible').'</a>';
- }
- } else {
- $sender.=' <a href="/adm/feedback?hide='.
- $ressymb.':::'.$idx;
- if ($newpostsflag) {
- $sender .= '&previous='.$prevread;
- }
- $sender .= '">'.&mt('Hide').'</a>';
- }
- $sender.=' <a href="/adm/feedback?deldisc='.
- $ressymb.':::'.$idx;
- if ($newpostsflag) {
- $sender .= '&previous='.$prevread;
- }
- $sender .= '">'.&mt('Delete').'</a>';
- }
- } else {
- if ($screenname) {
- $sender='<i>'.$screenname.'</i>';
- }
-# 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.=' <a href="/adm/feedback?replydisc='.
- $ressymb.':::'.$idx;
- if ($newpostsflag) {
- $sender .= '&previous='.$prevread;
- }
- $sender .= '" '.$target.'>'.&mt('Reply').'</a>';
- }
- my $vgrlink;
- if ($viewgrades) {
- $vgrlink=&Apache::loncommon::submlink('Submissions',
- $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb);
- }
- my $ctlink;
- if ($dischash{$readkey}=~/\.$idx\./) {
- $ctlink = '<b>'.&mt('Mark unread').'?</b> <input type="checkbox" name="postunread_'.$idx.'" />';
- } else {
- $ctlink = '<b>'.&mt('Mark read').'?</b> <input type="checkbox" name="postread_'.$idx.'" />';
- }
-#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;
- } 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] .= '
- <p><table border="0" width="100%">
- <tr><td align="left"><font color="#FF0000"><b>NEW</b></font></td>';
- } else {
- $newitem{$idx} = 0;
- $discussionitems[$idx] .= '
- <p><table border="0" width="100%">
- <tr><td align="left"> </td>';
- }
- $discussionitems[$idx] .= '<td align ="left"> '.
- '<b>'.$subject.'</b> '.
- $sender.'</b> '.$vgrlink.' ('.
- &Apache::lonlocal::locallocaltime($posttime).')</td>';
- if ($dischash{$toggkey}) {
- $discussionitems[$idx].='<td align="right"> '.
- $ctlink.'</td>';
- }
- $discussionitems[$idx].= '</tr></table><blockquote>'.$message.'</blockquote></p>';
- if ($contrib{$idx.':history'}) {
- my @postversions = ();
- $discussionitems[$idx] .= '<br />'.&mt('This post has been edited by the author.');
- if ($seeid) {
- $discussionitems[$idx] .= ' <a href="/adm/feedback?allversions='.$ressymb.':::'.$idx.'">'.&mt('Display all versions').'</a>';
- }
- $discussionitems[$idx].='<br/>'.&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] .= '<b>'.$version.'.</b> - '.&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',
@@ -627,7 +300,46 @@
if ($visible) {
# Print the discusssion
- if ($outputtarget ne 'tex') {
+ if ($outputtarget eq 'tex') {
+ $discussion.='<tex>\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.'}</tex>';
+ } 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|
+<?xml version="1.0" encoding="UTF-8"?>
+<manifest xmlns="http://www.imsglobal.org/xsd/imscp_v1p1" xmlns:imsmd="http://www.imsglobal.org/xsd/imsmd_v1p2"
+xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+identifier="MANIFEST-$ressymb" xsi:schemaLocation="http://www.imsglobal.org/xsd/imscp_v1p1
+imscp_v1p1.xsd http://www.imsglobal.org/xsd/imsmd_v1p2 imsmd_v1p2p2.xsd">
+ <organizations default="$ressymb">
+ <organization identifier="$ressymb">
+ <title>Discussion for $ressymb</title>\n|;
+ } else {
+ $discussion .= 'An error occurred opening the manifest file.<br />';
+ }
+ } else {
my $colspan=$maxdepth+1;
$discussion.= qq|
<script>
@@ -681,29 +393,24 @@
$discussion .= '<td> </td>';
}
$discussion .= '</tr></table></td></tr>';
- } else {
- $discussion.='<tex>\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.'}</tex>';
- }
- my $numhidden = keys %notshown;
- if ($numhidden > 0) {
- my $colspan = $maxdepth+1;
- $discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">'.
+
+ my $numhidden = keys %notshown;
+ if ($numhidden > 0) {
+ my $colspan = $maxdepth+1;
+ $discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">'.
'<a href="/adm/feedback?allposts='.$ressymb;
- if ($newpostsflag) {
- $discussion .= '&previous='.$prevread;
- }
- $discussion .= '">'.&mt('Show all posts').'</a> '.&mt('to display').' '.
+ if ($newpostsflag) {
+ $discussion .= '&previous='.$prevread;
+ }
+ $discussion .= '">'.&mt('Show all posts').'</a> '.&mt('to display').' '.
$numhidden.' ';
- if ($showunmark) {
- $discussion .= &mt('posts previously marked read');
- } else {
- $discussion .= &mt('previously viewed posts');
+ if ($showunmark) {
+ $discussion .= &mt('posts previously marked read');
+ } else {
+ $discussion .= &mt('previously viewed posts');
+ }
+ $discussion .= '<br/></td></tr>';
}
- $discussion .= '<br/></td></tr>';
}
# Choose sort mechanism
@@ -732,26 +439,24 @@
$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<tr>";
}
my $thisdepth=$depth[$alldiscussion{$_}];
- if ($outputtarget ne 'tex') {
+ unless ($outputtarget eq 'tex' || $outputtarget eq 'export') {
for (1..$thisdepth) {
$discussion.='<td> </td>';
}
}
my $colspan=$maxdepth-$thisdepth+1;
- if ($outputtarget ne 'tex') {
- $discussion.='<td bgcolor="'.$bgcols[$newitem{$alldiscussion{$_}}].'" colspan="'.$colspan.'">'.
- $discussionitems[$alldiscussion{$_}].
- '</td></tr>';
- } else {
+ if ($outputtarget eq 'tex') {
#cleanup block
$discussionitems[$alldiscussion{$_}]=~s/<table([^>]*)>/<table TeXwidth="90 mm">/;
$discussionitems[$alldiscussion{$_}]=~s/<tr([^>]*)><td([^>]*)>/<tr><td TeXwidth="20 mm" align="left">/;
@@ -765,10 +470,46 @@
$discussionitems[$alldiscussion{$_}]='<tex>\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}</tex>'.$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 ' </item>'."\n";
+ }
+ $currdepth = $depth[$alldiscussion{$_}];
+ print $manifestfile "\n".
+ '<item identifier="ITEM-'.$ressymb.'-'.$alldiscussion{$_}.'" isvisible="'.
+ $imsitems{$alldiscussion{$_}}{'isvisible'}.'" identifieref="RES-'.$ressymb.'-'.$alldiscussion{$_}.'">'.
+ '<title>'.$imsitems{$alldiscussion{$_}}{'title'}.'</title>';
+ $imsresources .= "\n".
+ '<resource identifier="RES-'.$ressymb.'-'.$alldiscussion{$_}.'" type="webcontent" href="'.$postfilename.'">'.
+ '<file href="'.$alldiscussion{$_}.'.html">'."\n".
+ $imsfiles{$alldiscussion{$_}}{$imsitems{$alldiscussion{$_}}{'currversion'}}."\n".
+ '</resource>';
+ }
+ my $postingfile;
+ my $postingfilename = $tempexport.'/'.$postfilename;
+ if ($postingfile = Apache::File->new('>'.$postingfilename)) {
+ print $postingfile '<html><head><title>Discussion Post</title></head><body>'.
+ $imsitems{$alldiscussion{$_}}{'title'}.' '.
+ $imsitems{$alldiscussion{$_}}{'sender'}.
+ $imsitems{$alldiscussion{$_}}{'timestamp'}.'<br /><br />'.
+ $imsitems{$alldiscussion{$_}}{'message'}.'<br />'.
+ $imsitems{$alldiscussion{$_}}{'attach'}.'</body></html>'."\n";
+ close($postingfile);
+ } else {
+ $discussion .= 'An error occurred opening the export file for posting '.$alldiscussion{$_}.'<br />';
+ }
+ $copyresult.=&replicate_attachments($imsitems{$alldiscussion{$_}}{'allattachments'},$tempexport);
+ } else {
+ $discussion.='<td bgcolor="'.$bgcols[$newitem{$alldiscussion{$_}}].
+ '" colspan="'.$colspan.'">'. $discussionitems[$alldiscussion{$_}].
+ '</td></tr>';
+ }
}
}
- if ($outputtarget ne 'tex') {
+ unless ($outputtarget eq 'tex' || $outputtarget eq 'export') {
my $colspan=$maxdepth+1;
$discussion .= <<END;
<tr bgcolor="#FFFFFF">
@@ -824,6 +565,48 @@
<br /><br /></form>
END
}
+ if ($outputtarget eq 'export') {
+ if ($manifestok) {
+ while ($currdepth > 0) {
+ print $manifestfile " </item>\n";
+ $currdepth --;
+ }
+ print $manifestfile qq|
+ </organization>
+ </organizations>
+ <resources>
+ $imsresources
+ </resources>
+</manifest>
+ |;
+ 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 <a href="'.$imszipfile.'">Discussion Posting Archive</a><br />';
+ if ($copyresult) {
+ $discussion .= 'The following errors occurred during export - '.$copyresult;
+ }
+ } else {
+ $discussion .= '<br />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.<br />';
+ }
+ return $discussion;
+ }
}
if ($discussiononly) {
my $now = time;
@@ -882,7 +665,7 @@
$discussion.=$newattachmsg;
$discussion.=&generate_preview_button();
}
- } else {
+ } else {
if (&discussion_open($status) &&
&Apache::lonnet::allowed('pch',
$ENV{'request.course.id'}.
@@ -898,6 +681,492 @@
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='<font color="#888888">'.$message.'</font>';
+ if ($studenthidden) {
+ $message .='<br /><br />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.=' <a href="/adm/feedback?editdisc='.
+ $ressymb.':::'.$idx;
+ if ($newpostsflag) {
+ $sender .= '&previous='.$prevread;
+ }
+ $sender .= '" '.$target.'>'.&mt('Edit').'</a>';
+ unless ($seeid) {
+ $sender.=" <a href=\"javascript:studentdelete('$ressymb','$idx','$newpostsflag','$prevread')";
+ $sender .= '">'.&mt('Delete').'</a>';
+ }
+ }
+ }
+ if ($seeid) {
+ if ($hidden) {
+ unless ($studenthidden) {
+ $sender.=' <a href="/adm/feedback?unhide='.
+ $ressymb.':::'.$idx;
+ if ($newpostsflag) {
+ $sender .= '&previous='.$prevread;
+ }
+ $sender .= '">'.&mt('Make Visible').'</a>';
+ }
+ } else {
+ $sender.=' <a href="/adm/feedback?hide='.
+ $ressymb.':::'.$idx;
+ if ($newpostsflag) {
+ $sender .= '&previous='.$prevread;
+ }
+ $sender .= '">'.&mt('Hide').'</a>';
+ }
+ $sender.=' <a href="/adm/feedback?deldisc='.
+ $ressymb.':::'.$idx;
+ if ($newpostsflag) {
+ $sender .= '&previous='.$prevread;
+ }
+ $sender .= '">'.&mt('Delete').'</a>';
+ }
+ } else {
+ if ($screenname) {
+ $sender='<i>'.$screenname.'</i>';
+ }
+# 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.=' <a href="/adm/feedback?replydisc='.
+ $ressymb.':::'.$idx;
+ if ($newpostsflag) {
+ $sender .= '&previous='.$prevread;
+ }
+ $sender .= '" '.$target.'>'.&mt('Reply').'</a>';
+ }
+ if ($viewgrades) {
+ $vgrlink=&Apache::loncommon::submlink('Submissions',
+ $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$ressymb);
+ }
+ if ($$dischash{$readkey}=~/\.$idx\./) {
+ $ctlink = '<b>'.&mt('Mark unread').'?</b> <input type="checkbox" name="postunread_'.$idx.'" />';
+ } else {
+ $ctlink = '<b>'.&mt('Mark read').'?</b> <input type="checkbox" name="postread_'.$idx.'" />';
+ }
+ }
+#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] .= '
+ <p><table border="0" width="100%">
+ <tr><td align="left"><font color="#FF0000"><b>NEW</b></font></td>';
+ } else {
+ $$newitem{$idx} = 0;
+ $$discussionitems[$idx] .= '
+ <p><table border="0" width="100%">
+ <tr><td align="left"> </td>';
+ }
+ $$discussionitems[$idx] .= '<td align ="left"> '.
+ '<b>'.$subject.'</b> '.
+ $sender.'</b> '.$vgrlink.' ('.
+ &Apache::lonlocal::locallocaltime($posttime).')</td>';
+ if ($$dischash{$toggkey}) {
+ $$discussionitems[$idx].='<td align="right"> '.
+ $ctlink.'</td>';
+ }
+ $$discussionitems[$idx].= '</tr></table><blockquote>'.
+ $message.'</blockquote></p>';
+ if ($contrib{$idx.':history'}) {
+ my @postversions = ();
+ $$discussionitems[$idx] .= &mt('This post has been edited by the author.');
+ if ($seeid) {
+ $$discussionitems[$idx] .= ' <a href="/adm/feedback?allversions='.$ressymb.':::'.$idx.'">'.&mt('Display all versions').'</a>';
+ }
+ $$discussionitems[$idx].='<br/>'.&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] .= '<b>'.$version.'.</b> - '.&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=('<b>'.$sender.'</b><br /><ul>');
+ }
+ for (my $i=$start; $i<$end; $i++) {
+ my ($timesent,$attachmsg);
+ my %currattach = ();
+ $timesent = &Apache::lonlocal::locallocaltime($postversions[$i]);
+ $$messages{$i}=~s/\n/\<br \/\>/g;
+ $$messages{$i}=&Apache::lontexconvert::msgtexconverted($$messages{$i});
+ $$subjects{$i}=~s/\n/\<br \/\>/g;
+ $$subjects{$i}=&Apache::lontexconvert::msgtexconverted($$subjects{$i});
+ if ($attachmenturls) {
+ &extract_attachments($attachmenturls,$idx,$i,\$attachmsg,$allattachments,\%currattach);
+ }
+ if ($type eq 'export') {
+ $$imsfiles{$idx}{$i} = '';
+ if ($attachmsg) {
+ $$attachtxt{$i} = '<br />Attachments:<br />';
+ foreach (sort keys %currattach) {
+ if ($$allattachments{$_}{'filename'} =~ m-^/uploaded/([^/]+/[^/]+)(/feedback)?(/?\d*)/([^/]+)$-) {
+ my $fname = $1.$3.'/'.$4;
+ $$imsfiles{$idx}{$i} .= '<file href="'.$fname.'">'."\n";
+ $$attachtxt{$i}.= '<a href="'.$fname.'">'.$4.'</a><br />';
+ }
+ }
+ }
+ } else {
+ if ($attachmsg) {
+ $$attachtxt{$i} = '<br />Attachments:'.$attachmsg.'<br />';
+ } else {
+ $$attachtxt{$i} = '';
+ }
+ }
+ if ($type eq 'allversions') {
+ $discussion.= <<"END";
+<li><b>$$subjects{$i}</b>, $timesent<br />
+$$messages{$i}<br />
+$$attachtxt{$i}</li>
+END
+ }
+ }
+ if ($type eq 'allversions') {
+ $discussion.=('</ul></body></html>');
+ 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: '.$!.'<br />'."\n";
+ }
+ } else {
+ print STDERR "return code from lonnet was $rtncode\n";
+ }
+ }
+ }
+ }
+}
+
sub mail_screen {
my ($r,$feedurl,$options) = @_;
if (exists($ENV{'form.origpage'})) {
@@ -984,44 +1253,27 @@
}
my $message;
if ($idx > 0) {
- if ($contrib{$idx.':message'} =~ /^<version num="0"/) {
- my %versions = ();
- &get_post_versions(\%versions,$contrib{$idx.':message'},$numoldver);
- $message = &HTML::Entities::decode($versions{$numoldver});
- } 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/\<br \/\>/g;
$quote='<blockquote>'.&Apache::lontexconvert::msgtexconverted($message).'</blockquote>';
if ($idx > 0) {
- if ($contrib{$idx.':subject'} =~ /^<version num="0"/) {
- my %versions = ();
- &get_post_versions(\%versions,$contrib{$idx.':subject'},$numoldver);
- $subject = &HTML::Entities::decode($versions{$numoldver});
- } 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'} =~ /^<version num="0">/) {
- my %versions = ();
- &get_post_versions(\%versions,$contrib{$idx.':message'},$numoldver);
- $comment = $versions{$numoldver};
- } else {
- $comment = &HTML::Entities::encode($contrib{$idx.':message'},'<>&"');
- }
- if ($contrib{$idx.':subject'} =~ /<version num="0">/) {
- my %versions = ();
- &get_post_versions(\%versions,$contrib{$idx.':subject'},$numoldver);
- $subject = $versions{$numoldver};
- } else {
- $subject = &HTML::Entities::encode($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};
}
if (defined($contrib{$idx.':replyto'})) {
$parentmsg = $contrib{$idx.':replyto'};
@@ -1665,19 +1917,36 @@
}
sub get_post_versions {
- my ($versions,$incoming,$numver) = @_;
- my $p = HTML::LCParser->new(\$incoming);
- my $done = 0;
- while ( (my $token = $p->get_tag("version")) && (!$done)) {
- my $num = $token->[1]{num};
- my $text = $p->get_text("/version");
- if (defined($numver)) {
- if ($num == $numver) {
- $$versions{$numver}=$text;
- $done = 1;
+ my ($versions,$incoming,$htmldecode,$numver) = @_;
+ if ($incoming =~ /^<version num="0">/) {
+ my $p = HTML::LCParser->new(\$incoming);
+ my $done = 0;
+ while ( (my $token = $p->get_tag("version")) && (!$done)) {
+ my $num = $token->[1]{num};
+ my $text = $p->get_text("/version");
+ if (defined($numver)) {
+ if ($num == $numver) {
+ if ($htmldecode) {
+ $text = &HTML::Entities::decode($text);
+ }
+ $$versions{$numver}=$text;
+ $done = 1;
+ }
+ } else {
+ if ($htmldecode) {
+ $text = &HTML::Entities::decode($text);
+ }
+ $$versions{$num}=$text;
}
+ }
+ } else {
+ if (!defined($numver)) {
+ $numver = 0;
+ }
+ if ($htmldecode) {
+ $$versions{$numver} = $incoming;
} else {
- $$versions{$num}=$text;
+ $$versions{$numver} = &HTML::Entities::encode($incoming,'<>&"');
}
}
return;
@@ -1686,21 +1955,67 @@
sub get_post_attachments {
my ($attachments,$attachmenturls) = @_;
my $num;
- my $p = HTML::LCParser->new(\$attachmenturls);
- while (my $token = $p->get_tag("attachment","filename","post")) {
- if ($token->[0] eq "attachment") {
- $num = $token->[1]{id};
- %{$$attachments{$num}} =();
- } elsif ($token->[0] eq "filename") {
- $$attachments{$num}{'filename'} = $p->get_text("/filename");
- } elsif ($token->[0] eq "post") {
- my $id = $token->[1]{id};
- $$attachments{$num}{$id} = $p->get_text("/post");
+ if ($attachmenturls =~ m/^<attachment id="0">/) {
+ my $p = HTML::LCParser->new(\$attachmenturls);
+ while (my $token = $p->get_tag("attachment","filename","post")) {
+ if ($token->[0] eq "attachment") {
+ $num = $token->[1]{id};
+ %{$$attachments{$num}} =();
+ } elsif ($token->[0] eq "filename") {
+ $$attachments{$num}{'filename'} = $p->get_text("/filename");
+ } elsif ($token->[0] eq "post") {
+ my $id = $token->[1]{id};
+ $$attachments{$num}{$id} = $p->get_text("/post");
+ }
}
+ } else {
+ %{$$attachments{'0'}} = ();
+ $$attachments{'0'}{'filename'} = $attachmenturls;
+ $$attachments{'0'}{'0'} = 'n';
}
+
return;
}
+sub build_ims_export {
+ my ($r,$symb,$previous,$feedurl) = @_;
+ # backward compatibility (bulletin boards used to be 'wrapped')
+ if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
+ $feedurl=~s|^/adm/wrapper||;
+ }
+ my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
+ $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
+ $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
+ my @depth=();
+ my %alldiscussion=();
+ my @discussionitems=();
+ my %usernamesort = ();
+ my %subjectsort = ();
+ my %namesort = ();
+ my %notshown = ();
+ my %newitem = ();
+ my %dischash = ();
+ my %shown = ();
+ my %roleinfo = ();
+ my @posters=();
+ my $maxdepth=0;
+ my $visible=0;
+ my $newpostsflag=0;
+ my $status;
+ my $viewgrades;
+ my $seeid;
+ my $prevread;
+ my $sortposts;
+ my $ressymb;
+ my $target;
+ my $readkey;
+ my $showunmark;
+ my $showonlyunread;
+
+}
+
+
+
sub fail_redirect {;
my ($r,$feedurl) = @_;
if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
@@ -2317,58 +2632,51 @@
sub extract_attachments {
my ($attachmenturls,$idx,$numoldver,$message,$attachments,$currattach,$currdelold) = @_;
- if ($attachmenturls =~ m/^<attachment id="0">/) {
- &get_post_attachments($attachments,$attachmenturls);
- foreach my $id (sort keys %{$attachments}) {
- if (exists($$attachments{$id}{$numoldver})) {
- if (defined($currdelold)) {
- if (@{$currdelold} > 0) {
- unless (grep/^$id$/,@{$currdelold}) {
- $$currattach{$id} = $$attachments{$id}{$numoldver};
- }
- } else {
- $$currattach{$id} = $$attachments{$id}{$numoldver};
+ %{$attachments}=();
+ &get_post_attachments($attachments,$attachmenturls);
+ foreach my $id (sort keys %{$attachments}) {
+ if (exists($$attachments{$id}{$numoldver})) {
+ if (defined($currdelold)) {
+ if (@{$currdelold} > 0) {
+ unless (grep/^$id$/,@{$currdelold}) {
+ $$currattach{$id} = $$attachments{$id}{$numoldver};
}
} else {
$$currattach{$id} = $$attachments{$id}{$numoldver};
}
+ } else {
+ $$currattach{$id} = $$attachments{$id}{$numoldver};
}
}
- my @attached = (sort { $a <=> $b } keys %{$currattach});
- if (@attached == 1) {
- my $id = $attached[0];
+ }
+ my @attached = (sort { $a <=> $b } keys %{$currattach});
+ if (@attached == 1) {
+ my $id = $attached[0];
+ my $attachurl;
+ if ($attachmenturls =~ m/^<attachment id="0">/) {
+ $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'});
+ } else {
+ $attachurl = $$attachments{$id}{'filename'};
+ }
+ $attachurl=~m|/([^/]+)$|;
+ $$message.='<br /><a href="'.$attachurl.'"><tt>'.
+ $1.'</tt></a><br />';
+ &Apache::lonnet::allowuploaded('/adm/feedback',
+ $attachurl);
+ } elsif (@attached > 1) {
+ $$message.='<ol>';
+ foreach (@attached) {
+ my $id = $_;
my $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'});
- $attachurl=~m|/([^/]+)$|;
- $$message.='<br /><a href="'.$attachurl.'"><tt>'.
- $1.'</tt></a><br />';
+ my ($fname)
+ =($attachurl=~m|/([^/]+)$|);
+ $$message .= '<li><a href="'.$attachurl.
+ '"><tt>'.
+ $fname.'</tt></a></li>';
&Apache::lonnet::allowuploaded('/adm/feedback',
- $attachurl);
- } elsif (@attached > 1) {
- $$message.='<ol>';
- foreach (@attached) {
- my $id = $_;
- my $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'});
- my ($fname)
- =($attachurl=~m|/([^/]+)$|);
- $$message .= '<li><a href="'.$attachurl.
- '"><tt>'.
- $fname.'</tt></a></li>';
- &Apache::lonnet::allowuploaded('/adm/feedback',
- $attachurl);
- }
- $$message .= '</ol><br />';
+ $attachurl);
}
- } else {
- my ($fname)
- =($attachmenturls=~m|/([^/]+)$|);
- $$message .='<p>'.&mt('Attachment').
- ': <a href="'.$attachmenturls.
- '"><tt>'.
- $fname.'</tt></a></p>';
- $$attachments{0} = $attachmenturls;
- $$currattach{'0'} = 'n';
- &Apache::lonnet::allowuploaded('/adm/feedback',
- $attachmenturls);
+ $$message .= '</ol>';
}
}
@@ -2398,12 +2706,14 @@
my %attachments = ();
my $prevver = $currver-1;
&get_post_attachments(\%attachments,$oldattachmenturl);
- my $numattach = keys %attachments;
+ my $numattach = scalar(keys %attachments);
$startnum += $numattach;
foreach my $num (sort {$a <=> $b} keys %attachments) {
$newattachmenturl .= '<attachment id="'.$num.'"><filename>'.$attachments{$num}{'filename'}.'</filename>';
- foreach (sort {$a <=> $b} keys %{$attachments{$num}}) {
- $newattachmenturl .= '<post id="'.$_.'">'.$attachments{$num}{$_}.'</post>';
+ foreach $_ (sort {$a <=> $b} keys %{$attachments{$num}}) {
+ unless ($_ eq 'filename') {
+ $newattachmenturl .= '<post id="'.$_.'">'.$attachments{$num}{$_}.'</post>';
+ }
}
if (grep/^$num$/,@{$keepold}) {
$newattachmenturl .= '<post id="'.$currver.'">'.$attachments{$num}{$prevver}.'</post>';
@@ -2411,7 +2721,7 @@
$newattachmenturl .= '</attachment>';
}
} else {
- $newattachmenturl = '<attachment id="0"><filename>'.&HTML::Entities::encode($oldattachmenturl).'<post id="0">n</post>';
+ $newattachmenturl = '<attachment id="0"><filename>'.&HTML::Entities::encode($oldattachmenturl).'</filename><post id="0">n</post>';
unless (grep/^0$/,@{$keepold}) {
$newattachmenturl .= '<post id="1">n</post>';
}
@@ -2438,7 +2748,7 @@
# --------------------------- Get query string for limited number of parameters
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
- ['hide','unhide','deldisc','postdata','preview','replydisc','editdisc','threadedon','threadedoff','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navmaps','navurl','sortfilter','sortposts','applysort','rolefilter','statusfilter','sectionpick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions']);
+ ['hide','unhide','deldisc','postdata','preview','replydisc','editdisc','threadedon','threadedoff','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navmaps','navurl','sortfilter','sortposts','applysort','rolefilter','statusfilter','sectionpick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export']);
if ($ENV{'form.discsymb'}) {
my $symb = $ENV{'form.discsymb'};
my $readkey = $symb.'_read';
@@ -2494,67 +2804,17 @@
$ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
}
if ($idx > 0) {
+ my %messages = ();
+ my %subjects = ();
+ my %attachmsgs = ();
+ my %allattachments = ();
+ my %imsfiles = ();
+ my ($screenname,$plainname);
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{$idx.':history'}) {
- my $attachmenturls = $contrib{$idx.':attachmenturl'};
- my @postversions = ();
- my %messages = ();
- my %subjects = ();
- if ($contrib{$idx.':history'} =~ m/:/) {
- @postversions = split/:/,$contrib{$idx.':history'};
- } else {
- @postversions = ("$contrib{$idx.':history'}");
- }
- if (@postversions > 0) {
- &get_post_versions(\%messages,$contrib{$idx.':message'});
- &get_post_versions(\%subjects,$contrib{$idx.':subject'});
- push @postversions,$contrib{$idx.':timestamp'};
- my $screenname=&Apache::loncommon::screenname(
- $contrib{$idx.':sendername'},
- $contrib{$idx.':senderdomain'});
- my $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'}.')';
- if ($contrib{$idx.':anonymous'}) {
- $sender.=' ['.&mt('anonymous').'] '.$screenname;
- }
- $r->print('<b>'.$sender.'</b><br /><ul>');
- for (my $i=0; $i<@postversions; $i++) {
- my ($timesent,$message,$subject,$attachmsg);
- $timesent = &Apache::lonlocal::locallocaltime($postversions[$i]);
- $message=&HTML::Entities::decode($messages{$i});
- $subject=&HTML::Entities::decode($subjects{$i});
- $message=~s/\n/\<br \/\>/g;
- $message=&Apache::lontexconvert::msgtexconverted($message);
- $subject=~s/\n/\<br \/\>/g;
- $subject=&Apache::lontexconvert::msgtexconverted($subject);
- if ($attachmenturls) {
- my %attachments = ();
- my %currattach = ();
- &extract_attachments($attachmenturls,$idx,$i,\$attachmsg,\%attachments,\%currattach);
- }
- if ($attachmsg) {
- $attachmsg = '<br />Attachments:'.$attachmsg.'<br />';
- } else {
- $attachmsg = '<br />';
- }
- $r->print (<<END);
-<li><b>$subject</b>, $timesent<br />
-$message<br />
-$attachmsg</li>
-END
- }
- $r->print('</ul></body></html>');
- }
- }
+ my $discussion = &get_post_contents(\%contrib,$idx,$seeid,'allversions',\%messages,\%subjects,\%allattachments,\%attachmsgs,\%imsfiles,\$screenname,\$plainname);
+ $r->print($discussion);
}
return OK;
}
@@ -2910,6 +3170,29 @@
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($ENV{'form.chgreads'});
&redirect_back($r,&Apache::lonnet::clutter($url),
&mt('Changed read status').'<br />','0','0');
+ } elsif ($ENV{'form.export'}) {
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+ my $symb=$ENV{'form.export'};
+ my $mode;
+ my $status='OPEN';
+ my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
+ my $previous=$ENV{'form.previous'};
+ my $feedurl = &Apache::lonnet::clutter($url);
+ # backward compatibility (bulletin boards used to be 'wrapped')
+ if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
+ $mode = 'board';
+ $feedurl=~s|^/adm/wrapper||;
+ }
+ if ($feedurl =~ /\.(problem|exam|quiz|assess|survey|form|library)$/) {
+ $mode='problem';
+ $status=$Apache::inputtags::status[-1];
+ }
+ my $discussion = &list_discussion($mode,$status,$symb);
+# &build_ims_export($r,$symb,$previous,$feedurl);
+ my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion');
+ $r->print($bodytag.$discussion);
+ return OK;
} else {
# ------------------------------------------------------------- Normal feedback
my $feedurl=$ENV{'form.postdata'};
--raeburn1092752839--