![]() ![]() | ![]() |
- lots of \w -> probper regexp replacements
# The LearningOnline Network # Feedback # # $Id: lonfeedback.pm,v 1.226 2006/12/05 02:55:52 albertel Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # ### package Apache::lonfeedback; use strict; use Apache::Constants qw(:common); 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 Apache::lonrss(); use HTML::LCParser(); use Apache::lonspeller(); use Apache::longroup; use Cwd; use LONCAPA; sub discussion_open { my ($status,$symb)=@_; if ($env{'request.role.adv'}) { return 1; } if (defined($status) && !($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER' || $status eq 'OPEN')) { return 0; } my $close=&Apache::lonnet::EXT('resource.0.discussend',$symb); if (defined($close) && $close ne '' && $close < time) { return 0; } return 1; } sub discussion_visible { my ($status)=@_; if (not &discussion_open($status)) { my $hidden=&Apache::lonnet::EXT('resource.0.discusshide'); if (lc($hidden) eq 'yes' or $hidden eq '' or !defined($hidden)) { if (!$env{'request.role.adv'}) { return 0; } } } return 1; } sub list_discussion { my ($mode,$status,$ressymb,$imsextras,$group)=@_; 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 ''; } if ($group ne '' && $mode eq 'board') { if (&check_group_priv($group,'vgb') ne 'ok') { return ''; } } my ($blocked,$blocktext) = &blocking_posts('boards',1); if ($blocked) { return $blocktext; } 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 ($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|task)$/)); my %usernamesort = (); my %namesort =(); my %subjectsort = (); # 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 $toggkey = $ressymb.'_readtoggle'; my $readkey = $ressymb.'_read'; $ressymb=$encsymb; my %dischash = &Apache::lonnet::get('nohist_'.$cid.'_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; my $visit = 0; my $newpostsflag = 0; my @posters = split(/\&/,$dischash{$userpickkey}); # 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','grouppick','totposters']); my $sortposts = $env{'form.sortposts'}; my $statusfilter = $env{'form.statusfilter'}; my @sectionpick = split(/,/,$env{'form.sectionpick'}); my @grouppick = split(/,/,$env{'form.grouppick'}); my @rolefilter = split(/,/,$env{'form.rolefilter'}); my $totposters = $env{'form.totposters'}; $previous = $env{'form.previous'}; if ($previous > 0) { $prevread = $previous; } elsif (defined($dischash{$lastkey})) { unless ($dischash{$lastkey} eq '') { $prevread = $dischash{$lastkey}; } } my $cdom = $env{'course.'.$cid.'.domain'}; my $cnum = $env{'course.'.$cid.'.num'}; # Get information about students and non-students in course for filtering display of posts my %roleshash = (); my %roleinfo = (); my ($classgroups,$studentgroups); if ($env{'form.rolefilter'}) { %roleshash = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum); foreach my $rolekey (keys(%roleshash)) { my ($role,$uname,$udom,$sec) = split(/:/,$rolekey); if ($role =~ /^cr/) { $role = 'cr'; } my ($end,$start) = split(/:/,$roleshash{$rolekey}); my $now = time; my $status = 'Active'; if (($now < $start) || ($end > 0 && $now > $end)) { $status = 'Expired'; } if ($uname && $udom) { push(@{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status); } } my ($classlist,$keylist) = &Apache::loncoursedata::get_classlist($cdom,$cnum); my $sec_index = &Apache::loncoursedata::CL_SECTION(); my $status_index = &Apache::loncoursedata::CL_STATUS(); while (my ($student,$data) = each %$classlist) { my ($section,$status) = ($data->[$sec_index], $data->[$status_index]); push(@{$roleinfo{$student}}, 'st:'.$section.':'.$status); } ($classgroups,$studentgroups) = &Apache::loncoursedata::get_group_memberships($classlist,$keylist, $cdom,$cnum); } # Get discussion display default settings for user if ($env{'environment.discdisplay'} eq 'unread') { $showonlyunread = 1; } if ($env{'environment.discmarkread'} eq 'ondisp') { $markondisp = 1; } # Override user's default if user specified display setting for this discussion if (defined($dischash{$ondispkey})) { unless ($dischash{$ondispkey} eq '') { $markondisp = $dischash{$ondispkey}; } } if ($markondisp) { $discinfo{$lastkey} = time; } if (defined($dischash{$showkey})) { unless ($dischash{$showkey} eq '') { $showonlyunread = $dischash{$showkey}; } } if (defined($dischash{$markkey})) { unless ($dischash{$markkey} eq '') { $showunmark = $dischash{$markkey}; } } if (defined($dischash{$visitkey})) { unless ($dischash{$visitkey} eq '') { $visit = $dischash{$visitkey}; } } $visit ++; my $seeid; if (($group ne '') && ($mode eq 'board') && ($ressymb =~ m|^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$|)) { if (&check_group_priv($group,'dgp') eq 'ok') { $seeid = 1; } } else { $seeid=&Apache::lonnet::allowed('rin',$crs); } my @discussionitems=(); my %shown = (); my @posteridentity=(); my $current=0; my $visible=0; my @depth=(); my @replies = (); my %alldiscussion=(); my %imsitems=(); my %imsfiles=(); my %notshown = (); my %newitem = (); my $maxdepth=0; my %anonhash=(); my $anoncnt=0; my $target=''; unless ($env{'browser.interface'} eq 'textual' || $env{'environment.remote'} eq 'off' ) { $target='target="LONcom"'; } my $now = time; $discinfo{$visitkey} = $visit; &Apache::lonnet::put('nohist_'.$cid.'_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,\@grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,\%anonhash,$anoncnt,$group); 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'}); 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 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', 'aner' => 'An error occurred opening the manifest file.', 'difo' => 'Discussion for', 'aerr' => 'An error occurred opening the export file for posting', 'aysu' => 'Are you sure you want to delete this post?', 'dpwn' => 'Deleted posts will no longer be visible to you and other students', 'bwco' => 'but will continue to be visible to your instructor', 'depo' => 'Deleted posts will no longer be visible to you or anyone else.', ); 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 $displinkA = 'onlyunread'; my $displinkB = 'onlyunmark'; my $marklink = 'markondisp'; my $togglink = 'toggon'; if ($markondisp) { $currmark = $lt{'ondisp'}; $markchange = $lt{'onmark'}; $marklink = 'markonread'; } if ($showonlyunread) { $currdisp = $lt{'unread'}; $dispchange = $lt{'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='.$displinkA.'_'.$displinkB.'_'.$marklink.'_'.$togglink; if ($newpostsflag) { $chglink .= '&previous='.$prevread; } $chglink.=&group_args($group); if ($visible) { # Print the discusssion if ($outputtarget eq 'tex') { $discussion.='<tex>{\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.'}}</tex>'; } 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| <?xml version="1.0" encoding="UTF-8"?> <manifest xmlns="http://www.imsglobal.org/xsd/imscp_v1p1" xmlns:imsmd="http://www.imsglobal.org/xsd/imsmd_v1p2" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" identifier="MANIFEST-$ressymb" xsi:schemaLocation="http://www.imsglobal.org/xsd/imscp_v1p1 imscp_v1p1.xsd http://www.imsglobal.org/xsd/imsmd_v1p2 imsmd_v1p2p2.xsd"> <organizations default="$ressymb"> <organization identifier="$ressymb"> <title>$lt{'difo'} $ressymb</title>\n|; } else { $discussion .= $lt{'aner'}.'<br />'; } } else { my $colspan=$maxdepth+1; $discussion.= qq| <script> function verifydelete (caller,symb,idx,newflag,previous,groupparm) { var symbparm = symb+':::'+idx var prevparm = "" if (newflag == 1) { prevparm = "&previous="+previous } if (caller == 'studentdelete') { if (confirm("$lt{'aysu'}\\n$lt{'dpwn'},\\n$lt{'bwco'}")) { document.location.href = "/adm/feedback?hide="+symbparm+prevparm+groupparm } } else { if (caller == 'seeiddelete') { if (confirm("$lt{'aysu'}\\n$lt{'depo'}")) { document.location.href = "/adm/feedback?deldisc="+symbparm+prevparm+groupparm } } } } </script> |; $discussion.='<form name="readchoices" method="post" action="/adm/feedback?chgreads='.$ressymb.'" ><table bgcolor="#AAAAAA" cellpadding="2" cellspacing="2" border="0">'; $discussion .= &action_links_bar($colspan,$ressymb,$visible, $newpostsflag,$group, $prevread,$markondisp); my $escsymb=&escape($ressymb); my $numhidden = keys(%notshown); if ($numhidden > 0) { my $colspan = $maxdepth+1; $discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">'. '<a href="/adm/feedback?allposts=1&symb='.$escsymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .= &group_args($group); $discussion .= '">'.&mt('Show all posts').'</a> '.&mt('to display').' '. $numhidden.' '; if ($showunmark) { $discussion .= &mt('posts previously marked read'); } else { $discussion .= &mt('previously viewed posts'); } $discussion .= '<br/></td></tr>'; } } # Choose sort mechanism my @showposts = (); if ($sortposts eq 'descdate') { @showposts = (sort { $b <=> $a } keys(%alldiscussion)); } elsif ($sortposts eq 'thread') { @showposts = (sort { $a <=> $b } keys(%alldiscussion)); } elsif ($sortposts eq 'subject') { foreach my $key (sort(keys(%subjectsort))) { push(@showposts, @{$subjectsort{$key}}); } } elsif ($sortposts eq 'username') { foreach my $domain (sort(keys(%usernamesort))) { foreach my $key (sort(keys(%{$usernamesort{$domain}}))) { push(@showposts, @{$usernamesort{$domain}{$key}}); } } } elsif ($sortposts eq 'lastfirst') { foreach my $last (sort(keys(%namesort))) { foreach my $key (sort(keys(%{$namesort{$last}}))) { push(@showposts, @{$namesort{$last}{$key}}); } } } else { @showposts = (sort { $a <=> $b } keys(%alldiscussion)); } my $currdepth = 0; my $firstidx = $alldiscussion{$showposts[0]}; foreach my $post (@showposts) { unless (($sortposts eq 'thread') || (($sortposts eq '') && ($env{'environment.threadeddiscussion'})) || ($outputtarget eq 'export')) { $alldiscussion{$post} = $post; } unless ( ($notshown{$alldiscussion{$post}} eq '1') || ($shown{$alldiscussion{$post}} == 0) ) { if ($outputtarget ne 'tex' && $outputtarget ne 'export') { $discussion.="\n<tr>"; } my $thisdepth=$depth[$alldiscussion{$post}]; if ($outputtarget ne 'tex' && $outputtarget ne 'export') { for (1..$thisdepth) { $discussion.='<td> </td>'; } } my $colspan=$maxdepth-$thisdepth+1; if ($outputtarget eq 'tex') { #cleanup block $discussionitems[$alldiscussion{$post}]=~s/<table([^>]*)>/<table TeXwidth="90 mm">/; $discussionitems[$alldiscussion{$post}]=~s/<tr([^>]*)><td([^>]*)>/<tr><td TeXwidth="20 mm" align="left">/; my $threadinsert=''; if ($thisdepth > 0) { $threadinsert='<br /><strong>Reply: '.$thisdepth.'</strong>'; } $discussionitems[$alldiscussion{$post}]=~s/<\/td><td([^>]*)>/$threadinsert<\/td><td TeXwidth="65 mm" align="left">/; $discussionitems[$alldiscussion{$post}]=~s/<a([^>]+)>(Edit|Hide|Delete|Reply|Submissions)<\/a>//g; $discussionitems[$alldiscussion{$post}]=~s/(<b>|<\/b>|<\/a>|<a([^>]+)>)//g; $discussionitems[$alldiscussion{$post}]='<tex>\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}</tex>'.$discussionitems[$alldiscussion{$post}]; $discussion.=$discussionitems[$alldiscussion{$post}]; } elsif ($outputtarget eq 'export') { my $postfilename = $alldiscussion{$post}.'-'.$imsitems{$alldiscussion{$post}}{'timestamp'}.'.html'; if ($manifestok) { if (($depth[$alldiscussion{$post}] <= $currdepth) && ($alldiscussion{$post} != $firstidx)) { print $manifestfile ' </item>'."\n"; } $currdepth = $depth[$alldiscussion{$post}]; print $manifestfile "\n". '<item identifier="ITEM-'.$ressymb.'-'.$alldiscussion{$post}.'" isvisible="'. $imsitems{$alldiscussion{$post}}{'isvisible'}.'" identifieref="RES-'.$ressymb.'-'.$alldiscussion{$post}.'">'. '<title>'.$imsitems{$alldiscussion{$post}}{'title'}.'</title>'; $imsresources .= "\n". '<resource identifier="RES-'.$ressymb.'-'.$alldiscussion{$post}.'" type="webcontent" href="'.$postfilename.'">'."\n". '<file href="'.$postfilename.'">'."\n". $imsfiles{$alldiscussion{$post}}{$imsitems{$alldiscussion{$post}}{'currversion'}}."\n". '</resource>'; } my $postingfile; my $postingfilename = $tempexport.'/'.$postfilename; if ($postingfile = Apache::File->new('>'.$postingfilename)) { print $postingfile '<html><head><title>Discussion Post</title></head><body>'. $imsitems{$alldiscussion{$post}}{'title'}.' '. $imsitems{$alldiscussion{$post}}{'sender'}. $imsitems{$alldiscussion{$post}}{'timestamp'}.'<br /><br />'. $imsitems{$alldiscussion{$post}}{'message'}.'<br />'. $imsitems{$alldiscussion{$post}}{'attach'}.'</body></html>'."\n"; close($postingfile); } else { $discussion .= $lt{'aerr'}.' '.$alldiscussion{$post}.'<br />'; } $copyresult.=&replicate_attachments($imsitems{$alldiscussion{$post}}{'allattachments'},$tempexport); } else { $discussion.='<td bgcolor="'.$bgcols[$newitem{$alldiscussion{$post}}]. '" colspan="'.$colspan.'">'. $discussionitems[$alldiscussion{$post}]. '</td></tr>'; } } } unless ($outputtarget eq 'tex' || $outputtarget eq 'export') { my $colspan=$maxdepth+1; $discussion .= <<END; <tr bgcolor="#FFFFFF"> <td colspan="$colspan" valign="top"> <table border="0" bgcolor="#FFFFFF" width="100%" cellspacing="2" cellpadding="2"> <tr> <td align="left"> <table border="0" cellpadding="0" cellspacing="4"> <tr> <td> <font size="-1"><b>$lt{'cuse'}</b>:</td> <td> </td> <td><font size="-1"> END if ($newpostsflag) { $discussion .= '1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i> 2. '.$lt{'nolo'}.' - <i>'.$currmark.'</i>'; if ($dischash{$toggkey}) { $discussion .= ' 3. '.$lt{'togg'}.' - <i>'.$currtogg.'</i>'; } } else { if ($dischash{$toggkey}) { $discussion .= '1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i> 2. '.$lt{'togg'}.' - <i>'.$currtogg.'</i>'; } else { $discussion .= $lt{'disp'}.' - <i>'.$currdisp.'</i>'; } } $discussion .= <<END; </font></td> <td> </td> <td align="left"> <font size="-1"><b><a href="$chglink">$lt{'chgt'}</a>?</font></b> </td> </tr> </table> </td> END if ($sortposts) { my %sort_types = (); my %role_types = (); my %status_types = (); &sort_filter_names(\%sort_types,\%role_types,\%status_types); $discussion .= '<td><font size="-1"><b>'.&mt('Sorted by').'</b>: '.$sort_types{$sortposts}.'<br />'; if (defined($env{'form.totposters'})) { $discussion .= &mt('Posts by').':'; if ($totposters > 0) { foreach my $poster (@posters) { $discussion .= ' '.$poster.','; } $discussion =~ s/,$//; } else { $discussion .= &mt('None selected'); } } else { my $filterchoice =''; if (@sectionpick > 0) { $filterchoice = '<i>'.&mt('sections').'</i>- '.$env{'form.sectionpick'}; $filterchoice .= ' '; } if (@grouppick > 0) { $filterchoice = '<i>'.&mt('groups').'</i>- '.$env{'form.grouppick'}; $filterchoice .= ' '; } if (@rolefilter > 0) { $filterchoice .= '<i>'.&mt('roles').'</i>-'; foreach my $role (@rolefilter) { $filterchoice .= ' '.$role_types{$role}.','; } $filterchoice =~ s/,$//; $filterchoice .= '<br />     '; } if ($statusfilter) { $filterchoice .= '<i>'.&mt('status').'</i>- '.$status_types{$statusfilter}; } if ($filterchoice) { $discussion .= '<b>'.&mt('Filters').'</b>: '.$filterchoice; } $discussion .= '</font></td>'; } } if ($dischash{$toggkey}) { my $storebutton = &mt('Store read/unread changes'); $discussion.='<td align="right">'. '<input type="hidden" name="discsymb" value="'.$ressymb.'">'."\n". '<input type="button" name="readoptions" value="'.$storebutton.'"'. ' onClick="this.form.submit();">'."\n". '</td>'; } $discussion .= (<<END); </tr> </table> </td> </tr> END $discussion .= &action_links_bar($colspan,$ressymb,$visible, $newpostsflag,$group, $prevread,$markondisp); $discussion .= " </table> <br /><br /></form>\n"; } if ($outputtarget eq 'export') { if ($manifestok) { while ($currdepth > 0) { print $manifestfile " </item>\n"; $currdepth --; } print $manifestfile qq| </organization> </organizations> <resources> $imsresources </resources> </manifest> |; close($manifestfile); 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 .= &mt('Download the zip file from [_1]Discussion Posting Archive','<a href="'.$imszipfile.'">').'</a><br />'; if ($copyresult) { $discussion .= &mt('The following errors occurred during export').' - <br />'.$copyresult; } } } else { $discussion .= '<br />'.&mt('Unfortunately you will not be able to retrieve an archive of the discussion posts at this time, because there was a problem creating a manifest file.').'<br />'; } return $discussion; } } if ($discussiononly) { my $now = time; my $attachnum = 0; my $currnewattach = []; my $currdelold = []; my $comment = ''; my $subject = ''; if ($env{'form.origpage'}) { &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['addnewattach','deloldattach','delnewattach','timestamp','idx','subject','comment']); $subject = &unescape($env{'form.subject'}); $comment = &unescape($env{'form.comment'}); my @keepold = (); &process_attachments($currnewattach,$currdelold,\@keepold); if (@{$currnewattach} > 0) { $attachnum += @{$currnewattach}; } } if (&discussion_open($status)) { if (($group ne '') && ($mode eq 'board')) { if (&check_group_priv($group,'pgd') eq 'ok') { $discussion .= &postingform_display($mode,$ressymb,$now,$subject, $comment,$outputtarget,$attachnum, $currnewattach,$currdelold, $group); } } else { $discussion.= &postingform_display($mode,$ressymb,$now,$subject, $comment,$outputtarget,$attachnum, $currnewattach,$currdelold); } } } else { $discussion.='<table bgcolor="#BBBBBB"><tr><td>'; 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.='<a href="/adm/feedback?replydisc='. &escape($ressymb).':::" '.$target.'>'. '<img alt="" src="'.&Apache::loncommon::lonhttpdurl('/adm/lonMisc/chat.gif').'" border="0" />'. &mt('Post Discussion').'</a><br />'; } } $discussion.='<a href="/adm/feedback?sendmessageonly=1&symb='. &escape($ressymb). '"><img alt="" src="'.&Apache::loncommon::lonhttpdurl('/adm/lonMisc/feedback.gif').'" border="0" />'. &mt('Send Message').'</a></td></tr></table>'; } return $discussion; } sub action_links_bar { my ($colspan,$ressymb,$visible,$newpostsflag,$group,$prevread,$markondisp) = @_; my $discussion = '<tr><td bgcolor="#DDDDBB" colspan="'.$colspan.'">'. '<table border="0" width="100%" bgcolor="#DDDDBB"><tr>'; my $escsymb=&escape($ressymb); if ($visible>2) { $discussion .= '<td align="left">'. '<a href="/adm/feedback?cmd=threadedon&symb='.$escsymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .= &group_args($group); $discussion .='">'.&mt('Threaded View').'</a> '. '<a href="/adm/feedback?cmd=threadedoff&symb='.$escsymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .= &group_args($group); $discussion .='">'.&mt('Chronological View').'</a> <a href= "/adm/feedback?cmd=sortfilter&symb='.$escsymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .= &group_args($group); $discussion .='">'.&mt('Sorting/Filtering options').'</a>  '; } else { $discussion .= '<td align="left">'; } $discussion .='<a href= "/adm/feedback?export='.$escsymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .= &group_args($group); $discussion .= '">'.&mt('Export').'?</a> </td>'; if ($newpostsflag) { if (!$markondisp) { $discussion .='<td align="right"><a href="/adm/preferences?action=changediscussions'; $discussion .= &group_args($group); $discussion .= '">'. &mt('Preferences on what is marked as NEW'). '</a><br /><a href="/adm/feedback?markread=1&symb='.$escsymb; $discussion .= &group_args($group); $discussion .= '">'.&mt('Mark NEW posts no longer new').'</a>'; } else { $discussion .= '<td> </td>'; } } else { $discussion .= '<td> </td>'; } $discussion .= '</tr></table></td></tr>'; return $discussion; } sub blocking_posts { my ($type,$showstatus) = @_; my %setters; my ($blocked,$output); my ($startblock,$endblock) = &Apache::loncommon::blockcheck(\%setters,$type); if ($startblock && $endblock) { $blocked = 1; if ($showstatus) { my $showstart = &Apache::lonlocal::locallocaltime($startblock); my $showend = &Apache::lonlocal::locallocaltime($endblock); $output = &mt('Discussion postings will not be viewable for resources in this course between [_1] and [_2] because communication is being blocked.',$showstart, $showend).'<br />'. &Apache::loncommon::build_block_table($startblock,$endblock, \%setters); } } return ($blocked,$output); } sub postingform_display { my ($mode,$ressymb,$now,$subject,$comment,$outputtarget,$attachnum, $currnewattach,$currdelold,$group) = @_; my $newattachmsg; my %lt = &Apache::lonlocal::texthash( 'note' => 'Note: in anonymous discussion, your name is visible only to course faculty', 'title' => 'Title', 'podi' => 'Post Discussion', 'poan' => 'Post Anonymous Discussion', 'newa' => 'New attachments', ); my $postingform = (<<ENDDISCUSS); <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data"> <input type="submit" name="discuss" value="$lt{'podi'}" /> <input type="submit" name="anondiscuss" value="$lt{'poan'}" /> <input type="hidden" name="symb" value="$ressymb" /> <input type="hidden" name="sendit" value="true" /> <input type="hidden" name="timestamp" value="$now" /> <br /><a name="newpost"></a> <font size="1">$lt{'note'}</font><br /> <b>$lt{'title'}:</b> <input type="text" name="subject" value="$subject" size="30" /><br /><br /> <textarea name="comment" cols="80" rows="14" wrap="hard">$comment</textarea> ENDDISCUSS if ($env{'form.origpage'}) { $postingform .= '<input type="hidden" name="origpage" value="'. $env{'form.origpage'}.'" />'."\n"; foreach my $att (@{$currnewattach}) { $postingform .= '<input type="hidden" name="currnewattach" '. 'value="'.$att.'" />'."\n"; } } if (exists($env{'form.ref'})) { $postingform .= '<input type="hidden" name="ref" value="'. $env{'form.ref'}.'" />'; } if ($group ne '') { $postingform .='<input type="hidden" name="group" value="'.$group.'" />'; } my ($blockblog) = &blocking_posts('blogs'); if (!$blockblog) { $postingform .= &add_blog_checkbox(); } $postingform .= "</form>\n"; if ($outputtarget ne 'tex') { $postingform .= &generate_attachments_button('',$attachnum,$ressymb, $now,$currnewattach, $currdelold,'',$mode, $blockblog); if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) { $newattachmsg = '<br /><b>'.$lt{'newa'}.'</b><br />'; if (@{$currnewattach} > 1) { $newattachmsg .= '<ol>'; foreach my $item (@{$currnewattach}) { $item =~ m#.*/([^/]+)$#; $newattachmsg .= '<li><a href="'.$item.'">'.$1.'</a></li>'."\n"; } $newattachmsg .= '</ol>'."\n"; } else { $$currnewattach[0] =~ m#.*/([^/]+)$#; $newattachmsg .= '<a href="'.$$currnewattach[0].'">'.$1.'</a><br />'."\n"; } } $postingform .= $newattachmsg; $postingform .= &generate_preview_button(); } return $postingform; } 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,$grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,$anonhash,$anoncnt,$group) = @_; my @original=(); my @index=(); my $skip_group_check = 0; my $symb=&Apache::lonenc::check_decrypt($ressymb); my $escsymb=&escape($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 ((@{$grouppick} == 0) || (grep(/^all$/,@{$grouppick}))) { $skip_group_check = 1; } 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'); # Anonymous users getting number within a discussion # Since idx is in static order, this should give the same sequence every time. my $key=$contrib{$idx.':sendername'}.'@'.$contrib{$idx.':senderdomain'}; unless ($$anonhash{$key}) { $anoncnt++; $$anonhash{$key}=&mt('Anonymous').' '.$anoncnt; } my ($message,$subject,$vgrlink,$ctlink); &get_post_contents(\%contrib,$idx,$seeid,$outputtarget,\%messages,\%subjects,\%allattachments,\%attachtxt,$imsfiles,\$screenname,\$plainname,$numoldver); # Set up for sorting by subject unless ($outputtarget eq 'export') { $message=$messages{$numoldver}; $message.=$attachtxt{$numoldver}; $subject=$subjects{$numoldver}; if ($message) { if ($hidden) { $message='<font color="#888888">'.$message.'</font>'; if ($studenthidden) { $message .='<br /><br />Deleted by poster (student).'; } } if ($subject eq '') { if (defined($$subjectsort{'__No subject'})) { push(@{$$subjectsort{'__No subject'}}, $idx); } else { @{$$subjectsort{'__No subject'}} = ("$idx"); } } else { if (defined($$subjectsort{$subject})) { push(@{$$subjectsort{$subject}}, $idx); } else { @{$$subjectsort{$subject}} = ("$idx"); } } if ((!$contrib{$idx.':anonymous'}) || (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { $sender=&Apache::loncommon::aboutmewrapper( $plainname, $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}).' ('. $contrib{$idx.':sendername'}.' at '. $contrib{$idx.':senderdomain'}.')'; if ($contrib{$idx.':anonymous'}) { $sender.=' <font color="red"><b>['.$$anonhash{$key}.']</b></font> '. $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 (&editing_allowed($escsymb.':::'.$idx,$group)) { if (($env{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($env{'user.name'} eq $contrib{$idx.':sendername'})) { $sender.=' <a href="/adm/feedback?editdisc='. $escsymb.':::'.$idx; if ($$newpostsflag) { $sender .= '&previous='.$prevread; } $sender .= &group_args($group); $sender .= '" '.$target.'>'.&mt('Edit').'</a>'; unless ($seeid) { my $grpargs = &group_args($group); $sender.=" <a href=\"javascript:verifydelete('studentdelete','$escsymb','$idx','$$newpostsflag','$prevread','$grpargs')"; $sender .= '">'.&mt('Delete').'</a>'; } } } if ($seeid) { if ($hidden) { unless ($studenthidden) { $sender.=' <a href="/adm/feedback?unhide='. $escsymb.':::'.$idx; if ($$newpostsflag) { $sender .= '&previous='.$prevread; } $sender .= '">'.&mt('Make Visible').'</a>'; } } else { $sender.=' <a href="/adm/feedback?hide='. $escsymb.':::'.$idx; if ($$newpostsflag) { $sender .= '&previous='.$prevread; } $sender .= &group_args($group); $sender .= '">'.&mt('Hide').'</a>'; } my $grpargs = &group_args($group); $sender.= " <a href=\"javascript:verifydelete('seeiddelete','$escsymb','$idx','$$newpostsflag','$prevread','$grpargs')\">"; $sender .= &mt('Delete').'</a>'; } } else { if ($screenname) { $sender='<i>'.$screenname.'</i>'; } else { $sender='<i>'.$$anonhash{$key}.'</i>'; } # Set up for sorting by domain, then username for anonymous unless (defined($$usernamesort{'__anon'})) { %{$$usernamesort{'__anon'}} = (); } if (defined($$usernamesort{'__anon'}{'__anon'})) { push(@{$$usernamesort{'__anon'}{'__anon'}}, $idx); } else { @{$$usernamesort{'__anon'}{'__anon'}} = ("$idx"); } # Set up for sorting by last name, then first name for anonymous unless (defined($$namesort{'__anon'})) { %{$$namesort{'__anon'}} = (); } if (defined($$namesort{'__anon'}{'__anon'})) { push(@{$$namesort{'__anon'}{'__anon'}}, $idx); } else { @{$$namesort{'__anon'}{'__anon'}} = ("$idx"); } } if (&discussion_open($status)) { if (($group ne '') && (&check_group_priv($group,'pgd') eq 'ok')) { $sender.=' <a href="/adm/feedback?replydisc='. $escsymb.':::'.$idx; if ($$newpostsflag) { $sender .= '&previous='.$prevread; } $sender .= &group_args($group); $sender .= '" '.$target.'>'.&mt('Reply').'</a>'; } elsif (&Apache::lonnet::allowed('pch', $env{'request.course.id'}. ($env{'request.course.sec'}?'/'. $env{'request.course.sec'}:''))) { $sender.=' <a href="/adm/feedback?replydisc='. $escsymb.':::'.$idx; if ($$newpostsflag) { $sender .= '&previous='.$prevread; } $sender .= '" '.$target.'>'.&mt('Reply').'</a>'; } } if ($viewgrades) { $vgrlink=&Apache::loncommon::submlink('Submissions', $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$ressymb); } if ($$dischash{$readkey}=~/\.$idx\./) { $ctlink = '<label><b>'.&mt('Mark unread').'?</b> <input type="checkbox" name="postunread_'.$idx.'" /></label>'; } else { $ctlink = '<label><b>'.&mt('Mark read').'?</b> <input type="checkbox" name="postread_'.$idx.'" /></label>'; } } #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 ($env{'form.totposters'} ne '') { 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; } } } if ($$shown{$idx} && !$skip_group_check) { my $showflag = 0; if (ref($$classgroups{$poster}{active}) eq 'HASH') { foreach my $grp (@{$grouppick}) { if (grep/^\Q$grp\E$/, keys(%{$$classgroups{$poster}{active}})) { $showflag = 1; last; } } } if ($showflag) { $$shown{$idx} = 1; } else { $$shown{$idx} = 0; } } } else { $$shown{$idx} = 1; } } unless ($$notshown{$idx} == 1) { if ($prevread > 0 && $prevread <= $posttime) { $$newitem{$idx} = 1; $$discussionitems[$idx] .= ' <p><table border="0" width="100%"> <tr><td align="left"><font color="#FF0000"><b>NEW</b></font></td>'; } else { $$newitem{$idx} = 0; $$discussionitems[$idx] .= ' <p><table border="0" width="100%"> <tr><td align="left"> </td>'; } $$discussionitems[$idx] .= '<td align ="left"> '. '<b>'.$subject.'</b> '. $sender.'</b> '.$vgrlink.' ('. &Apache::lonlocal::locallocaltime($posttime).')</td>'; if ($$dischash{$toggkey}) { $$discussionitems[$idx].='<td align="right"> '. $ctlink.'</td>'; } $$discussionitems[$idx].= '</tr></table><blockquote>'. $message.'</blockquote></p>'; if ($contrib{$idx.':history'}) { my @postversions = (); $$discussionitems[$idx] .= &mt('This post has been edited by the author.'); if ($seeid) { $$discussionitems[$idx] .= ' <a href="/adm/feedback?allversions='.$escsymb.':::'.$idx; $$discussionitems[$idx] .= &group_args($group); $$discussionitems[$idx] .= '">'.&mt('Display all versions').'</a>'; } $$discussionitems[$idx].='<br/>'.&mt('Earlier version(s) were posted on: '); if ($contrib{$idx.':history'} =~ m/:/) { @postversions = split(/:/,$contrib{$idx.':history'}); } else { @postversions = ("$contrib{$idx.':history'}"); } for (my $i=0; $i<@postversions; $i++) { my $version = $i+1; $$discussionitems[$idx] .= '<b>'.$version.'.</b> - '.&Apache::lonlocal::locallocaltime($postversions[$i]).' '; } } } } } } } } } sub filter_regexp { my ($rolefilter,$sectionpick,$statusfilter) = @_; my ($roleregexp,$secregexp,$statusregexp); my $skiptest = 1; if (@{$rolefilter} > 0) { my @okrolefilter = (); foreach my $role (@{$rolefilter}) { unless ($role eq '') { push(@okrolefilter, $role); } } 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 my $sec (@{$sectionpick}) { unless ($sec eq '') { push(@oksectionpick, $sec); } } 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=$$contrib{$idx.':screenname'}; 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'}) { @postversions = split(/:/,$$contrib{$idx.':history'}); } &get_post_versions($messages,$$contrib{$idx.':message'},1); &get_post_versions($subjects,$$contrib{$idx.':subject'},1); push(@postversions,$$contrib{$idx.':timestamp'}); $end = @postversions; } else { &get_post_versions($messages,$$contrib{$idx.':message'},1,$numver); &get_post_versions($subjects,$$contrib{$idx.':subject'},1,$numver); } if ($$contrib{$idx.':anonymous'}) { $sender.=' ['.&mt('anonymous').'] '.$$screenname; } if ($type eq 'allversions') { $discussion=('<b>'.$sender.'</b><br /><ul>'); } for (my $i=$start; $i<$end; $i++) { my ($timesent,$attachmsg); my %currattach = (); $timesent = &Apache::lonlocal::locallocaltime($postversions[$i]); &newline_to_br(\$messages->{$i}); $$messages{$i}=&Apache::lontexconvert::msgtexconverted($$messages{$i}); $$subjects{$i}=~s/\n/\<br \/\>/g; $$subjects{$i}=&Apache::lontexconvert::msgtexconverted($$subjects{$i}); if ($attachmenturls) { &extract_attachments($attachmenturls,$idx,$i,\$attachmsg,$allattachments,\%currattach); } if ($type eq 'export') { $$imsfiles{$idx}{$i} = ''; if ($attachmsg) { $$attachtxt{$i} = '<br />'.&mt('Attachments').':<br />'; foreach my $key (sort(keys(%currattach))) { if ($$allattachments{$key}{'filename'} =~ m-^/uploaded/([^/]+/[^/]+)(/feedback)?(/?\d*)/([^/]+)$-) { my $fname = $1.$3.'/'.$4; $$imsfiles{$idx}{$i} .= '<file href="'.$fname.'">'."\n"; $$attachtxt{$i}.= '<a href="'.$fname.'">'.$4.'</a><br />'; } } } } else { if ($attachmsg) { $$attachtxt{$i} = '<br />'.&mt('Attachments').':'.$attachmsg.'<br />'; } else { $$attachtxt{$i} = ''; } } if ($type eq 'allversions') { $discussion.= <<"END"; <li><b>$$subjects{$i}</b>, $timesent<br /> $$messages{$i}<br /> $$attachtxt{$i}</li> END } } if ($type eq 'allversions') { $discussion.='</ul>'; 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 .= &mt('Error copying file attachment - [_1] to IMS package',$5).': '.$!.'<br />'."\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 .= &mt('Error copying file attachment - [_1] to IMS package: ',$5).$rtncode.'<br />'."\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','blog','group','ref']); } my %lt = &Apache::lonlocal::texthash( 'plch' => 'Please check at least one of the following feedback types:', 'myqu' => 'My question/comment/feedback:', 'title' => 'Title', 'reta' => 'Retained attachments', 'atta' => 'Attachment (128 KB max size)', ); my $title=&Apache::lonnet::gettitle($feedurl); if (!$title) { $title = $feedurl; } my $quote=''; my $subject = ''; my $comment = ''; my $prevtag = ''; my $parentmsg = ''; my ($symb,$idx,$attachmenturls); my $numoldver = 0; my $attachmsg = ''; my $newattachmsg = ''; my @currnewattach = (); my @currdelold = (); my @keepold = (); my %attachments = (); my %currattach = (); my $attachnum = 0; my $anonchk = (<<END); function anonchk() { for (var i=0; i < document.mailform.discuss.length; i++) { if (document.mailform.discuss[i].checked) { document.attachment.discuss.value = document.mailform.discuss[i].value; } } if (document.mailform.blog.checked) { document.attachment.blog.value = 1; } return } END my $anonscript; if (exists($env{'form.origpage'})) { $anonscript = (<<END); function setposttype() { var disc = "$env{'form.discuss'}"; for (var i=0; i < document.mailform.discuss.length; i++) { if (disc == document.mailform.discuss[i].value) { document.mailform.discuss[i].checked = 1; } } var blog = "$env{'form.blog'}"; if (blog == 1) { document.mailform.blog.checked=1; } return } END } else { $anonscript = (<<END); function setposttype() { return } END } if (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { if ($env{'form.replydisc'}) { ($symb,$idx)=split(/\:\:\:/,$env{'form.replydisc'}); } else { ($symb,$idx)=split(/\:\:\:/,$env{'form.editdisc'}); } my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); unless (($contrib{'hidden'}=~/\.$idx\./) || ($contrib{'deleted'}=~/\.$idx\./)) { if ($contrib{$idx.':history'}) { if ($contrib{$idx.':history'} =~ /:/) { my @oldversions = split(/:/,$contrib{$idx.':history'}); $numoldver = @oldversions; } else { $numoldver = 1; } } if ($env{'form.replydisc'}) { if ($contrib{$idx.':history'}) { if ($contrib{$idx.':history'} =~ /:/) { my @oldversions = split(/:/,$contrib{$idx.':history'}); $numoldver = @oldversions; } else { $numoldver = 1; } } if ($idx > 0) { my %msgversions = (); &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); $quote = $msgversions{$numoldver}; } if ($idx > 0) { my %subversions = (); &get_post_versions(\%subversions,$contrib{$idx.':subject'},1,$numoldver); $subject = &mt('Re: ').$subversions{$numoldver}; } $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'}; } unless (exists($env{'form.origpage'})) { my $anonflag = 'nonanon'; if ($contrib{$idx.':anonymous'}) { $anonflag = 'anon'; } $anonscript = (<<END); function setposttype () { var currtype = "$anonflag"; for (var i=0; i<document.mailform.discuss.length; i++) { if (document.mailform.elements.discuss[i].value == currtype ) { document.mailform.elements.discuss[i].checked=1; } } return } END } } } if ($env{'form.previous'}) { $prevtag = '<input type="hidden" name="previous" value="'.$env{'form.previous'}.'" />'; } } if ($env{'form.origpage'}) { $subject = &unescape($env{'form.subject'}); $comment = &unescape($env{'form.comment'}); &process_attachments(\@currnewattach,\@currdelold,\@keepold); } my $latexHelp=&Apache::loncommon::helpLatexCheatsheet(); my $send=&mt('Send'); my $alert = &mt('Please select a feedback type.'); my $js= <<END; <script type="text/javascript"> //<!-- function gosubmit() { var rec=0; if (typeof(document.mailform.elements.discuss)!="undefined") { if (typeof(document.mailform.elements.discuss.length) == "undefined") { if (document.mailform.elements.discuss.checked ) { rec=1; } } else { for (var i=0; i<document.mailform.elements.discuss.length; i++) { if (document.mailform.elements.discuss[i].checked ) { rec=1; } } } } if (typeof(document.mailform.elements.blog)!="undefined") { if (document.mailform.elements.blog.checked) { rec=1; } } if (rec) { if (typeof(document.mailform.onsubmit)=='function') { document.mailform.onsubmit(); } document.mailform.submit(); } else { alert('$alert'); } } $anonchk $anonscript //--> </script> END my %onload = ('onload' => 'window.focus();setposttype();'); my $start_page= &Apache::loncommon::start_page('Resource Feedback and Discussion',$js, {'add_entries' => \%onload}); if ($quote ne '') { &newline_to_br(\$quote); $quote='<blockquote>'.&Apache::lontexconvert::msgtexconverted($quote).'</blockquote>'; } $r->print(<<END); $start_page <h2><tt>$title</tt></h2> <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data"> $prevtag <input type="hidden" name="postdata" value="$feedurl" /> END if ($env{'form.replydisc'}) { $r->print(<<END); <input type="hidden" name="replydisc" value="$env{'form.replydisc'}" /> END } elsif ($env{'form.editdisc'}) { $r->print(<<END); <input type="hidden" name="editdisc" value ="$env{'form.editdisc'}" /> <input type="hidden" name="parentmsg" value ="$parentmsg" /> END } $r->print(<<END); $lt{'plch'} $options<hr /> $quote <p>$lt{'myqu'}</p> <p> $latexHelp $lt{'title'}: <input type="text" name="subject" size="30" value="$subject" /></p> <p> <textarea name="comment" id="comment" cols="60" rows="10" wrap="hard">$comment </textarea></p> <p> END if ( ($env{'form.editdisc'}) || ($env{'form.replydisc'}) ) { if ($env{'form.origpage'}) { foreach my $attach (@currnewattach) { $r->print('<input type="hidden" name="currnewattach" value="'.$attach.'" />'."\n"); } foreach my $oldatt (@currdelold) { $r->print('<input type="hidden" name="deloldattach" value="'.$oldatt.'" />'."\n"); } } if ($env{'form.editdisc'}) { if ($attachmenturls) { &extract_attachments($attachmenturls,$idx,$numoldver,\$attachmsg,\%attachments,\%currattach,\@currdelold); $attachnum = scalar(keys(%currattach)); foreach my $key (keys(%currattach)) { $r->print('<input type="hidden" name="keepold" value="'.$key.'" />'."\n"); } } } } else { $r->print(<<END); $lt{'atta'}: <input type="file" name="attachment" /> </p> END } if (exists($env{'form.group'})) { $r->print('<input type="hidden" name="group" value="'.$env{'form.group'}.'" />'); } if (exists($env{'form.ref'})) { $r->print('<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />'); } $r->print(<<END); <p> <input type="hidden" name="sendit" value="1" /> <input type="button" value="$send" onClick='gosubmit();' /> </p> </form> 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; } my ($blockblog) = &blocking_posts('blogs'); $r->print(&generate_attachments_button($postidx,$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,$numoldver,'',$blockblog)); if ($attachnum > 0) { if (@currnewattach > 0) { $newattachmsg .= '<br /><b>'.&mt('New attachments').'</b><br />'; if (@currnewattach > 1) { $newattachmsg .= '<ol>'; foreach my $item (@currnewattach) { $item =~ m#.*/([^/]+)$#; $newattachmsg .= '<li><a href="'.$item.'">'.$1.'</a></li>'."\n"; } $newattachmsg .= '</ol>'."\n"; } else { $currnewattach[0] =~ m#.*/([^/]+)$#; $newattachmsg .= '<a href="'.$currnewattach[0].'">'.$1.'</a><br />'."\n"; } } if ($attachmsg) { $r->print("<br /><b>$lt{'reta'}</b>:$attachmsg<br />\n"); } if ($newattachmsg) { $r->print("$newattachmsg<br />"); } } } $r->print(&generate_preview_button(). &Apache::lonhtmlcommon::htmlareaselectactive('comment'). &Apache::loncommon::end_page()); } sub print_display_options { 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'}); my %lt = &Apache::lonlocal::texthash( 'pref' => 'Display Preference', 'curr' => 'Current setting ', 'actn' => 'Action', '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 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 not NEW ', 'toggon' => 'Shown', 'toggoff' => 'Not shown', 'disa' => 'Posts displayed?', '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 any of the discussion settings', 'ywbr' => 'You will be returned to the previous page if you click OK.' ); 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 ($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 $js = <<END; <script type="text/javascript"> function discdispChk(caller) { var disctogg = '$toggchg' if (caller == 0) { if (document.modifydisp.discdisp[0].checked == true) { if (document.modifydisp.discdisp[1].checked == true) { document.modifydisp.discdisp[1].checked = false } } } if (caller == 1) { if (document.modifydisp.discdisp[1].checked == true) { if (document.modifydisp.discdisp[0].checked == true) { document.modifydisp.discdisp[0].checked = false } if (disctogg == 'toggon') { document.modifydisp.disctogg.checked = true } if (disctogg == 'toggoff') { document.modifydisp.disctogg.checked = false } } } if (caller == 2) { var dispchgB = '$dispchgB' if (disctogg == 'toggoff') { if (document.modifydisp.disctogg.checked == true) { if (dispchgB == 'onlyunmark') { document.modifydisp.discdisp[1].checked = false } } } } } function setDisp() { var prev = "$previous" var chktotal = 0 if (document.modifydisp.discdisp[0].checked == true) { document.modifydisp.$dispchgA.value = "$symb" chktotal ++ } if (document.modifydisp.discdisp[1].checked == true) { document.modifydisp.$dispchgB.value = "$symb" chktotal ++ } if (document.modifydisp.discmark.checked == true) { document.modifydisp.$markchg.value = "$symb" chktotal ++ } if (document.modifydisp.disctogg.checked == true) { document.modifydisp.$toggchg.value = "$symb" chktotal ++ } if (chktotal > 0) { document.modifydisp.submit() } else { if(confirm("$lt{'yhni'}. \\n$lt{'ywbr'}")) { if (prev > 0) { location.href = "$feedurl?previous=$previous" } else { location.href = "$feedurl" } } } } </script> END my $start_page = &Apache::loncommon::start_page('Discussion display options',$js); my $end_page = &Apache::loncommon::end_page(); $r->print(<<END); $start_page <form name="modifydisp" method="POST" action="/adm/feedback"> $lt{'sdpf'}<br/> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li><li>$lt{'wipa'}</li></ol> <br /> END $r->print(&Apache::loncommon::start_data_table()); $r->print(<<END); <tr> <th>$lt{'pref'}</td> <th>$lt{'curr'}</td> <th>$lt{'actn'}?</td> </tr> END $r->print(&Apache::loncommon::start_data_table_row()); $r->print(<<END); <td>$lt{'disa'}</td> <td>$lt{$discdisp}</td> <td><label><input type="checkbox" name="discdisp" onClick="discdispChk('0')" /> $lt{'chgt'} "$dispchangeA"</label> <br /> <label><input type="checkbox" name="discdisp" onClick="discdispChk('1')" /> $lt{'chgt'} "$dispchangeB"</label> </td> END $r->print(&Apache::loncommon::end_data_table_row()); $r->print(&Apache::loncommon::start_data_table_row()); $r->print(<<END); <td>$lt{'npmr'}</td> <td>$lt{$discmark}</td> <td><label><input type="checkbox" name="discmark" />$lt{'chgt'} "$markchange"</label></td> END $r->print(&Apache::loncommon::end_data_table_row()); $r->print(&Apache::loncommon::start_data_table_row()); $r->print(<<END); <td>$lt{'dotm'}</td> <td>$lt{$disctogg}</td> <td><label><input type="checkbox" name="disctogg" onClick="discdispChk('2')" />$lt{'chgt'} "$toggchange"</label></td> END $r->print(&Apache::loncommon::end_data_table_row()); $r->print(&Apache::loncommon::end_data_table()); $r->print(<<END); <br /> <br /> <input type="hidden" name="symb" value="$symb" /> <input type="hidden" name="previous" value="$previous" /> <input type="hidden" name="$dispchgA" value=""/> <input type="hidden" name="$dispchgB" value=""/> <input type="hidden" name="$markchg" value=""/> <input type="hidden" name="$toggchg" value="" /> <input type="button" name="sub" value="Store Changes" onClick="javascript:setDisp()" /> END if (exists($env{'form.group'})) { $r->print('<input type="hidden" name="group" value="'.$env{'form.group'}.'" />'); } if (exists($env{'form.ref'})) { $r->print('<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />'); } $r->print(" <br /> <br /> </form> $end_page "); return; } sub print_sortfilter_options { my ($r,$symb,$previous,$feedurl) = @_; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; &Apache::lonenc::check_encrypt(\$symb); my @sections; my $section_sel = ''; my $numvisible = 5; my @groups; my $group_sel = ''; my $numgroupvis = 5; my %sectioncount = &Apache::loncommon::get_sections(); if ($env{'request.course.sec'} !~ /^\s*$/) { #Restrict section choice to current section @sections = ('all',$env{'request.course.sec'}); $numvisible = 2; } else { @sections = sort {$a cmp $b} keys(%sectioncount); if (scalar(@sections) < 4) { $numvisible = scalar(@sections) + 1; } unshift(@sections,'all'); # Put 'all' at the front of the list } foreach my $sec (@sections) { $section_sel .= " <option value=\"$sec\">$sec</option>\n"; } if (&check_group_priv() eq 'ok') { my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum); @groups = sort {$a cmp $b} keys(%curr_groups); if (scalar(@groups) < 4) { $numgroupvis = scalar(@groups) + 1; } unshift(@groups,'all'); # Put 'all' at the front of the list } else { my @coursegroups = split(/:/,$env{'request.course.groups'}); if (@coursegroups > 0) { @coursegroups = sort {$a cmp $b} @coursegroups; @groups = ('all',@coursegroups); if (scalar(@groups) < 4) { $numgroupvis = scalar(@groups) + 1; } } else { @groups = ('all'); $numgroupvis = 1; } } foreach my $group (@groups) { $group_sel .= " <option value=\"$group\">$group</option>\n"; } my $function = &Apache::loncommon::get_users_function(); my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg', $env{'user.domain'}); my %lt = &Apache::lonlocal::texthash( 'diop' => 'Display Options', 'curr' => 'Current setting ', 'actn' => 'Action', 'prca' => 'Set options that control the sort order of posts, and/or which posts are displayed.', 'soor' => 'Sort order', 'spur' => 'Specific user roles', 'sprs' => 'Specific role status', 'spse' => 'Specific sections', 'spgr' => 'Specific groups', 'psub' => 'Pick specific users (by name)', 'shal' => 'Show a list of current posters', 'stor' => 'Store changes', ); my %sort_types = (); my %role_types = (); my %status_types = (); &sort_filter_names(\%sort_types,\%role_types,\%status_types); my $js = <<END; <script type="text/javascript"> function verifyFilter() { var rolenum = 0 for (var i=0; i<document.modifyshown.rolefilter.length; i++) { if (document.modifyshown.rolefilter.options[i].selected == true) { rolenum ++ } } if (rolenum == 0) { document.modifyshown.rolefilter.options[0].selected = true } var secnum = 0 for (var i=0; i<document.modifyshown.sectionpick.length; i++) { if (document.modifyshown.sectionpick.options[i].selected == true) { secnum ++ } } if (secnum == 0) { document.modifyshown.sectionpick.options[0].selected = true } var grpnum = 0 for (var i=0; i<document.modifyshown.grouppick.length; i++) { if (document.modifyshown.grouppick.options[i].selected == true) { grpnum ++ } } if (grpnum == 0) { document.modifyshown.grouppick.options[0].selected = true } document.modifyshown.submit(); } </script> END my $start_page= &Apache::loncommon::start_page('Discussion options',$js); my $end_page= &Apache::loncommon::end_page(); $r->print(<<END); $start_page <form name="modifyshown" method="POST" action="/adm/feedback"> <b>$lt{'diso'}</b><br/> $lt{'prca'} <br /><br /> <table border="0"> <tr> <td><b>$lt{'soor'}</b></td> <td> </td> <td><b>$lt{'sprs'}</b></td> <td> </td> <td><b>$lt{'spur'}</b></td> <td> </td> <td><b>$lt{'spse'}</b></td> <td> </td> <td><b>$lt{'spgr'}</b></td> <td> </td> <td><b>$lt{'psub'}</b></td> </tr> <tr> <td align="center" valign="top"> <select name="sortposts"> <option value="ascdate" selected="selected">$sort_types{'ascdate'}</option> <option value="descdate">$sort_types{'descdate'}</option> <option value="thread">$sort_types{'thread'}</option> <option value="subject">$sort_types{'subject'}</option> <option value="username">$sort_types{'username'}</option> <option value="lastfirst">$sort_types{'lastfirst'}</option> </select> </td> <td> </td> <td align="center" valign="top"> <select name="statusfilter"> <option value="all" selected="selected">$status_types{'all'}</option> <option value="Active">$status_types{'Active'}</option> <option value="Expired">$status_types{'Expired'}</option> <option value="Future">$status_types{'Future'}</option> </select> </td> <td> </td> <td align="center" valign="top"> <select name="rolefilter" multiple="true" size="5"> <option value="all">$role_types{'all'}</option> <option value="st">$role_types{'st'}</option> <option value="cc">$role_types{'cc'}</option> <option value="in">$role_types{'in'}</option> <option value="ta">$role_types{'ta'}</option> <option value="ep">$role_types{'ep'}</option> <option value="cr">$role_types{'cr'}</option> </select> </td> <td> </td> <td align="center" valign="top"> <select name="sectionpick" multiple="true" size="$numvisible"> $section_sel </select> </td> <td> </td> <td align="center" valign="top"> <select name="grouppick" multiple="true" size="$numvisible"> $group_sel </select> </td> <td> </td> <td valign="top"><label><input type="checkbox" name="posterlist" value="$symb" />$lt{'shal'}</label></td> </tr> </table> <br /> <br /> <input type="hidden" name="previous" value="$previous" /> <input type="hidden" name="applysort" value="$symb" /> <input type="button" name="sub" value="$lt{'stor'}" onClick="verifyFilter()" /> END if (exists($env{'form.group'})) { $r->print('<input type="hidden" name="group" value="'.$env{'form.group'}.'" />'); } if (exists($env{'form.ref'})) { $r->print('<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />'); } $r->print(" <br /> <br /> </form> $end_page "); } sub print_showposters { my ($r,$symb,$previous,$feedurl,$sortposts) = @_; &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; my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my $group = $env{'form.group'}; my $ressymb = &wrap_symb($symb); if (($group ne '') && ($ressymb =~ m|^bulletin___ \d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$|)) { if (&check_group_priv($group,'dgp') eq 'ok') { $seeid = 1; } } else { $seeid=&Apache::lonnet::allowed('rin',$crs); } my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $cdom,$cnum); my %namesort = (); my %postcounts = (); my %lt = &Apache::lonlocal::texthash( sele => 'Select', full => 'Fullname', usdo => 'Username:domain', post => 'Posts', ); if ($contrib{'version'}) { for (my $idx=1;$idx<=$contrib{'version'};$idx++) { my $hidden=($contrib{'hidden'}=~/\.$idx\./); my $deleted=($contrib{'deleted'}=~/\.$idx\./); unless ((($hidden) && (!$seeid)) || ($deleted)) { if ((!$contrib{$idx.':anonymous'}) || (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { 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}} = (); } my $poster = $contrib{$idx.':sendername'}.':'.$contrib{$idx.':senderdomain'}; $postcounts{$poster} ++; if (defined($namesort{$lastname}{$firstname})) { if (!grep/^$poster$/,@{$namesort{$lastname}{$firstname}}) { push(@{$namesort{$lastname}{$firstname}}, $poster); } } else { @{$namesort{$lastname}{$firstname}} = ("$poster"); } } } } } my $start_page = &Apache::loncommon::start_page('Discussion options'); my $table_start =&Apache::loncommon::start_data_table(); $r->print(<<END); $start_page <form name="pickpostersform" method="post"> <br /> $table_start <tr> <th>#</th> <th>$lt{'sele'}</th> <th>$lt{'full'} <font color="#999999">($lt{'usdo'})</font></th> <th>$lt{'post'}</th> </tr> END my $count = 0; foreach my $last (sort(keys(%namesort))) { foreach my $first (sort(keys(%{$namesort{$last}}))) { foreach my $user (sort(@{$namesort{$last}{$first}})) { my ($uname,$udom) = split(/:/,$user); if (!$uname || !$udom) { next; } else { $count ++; $r->print(&Apache::loncommon::start_data_table_row(). '<td align="right">'.$count.'</td> <td align="center"><label><input name="stuinfo" type="checkbox" value="'.$user.'" /></td> <td>'.$last.', '.$first.' ('.$uname.':'.$udom.')</label></td> <td>'.$postcounts{$user}.'</td>'. &Apache::loncommon::end_data_table_row()); } } } } $r->print(&Apache::loncommon::end_data_table()); my $end_page = &Apache::loncommon::end_page(); $r->print(<<END); <br /> <input type="hidden" name="sortposts" value="$sortposts" /> <input type="hidden" name="userpick" value="$symb" /> <input type="button" name="store" value="Display posts" onClick="javascript:document.pickpostersform.submit()" /> </form> $end_page END } sub get_post_versions { my ($versions,$incoming,$htmldecode,$numver) = @_; if ($incoming =~ /^<version num="0">/) { my $p = HTML::LCParser->new(\$incoming); my $done = 0; while ( (my $token = $p->get_tag("version")) && (!$done)) { my $num = $token->[1]{num}; my $text = $p->get_text("/version"); if (defined($numver)) { if ($num == $numver) { if ($htmldecode) { $text = &HTML::Entities::decode($text); } $$versions{$numver}=$text; $done = 1; } } else { if ($htmldecode) { $text = &HTML::Entities::decode($text); } $$versions{$num}=$text; } } } else { if (!defined($numver)) { $numver = 0; } if ($htmldecode) { $$versions{$numver} = $incoming; } else { $$versions{$numver} = &HTML::Entities::encode($incoming,'<>&"'); } } return; } sub get_post_attachments { my ($attachments,$attachmenturls) = @_; my $num; if ($attachmenturls =~ m/^<attachment id="0">/) { my $p = HTML::LCParser->new(\$attachmenturls); while (my $token = $p->get_tag("attachment","filename","post")) { if ($token->[0] eq "attachment") { $num = $token->[1]{id}; %{$$attachments{$num}} =(); } elsif ($token->[0] eq "filename") { $$attachments{$num}{'filename'} = $p->get_text("/filename"); } elsif ($token->[0] eq "post") { my $id = $token->[1]{id}; $$attachments{$num}{$id} = $p->get_text("/post"); } } } else { %{$$attachments{'0'}} = (); $$attachments{'0'}{'filename'} = $attachmenturls; $$attachments{'0'}{'0'} = 'n'; } return; } sub fail_redirect { my ($r,$feedurl) = @_; if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; my %lt = &Apache::lonlocal::texthash( 'sorr' => 'Sorry, no recipients ...', ); my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); $r->print(&Apache::loncommon::start_page('Feedback not sent',undef, {'redirect' => [2,$feedurl], 'only_body' => 1,})); $r->print(<<ENDFAILREDIR); <img align="right" src="$logo" /> <b>$lt{'sorr'}</b> ENDFAILREDIR $r->print(&Apache::loncommon::end_page()); } sub redirect_back { my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$blog,$status,$previous,$sort,$rolefilter,$statusfilter,$sectionpick,$grouppick,$numpicks,$group) = @_; my $sorttag = ''; my $roletag = ''; my $statustag = ''; my $sectag = ''; my $grptag = ''; my $userpicktag = ''; my $qrystr = ''; my $prevtag = ''; &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; if ($feedurl =~ /\?register=1/) { $feedurl .= '&'.$qrystr; } else { $feedurl .= '?'.$qrystr; } $prevtag = '<input type="hidden" name="previous" value="'.$previous.'" />'; } if (defined($sort)) { my $sortqry = 'sortposts='.$sort; if (($feedurl =~ /\?register=1/) || ($feedurl =~ /\?previous=/)) { $feedurl .= '&'.$sortqry; } else { $feedurl .= '?'.$sortqry; } $sorttag = '<input type="hidden" name="sortposts" value="'.$sort.'" />'; if (defined($numpicks)) { my $userpickqry = 'totposters='.$numpicks; $feedurl .= '&'.$userpickqry; $userpicktag = '<input type="hidden" name="totposters" value="'.$numpicks.'" />'; } else { if (ref($sectionpick) eq 'ARRAY') { $feedurl .= '§ionpick='; $sectag .= '<input type="hidden" name="sectionpick" value="'; foreach my $sec (@{$sectionpick}) { $feedurl .= $sec.','; $sectag .= $sec.','; } $feedurl =~ s/,$//; $sectag =~ s/,$//; $sectag .= '" />'; } else { $feedurl .= '§ionpick='.$sectionpick; $sectag = '<input type="hidden" name="sectionpick" value="'.$sectionpick.'" />'; } if (ref($grouppick) eq 'ARRAY') { $feedurl .= '&grouppick='; $sectag .= '<input type="hidden" name="grouppick" value="'; foreach my $grp (@{$grouppick}) { $feedurl .= $grp.','; $grptag .= $grp.','; } $feedurl =~ s/,$//; $grptag =~ s/,$//; $grptag .= '" />'; } else { $feedurl .= '&grouppick='.$grouppick; $grptag = '<input type="hidden" name="grouppick" value="'.$grouppick.'" />'; } if (ref($rolefilter) eq 'ARRAY') { $feedurl .= '&rolefilter='; $roletag .= '<input type="hidden" name="rolefilter" value="'; foreach my $role (@{$rolefilter}) { $feedurl .= $role.','; $roletag .= $role.','; } $feedurl =~ s/,$//; $roletag =~ s/,$//; $roletag .= '" />'; } else { $feedurl .= '&rolefilter='.$rolefilter; $roletag = '<input type="hidden" name="rolefilter" value="'.$rolefilter.'" />'; } $feedurl .= '&statusfilter='.$statusfilter; $statustag ='<input type="hidden" name="statusfilter" value="'.$statusfilter.'" />'; } } my $grouptag; if ($group ne '') { $grouptag = '<input type="hidden" name="group" value="'.$group.'" />'; my $refarg; if (exists($env{'form.ref'})) { $refarg = '&ref='.$env{'form.ref'}; $grouptag .= '<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />'; } if ($feedurl =~ /\?/) { $feedurl .= '&group='.$group.$refarg; } else { $feedurl .= '?group='.$group.$refarg; } } $feedurl=&Apache::lonenc::check_encrypt($feedurl); my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); my %onload; if ($env{'environment.remote'} ne 'off') { $onload{'onload'} = "if (window.name!='loncapaclient') { this.document.reldt.submit(); self.window.close(); }"; } my $start_page= &Apache::loncommon::start_page('Feedback sent',undef, {'redirect' => [0,$feedurl], 'only_body' => 1, 'add_entries' => \%onload}); my $end_page = &Apache::loncommon::end_page(); $r->print(<<ENDREDIR); $start_page <img align="right" src="$logo" /> $typestyle <b>Sent $sendsomething message(s), and $sendposts post(s).</b> $blog <font color="red">$status</font> <form name="reldt" action="$feedurl" target="loncapaclient"> $prevtag $sorttag $statustag $roletag $sectag $grptag $userpicktag $grouptag </form> $end_page ENDREDIR } sub no_redirect_back { my ($r,$feedurl) = @_; my $nofeed=&mt('Sorry, no feedback possible on this resource ...'); my %onload; if ($env{'environment.remote'} ne 'off') { $onload{'onload'} = "if (window.name!='loncapaclient') { self.window.close(); }"; } my %body_options = ('only_body' => 1, 'bgcolor' => '#FFFFFF', 'add_entries' => \%onload,); if ($feedurl !~ m{^/adm/feedback}) { $body_options{'rediect'} = [2,$feedurl]; } my $start_page= &Apache::loncommon::start_page('Feedback not sent',undef, \%body_options); my $end_page = &Apache::loncommon::end_page(); $feedurl=&Apache::lonenc::check_encrypt($feedurl); my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); $r->print (<<ENDNOREDIRTWO); $start_page <img align="right" src="$logo" /> <b>$nofeed</b> <br /> $end_page ENDNOREDIRTWO } sub screen_header { my ($feedurl,$symb) = @_; my $msgoptions=''; my $discussoptions=''; unless (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/) && ($env{'user.adv'})) { $msgoptions= '<p><label><input type="radio" name="discuss" value="author" /> '. &mt('Feedback to resource author').'</label></p>'; } if (&feedback_available(1)) { $msgoptions.= '<p><label><input type="radio" name="discuss" value="question" /> '. &mt('Question about resource content').'</label></p>'; } if (&feedback_available(0,1)) { $msgoptions.= '<p><label><input type="radio" name="discuss" value="course" /> '. &mt('Question/Comment/Feedback about course content'). '</label></p>'; } if (&feedback_available(0,0,1)) { $msgoptions.= '<p><label><input type="radio" name="discuss" value="policy" /> '. &mt('Question/Comment/Feedback about course policy'). '</label></p>'; } } if (($env{'request.course.id'}) && (!$env{'form.sendmessageonly'})) { if (&discussion_open(undef,$symb) && &Apache::lonnet::allowed('pch', $env{'request.course.id'}. ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { my ($blocked) = &blocking_posts('boards'); if (!$blocked) { $discussoptions='<label><input type="radio" name="discuss" value="nonanon" checked="checked" /> '. &mt('Contribution to course discussion of resource'); $discussoptions.='</label><br /><label><input type="radio" name="discuss" value="anon" /> '. &mt('Anonymous contribution to course discussion of resource'). ' <i>('.&mt('name only visible to course faculty').')</i></label> '. '<a href="/adm/preferences?action=changescreenname">'.&mt('Change Screenname').'</a>'; } } my ($blockblog) = &blocking_posts('blogs'); if (!$blockblog) { $discussoptions.= &add_blog_checkbox(); } } if ($msgoptions) { $msgoptions='<h2><img src="'.&Apache::loncommon::lonhttpdurl('/adm/lonMisc/feedback.gif').'" />'.&mt('Sending Messages').'</h2>'.$msgoptions; } if ($discussoptions) { $discussoptions='<h2><img src="'.&Apache::loncommon::lonhttpdurl('/adm/lonMisc/chat.gif').'" />'.&mt('Discussion Contributions').'</h2>'.$discussoptions; } return $msgoptions.$discussoptions; } sub resource_output { my ($feedurl) = @_; my $usersaw=&Apache::lonnet::ssi_body($feedurl); $usersaw=~s/\<body[^\>]*\>//gi; $usersaw=~s/\<\/body\>//gi; $usersaw=~s/\<html\>//gi; $usersaw=~s/\<\/html\>//gi; $usersaw=~s/\<head\>//gi; $usersaw=~s/\<\/head\>//gi; $usersaw=~s/action\s*\=/would_be_action\=/gi; return $usersaw; } sub clear_out_html { my ($message,$override,$ignore_htmlarea)=@_; if (!$ignore_htmlarea && !&Apache::lonhtmlcommon::htmlareablocked()) { return $message; } # Always allow the <m>-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) || ($override)) { # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG> # <BLOCKQUOTE> <DIV .*> <DIV> <IMG> <M> <SPAN> <H1> <H2> <H3> <H4> <SUB> # <SUP> %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, 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 $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/ {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge; $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/ {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge; return $message; } sub assemble_email { my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_; my %lt = &Apache::lonlocal::texthash( 'prev' => 'Previous attempts of student (if applicable)', 'orig' => 'Original screen output (if applicable)', 'corr' => 'Correct Answer(s) (if applicable)', ); my $email=<<"ENDEMAIL"; $message ENDEMAIL my $citations=<<"ENDCITE"; <h2>$lt{'prev'}</h2> $prevattempts <br /><hr /> <h2>$lt{'orig'}</h2> $usersaw <h2>$lt{'corr'}</h2> $useranswer ENDCITE return ($email,$citations); } sub secapply { my $rec=shift; my $defaultflag=shift; $rec=~s/\s+//g; $rec=~s/\@/\:/g; my ($adr,$sections)=($rec=~/^([^\(]+)\(([^\)]+)\)/); if ($sections) { foreach my $sec (split(/\;/,$sections)) { if (($sec eq $env{'request.course.sec'}) || ($defaultflag && ($sec eq '*'))) { return $adr; } } } else { return $rec; } 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.<name> 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.discuss'} eq 'author' ||$author) { $typestyle.='Submitting as Author Feedback<br />'; $feedurl=~{^/res/($LONAPA::domain_re)/($LONCAPA::username_re)/}; $to{$2.':'.$1}=1; } if ($env{'form.discuss'} eq 'question' ||$question) { $typestyle.=&mt('Submitting as Question').'<br />'; foreach my $item (split(/\,/, $env{'course.'.$env{'request.course.id'}.'.question.email'}) ) { my $rec=&secapply($item,$defaultflag); if ($rec) { $to{$rec}=1; } } } if ($env{'form.discuss'} eq 'course' ||$course) { $typestyle.=&mt('Submitting as Comment').'<br />'; foreach my $item (split(/\,/, $env{'course.'.$env{'request.course.id'}.'.comment.email'}) ) { my $rec=&secapply($item,$defaultflag); if ($rec) { $to{$rec}=1; } } } if ($env{'form.discuss'} eq 'policy' ||$policy) { $typestyle.=&mt('Submitting as Policy Feedback').'<br />'; foreach my $item (split(/\,/, $env{'course.'.$env{'request.course.id'}.'.policy.email'}) ) { my $rec=&secapply($item,$defaultflag); if ($rec) { $to{$rec}=1; } } } if ((scalar(%to) eq '0') && (!$defaultflag)) { ($typestyle,%to)= &decide_receiver($feedurl,$author,$question,$course,$policy,1); } return ($typestyle,%to); } sub feedback_available { my ($question,$course,$policy)=@_; my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy); return scalar(%to); } sub send_msg { my ($title,$feedurl,$email,$citations,$attachmenturl,%to)=@_; my $status=''; my $sendsomething=0; if ($title=~/^Error/) { $title=&mt('Feedback').': '.$title; } unless ($title=~/\w/) { $title=&mt('Feedback'); } foreach my $key (keys(%to)) { if ($key) { my $declutter=&Apache::lonnet::declutter($feedurl); unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$key), $title.' ['.$declutter.']',$email,$citations,$feedurl, $attachmenturl)=~/ok/) { $status.='<br />'.&mt('Error sending message to').' '.$key.'<br />'; } else { $sendsomething++; } } } my %record=&Apache::lonnet::restore('_feedback'); my ($temp)=keys(%record); unless ($temp=~/^error\:/) { my %newrecord=(); $newrecord{'resource'}=$feedurl; $newrecord{'subnumber'}=$record{'subnumber'}+1; unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') { $status.='<br />'.&mt('Not registered').'<br />'; } } return ($status,$sendsomething); } sub adddiscuss { my ($symb,$email,$anon,$attachmenturl,$subject)=@_; my $status=''; 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'}, 'attachmenturl'=> $attachmenturl, 'subject' => $subject); if ($env{'form.replydisc'}) { $contrib{'replyto'}=(split(/\:\:\:/,$env{'form.replydisc'}))[1]; } if ($anon) { $contrib{'anonymous'}='true'; } if (($symb) && ($email)) { if ($env{'form.editdisc'}) { $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'}); &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'}); if (defined($oldcontrib{$oldidx.':replyto'})) { $contrib{'replyto'} = $oldcontrib{$oldidx.':replyto'}; } if (defined($oldcontrib{$oldidx.':history'})) { if ($oldcontrib{$oldidx.':history'} =~ /:/) { my @oldversions = split(/:/,$oldcontrib{$oldidx.':history'}); $numoldver = @oldversions; } else { $numoldver = 1; } $contrib{'history'} = $oldcontrib{$oldidx.':history'}.':'; } my $numnewver = $numoldver + 1; if (defined($oldcontrib{$oldidx.':subject'})) { if ($oldcontrib{$oldidx.':subject'} =~ /^<version num="0">/) { $contrib{'subject'} = '<version num="'.$numnewver.'">'.&HTML::Entities::encode($contrib{'subject'},'<>&"').'</version>'; $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.$contrib{'subject'}; } else { $contrib{'subject'} = '<version num="0">'.&HTML::Entities::encode($oldcontrib{$oldidx.':subject'},'<>&"').'</version><version num="1">'.&HTML::Entities::encode($contrib{'subject'},'<>&"').'</version>'; } } if (defined($oldcontrib{$oldidx.':message'})) { if ($oldcontrib{$oldidx.':message'} =~ /^<version num="0">/) { $contrib{'message'} = '<version num="'.$numnewver.'">'.&HTML::Entities::encode($contrib{'message'},'<>&"').'</version>'; $contrib{'message'} = $oldcontrib{$oldidx.':message'}.$contrib{'message'}; } else { $contrib{'message'} = '<version num="0">'.&HTML::Entities::encode($oldcontrib{$oldidx.':message'},'<>&"').'</version><version num="1">'.&HTML::Entities::encode($contrib{'message'},'<>&"').'</version>'; } } $contrib{'history'} .= $oldcontrib{$oldidx.':timestamp'}; my $put_reply = &Apache::lonnet::putstore($env{'request.course.id'}, $oldsymb,$oldidx,\%contrib, $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'}); } my %storenewentry=($symb => time); $status.='<br />'.&mt('Updating discussion time').': '. &Apache::lonnet::put('discussiontimes',\%storenewentry, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); } my %record=&Apache::lonnet::restore('_discussion'); my ($temp)=keys(%record); unless ($temp=~/^error\:/) { my %newrecord=(); $newrecord{'resource'}=$symb; $newrecord{'subnumber'}=$record{'subnumber'}+1; $status.='<br />'.&mt('Registering').': '. &Apache::lonnet::cstore(\%newrecord,'_discussion'); } } else { $status.='Failed.'; } return $status.'<br />'; } # ----------------------------------------------------------- Preview function sub show_preview { my ($r) = @_; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $start_page= &Apache::loncommon::start_page('Preview',undef, {'only_body' => 1,}); 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'},undef,1); $subject=~s/\n/\<br \/\>/g; $subject=&Apache::lontexconvert::msgtexconverted($subject); my $end_page = &Apache::loncommon::end_page(); $r->print($start_page.'<table border="2"><tr><td>'. '<b>'.&mt('Subject').':</b> '.$subject.'<br /><br />'. $message.'</td></tr></table>'.$end_page); } 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/\<br \/\>/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 { my ($formname,$fieldname)=@_; unless ($formname) { $formname='mailform'; } unless ($fieldname) { $fieldname='comment'; } my $pre=&mt("Show Preview and Check Spelling"); return(<<ENDPREVIEW); <br /> <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview"> <input type="hidden" name="subject"> <input type="hidden" name="comment" /> <input type="button" value="$pre" onClick="if (typeof(document.$formname.onsubmit)=='function') {document.$formname.onsubmit();};this.form.comment.value=document.$formname.$fieldname.value;this.form.subject.value=document.$formname.subject.value;this.form.submit();" /> </form> ENDPREVIEW } sub modify_attachments { my ($r,$currnewattach,$currdelold,$symb,$idx,$attachmenturls)=@_; my %lt = &Apache::lonlocal::texthash( 'subj' => 'Subject', 'thfo' => 'The following attachments were part of the most recent saved version of this posting.', 'chth' => 'Check the checkboxes for any you wish to remove.', 'thef' => 'The following attachments have been uploaded for inclusion with this posting.', 'adda' => 'Add a new attachment to this post.', 'stch' => 'Store Changes', ); my $js = <<END; <script type="text/javascript"> function setAction () { document.modattachments.action = document.modattachments.origpage.value; document.modattachments.submit(); } </script> END my $start_page = &Apache::loncommon::start_page('Discussion Post Attachments',$js); my $orig_subject = &unescape($env{'form.subject'}); my $subject=&clear_out_html($orig_subject,undef,1); $subject=~s/\n/\<br \/\>/g; $subject=&Apache::lontexconvert::msgtexconverted($subject); my $timestamp=$env{'form.timestamp'}; my $numoldver=$env{'form.numoldver'}; my $msg = ''; my %attachments = (); my %currattach = (); if ($idx) { &extract_attachments($attachmenturls,$idx,$numoldver,\$msg,\%attachments,\%currattach,$currdelold); } &Apache::lonenc::check_encrypt(\$symb); my $end_page = &Apache::loncommon::end_page(); $r->print(<<END); $start_page <form name="modattachments" method="post" enctype="multipart/form-data" action="/adm/feedback?attach=$symb"> <table border="2"> <tr> <td> <b>Subject:</b> $subject</b><br /><br /> END if ($idx) { if ($attachmenturls) { my @currold = keys(%currattach); if (@currold > 0) { $r->print($lt{'thfo'}.'<br />'.$lt{'chth'}.'<br />'."\n"); foreach my $id (@currold) { my $attachurl = &HTML::Entities::decode($attachments{$id}{'filename'}); $attachurl =~ m#/([^/]+)$#; $r->print('<label><input type="checkbox" name="deloldattach" value="'.$id.'" /> '.$1.'</label><br />'."\n"); } $r->print("<br />"); } } } if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) { $r->print($lt{'thef'}.'<br />'.$lt{'chth'}.'<br />'."\n"); foreach my $attach (@{$currnewattach}) { $attach =~ m#/([^/]+)$#; $r->print('<label><input type="checkbox" name="delnewattach" value="'.$attach.'" /> '.$1.'</label><br />'."\n"); } $r->print("<br />"); } $r->print(<<END); $lt{'adda'} <input type="file" name="addnewattach" /><input type="button" name="upload" value="Upload" onClick="this.form.submit()" /> </td> </tr> </table> <input type="hidden" name="subject" value="$env{'form.subject'}" /> <input type="hidden" name="comment" value="$env{'form.comment'}" /> <input type="hidden" name="timestamp" value="$env{'form.timestamp'}" /> <input type="hidden" name="idx" value="$env{'form.idx'}" /> <input type="hidden" name="numoldver" value="$env{'form.numoldver'}" /> <input type="hidden" name="origpage" value="$env{'form.origpage'}" /> <input type="hidden" name="blog" value="$env{'form.blog'}" /> <input type="hidden" name="discuss" value="$env{'form.discuss'}" /> END foreach my $item (@{$currnewattach}) { $r->print('<input type="hidden" name="currnewattach" value="'.$item.'" />'."\n"); } foreach my $item (@{$currdelold}) { $r->print('<input type="hidden" name="deloldattach" value="'.$item.'" />'."\n"); } $r->print(<<END); <input type="button" name="rtntoedit" value="$lt{'stch'}" onClick="setAction()"/> </form> $end_page 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 my $item (@currdelnew) { if ($newone eq $item) { $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,$blockblog) = @_; my $origpage = $ENV{'REQUEST_URI'}; my $att=$attachnum.' '.&mt("attachments"); my %lt = &Apache::lonlocal::texthash( 'clic' => 'Click to add/remove attachments', ); my $response = (<<END); <br /> <form name="attachment" action="/adm/feedback?attach=$ressymb" method="post"> $lt{'clic'}: <input type="button" value="$att" onClick="if (typeof(document.mailform.onsubmit)=='function') {document.mailform.onsubmit();};this.form.comment.value=escape(document.mailform.comment.value);this.form.subject.value=escape(document.mailform.subject.value); END if (!$blockblog) { $response .= 'setblogvalue();'; } unless ($mode eq 'board') { $response .= 'javascript:anonchk();'; } $response .= (<<ENDATTACH); this.form.submit();" /> <input type="hidden" name="origpage" value="$origpage" /> <input type="hidden" name="idx" value="$idx" /> <input type="hidden" name="timestamp" value="$now" /> <input type="hidden" name="subject" /> <input type="hidden" name="comment" /> <input type="hidden" name="blog" value = "0" /> <input type="hidden" name="discuss" value = "0" /> <input type="hidden" name="numoldver" value="$numoldver" /> ENDATTACH if (defined($deloldattach)) { if (@{$deloldattach} > 0) { foreach my $delatt (@{$deloldattach}) { $response .= '<input type="hidden" name="deloldattach" value="'.$delatt.'" />'."\n"; } } } if (defined($currnewattach)) { if (@{$currnewattach} > 0) { foreach my $attach (@{$currnewattach}) { $response .= '<input type="hidden" name="currnewattach" value="'.$attach.'" />'."\n"; } } } $response .= '</form>'; 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/^<attachment id="0">/) { $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); } else { $attachurl = $$attachments{$id}{'filename'}; } $attachurl=~m|/([^/]+)$|; $$message.='<br /><a href="'.$attachurl.'"><tt>'. $1.'</tt></a><br />'; &Apache::lonnet::allowuploaded('/adm/feedback', $attachurl); } elsif (@attached > 1) { $$message.='<ol>'; foreach my $attach (@attached) { my $id = $attach; my $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); my ($fname) =($attachurl=~m|/([^/]+)$|); $$message .= '<li><a href="'.$attachurl. '"><tt>'. $fname.'</tt></a></li>'; &Apache::lonnet::allowuploaded('/adm/feedback', $attachurl); } $$message .= '</ol>'; } } 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/^<attachment id="0">/) { 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 .= '<attachment id="'.$num.'"><filename>'.$attachments{$num}{'filename'}.'</filename>'; foreach my $item (sort {$a <=> $b} keys(%{$attachments{$num}})) { unless ($item eq 'filename') { $newattachmenturl .= '<post id="'.$item.'">'.$attachments{$num}{$item}.'</post>'; } } if (grep/^$num$/,@{$keepold}) { $newattachmenturl .= '<post id="'.$currver.'">'.$attachments{$num}{$prevver}.'</post>'; } $newattachmenturl .= '</attachment>'; } } else { $newattachmenturl = '<attachment id="0"><filename>'.&HTML::Entities::encode($oldattachmenturl).'</filename><post id="0">n</post>'; unless (grep/^0$/,@{$keepold}) { $newattachmenturl .= '<post id="1">n</post>'; } $newattachmenturl .= '</attachment>'; $startnum ++; } } } for (my $i=0; $i<@{$currnewattach}; $i++) { my $attachnum = $startnum + $i; $newattachmenturl .= '<attachment id="'.$attachnum.'"><filename>'.&HTML::Entities::encode($$currnewattach[$i]).'</filename><post id="'.$currver.'">n</post></attachment>'; } return $newattachmenturl; } sub add_blog_checkbox { my ($checkstatus); if ($env{'form.blog'}) { $checkstatus = 'checked="checked"'; } my $output = ' <script type="text/javascript"> function setblogvalue() { if (document.mailform.blog.checked) { document.attachment.blog.value = 1; } else { document.attachment.blog.value = 0; } } </script><br /> <label><input type="checkbox" name="blog" '.$checkstatus.' /> '. &mt('Add to my public course blog').'</label><br />'."\n"; return $output; } 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 past roles', Future => 'Only future roles', ); } sub handler { my $r = shift; if ($r->header_only) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK; } # --------------------------- Get query string for limited number of parameters &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['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','groupick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export','sendmessageonly','group','ref']); my $group = $env{'form.group'}; if ($env{'form.editdisc'}) { if (!(&editing_allowed($env{'form.editdisc'},$env{'form.group'}))) { my $symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0]; my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); my $feedurl=&Apache::lonnet::clutter($url); &redirect_back($r,$feedurl,&mt('Editing not permitted').'<br />', '0','0','','',$env{'form.previous'},undef,undef,undef, undef,undef,undef,$group); return OK; } } 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'}); } &redirect_back($r,$feedurl,&mt('Marked postings read/unread').'<br />', '0','0','','',$env{'form.previous'},'','','', undef,undef,undef,$group); return OK; } if ($env{'form.allversions'}) { &Apache::loncommon::content_type($r,'text/html'); &Apache::loncommon::no_cache($r); $r->send_http_header; $r->print(&Apache::loncommon::start_page('Discussion Post Versions')); my $crs='/'.$env{'request.course.id'}; if ($env{'request.course.sec'}) { $crs.='_'.$env{'request.course.sec'}; } $crs=~s|_|/|g; my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my ($symb,$idx)=split(/\:\:\:/,$env{'form.allversions'}); ($symb)=&get_feedurl_and_clean_symb($symb); my $ressymb = &wrap_symb($symb); my $group = $env{'form.group'}; my $seeid; if (($group ne '') && (($ressymb =~ m|^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$|))) { if (&check_group_priv($group,'dgp') eq 'ok') { $seeid = 1; } } else { $seeid = &Apache::lonnet::allowed('rin',$crs); } 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)); } $r->print(&Apache::loncommon::end_page()); 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; 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').'<br />','0','0','', '',$env{'form.previous'},$env{'form.sortposts'},'','','', '',$numpicks,$group); return OK; } if ($env{'form.applysort'}) { my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.applysort'}); &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','', '',$env{'form.previous'},$env{'form.sortposts'}, $env{'form.rolefilter'},$env{'form.statusfilter'}, $env{'form.sectionpick'},$env{'form.grouppick'}, undef,$group); return OK; } 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.navtime'}) { my %discinfo = (); my @resources = (); if (defined($env{'form.navmaps'})) { if ($env{'form.navmaps'} =~ /:/) { @resources = split(/:/,$env{'form.navmaps'}); } else { @resources = ("$env{'form.navmaps'}"); } } else { &has_discussion(\@resources); } my $numitems = @resources; my $feedurl = '/adm/navmaps'; 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.', 'twnp' => 'There are currently no resources or bulletin boards with unread discussion postings.' ); foreach my $res (@resources) { my $ressymb=$res; &Apache::lonenc::check_decrypt(\$ressymb); my $lastkey = $ressymb.'_lastread'; $discinfo{$lastkey} = $env{'form.navtime'}; } my $textline = "<b>$lt{'mnpa'} $numitems $lt{'robb'}</b>"; if ($numitems > 0) { &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', \%discinfo,$env{'user.domain'},$env{'user.name'}); } else { $textline = "<b>$lt{'twnp'}</b>"; } &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); my %onload; if ($env{'environment.remote'} ne 'off') { $onload{'onload'} = "if (window.name!='loncapaclient') { this.document.reldt.submit(); self.window.close(); }"; } my $start_page= &Apache::loncommon::start_page('New posts marked as read',undef, {'redirect' => [2,$feedurl], 'only_body' => 1, 'add_entries' => \%onload}); my $end_page = &Apache::loncommon::end_page(); $r->print (<<ENDREDIR); $start_page <img align="right" src="$logo" /> $textline <form name="reldt" action="$feedurl" target="loncapaclient"> </form> <br /> $end_page ENDREDIR return OK; } 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'} || $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; } # --------------------------------- 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').'<br />', '0','0','','',$previous,'','','','','','',$group); 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 $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'} && !$seeid && !(&editing_allowed($env{'form.hide'},$env{'form.group'}))) { &redirect_back($r,$feedurl,&mt('Deletion not permitted').'<br />', '0','0','','',$env{'form.previous'},'','','','', undef,undef,$group,); return OK; } 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'}; 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,$feedurl,&mt('Changed discussion status').'<br />', '0','0','','',$env{'form.previous'},undef,undef,undef, undef,undef,undef,$group); 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'); } &redirect_back($r,$feedurl,&mt('Changed discussion view mode').'<br />', '0','0','','',$env{'form.previous'},undef,undef,undef, undef,undef,undef,$group); return OK; } elsif ($env{'form.deldisc'}) { # --------------------------------------------------------------- Hide for good 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').'<br />', '0','0','','',$env{'form.previous'},undef,undef,undef, undef,undef,undef,$group); return OK; } elsif ($env{'form.preview'}) { # -------------------------------------------------------- User wants a preview &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','discuss','blog']); 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|task)$/) { $mode='problem'; $status=$Apache::inputtags::status[-1]; } my $discussion = &list_discussion($mode,$status,$symb); my $start_page = &Apache::loncommon::start_page('Resource Feedback and Discussion'); my $end_page = &Apache::loncommon::end_page(); $r->print($start_page.$discussion.$end_page); 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); } 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|task)$/) { 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; } # Go ahead with feedback, no ambiguous reference 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); return OK; } # --------------------------------------------------- Print login screen header 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; } # Get previous user input my $prevattempts=&Apache::loncommon::get_previous_attempt( $symb,$env{'user.name'},$env{'user.domain'}, $env{'request.course.id'}); # Get output from resource my $usersaw=&resource_output($feedurl); # 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'}); &Apache::lonnet::delenv('allowed.vgr'); # Get attachments, if any, and not too large my $attachmenturl=''; 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'}); # Assemble email my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts, $usersaw,$useranswer); # Who gets this? my ($typestyle,%to) = &decide_receiver($feedurl); # Actually send mail my ($status,$numsent)=&send_msg(&clear_out_html($env{'form.subject'}, undef,1), $feedurl,$email,$citations, $attachmenturl,%to); # Discussion? Store that. my $numpost=0; if ( ($env{'form.discuss'} ne '' && $env{'form.discuss'} !~ /^(?:author|question|course|policy)/) || $env{'form.anondiscuss'} ne '') { my $subject = &clear_out_html($env{'form.subject'},undef,1); my $anonmode=($env{'form.discuss'} eq 'anon' || $env{'form.anondiscuss'} ); $typestyle.=&adddiscuss($symb,$message,$anonmode,$attachmenturl, $subject); $numpost++; } # Add to blog? my $blog=''; if ($env{'form.blog'}) { my $subject = &clear_out_html($env{'form.subject'},undef,1); $status.=&Apache::lonrss::addentry($env{'user.name'}, $env{'user.domain'}, 'CourseBlog_'.$env{'request.course.id'}, $subject,$message,$feedurl,'public'); $blog='<br />'.&mt('Added to my course blog').'<br />'; } # Receipt screen and redirect back to where came from &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$blog,$status,$env{'form.previous'},undef,undef,undef,undef,undef,undef,$group); } 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); } sub editing_allowed { my ($postid,$group) = @_; $postid = &unescape($postid); my $can_edit = 0; if ($group ne '') { my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; if ($postid =~ m|^bulletin___\d+___adm/wrapper(/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard)|) { if (&check_group_priv($group,'egp') eq 'ok') { $can_edit = 1; } return $can_edit; } } my $cid = $env{'request.course.id'}; my $role = (split(/\./,$env{'request.role'}))[0]; my $section = $env{'request.course.sec'}; my $allow_editing_config = $env{'course.'.$cid.'.allow_discussion_post_editing'}; if ($allow_editing_config =~ m/^\s*yes\s*$/i) { $can_edit = 1; } else { foreach my $editor (split(/,/,$allow_editing_config)) { my ($editor_role,$editor_sec) = split(/:/,$editor); if ($editor_role eq $role && defined($editor_sec) && defined($section) && $editor_sec eq $section) { $can_edit = 1; last; } if ($editor_role eq $role && !defined($editor_sec)) { $can_edit = 1; } } } return $can_edit; } sub check_group_priv { my ($group,$grp_priv) = @_; foreach my $priv ('mdg','vcg') { my $checkcourse = $env{'request.course.id'}. ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''); if (&Apache::lonnet::allowed($priv,$checkcourse)) { return 'ok'; } } if ($grp_priv && $group ne '') { if (&Apache::lonnet::allowed($grp_priv,$env{'request.course.id'}.'/'.$group)) { return 'ok'; } } return ''; } sub group_args { my ($group) = @_; if ($group eq '') { return ''; } my $extra_args = '&group='.$group; if (exists($env{'form.ref'})) { $extra_args .= '&ref='.$env{'form.ref'}; } return $extra_args; } 1; __END__