--- loncom/interface/lonfeedback.pm 2004/07/27 23:35:34 1.107 +++ loncom/interface/lonfeedback.pm 2005/06/06 20:40:01 1.167 @@ -1,7 +1,7 @@ # The LearningOnline Network # Feedback # -# $Id: lonfeedback.pm,v 1.107 2004/07/27 23:35:34 www Exp $ +# $Id: lonfeedback.pm,v 1.167 2005/06/06 20:40:01 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,17 +35,22 @@ use Apache::lonmsg(); use Apache::loncommon(); use Apache::lontexconvert(); use Apache::lonlocal; # must not have () +use Apache::lonnet; use Apache::lonhtmlcommon(); +use Apache::lonnavmaps; +use Apache::lonenc(); +use HTML::LCParser(); use Apache::lonspeller(); +use Cwd; sub discussion_open { - my ($status)=@_; + my ($status,$symb)=@_; if (defined($status) && !($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER' || $status eq 'OPEN')) { return 0; } - my $close=&Apache::lonnet::EXT('resource.0.discussend'); + my $close=&Apache::lonnet::EXT('resource.0.discussend',$symb); if (defined($close) && $close ne '' && $close < time) { return 0; } @@ -57,51 +62,61 @@ sub discussion_visible { if (not &discussion_open($status)) { my $hidden=&Apache::lonnet::EXT('resource.0.discusshide'); if (lc($hidden) eq 'yes' or $hidden eq '' or !defined($hidden)) { - return 0; + if (!$env{'request.role.adv'}) { return 0; } } } return 1; } sub list_discussion { - my ($mode,$status,$symb)=@_; - - my $outputtarget=$ENV{'form.grade_target'}; + my ($mode,$status,$ressymb,$imsextras)=@_; + my $outputtarget=$env{'form.grade_target'}; + if (defined($env{'form.export'})) { + if($env{'form.export'}) { + $outputtarget = 'export'; + } + } + if (defined($imsextras)) { + if ($$imsextras{'caller'} eq 'imsexport') { + $outputtarget = 'export'; + } + } if (not &discussion_visible($status)) { return ''; } my @bgcols = ("#cccccc","#eeeeee"); my $discussiononly=0; if ($mode eq 'board') { $discussiononly=1; } - unless ($ENV{'request.course.id'}) { return ''; } - my $crs='/'.$ENV{'request.course.id'}; - my $cid=$ENV{'request.course.id'}; - if ($ENV{'request.course.sec'}) { - $crs.='_'.$ENV{'request.course.sec'}; - } - $crs=~s/\_/\//g; - unless ($symb) { - $symb=&Apache::lonnet::symbread(); + unless ($env{'request.course.id'}) { return ''; } + my $crs='/'.$env{'request.course.id'}; + my $cid=$env{'request.course.id'}; + if ($env{'request.course.sec'}) { + $crs.='_'.$env{'request.course.sec'}; } - unless ($symb) { return ''; } + $crs=~s/\_/\//g; + unless ($ressymb) { $ressymb=&Apache::lonnet::symbread(); } + unless ($ressymb) { return ''; } + $ressymb=&wrap_symb($ressymb); + my $encsymb=&Apache::lonenc::check_encrypt($ressymb); + my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) + && ($ressymb=~/\.(problem|exam|quiz|assess|survey|form)$/)); + my %usernamesort = (); my %namesort =(); my %subjectsort = (); -# backward compatibility (bulletin boards used to be 'wrapped') - my $ressymb=$symb; - if ($mode eq 'board') { - unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { - $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; - } - } # 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'; + $ressymb=$encsymb; + 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; @@ -111,12 +126,22 @@ sub list_discussion { # Retain identification of "NEW" posts identified in last display, if continuing 'previous' browsing of posts. &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['previous','sortposts','rolefilter','statusfilter','sectionpick','totposters']); - my $sortposts = $ENV{'form.sortposts'}; - my $rolefilter = $ENV{'form.rolefilter'}; - my $statusfilter = $ENV{'form.statusfilter'}; - my $sectionpick = $ENV{'form.sectionpick'}; - my $totposters = $ENV{'form.totposters'}; - $previous = $ENV{'form.previous'}; + my $sortposts = $env{'form.sortposts'}; + my $statusfilter = $env{'form.statusfilter'}; + my @sectionpick = (); + if ($env{'form.sectionpick'} =~ /,/) { + @sectionpick = split/,/,$env{'form.sectionpick'}; + } else { + $sectionpick[0] = $env{'form.sectionpick'}; + } + my @rolefilter = (); + if ($env{'form.rolefilter'} =~ /,/) { + @rolefilter = split/,/,$env{'form.rolefilter'}; + } else { + $rolefilter[0] = $env{'form.rolefilter'}; + } + my $totposters = $env{'form.totposters'}; + $previous = $env{'form.previous'}; if ($previous > 0) { $prevread = $previous; } elsif (defined($dischash{$lastkey})) { @@ -125,25 +150,30 @@ sub list_discussion { } } -# Get information about students and non-stundents in course for filtering display of posts +# Get information about students and non-students in course for filtering display of posts my %roleshash = (); my %roleinfo = (); - if ($rolefilter) { - %roleshash = &Apache::lonnet::dump('nohist_userroles',$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},$ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + if ($env{'form.rolefilter'}) { + %roleshash = &Apache::lonnet::dump('nohist_userroles',$env{'course.'.$env{'request.course.id'}.'.domain'},$env{'course.'.$env{'request.course.id'}.'.num'}); foreach (keys %roleshash) { my ($role,$uname,$udom,$sec) = split/:/,$_; + if ($role =~ /^cr/) { + $role = 'cr'; + } my ($end,$start) = split/:/,$roleshash{$_}; my $now = time; my $status = 'Active'; if (($now < $start) || ($end > 0 && $now > $end)) { $status = 'Expired'; } - push @{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status; + if ($uname && $udom) { + push @{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status; + } } my ($classlist) = &Apache::loncoursedata::get_classlist( - $ENV{'request.course.id'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + $env{'request.course.id'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); my $sec_index = &Apache::loncoursedata::CL_SECTION(); my $status_index = &Apache::loncoursedata::CL_STATUS(); while (my ($student,$data) = each %$classlist) { @@ -154,392 +184,109 @@ sub list_discussion { } # Get discussion display default settings for user - my %userenv = &Apache::lonnet::get('environment',['discdisplay','discmarkread'],$ENV{'user.domain'},$ENV{'user.name'}); - my $discdisplay=$userenv{'discdisplay'}; - if ($discdisplay eq 'unread') { + if ($env{'environment.discdisplay'} eq 'unread') { $showonlyunread = 1; } - my $discmarkread=$userenv{'discmarkread'}; - if ($discmarkread eq 'ondisp') { + if ($env{'environment.discmarkread'} eq 'ondisp') { $markondisp = 1; } # Override user's default if user specified display setting for this discussion if (defined($dischash{$ondispkey})) { - $markondisp = $dischash{$ondispkey}; + unless ($dischash{$ondispkey} eq '') { + $markondisp = $dischash{$ondispkey}; + } } if ($markondisp) { $discinfo{$lastkey} = time; } if (defined($dischash{$showkey})) { - $showonlyunread = $dischash{$showkey}; + unless ($dischash{$showkey} eq '') { + $showonlyunread = $dischash{$showkey}; + } + } + + if (defined($dischash{$markkey})) { + unless ($dischash{$markkey} eq '') { + $showunmark = $dischash{$markkey}; + } } if (defined($dischash{$visitkey})) { - $visit = $dischash{$visitkey}; + unless ($dischash{$visitkey} eq '') { + $visit = $dischash{$visitkey}; + } } $visit ++; my $seeid=&Apache::lonnet::allowed('rin',$crs); - my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) - && ($symb=~/\.(problem|exam|quiz|assess|survey|form)$/)); 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; my $target=''; - unless ($ENV{'browser.interface'} eq 'textual' || - $ENV{'environment.remote'} eq 'off' ) { + unless ($env{'browser.interface'} eq 'textual' || + $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=$contrib{$idx.':message'}; - $message=~s/\n/\
/g; - $message=&Apache::lontexconvert::msgtexconverted($message,undef,$numoldver); - my $subject=$contrib{$idx.':subject'}; - if (defined($subject)) { - $subject=~s/\n/\
/g; - $subject=&Apache::lontexconvert::msgtexconverted($subject,undef,$numoldver); - } - if ($contrib{$idx.':attachmenturl'}) { - my ($fname) - =($contrib{$idx.':attachmenturl'}=~m|/([^/]+)$|); - &Apache::lonnet::allowuploaded('/adm/feedback', - $contrib{$idx.':attachmenturl'}); - $message.='

'.&mt('Attachment'). - ': '. - $fname.'

'; - } - 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 { - 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.' ('. - localtime($posttime).')

'.$message.'

'; - if ($contrib{$idx.':history'}) { - my @postversions = (); - $discussionitems[$idx] .= '
'.&mt('This post has been edited by the author.').'
'.&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]).' '; - } - $discussionitems[$idx] .= '
'; - } - } - } - } - } - } + &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss',\%discinfo,$env{'user.domain'},$env{'user.name'}); + &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,$encsymb,$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', - $ENV{'user.domain'}); + $env{'user.domain'}); my %lt = &Apache::lonlocal::texthash( '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'}; @@ -550,10 +297,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; @@ -561,7 +322,56 @@ sub list_discussion { if ($visible) { # Print the discusssion - if ($outputtarget ne 'tex') { + if ($outputtarget eq 'tex') { + $discussion.='{\tiny \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; + if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) { + $tempexport = $$imsextras{'tempexport'}; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } + $tempexport .= '/'.$$imsextras{'count'}; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } + } else { + $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; + 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 @@ -658,31 +468,26 @@ sub list_discussion { } } } else { - $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 '') && ($env{'environment.threadeddiscussion'})) || ($outputtarget eq 'export')) { $alldiscussion{$_} = $_; } unless ( ($notshown{$alldiscussion{$_}} eq '1') || ($shown{$alldiscussion{$_}} == 0) ) { - if ($outputtarget ne 'tex') { + if ($outputtarget ne 'tex' && $outputtarget ne 'export') { $discussion.="\n"; - } else { - $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'; } my $thisdepth=$depth[$alldiscussion{$_}]; - if ($outputtarget ne 'tex') { + if ($outputtarget ne 'tex' && $outputtarget ne '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) { $discussion.=''; if ($newpostsflag) { if (!$markondisp) { - $discussion .=''; } @@ -615,24 +425,24 @@ sub list_discussion { $discussion .= ''; } $discussion .= '
'. - '  '. - '   -   '.&mt('Mark new posts as read').'  '; + $discussion .=''.&mt('Mark NEW posts no longer new').'  '; } else { $discussion .= '  
'. - ''. + ''.&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 ($sortposts) { + my %sort_types = (); + my %role_types = (); + my %status_types = (); + &sort_filter_names(\%sort_types,\%role_types,\%status_types); + + $discussion .= ''; + } + } + if ($dischash{$toggkey}) { + my $storebutton = &mt('Store read/unread changes'); + $discussion.=''; + } + $discussion .= (<
/; @@ -693,19 +498,50 @@ 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 $manifestfile ' '."\n"; + } + $currdepth = $depth[$alldiscussion{$_}]; + print $manifestfile "\n". + ''. + ''.$imsitems{$alldiscussion{$_}}{'title'}.''; + $imsresources .= "\n". + ''."\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{$_}]. + '
@@ -716,95 +552,815 @@ 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{'cuse'}:   END if ($newpostsflag) { $discussion .= - '1. '.$lt{'disp'}.' - '.$currdisp.'  2. '.$lt{'nolo'}.' - '.$currmark.''.$lt{'disp'}.' - '.$currdisp.'  - $lt{'chgt'}? + $lt{'chgt'}? +
'.&mt('Sorted by').': '.$sort_types{$sortposts}.'
'; + if (defined($env{'form.totposters'})) { + $discussion .= &mt('Posts by').':'; + if ($totposters > 0) { + foreach my $poster (@posters) { + $poster =~ s/:/\@/; + $discussion .= ' '.$poster.','; + } + $discussion =~ s/,$//; + } else { + $discussion .= &mt('None selected'); + } + } else { + my $filterchoice =''; + if (@sectionpick > 0) { + $filterchoice = ''.&mt('sections').'- '.$env{'form.sectionpick'}; + $filterchoice .= '    '; + } + if (@rolefilter > 0) { + $filterchoice .= ''.&mt('roles').'-'; + foreach (@rolefilter) { + $filterchoice .= ' '.$role_types{$_}.','; + } + $filterchoice =~ s/,$//; + $filterchoice .= '
        '; + } + if ($statusfilter) { + $filterchoice .= ''.&mt('status').'- '.$status_types{$statusfilter}; + } + if ($filterchoice) { + $discussion .= ''.&mt('Filters').': '.$filterchoice; + } + $discussion .= '		'. + ''."\n". + ''."\n". + '
-

+

END - } + } + if ($outputtarget eq 'export') { + if ($manifestok) { + while ($currdepth > 0) { + print $manifestfile " \n"; + $currdepth --; + } + print $manifestfile qq| + + + + $imsresources + + + |; + close($manifestfile); + if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) { + $discussion = $copyresult; + } else { + +#Create zip file in prtspool + + my $imszipfile = '/prtspool/'. + $env{'user.name'}.'_'.$env{'user.domain'}.'_'. + time.'_'.rand(1000000000).'.zip'; + my $cwd = &getcwd(); + my $imszip = '/home/httpd/'.$imszipfile; + chdir $tempexport; + open(OUTPUT, "zip -r $imszip * 2> /dev/null |"); + close(OUTPUT); + chdir $cwd; + $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) { - $discussion.=(< 0) { + $attachnum += @currnewattach; + } + } + if (&discussion_open($status)) { + $discussion.=(< -
-Note: in anonymous discussion, your name is visible only to -course faculty
-Title: 

- -

-Attachment (128 KB max size): -

- + +
+Note: in anonymous discussion, your name is visible only +to course faculty
+Title: 

+ ENDDISCUSS - if ($outputtarget ne 'tex') { - $discussion.=&generate_preview_button(); + if ($env{'form.origpage'}) { + $discussion.=''."\n"; + foreach (@currnewattach) { + $discussion.=''."\n"; + } + } + $discussion.="\n"; + if ($outputtarget ne 'tex') { + $discussion.=&generate_attachments_button('',$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,'',$mode); + if (@currnewattach > 0) { + $newattachmsg .= 'New attachments
'; + if (@currnewattach > 1) { + $newattachmsg .= '
    '; + foreach my $item (@currnewattach) { + $item =~ m#.*/([^/]+)$#; + $newattachmsg .= '
  1. '.$1.'
    2. '."\n"; + } + $newattachmsg .= '
'."\n"; + } else { + $currnewattach[0] =~ m#.*/([^/]+)$#; + $newattachmsg .= ''.$1.'
'."\n"; + } + } + $discussion.=$newattachmsg; + $discussion.=&generate_preview_button(); + } } } else { - if (&discussion_open($status) && - &Apache::lonnet::allowed('pch', - $ENV{'request.course.id'}. - ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { + if (&discussion_open($status) && + &Apache::lonnet::allowed('pch', + $env{'request.course.id'}. + ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { if ($outputtarget ne 'tex') { $discussion.='
'. - ''. + $ressymb.':::" '.$target.'>'. + ''. &mt('Post Discussion').'
'; } } } - 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 $symb=&Apache::lonenc::check_decrypt($ressymb); + my %contrib=&Apache::lonnet::restore($symb,$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; + } + my ($skiptest,$rolematch,$roleregexp,$secregexp,$statusregexp); + if ($sortposts) { + ($skiptest,$roleregexp,$secregexp,$statusregexp) = &filter_regexp($rolefilter,$sectionpick,$statusfilter); + $rolematch = $roleregexp.':'.$secregexp.':'.$statusregexp; + } + 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 '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 = ''; + } else { + $ctlink = ''; + } + } +#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 '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; + if (defined($env{'form.totposters'})) { + if ($totposters == 0) { + $$shown{$idx} = 0; + } elsif ($totposters > 0) { + if (grep/^$poster$/,@{$posters}) { + $$shown{$idx} = 1; + } + } + } elsif ($sortposts) { + if ($skiptest) { + $$shown{$idx} = 1; + } else { + foreach my $role (@{$$roleinfo{$poster}}) { + if ($role =~ /^cc:/) { + my $cc_regexp = $roleregexp.':[^:]*:'.$statusregexp; + if ($role =~ /$cc_regexp/) { + $$shown{$idx} = 1; + last; + } + } elsif ($role =~ /^$rolematch$/) { + $$shown{$idx} = 1; + last; + } + } + } + } else { + $$shown{$idx} = 1; + } + } + 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 filter_regexp { + my ($rolefilter,$sectionpick,$statusfilter) = @_; + my ($roleregexp,$secregexp,$statusregexp); + my $skiptest = 1; + if (@{$rolefilter} > 0) { + my @okrolefilter = (); + foreach (@{$rolefilter}) { + unless ($_ eq '') { + push @okrolefilter, $_; + } + } + if (@okrolefilter > 0) { + if (grep/^all$/,@okrolefilter) { + $roleregexp='[^:]+'; + } else { + if (@okrolefilter == 1) { + $roleregexp=$okrolefilter[0]; + } else { + $roleregexp='('.join('|',@okrolefilter).')'; + } + $skiptest = 0; + } + } + } + if (@{$sectionpick} > 0) { + my @oksectionpick = (); + foreach (@{$sectionpick}) { + unless ($_ eq '') { + push @oksectionpick, $_; + } + } + if ((@oksectionpick > 0) && (!grep/^all$/,@oksectionpick)) { + if (@oksectionpick == 1) { + $secregexp = $oksectionpick[0]; + } else { + $secregexp .= '('.join('|',@oksectionpick).')'; + } + $skiptest = 0; + } else { + $secregexp .= '[^:]*'; + } + } + if (defined($statusfilter) && $statusfilter ne '') { + if ($statusfilter eq 'all') { + $statusregexp = '[^:]+'; + } else { + $statusregexp = $statusfilter; + $skiptest = 0; + } + } + return ($skiptest,$roleregexp,$secregexp,$statusregexp); +} + + +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'}); + ($$screenname,$$plainname)=($$contrib{$idx.':screenname'}, + $$contrib{$idx.':plainname'}); + 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); + 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 file attachment - '.$5.' to IMS package: '.$!.'
'."\n"; + } + } else { + &Apache::lonnet::logthis("Replication of attachment failed when building IMS export of discussion posts - domain: $1, course: $2, file: $$attachrefs{$id}{'filename'} -error: $rtncode"); + $response .= 'Error copying file attachment - '.$5.' to IMS package: '.$rtncode.'
'."\n"; + } + } + } + } + return $response; } sub mail_screen { my ($r,$feedurl,$options) = @_; + if (exists($env{'form.origpage'})) { + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','currnewattach','addnewattach','deloldattach','delnewattach','timestamp','idx','anondiscuss','discuss']); + } my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion', '','onLoad="window.focus();setposttype();"'); my $title=&Apache::lonnet::gettitle($feedurl); if (!$title) { $title = $feedurl; } my $quote=''; my $subject = ''; - my $oldmessage = ''; + my $comment = ''; my $prevtag = ''; my $parentmsg = ''; - my $anonscript = (</g; - $quote='
'.&Apache::lontexconvert::msgtexconverted($message,undef,$numoldver).'
'; + my $message; if ($idx > 0) { - if ($contrib{'subject'} =~ /::::\d+::::(.+)$/si) { - $subject = $1; - } else { - $subject = $contrib{$idx.':subject'}; - } - $subject = 'Re: '.$subject; + my %msgversions = (); + &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); + $message = $msgversions{$numoldver}; } - } else { - if ($contrib{$idx.':message'} =~ /::::\d+::::(.+)$/si) { - $oldmessage = $1; - } else { - $oldmessage = $contrib{$idx.':message'}; + &newline_to_br(\$message); + $quote='
'.&Apache::lontexconvert::msgtexconverted($message).'
'; + if ($idx > 0) { + my %subversions = (); + &get_post_versions(\%subversions,$contrib{$idx.':subject'},1,$numoldver); + $subject = 'Re: '.$subversions{$numoldver}; } - $oldmessage=&HTML::Entities::encode($oldmessage,'<>&"'); - if ($contrib{$idx.':subject'} =~ /::::\d+::::(.+)$/si) { - $subject = $1; - } else { - $subject = $contrib{$idx.':subject'}; + $subject = &HTML::Entities::encode($subject,'<>&"'); + } else { + $attachmenturls = $contrib{$idx.':attachmenturl'}; + 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'}; } - my $anonflag = 0; - if ($contrib{$idx.':anonymous'}) { - $anonflag = 1; - } - $anonscript = (<'; + if ($env{'form.previous'}) { + $prevtag = ''; } } + + if ($env{'form.origpage'}) { + $subject = &Apache::lonnet::unescape($env{'form.subject'}); + $comment = &Apache::lonnet::unescape($env{'form.comment'}); + &process_attachments(\@currnewattach,\@currdelold,\@keepold); + } my $latexHelp=&Apache::loncommon::helpLatexCheatsheet(); my $htmlheader=&Apache::lonhtmlcommon::htmlareaheaders(); my $send=&mt('Send'); + my $html=&Apache::lonxml::xmlbegin(); $r->print(< +$html The LearningOnline Network with CAPA @@ -908,7 +1474,7 @@ $htmlheader } if (rec) { - if (typeof(document.mailform.onsubmit)!='undefined') { + if (typeof(document.mailform.onsubmit)=='function') { document.mailform.onsubmit(); } document.mailform.submit(); @@ -916,6 +1482,7 @@ $htmlheader alert('Please check a feedback type.'); } } + $anonchk $anonscript //--> @@ -927,17 +1494,17 @@ enctype="multipart/form-data"> $prevtag END - if ($ENV{'form.replydisc'}) { + if ($env{'form.replydisc'}) { $r->print(< + END - } elsif ($ENV{'form.editdisc'}) { + } elsif ($env{'form.editdisc'}) { $r->print(< + END } - $r->print(<print(< $quote @@ -946,32 +1513,88 @@ $quote $latexHelp Title:

-

+END + if ( ($env{'form.editdisc'}) || ($env{'form.replydisc'}) ) { + if ($env{'form.origpage'}) { + foreach (@currnewattach) { + $r->print(''."\n"); + } + foreach (@currdelold) { + $r->print(''."\n"); + } + } + if ($env{'form.editdisc'}) { + if ($attachmenturls) { + &extract_attachments($attachmenturls,$idx,$numoldver,\$attachmsg,\%attachments,\%currattach,\@currdelold); + $attachnum = scalar(keys %currattach); + foreach (keys %currattach) { + $r->print(''."\n"); + } + } + } + } else { + $r->print(<

+END + } + $r->print(<

-ENDDOCUMENT -$r->print(&generate_preview_button(). -&Apache::lonhtmlcommon::htmlareaselectactive('comment'). -''); +END + if ($env{'form.editdisc'} || $env{'form.replydisc'}) { + my $now = time; + my $ressymb = $symb; + my $postidx = ''; + if ($env{'form.editdisc'}) { + $postidx = $idx; + } + if (@currnewattach > 0) { + $attachnum += @currnewattach; + } + $r->print(&generate_attachments_button($postidx,$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,$numoldver)); + if ($attachnum > 0) { + if (@currnewattach > 0) { + $newattachmsg .= 'New attachments
'; + if (@currnewattach > 1) { + $newattachmsg .= '
    '; + foreach my $item (@currnewattach) { + $item =~ m#.*/([^/]+)$#; + $newattachmsg .= '
  1. '.$1.'
    2. '."\n"; + } + $newattachmsg .= '
'."\n"; + } else { + $currnewattach[0] =~ m#.*/([^/]+)$#; + $newattachmsg .= ''.$1.'
'."\n"; + } + } + if ($attachmsg) { + $r->print("Retained attachments:$attachmsg
\n"); + } + if ($newattachmsg) { + $r->print("$newattachmsg
"); + } + } + } + $r->print(&generate_preview_button(). + &Apache::lonhtmlcommon::htmlareaselectactive('comment'). + ''); } sub print_display_options { - my ($r,$symb,$previous,$dispchg,$markchg,$feedurl) = @_; - # backward compatibility (bulletin boards used to be 'wrapped') - if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { - $feedurl=~s|^/adm/wrapper||; - } + my ($r,$symb,$previous,$dispchgA,$dispchgB,$markchg,$toggchg,$feedurl) = @_; + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; my $function = &Apache::loncommon::get_users_function(); my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg', - $ENV{'user.domain'}); + $env{'user.domain'}); my $bodytag=&Apache::loncommon::bodytag('Discussion options', '',''); @@ -983,54 +1606,117 @@ 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'; + } + my $html=&Apache::lonxml::xmlbegin(); $r->print(< +$html $lt{'dido'} $bodytag
@@ -1169,60 +1879,61 @@ $bodytag $lt{'soor'}   - $lt{'disp'} + $lt{'sprs'}   - $lt{'actv'} + $lt{'spur'}   $lt{'spse'}   $lt{'psub'} - +   - - +
@@ -1233,26 +1944,20 @@ END sub print_showposters { my ($r,$symb,$previous,$feedurl,$sortposts) = @_; - # backward compatibility (bulletin boards used to be 'wrapped') - if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { - $feedurl=~s|^/adm/wrapper||; - } -# backward compatibility (bulletin boards used to be 'wrapped') - my $ressymb=$symb; - if ($ressymb =~ /bulletin___\d+___/) { - unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { - $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; - } - } - my $crs='/'.$ENV{'request.course.id'}; - if ($ENV{'request.course.sec'}) { - $crs.='_'.$ENV{'request.course.sec'}; + + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + + &Apache::lonenc::check_encrypt(\$symb); + my $crs='/'.$env{'request.course.id'}; + if ($env{'request.course.sec'}) { + $crs.='_'.$env{'request.course.sec'}; } $crs=~s/\_/\//g; my $seeid=&Apache::lonnet::allowed('rin',$crs); - 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 %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); my %namesort = (); my %postcounts = (); my %lt=&Apache::lonlocal::texthash( @@ -1291,8 +1996,9 @@ sub print_showposters { } } } + my $html=&Apache::lonxml::xmlbegin(); $r->print(< +$html $lt{'diso'} @@ -1319,7 +2025,7 @@ END next; } else { $count ++; - $r->print(''.$count.''.$last.', '.$first.' ('.$uname.','.$udom.')'.$postcounts{$_}.''); + $r->print(''.$count.''.$postcounts{$_}.''); } } } @@ -1339,25 +2045,90 @@ END END } +sub get_post_versions { + my ($versions,$incoming,$htmldecode,$numver) = @_; + if ($incoming =~ /^/) { + 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{$numver} = &HTML::Entities::encode($incoming,'<>&"'); + } + } + return; +} + +sub get_post_attachments { + my ($attachments,$attachmenturls) = @_; + my $num; + if ($attachmenturls =~ m/^/) { + 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 fail_redirect { my ($r,$feedurl) = @_; if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; + my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); + my $html=&Apache::lonxml::xmlbegin(); $r->print (< -Feedback not sent +$html + +Feedback not sent - + Sorry, no recipients ... +
Continue ENDFAILREDIR } sub redirect_back { - my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status,$previous,$sort,$rolefilter,$statusfilter,$secpick,$numpicks) = @_; + my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status,$previous,$sort,$rolefilter,$statusfilter,$sectionpick,$numpicks) = @_; my $sorttag = ''; my $roletag = ''; my $statustag = ''; @@ -1365,10 +2136,11 @@ sub redirect_back { my $userpicktag = ''; my $qrystr = ''; my $prevtag = ''; - # backward compatibility (bulletin boards used to be 'wrapped') - if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { - $feedurl=~s|^/adm/wrapper||; - } + + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + + &dewrapper(\$feedurl); if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; if ($previous > 0) { $qrystr = 'previous='.$previous; @@ -1387,29 +2159,55 @@ sub redirect_back { $feedurl .= '?'.$sortqry; } $sorttag = ''; - if ( (defined($numpicks)) && ($numpicks > 0) ) { + if (defined($numpicks)) { my $userpickqry = 'totposters='.$numpicks; $feedurl .= '&'.$userpickqry; $userpicktag = ''; } else { - my $roleqry = 'rolefilter='.$rolefilter; - $feedurl .= '&'.$roleqry; - $roletag = ''; + if (ref($sectionpick) eq 'ARRAY') { + $feedurl .= '§ionpick='; + $sectag .= ''; + } else { + $feedurl .= '§ionpick='.$sectionpick; + $sectag = ''; + } + if (ref($rolefilter) eq 'ARRAY') { + $feedurl .= '&rolefilter='; + $roletag .= ''; + } else { + $feedurl .= '&rolefilter='.$rolefilter; + $roletag = ''; + } $feedurl .= '&statusfilter='.$statusfilter; $statustag =''; - $feedurl .= '§ionpick='.$secpick; - $sectag = ''; } } + $feedurl=&Apache::lonenc::check_encrypt($feedurl); + my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); + my $html=&Apache::lonxml::xmlbegin(); $r->print (< +$html Feedback sent - + $typestyle Sent $sendsomething message(s), and $sendposts post(s). $status @@ -1421,6 +2219,7 @@ $roletag $sectag $userpicktag +
Continue ENDREDIR @@ -1429,68 +2228,76 @@ ENDREDIR sub no_redirect_back { my ($r,$feedurl) = @_; my $nofeed=&mt('Sorry, no feedback possible on this resource ...'); + my $continue=&mt('Continue'); + my $html=&Apache::lonxml::xmlbegin(); $r->print (< -Feedback not sent +$html + +Feedback not sent ENDNOREDIR if ($feedurl!~/^\/adm\/feedback/) { - $r->print(''); + $r->print(''); } - + $feedurl=&Apache::lonenc::check_encrypt($feedurl); + my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); $r->print (< - + $nofeed +
$continue ENDNOREDIRTWO } sub screen_header { - my ($feedurl) = @_; + my ($feedurl,$symb) = @_; my $msgoptions=''; my $discussoptions=''; - unless (($ENV{'form.replydisc'}) || ($ENV{'form.editdisc'})) { - if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) { + unless (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { + if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/) && ($env{'user.adv'})) { $msgoptions= - '

'. - &mt('Feedback to resource author').'

'; + '

'; } if (&feedback_available(1)) { $msgoptions.= - '
'. - &mt('Question about resource content'); + '

'; } if (&feedback_available(0,1)) { $msgoptions.= - '
'. - &mt('Question/Comment/Feedback about course content'); + '

'; } if (&feedback_available(0,0,1)) { $msgoptions.= - '
'. - &mt('Question/Comment/Feedback about course policy'); + '

'; } } - if ($ENV{'request.course.id'}) { - if (&discussion_open() && + if ($env{'request.course.id'}) { + if (&discussion_open(undef,$symb) && &Apache::lonnet::allowed('pch', - $ENV{'request.course.id'}. - ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { - $discussoptions=' '. + $env{'request.course.id'}. + ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { + $discussoptions='
'; + } } - if ($msgoptions) { $msgoptions='

'.&mt('Sending Messages').'

'.$msgoptions; } + if ($msgoptions) { $msgoptions='

'.&mt('Sending Messages').'

'.$msgoptions; } if ($discussoptions) { - $discussoptions='

'.&mt('Discussion Contributions').'

'.$discussoptions; } + $discussoptions='

'.&mt('Discussion Contributions').'

'.$discussoptions; } return $msgoptions.$discussoptions; } @@ -1513,15 +2320,15 @@ sub clear_out_html { # Always allow the -tag my %html=(M=>1); # Check if more is allowed - my $cid=$ENV{'request.course.id'}; - if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) || + my $cid=$env{'request.course.id'}; + if (($env{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) || ($override)) { # allows


      • #

        # %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1, BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1, - M=>1, SUB=>1, SUP=>1, SPAN=>1, + M=>1, ALGEBRA=>1, SUB=>1, SUP=>1, SPAN=>1, H1=>1, H2=>1, H3=>1, H4=>1, H5=>1); } # Do the substitution of everything that is not explicitly allowed @@ -1535,8 +2342,6 @@ sub clear_out_html { sub assemble_email { my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_; my $email=<<"ENDEMAIL"; -Refers to $feedurl - $message ENDEMAIL my $citations=<<"ENDCITE"; @@ -1559,7 +2364,7 @@ sub secapply { my ($adr,$sections)=($rec=~/^([^\(]+)\(([^\)]+)\)/); if ($sections) { foreach (split(/\;/,$sections)) { - if (($_ eq $ENV{'request.course.sec'}) || + if (($_ eq $env{'request.course.sec'}) || ($defaultflag && ($_ eq '*'))) { return $adr; } @@ -1570,37 +2375,68 @@ sub secapply { return ''; } +=pod + +=over 4 + +=item * + +decide_receiver($feedurl,$author,$question,$course,$policy,$defaultflag); + +Arguments + $feedurl - /res/ url of resource (only need if $author is true) + $author,$question,$course,$policy - all true/false parameters + if true will attempt to find the addresses of user that should receive + this type of feedback (author - feedback to author of resource $feedurl, + $question 'Resource Content Questions', $course 'Course Content Question', + $policy 'Course Policy') + (Additionally it also checks $env for whether the corresponding form. + element exists, for ease of use in a html response context) + + $defaultflag - (internal should be left blank) if true gather addresses + that aren't for a section even if I have a section + (used for reccursion internally, first we look for + addresses for our specific section then we recurse + and look for non section addresses) + +Returns + $typestyle - string of html text, describing what addresses were found + %to - a hash, which keys are addresses of users to send messages to + the keys will look like name:domain + +=cut + sub decide_receiver { my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; my $typestyle=''; my %to=(); - if ($ENV{'form.author'}||$author) { - $typestyle.='Submitting as Author Feedback
        '; + if ($env{'form.author'}||$author) { + $typestyle.='Submitting as Author Feedback
        '; $feedurl=~/^\/res\/(\w+)\/(\w+)\//; $to{$2.':'.$1}=1; } - if ($ENV{'form.question'}||$question) { - $typestyle.='Submitting as Question
        '; + if ($env{'form.question'}||$question) { + $typestyle.='Submitting as Question
        '; foreach (split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) + $env{'course.'.$env{'request.course.id'}.'.question.email'}) ) { my $rec=&secapply($_,$defaultflag); if ($rec) { $to{$rec}=1; } } } - if ($ENV{'form.course'}||$course) { + if ($env{'form.course'}||$course) { $typestyle.='Submitting as Comment
        '; foreach (split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) + $env{'course.'.$env{'request.course.id'}.'.comment.email'}) ) { my $rec=&secapply($_,$defaultflag); if ($rec) { $to{$rec}=1; } } } - if ($ENV{'form.policy'}||$policy) { + if ($env{'form.policy'}||$policy) { $typestyle.='Submitting as Policy Feedback
        '; foreach (split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) + $env{'course.'.$env{'request.course.id'}.'.policy.email'}) ) { my $rec=&secapply($_,$defaultflag); if ($rec) { $to{$rec}=1; } @@ -1653,39 +2489,47 @@ sub send_msg { sub adddiscuss { my ($symb,$email,$anon,$attachmenturl,$subject)=@_; my $status=''; - if (&discussion_open() && - &Apache::lonnet::allowed('pch',$ENV{'request.course.id'}. - ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { + my $realsymb; + if ($symb=~/^bulletin___/) { + my $filename=(&Apache::lonnet::decode_symb($symb))[2]; + $filename=~s|^adm/wrapper/||; + $realsymb=&Apache::lonnet::symbread($filename); + } + if (&discussion_open(undef,$realsymb) && + &Apache::lonnet::allowed('pch',$env{'request.course.id'}. + ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { my %contrib=('message' => $email, - 'sendername' => $ENV{'user.name'}, - 'senderdomain' => $ENV{'user.domain'}, - 'screenname' => $ENV{'environment.screenname'}, - 'plainname' => $ENV{'environment.firstname'}.' '. - $ENV{'environment.middlename'}.' '. - $ENV{'environment.lastname'}.' '. - $ENV{'enrironment.generation'}, + 'sendername' => $env{'user.name'}, + 'senderdomain' => $env{'user.domain'}, + 'screenname' => $env{'environment.screenname'}, + 'plainname' => $env{'environment.firstname'}.' '. + $env{'environment.middlename'}.' '. + $env{'environment.lastname'}.' '. + $env{'enrironment.generation'}, 'attachmenturl'=> $attachmenturl, 'subject' => $subject); - if ($ENV{'form.replydisc'}) { - $contrib{'replyto'}=(split(/\:\:\:/,$ENV{'form.replydisc'}))[1]; + if ($env{'form.replydisc'}) { + $contrib{'replyto'}=(split(/\:\:\:/,$env{'form.replydisc'}))[1]; } if ($anon) { $contrib{'anonymous'}='true'; } if (($symb) && ($email)) { - if ($ENV{'form.editdisc'}) { + if ($env{'form.editdisc'}) { my %newcontrib = (); $contrib{'ip'}=$ENV{'REMOTE_ADDR'}; $contrib{'host'}=$Apache::lonnet::perlvar{'lonHostID'}; $contrib{'timestamp'} = time; $contrib{'history'} = ''; my $numoldver = 0; - my ($oldsymb,$oldidx)=split(/\:\:\:/,$ENV{'form.editdisc'}); + my ($oldsymb,$oldidx)=split(/\:\:\:/,$env{'form.editdisc'}); + &Apache::lonenc::check_decrypt(\$oldsymb); + $oldsymb=~s|(bulletin___\d+___)adm/wrapper/|$1|; # get timestamp for last post and history - my %oldcontrib=&Apache::lonnet::restore($oldsymb,$ENV{'request.course.id'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + my %oldcontrib=&Apache::lonnet::restore($oldsymb,$env{'request.course.id'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); if (defined($oldcontrib{$oldidx.':replyto'})) { $contrib{'replyto'} = $oldcontrib{$oldidx.':replyto'}; } @@ -1698,33 +2542,44 @@ sub adddiscuss { } $contrib{'history'} = $oldcontrib{$oldidx.':history'}.':'; } + my $numnewver = $numoldver + 1; if (defined($oldcontrib{$oldidx.':subject'})) { - $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.'::::'.$numoldver.'::::'.$contrib{'subject'}; + if ($oldcontrib{$oldidx.':subject'} =~ /^/) { + $contrib{'subject'} = ''.&HTML::Entities::encode($contrib{'subject'},'<>&"').''; + $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.$contrib{'subject'}; + } else { + $contrib{'subject'} = ''.&HTML::Entities::encode($oldcontrib{$oldidx.':subject'},'<>&"').''.&HTML::Entities::encode($contrib{'subject'},'<>&"').''; + } } if (defined($oldcontrib{$oldidx.':message'})) { - $contrib{'message'} = $oldcontrib{$oldidx.':message'}.'::::'.$numoldver.'::::'.$contrib{'message'}; + if ($oldcontrib{$oldidx.':message'} =~ /^/) { + $contrib{'message'} = ''.&HTML::Entities::encode($contrib{'message'},'<>&"').''; + $contrib{'message'} = $oldcontrib{$oldidx.':message'}.$contrib{'message'}; + } else { + $contrib{'message'} = ''.&HTML::Entities::encode($oldcontrib{$oldidx.':message'},'<>&"').''.&HTML::Entities::encode($contrib{'message'},'<>&"').''; + } } $contrib{'history'} .= $oldcontrib{$oldidx.':timestamp'}; foreach (keys %contrib) { my $key = $oldidx.':'.&Apache::lonnet::escape($oldsymb).':'.$_; $newcontrib{$key} = $contrib{$_}; } - my $put_reply = &Apache::lonnet::putstore($ENV{'request.course.id'}, + my $put_reply = &Apache::lonnet::putstore($env{'request.course.id'}, \%newcontrib, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); $status='Editing class discussion'.($anon?' (anonymous)':''); } else { $status='Adding to class discussion'.($anon?' (anonymous)':'').': '. - &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + &Apache::lonnet::store(\%contrib,$symb,$env{'request.course.id'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); } my %storenewentry=($symb => time); $status.='
        '.&mt('Updating discussion time').': '. &Apache::lonnet::put('discussiontimes',\%storenewentry, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); } my %record=&Apache::lonnet::restore('_discussion'); my ($temp)=keys %record; @@ -1745,16 +2600,42 @@ sub adddiscuss { sub show_preview { my $r=shift; - my $message=&clear_out_html($ENV{'form.comment'}); - $message=~s/\n/\
        /g; + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + my $message=&clear_out_html($env{'form.comment'}); + &newline_to_br(\$message); $message=&Apache::lonspeller::markeduptext($message); $message=&Apache::lontexconvert::msgtexconverted($message); - my $subject=&clear_out_html($ENV{'form.subject'}); + my $subject=&clear_out_html($env{'form.subject'}); $subject=~s/\n/\
        /g; $subject=&Apache::lontexconvert::msgtexconverted($subject); - $r->print('
        '. - 'Subject: '.$subject.'

        '. - $message.'
        '); + my $html=&Apache::lonxml::xmlbegin(); + $r->print($html.''. + '
        '. + 'Subject: '.$subject.'

        '. + $message.'
        '); +} + + +sub newline_to_br { + my ($message)=@_; + my $newmessage; + my $parser=HTML::LCParser->new($message); + while (my $token=$parser->get_token()) { + if ($token->[0] eq 'T') { + my $text=$token->[1]; + $text=~s/\n/\
        /g; + $newmessage.=$text; + } elsif ($token->[0] eq 'D' || $token->[0] eq 'C') { + $newmessage.=$token->[1]; + } elsif ($token->[0] eq 'PI' || $token->[0] eq 'E') { + $newmessage.=$token->[2]; + } elsif ($token->[0] eq 'S') { + $newmessage.=$token->[4]; + } + + } + $$message=$newmessage; } sub generate_preview_button { @@ -1764,11 +2645,314 @@ sub generate_preview_button { +onClick="if (typeof(document.mailform.onsubmit)=='function') {document.mailform.onsubmit();};this.form.comment.value=document.mailform.comment.value;this.form.subject.value=document.mailform.subject.value;this.form.submit();" /> ENDPREVIEW } +sub modify_attachments { + my ($r,$currnewattach,$currdelold,$symb,$idx,$attachmenturls)=@_; + my $orig_subject = &Apache::lonnet::unescape($env{'form.subject'}); + my $subject=&clear_out_html($orig_subject); + $subject=~s/\n/\
        /g; + $subject=&Apache::lontexconvert::msgtexconverted($subject); + my $timestamp=$env{'form.timestamp'}; + my $numoldver=$env{'form.numoldver'}; + my $bodytag=&Apache::loncommon::bodytag('Discussion Post Attachments', + '',''); + my $msg = ''; + my %attachments = (); + my %currattach = (); + if ($idx) { + &extract_attachments($attachmenturls,$idx,$numoldver,\$msg,\%attachments,\%currattach,$currdelold); + } + &Apache::lonenc::check_encrypt(\$symb); + my $html=&Apache::lonxml::xmlbegin(); + $r->print(< +Managing Attachments + + +$bodytag +
        + + + + +
        + Subject: $subject

        +END + if ($idx) { + if ($attachmenturls) { + my @currold = keys %currattach; + if (@currold > 0) { + $r->print("The following attachments were part of the most recent saved version of this posting.
        Check the checkboxes for any you wish to remove
        \n"); + foreach my $id (@currold) { + my $attachurl = &HTML::Entities::decode($attachments{$id}{'filename'}); + $attachurl =~ m#/([^/]+)$#; + $r->print('
        '."\n"); + } + $r->print("
        "); + } + } + } + if (@{$currnewattach} > 0) { + $r->print("The following attachments have been uploaded for inclusion with this posting.
        Check the checkboxes for any you wish to remove
        \n"); + foreach (@{$currnewattach}) { + $_ =~ m#/([^/]+)$#; + $r->print('
        '."\n"); + } + $r->print("
        "); + } + $r->print(< +
        + + + + + + + + +END + foreach (@{$currnewattach}) { + $r->print(''."\n"); + } + foreach (@{$currdelold}) { + $r->print(''."\n"); + } + $r->print(< + + + +END + return; +} + +sub process_attachments { + my ($currnewattach,$currdelold,$keepold) = @_; + + @{$currnewattach}= + &Apache::loncommon::get_env_multiple('form.currnewattach'); + @{$currdelold}= + &Apache::loncommon::get_env_multiple('form.deloldattach'); + if (exists($env{'form.delnewattach'})) { + my @currdelnew = + &Apache::loncommon::get_env_multiple('form.delnewattach'); + my @currnew = (); + foreach my $newone (@{$currnewattach}) { + my $delflag = 0; + foreach (@currdelnew) { + if ($newone eq $_) { + $delflag = 1; + last; + } + } + unless ($delflag) { + push @currnew, $newone; + } + } + @{$currnewattach} = @currnew; + } + @{$keepold} = &Apache::loncommon::get_env_multiple('form.keepold'); +} + +sub generate_attachments_button { + my ($idx,$attachnum,$ressymb,$now,$currnewattach,$deloldattach,$numoldver,$mode) = @_; + my $origpage = $ENV{'REQUEST_URI'}; + my $att=$attachnum.' '.&mt("attachments"); + my $response = (< +Click to add/remove attachments:  + + + + + + + + +ENDATTACH + if (defined($deloldattach)) { + if (@{$deloldattach} > 0) { + foreach (@{$deloldattach}) { + $response .= ''."\n"; + } + } + } + if (defined($currnewattach)) { + if (@{$currnewattach} > 0) { + foreach (@{$currnewattach}) { + $response .= ''."\n"; + } + } + } + $response .= ''; + return $response; +} + +sub extract_attachments { + my ($attachmenturls,$idx,$numoldver,$message,$attachments,$currattach,$currdelold) = @_; + %{$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 $attachurl; + if ($attachmenturls =~ m/^/) { + $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); + } else { + $attachurl = $$attachments{$id}{'filename'}; + } + $attachurl=~m|/([^/]+)$|; + $$message.='
        '. + $1.'
        '; + &Apache::lonnet::allowuploaded('/adm/feedback', + $attachurl); + } elsif (@attached > 1) { + $$message.='
          '; + foreach (@attached) { + my $id = $_; + my $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); + my ($fname) + =($attachurl=~m|/([^/]+)$|); + $$message .= '
        1. '. + $fname.'
          2. '; + &Apache::lonnet::allowuploaded('/adm/feedback', + $attachurl); + } + $$message .= '
        '; + } +} + +sub construct_attachmenturl { + my ($currnewattach,$keepold,$symb,$idx)=@_; + my $oldattachmenturl; + my $newattachmenturl; + my $startnum = 0; + my $currver = 0; + if (($env{'form.editdisc'}) && ($idx)) { + my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + $oldattachmenturl = $contrib{$idx.':attachmenturl'}; + if ($contrib{$idx.':history'}) { + if ($contrib{$idx.':history'} =~ /:/) { + my @oldversions = split/:/,$contrib{$idx.':history'}; + $currver = 1 + scalar(@oldversions); + } else { + $currver = 2; + } + } else { + $currver = 1; + } + if ($oldattachmenturl) { + if ($oldattachmenturl =~ m/^/) { + my %attachments = (); + my $prevver = $currver-1; + &get_post_attachments(\%attachments,$oldattachmenturl); + my $numattach = scalar(keys %attachments); + $startnum += $numattach; + foreach my $num (sort {$a <=> $b} keys %attachments) { + $newattachmenturl .= ''.$attachments{$num}{'filename'}.''; + foreach $_ (sort {$a <=> $b} keys %{$attachments{$num}}) { + unless ($_ eq 'filename') { + $newattachmenturl .= ''.$attachments{$num}{$_}.''; + } + } + if (grep/^$num$/,@{$keepold}) { + $newattachmenturl .= ''.$attachments{$num}{$prevver}.''; + } + $newattachmenturl .= ''; + } + } else { + $newattachmenturl = ''.&HTML::Entities::encode($oldattachmenturl).'n'; + unless (grep/^0$/,@{$keepold}) { + $newattachmenturl .= 'n'; + } + $newattachmenturl .= ''; + $startnum ++; + } + } + } + for (my $i=0; $i<@{$currnewattach}; $i++) { + my $attachnum = $startnum + $i; + $newattachmenturl .= ''.&HTML::Entities::encode($$currnewattach[$i]).'n'; + } + return $newattachmenturl; +} + +sub has_discussion { + my $resourcesref = shift; + my $navmap = Apache::lonnavmaps::navmap->new(); + my @allres=$navmap->retrieveResources(); + foreach my $resource (@allres) { + if ($resource->hasDiscussion()) { + my $ressymb = $resource->wrap_symb(); + push @{$resourcesref}, $ressymb; + } + } + return; +} + +sub sort_filter_names { + my ($sort_types,$role_types,$status_types) = @_; + %{$sort_types} = ( + ascdate => 'Date order - oldest first', + descdate => 'Date order - newest first', + thread => 'Threaded', + subject => 'By subject', + username => 'By domain and username', + lastfirst => 'By last name, first name' + ); + %{$role_types} = ( + all => 'All roles', + st => 'Students', + cc => 'Course Coordinators', + in => 'Instructors', + ta => 'TAs', + ep => 'Exam proctors', + ad => 'Administrators', + cr => 'Custom roles' + ); + %{$status_types} = ( + all => 'Roles of any status', + Active => 'Only active roles', + Expired => 'Only inactive roles' + ); +} + sub handler { my $r = shift; if ($r->header_only) { @@ -1780,363 +2964,380 @@ sub handler { # --------------------------- 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','previous','markread','markonread','markondisp','modifydisp','changes','navmaps','navurl','sortfilter','sortposts','applysort','rolefilter','statusfilter','sectionpick','posterlist','userpick']); - if ($ENV{'form.posterlist'}) { - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - my $symb=$ENV{'form.posterlist'}; - my $sortposts = $ENV{'form.sortposts'}; - 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$|) { - $feedurl=~s|^/adm/wrapper||; + ['hide','unhide','deldisc','postdata','preview','replydisc','editdisc','cmd','symb','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navtime','navmaps','navurl','sortposts','applysort','rolefilter','statusfilter','sectionpick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export']); + + if ($env{'form.discsymb'}) { + my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.discsymb'}); + my $readkey = $symb.'_read'; + my $chgcount = 0; + my %readinghash = &Apache::lonnet::get('nohist_'.$env{'request.course.id'}.'_discuss',[$readkey],$env{'user.domain'},$env{'user.name'}); + foreach my $key (keys %env) { + if ($key =~ m/^form\.postunread_(\d+)/) { + if ($readinghash{$readkey} =~ /\.$1\./) { + $readinghash{$readkey} =~ s/\.$1\.//; + $chgcount ++; + } + } elsif ($key =~ m/^form\.postread_(\d+)/) { + unless ($readinghash{$readkey} =~ /\.$1\./) { + $readinghash{$readkey} .= '.'.$1.'.'; + $chgcount ++; + } + } + } + if ($chgcount > 0) { + &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', + \%readinghash,$env{'user.domain'},$env{'user.name'}); } - &print_showposters($r,$symb,$previous,$feedurl,$sortposts); + &redirect_back($r,$feedurl,&mt('Marked postings read/unread').'
        ', + '0','0','',$env{'form.previous'},'','','',); return OK; } - if ($ENV{'form.userpick'}) { + if ($env{'form.allversions'}) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; - my $symb=$ENV{'form.userpick'}; - my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - my $previous=$ENV{'form.previous'}; -# backward compatibility (bulletin boards used to be 'wrapped') - my $ressymb=$symb; - unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { - $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; - } - my $sort=$ENV{'form.sortposts'}; - my @posters = (); - if (ref($ENV{'form.stuinfo'}) eq 'ARRAY') { - @posters = $ENV{'form.stuinfo'}; - } else { - $posters[0] = $ENV{'form.stuinfo'}; + my $html=&Apache::lonxml::xmlbegin(); + my $bodytag=&Apache::loncommon::bodytag('Discussion Post Versions'); + $r->print(< +Post Versions + + +$bodytag +END + my $crs='/'.$env{'request.course.id'}; + if ($env{'request.course.sec'}) { + $crs.='_'.$env{'request.course.sec'}; + } + $crs=~s|_|/|g; + my $seeid=&Apache::lonnet::allowed('rin',$crs); + my ($symb,$idx)=split(/\:\:\:/,$env{'form.allversions'}); + ($symb)=&get_feedurl_and_clean_symb($symb); + if ($idx > 0) { + my %messages = (); + my %subjects = (); + my %attachmsgs = (); + my %allattachments = (); + my %imsfiles = (); + my ($screenname,$plainname); + my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + $r->print(&get_post_contents(\%contrib,$idx,$seeid,'allversions',\%messages,\%subjects,\%allattachments,\%attachmsgs,\%imsfiles,\$screenname,\$plainname)); } + return OK; + } + if ($env{'form.posterlist'}) { + my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.applysort'}); + &print_showposters($r,$symb,$env{'form.previous'},$feedurl, + $env{'form.sortposts'}); + return OK; + } + if ($env{'form.userpick'}) { + my @posters = &Apache::loncommon::get_env_multiple('form.stuinfo'); + my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.userpick'}); my $numpicks = @posters; - if (defined($ENV{'form.userpick'})) { - my %discinfo = (); - $discinfo{$ressymb.'_userpick'} = join('&',@posters); - &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); - } - my $feedurl = &Apache::lonnet::clutter($url); - # backward compatibility (bulletin boards used to be 'wrapped') - if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { - $feedurl=~s|^/adm/wrapper||; - } - &redirect_back($r,$feedurl,&mt('Changed sort/filter').'
        ','0','0','',$previous,$sort,'','','',$numpicks); + my %discinfo; + $discinfo{$symb.'_userpick'} = join('&',@posters); + &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', + \%discinfo,$env{'user.domain'},$env{'user.name'}); + &redirect_back($r,$feedurl,&mt('Changed sort/filter').'
        ','0','0', + '',$env{'form.previous'},$env{'form.sortposts'},'','','', + $numpicks); return OK; } - if ($ENV{'form.applysort'}) { - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - my $symb=$ENV{'form.applysort'}; - my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - my $previous=$ENV{'form.previous'}; - my $sort = $ENV{'form.sortposts'}; - my $rolefilter = $ENV{'form.rolefilter'}; - my $statusfilter = $ENV{'form.statusfilter'}; - my $secpick = $ENV{'form.sectionpick'}; - my $feedurl = &Apache::lonnet::clutter($url); - # backward compatibility (bulletin boards used to be 'wrapped') - if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { - $feedurl=~s|^/adm/wrapper||; - } - &redirect_back($r,$feedurl,&mt('Changed sort/filter').'
        ','0','0','',$previous,$sort,$rolefilter,$statusfilter,$secpick); + if ($env{'form.applysort'}) { + my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.applysort'}); + &redirect_back($r,$feedurl,&mt('Changed sort/filter').'
        ','0','0', + '',$env{'form.previous'},$env{'form.sortposts'}, + $env{'form.rolefilter'},$env{'form.statusfilter'}, + $env{'form.sectionpick'}); return OK; - } elsif ($ENV{'form.sortfilter'}) { - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - my $symb=$ENV{'form.sortfilter'}; - 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$|) { - $feedurl=~s|^/adm/wrapper||; - } - &print_sortfilter_options($r,$symb,$previous,$feedurl); + } elsif ($env{'form.cmd'} eq 'sortfilter') { + my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'}); + &print_sortfilter_options($r,$symb,$env{'form.previous'},$feedurl); return OK; - } elsif ($ENV{'form.navmaps'}) { + } elsif ($env{'form.navtime'}) { my %discinfo = (); my @resources = (); - if ($ENV{'form.navmaps'} =~ /:/) { - @resources = split/:/,$ENV{'form.navmaps'}; + if (defined($env{'form.navmaps'})) { + if ($env{'form.navmaps'} =~ /:/) { + @resources = split/:/,$env{'form.navmaps'}; + } else { + @resources = ("$env{'form.navmaps'}"); + } } else { - @resources = ("$ENV{'form.navmaps'}"); + &has_discussion(\@resources); } my $numitems = @resources; my $feedurl = '/adm/navmaps'; - if ($ENV{'form.navurl'}) { - $feedurl .= '?'.$ENV{'form.navurl'}; - } + if ($env{'form.navurl'}) { $feedurl .= '?'.$env{'form.navurl'}; } my %lt = &Apache::lonlocal::texthash( 'mnpa' => 'Marked "New" posts as read in a total of', - 'robb' => 'resources/bulletin boards.' + 'robb' => 'resources/bulletin boards.', + 'twnp' => 'There are currently no resources or bulletin boards with unread discussion postings.' ); foreach (@resources) { -# backward compatibility (bulletin boards used to be 'wrapped') my $ressymb=$_; - if ($ressymb =~ m/bulletin___\d+___/) { - unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { - $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper/|; - } - } + &Apache::lonenc::check_decrypt(\$ressymb); my $lastkey = $ressymb.'_lastread'; - $discinfo{$lastkey} = time; + $discinfo{$lastkey} = $env{'form.navtime'}; + } + my $textline = "$lt{'mnpa'} $numitems $lt{'robb'}"; + if ($numitems > 0) { + &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', + \%discinfo,$env{'user.domain'},$env{'user.name'}); + } else { + $textline = "$lt{'twnp'}"; } - &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; + my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); + my $html=&Apache::lonxml::xmlbegin(); $r->print (< +$html New posts marked as read - -$lt{'mnpa'} $numitems $lt{'robb'} + +$textline
        +
        Continue ENDREDIR return OK; - } elsif ($ENV{'form.modifydisp'}) { - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - my $symb=$ENV{'form.modifydisp'}; - my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - my $previous=$ENV{'form.previous'}; - my ($dispchg,$markchg) = split/_/,$ENV{'form.changes'}; - my $feedurl = &Apache::lonnet::clutter($url); - # backward compatibility (bulletin boards used to be 'wrapped') - if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { - $feedurl=~s|^/adm/wrapper||; - } - &print_display_options($r,$symb,$previous,$dispchg,$markchg,$feedurl); + } elsif ($env{'form.modifydisp'}) { + my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.modifydisp'}); + my ($dispchgA,$dispchgB,$markchg,$toggchg) = + split(/_/,$env{'form.changes'}); + &print_display_options($r,$symb,$env{'form.previous'},$dispchgA, + $dispchgB,$markchg,$toggchg,$feedurl); return OK; - } elsif (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) { - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - my $previous=$ENV{'form.previous'}; - my ($map,$ind,$url); - if (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'})) { -# ---------------------- Modify setting for identification of 'NEW' posts in this discussion - my $symb=$ENV{'form.markondisp'}?$ENV{'form.markondisp'}:$ENV{'form.markonread'}; - my $ressymb = $symb; - ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { - $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; - } - my %discinfo = (); - my $lastkey = $ressymb.'_lastread'; - my $ondispkey = $ressymb.'_markondisp'; - if ($ENV{'form.markondisp'}) { - $discinfo{$lastkey} = time; - $discinfo{$ondispkey} = 1; - } elsif ($ENV{'form.markonread'}) { - if ( $previous > 0 ) { - $discinfo{$lastkey} = $previous; - } - $discinfo{$ondispkey} = 0; - } - &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); - } - if (($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'})) { -# ----------------------------------------------------------------- Modify display setting for this discussion - my $symb=$ENV{'form.allposts'}?$ENV{'form.allposts'}:$ENV{'form.onlyunread'}; - my $ressymb = $symb; - ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { - $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; - } - my %discinfo = (); - if ($ENV{'form.allposts'}) { - $discinfo{$ressymb.'_showonlyunread'} = 0; - } elsif ($ENV{'form.onlyunread'}) { - $discinfo{$ressymb.'_showonlyunread'} = 1; - } - &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); + } elsif ($env{'form.markondisp'} || $env{'form.markonread'} || + $env{'form.allposts'} || $env{'form.onlyunread'} || + $env{'form.onlyunmark'} || $env{'form.toggoff'} || + $env{'form.toggon'} || $env{'form.markread'}) { + my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'}); + my %discinfo; +# ------------------------ Modify setting for read/unread toggle for each post + if ($env{'form.toggoff'}) { $discinfo{$symb.'_readtoggle'}=0; } + if ($env{'form.toggon'}) { $discinfo{$symb.'_readtoggle'}=1; } +# --------- Modify setting for identification of 'NEW' posts in this discussion + if ($env{'form.markondisp'}) { + $discinfo{$symb.'_lastread'} = time; + $discinfo{$symb.'_markondisp'} = 1; + } + if ($env{'form.markonread'}) { + if ( $env{'form.previous'} > 0 ) { + $discinfo{$symb.'_lastread'} = $env{'form.previous'}; + } + $discinfo{$symb.'_markondisp'} = 0; } - if (($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) { - &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'
        ','0','0','',$previous); +# --------------------------------- Modify display setting for this discussion + if ($env{'form.allposts'}) { + $discinfo{$symb.'_showonlyunread'} = 0; + $discinfo{$symb.'_showonlyunmark'} = 0; + } + if ($env{'form.onlyunread'}) { $discinfo{$symb.'_showonlyunread'} = 1; } + if ($env{'form.onlyunmark'}) { $discinfo{$symb.'_showonlyunmark'} = 1; } +# ----------------------------------------------------- Mark new posts not NEW + if ($env{'form.markread'}) { $discinfo{$symb.'_lastread'} = time; } + &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', + \%discinfo,$env{'user.domain'},$env{'user.name'}); + my $previous=$env{'form.previous'}; + if ($env{'form.markondisp'}) { $previous=undef; } + &redirect_back($r,$feedurl,&mt('Changed display status').'
        ', + '0','0','',$previous); + return OK; + } elsif (($env{'form.hide'}) || ($env{'form.unhide'})) { +# ----------------------------------------------------------------- Hide/unhide + my $entry=$env{'form.hide'}?$env{'form.hide'}:$env{'form.unhide'}; + my ($symb,$idx)=split(/\:\:\:/,$entry); + ($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb); + + 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 $currenthidden=$contrib{'hidden'}; + my $currentstudenthidden=$contrib{'studenthidden'}; + + my $crs='/'.$env{'request.course.id'}; + if ($env{'request.course.sec'}) { + $crs.='_'.$env{'request.course.sec'}; + } + $crs=~s/\_/\//g; + my $seeid=&Apache::lonnet::allowed('rin',$crs); + + if ($env{'form.hide'}) { + $currenthidden.='.'.$idx.'.'; + unless ($seeid) { + $currentstudenthidden.='.'.$idx.'.'; + } } else { - &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'
        ','0','0'); + $currenthidden=~s/\.$idx\.//g; } - return OK; - } elsif ($ENV{'form.markread'}) { -# ----------------------------------------------------------------- Mark new posts as read - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - my $symb=$ENV{'form.markread'}; - my $ressymb = $symb; - my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { - $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; + my %newhash=('hidden' => $currenthidden); + if ( ($env{'form.hide'}) && (!$seeid) ) { + $newhash{'studenthidden'} = $currentstudenthidden; } - my %discinfo = (); - my $lastkey = $ressymb.'_lastread'; - $discinfo{$lastkey} = time; - &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); - &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed reading status').'
        ','0','0'); - return OK; - } elsif (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) { -# ----------------------------------------------------------------- Hide/unhide - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'}; + &Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); - my ($symb,$idx)=split(/\:\:\:/,$entry); - my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - - 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 $currenthidden=$contrib{'hidden'}; - my $currentstudenthidden=$contrib{'studenthidden'}; - - my $crs='/'.$ENV{'request.course.id'}; - if ($ENV{'request.course.sec'}) { - $crs.='_'.$ENV{'request.course.sec'}; - } - $crs=~s/\_/\//g; - my $seeid=&Apache::lonnet::allowed('rin',$crs); - - if ($ENV{'form.hide'}) { - $currenthidden.='.'.$idx.'.'; - unless ($seeid) { - $currentstudenthidden.='.'.$idx.'.'; - } - } else { - $currenthidden=~s/\.$idx\.//g; - } - my %newhash=('hidden' => $currenthidden); - if ( ($ENV{'form.hide'}) && (!$seeid) ) { - $newhash{'studenthidden'} = $currentstudenthidden; - } - - &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - - &redirect_back($r,&Apache::lonnet::clutter($url), - &mt('Changed discussion status').'
        ','0','0','',$ENV{'form.previous'}); - } elsif (($ENV{'form.threadedon'}) || ($ENV{'form.threadedoff'})) { - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - if ($ENV{'form.threadedon'}) { + &redirect_back($r,$feedurl,&mt('Changed discussion status').'
        ', + '0','0','',$env{'form.previous'}); + return OK; + } elsif ($env{'form.cmd'}=~/^(threadedoff|threadedon)$/) { + my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'}); + if ($env{'form.cmd'} eq 'threadedon') { &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'}); &Apache::lonnet::appenv('environment.threadeddiscussion' => 'on'); } else { &Apache::lonnet::del('environment',['threadeddiscussion']); &Apache::lonnet::delenv('environment\.threadeddiscussion'); } - my $symb=$ENV{'form.threadedon'}?$ENV{'form.threadedon'}:$ENV{'form.threadedoff'}; - my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - &redirect_back($r,&Apache::lonnet::clutter($url), - &mt('Changed discussion view mode').'
        ','0','0','',$ENV{'form.previous'}); - } elsif ($ENV{'form.deldisc'}) { + &redirect_back($r,$feedurl,&mt('Changed discussion view mode').'
        ', + '0','0','',$env{'form.previous'}); + return OK; + } elsif ($env{'form.deldisc'}) { # --------------------------------------------------------------- Hide for good - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - - my $entry=$ENV{'form.deldisc'}; - - my ($symb,$idx)=split(/\:\:\:/,$entry); - my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); - - 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 $currentdeleted=$contrib{'deleted'}; - - $currentdeleted.='.'.$idx.'.'; - - my %newhash=('deleted' => $currentdeleted); - - &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - - &redirect_back($r,&Apache::lonnet::clutter($url), - &mt('Changed discussion status').'
        ','0','0','',$ENV{'form.previous'}); - } elsif ($ENV{'form.preview'}) { + my ($symb,$idx)=split(/\:\:\:/,$env{'form.deldisc'}); + ($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb); + 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 %newhash=('deleted' => $contrib{'deleted'}.".$idx."); + &Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + &redirect_back($r,$feedurl,&mt('Changed discussion status').'
        ', + '0','0','',$env{'form.previous'}); + return OK; + } elsif ($env{'form.preview'}) { # -------------------------------------------------------- User wants a preview - $r->content_type('text/html'); - $r->send_http_header; &show_preview($r); + return OK; + } elsif ($env{'form.attach'}) { +# -------------------------------------------------------- Work on attachments + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','addnewattach','delnewattach','timestamp','numoldver','idx','anondiscuss','discuss']); + my (@currnewattach,@currdelold,@keepold); + &process_attachments(\@currnewattach,\@currdelold,\@keepold); + if (exists($env{'form.addnewattach.filename'})) { + unless (length($env{'form.addnewattach'})>131072) { + my $subdir = 'feedback/'.$env{'form.timestamp'}; + my $newattachment=&Apache::lonnet::userfileupload('addnewattach',undef,$subdir); + push @currnewattach, $newattachment; + } + } + my $attachmenturls; + my ($symb) = &get_feedurl_and_clean_symb($env{'form.attach'}); + my $idx = $env{'form.idx'}; + if ($idx) { + my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + $attachmenturls = $contrib{$idx.':attachmenturl'}; + } + &modify_attachments($r,\@currnewattach,\@currdelold,$symb,$idx, + $attachmenturls); + return OK; + } elsif ($env{'form.export'}) { + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.export'}); + my $mode='board'; + my $status='OPEN'; + my $previous=$env{'form.previous'}; + if ($feedurl =~ /\.(problem|exam|quiz|assess|survey|form|library)$/) { + $mode='problem'; + $status=$Apache::inputtags::status[-1]; + } + my $discussion = &list_discussion($mode,$status,$symb); + my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion'); + $r->print($bodytag.$discussion); + return OK; } else { # ------------------------------------------------------------- Normal feedback - my $feedurl=$ENV{'form.postdata'}; - $feedurl=~s/^http\:\/\///; - $feedurl=~s/^$ENV{'SERVER_NAME'}//; - $feedurl=~s/^$ENV{'HTTP_HOST'}//; - $feedurl=~s/\?.+$//; - - my $symb; - if ($ENV{'form.replydisc'}) { - $symb=(split(/\:\:\:/,$ENV{'form.replydisc'}))[0]; - my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); - $feedurl=&Apache::lonnet::clutter($url); - } elsif ($ENV{'form.editdisc'}) { - $symb=(split(/\:\:\:/,$ENV{'form.editdisc'}))[0]; - my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); - $feedurl=&Apache::lonnet::clutter($url); - } else { - $symb=&Apache::lonnet::symbread($feedurl); - } - unless ($symb) { - $symb=$ENV{'form.symb'}; - if ($symb) { + my $feedurl=$env{'form.postdata'}; + $feedurl=~s/^http\:\/\///; + $feedurl=~s/^$ENV{'SERVER_NAME'}//; + $feedurl=~s/^$ENV{'HTTP_HOST'}//; + $feedurl=~s/\?.+$//; + + my $symb; + if ($env{'form.replydisc'}) { + $symb=(split(/\:\:\:/,$env{'form.replydisc'}))[0]; my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); - $feedurl=&Apache::lonnet::clutter($url); + $feedurl=&Apache::lonnet::clutter($url); + } elsif ($env{'form.editdisc'}) { + $symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0]; + my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); + $feedurl=&Apache::lonnet::clutter($url); + } elsif ($env{'form.origpage'}) { + $symb=""; + } else { + $symb=&Apache::lonnet::symbread($feedurl); + } + unless ($symb) { + $symb=$env{'form.symb'}; + if ($symb) { + my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); + $feedurl=&Apache::lonnet::clutter($url); + } + } + &Apache::lonenc::check_decrypt(\$symb); + my $goahead=1; + if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) { + unless ($symb) { $goahead=0; } + } + # backward compatibility (bulletin boards used to be 'wrapped') + &dewrapper(\$feedurl); + if (!$goahead) { + # Ambiguous Problem Resource + $r->internal_redirect('/adm/ambiguous'); + return OK; } - } - my $goahead=1; - if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) { - unless ($symb) { $goahead=0; } - } - # backward compatibility (bulletin boards used to be 'wrapped') - if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { - $feedurl=~s|^/adm/wrapper||; - } - if ($goahead) { # Go ahead with feedback, no ambiguous reference - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - - if ( - ( - ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:) - ) - || - ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:)) - || - ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/)) - ) { + unless ( + ( + ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:) + ) + || + ($env{'request.course.id'} && ($feedurl!~m:^/adm:)) + || + ($env{'request.course.id'} && ($symb=~/^bulletin\_\_\_/)) + ) { + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; +# Unable to give feedback + &no_redirect_back($r,$feedurl); + } # --------------------------------------------------- Print login screen header - unless ($ENV{'form.sendit'}) { - my $options=&screen_header($feedurl); - if ($options) { - &mail_screen($r,$feedurl,$options); - } else { - &fail_redirect($r,$feedurl); + unless ($env{'form.sendit'}) { + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + my $options=&screen_header($feedurl,$symb); + if ($options) { + &mail_screen($r,$feedurl,$options); + } else { + &fail_redirect($r,$feedurl); + } + return OK; } - } else { # Get previous user input my $prevattempts=&Apache::loncommon::get_previous_attempt( - $symb,$ENV{'user.name'},$ENV{'user.domain'}, - $ENV{'request.course.id'}); + $symb,$env{'user.name'},$env{'user.domain'}, + $env{'request.course.id'}); # Get output from resource my $usersaw=&resource_output($feedurl); @@ -2144,64 +3345,97 @@ ENDREDIR # Get resource answer (need to allow student to view grades for this to work) &Apache::lonnet::appenv(('allowed.vgr'=>'F')); my $useranswer=&Apache::loncommon::get_student_answers( - $symb,$ENV{'user.name'},$ENV{'user.domain'}, - $ENV{'request.course.id'}); + $symb,$env{'user.name'},$env{'user.domain'}, + $env{'request.course.id'}); &Apache::lonnet::delenv('allowed.vgr'); # Get attachments, if any, and not too large my $attachmenturl=''; - if ($ENV{'form.attachment.filename'}) { - unless (length($ENV{'form.attachment'})>131072) { + if (($env{'form.origpage'}) || ($env{'form.editdisc'}) || + ($env{'form.replydisc'})) { + my ($symb,$idx); + if ($env{'form.replydisc'}) { + ($symb,$idx)=split(/\:\:\:/,$env{'form.replydisc'}); + } elsif ($env{'form.editdisc'}) { + ($symb,$idx)=split(/\:\:\:/,$env{'form.editdisc'}); + } elsif ($env{'form.origpage'}) { + $symb = $env{'form.symb'}; + } + &Apache::lonenc::check_decrypt(\$symb); + my @currnewattach = (); + my @deloldattach = (); + my @keepold = (); + &process_attachments(\@currnewattach,\@deloldattach,\@keepold); + $symb=~s|(bulletin___\d+___)adm/wrapper/|$1|; + $attachmenturl=&construct_attachmenturl(\@currnewattach,\@keepold,$symb,$idx); + } elsif ($env{'form.attachment.filename'}) { + unless (length($env{'form.attachment'})>131072) { $attachmenturl=&Apache::lonnet::userfileupload('attachment',undef,'feedback'); } } # Filter HTML out of message (could be nasty) - my $message=&clear_out_html($ENV{'form.comment'}); + my $message=&clear_out_html($env{'form.comment'}); # Assemble email my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts, - $usersaw,$useranswer); + $usersaw,$useranswer); # Who gets this? my ($typestyle,%to) = &decide_receiver($feedurl); # Actually send mail my ($status,$numsent)=&send_msg($feedurl,$email,$citations, - $attachmenturl,%to); + $attachmenturl,%to); # Discussion? Store that. my $numpost=0; - if ($ENV{'form.discuss'}) { - my $subject = &clear_out_html($ENV{'form.subject'}); - $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl,$subject); + if ($env{'form.discuss'} || $env{'form.anondiscuss'}) { + my $subject = &clear_out_html($env{'form.subject'}); + my $anonmode=(defined($env{'form.anondiscuss'})); + $typestyle.=&adddiscuss($symb,$message,$anonmode,$attachmenturl, + $subject); $numpost++; } - - if ($ENV{'form.anondiscuss'}) { - my $subject = &clear_out_html($ENV{'form.subject'}); - $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl,$subject); - $numpost++; - } - - + # Receipt screen and redirect back to where came from - &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status,$ENV{'form.previous'}); - - } - } else { -# Unable to give feedback - &no_redirect_back($r,$feedurl); - } - } else { -# Ambiguous Problem Resource - if ( &Apache::lonnet::mod_perl_version() == 2 ) { - &Apache::lonnet::cleanenv(); - } - $r->internal_redirect('/adm/ambiguous'); + &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status,$env{'form.previous'}); } -} return OK; } +sub wrap_symb { + my ($ressymb)=@_; + if ($ressymb =~ /bulletin___\d+___/) { + unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { + $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; + } + } + return $ressymb; +} +sub dewrapper { + my ($feedurl)=@_; + if ($$feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { + $$feedurl=~s|^/adm/wrapper||; + } +} + +sub get_feedurl { + my ($symb)=@_; + my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); + my $feedurl = &Apache::lonnet::clutter($url); + &dewrapper(\$feedurl); + return $feedurl; +} + +sub get_feedurl_and_clean_symb { + my ($symb)=@_; + &Apache::lonenc::check_decrypt(\$symb); +# backward compatibility (bulletin boards used to be 'wrapped') + unless ($symb =~ m|bulletin___\d+___adm/wrapper|) { + $symb=~s|(bulletin___\d+___)|$1adm/wrapper|; + } + my $feedurl = &get_feedurl($symb); + return ($symb,$feedurl); +} 1; __END__