# The LearningOnline Network # Feedback # # $Id: lonfeedback.pm,v 1.370.2.5.2.4 2022/11/16 14:46:16 raeburn 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 HTML::Tidy::libXML; use Apache::lonspeller(); use Apache::longroup; use Archive::Zip qw( :ERROR_CODES ); use LONCAPA qw(:DEFAULT :match); sub discussion_open { my ($status,$symb)=@_; # Advanced roles can always discuss if ($env{'request.role.adv'}) { return 1; } # Get discussion closing date my $close=&Apache::lonnet::EXT('resource.0.discussend',$symb); # If it is defined and in the future, the instructor wants this discussion to be open if (defined($close) && $close ne '' && $close > time) { return 1; } # It was not explicitly open, check if the problem is available. # If the problem is not available, close the discussion if (defined($status) && !($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER' || $status eq 'OPEN')) { return 0; } # The problem is available, but check if the instructor explictly closed discussion 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 discussion_vote_available { my ($status,$symb)=@_; my $canvote=&Apache::lonnet::EXT('resource.0.discussvote',$symb); if ((lc($canvote) eq 'yes') || ((lc($canvote) eq 'notended') && (&discussion_open($status,$symb)))) { return 1; } } sub get_realsymb { my ($symb) = @_; my $realsymb = $symb; if ($symb=~/^bulletin___/) { my $filename=(&Apache::lonnet::decode_symb($symb))[2]; $filename=~s{^adm/wrapper/}{}; $realsymb=&Apache::lonnet::symbread($filename); } return $realsymb; } sub list_discussion { my ($mode,$status,$ressymb,$imsextras,$group)=@_; unless ($ressymb) { $ressymb=&Apache::lonnet::symbread(); } unless ($ressymb) { return ''; } $ressymb=&wrap_symb($ressymb); 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'; } } my ($nofooter,$nodisclink,$nofdbklink); if (not &discussion_visible($status)) { if ($mode ne 'board') { ($nofooter,$nodisclink,$nofdbklink) = &check_menucoll(); if ($nofooter || $nofdbklink) { return '
'; } else { &Apache::lonenc::check_encrypt(\$ressymb); return '
"; } } } if ($group ne '' && $mode eq 'board') { if (&check_group_priv($group,'vgb') ne 'ok') { return ''; } } unless ($outputtarget eq 'export') { ($nofooter,$nodisclink,$nofdbklink) = &check_menucoll(); } unless ($nofooter) { my ($blocked,$blocktext) = &Apache::loncommon::blocking_status('boards'); if ($blocked) { my $footer = '
'; return $footer; } } my @bgcols = ("LC_disc_old_item","LC_disc_new_item"); 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; my $encsymb=&Apache::lonenc::check_encrypt($ressymb); my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) && ($ressymb=~/$LONCAPA::assess_re/)); 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'}; my $crstype = &Apache::loncommon::course_type(); # 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 (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { $seeid = 1; } my $seehidden = &can_see_hidden($mode,$ressymb,undef,$group,$cdom,$cnum,$crs); # Is voting on discussions available my $realsymb = &get_realsymb($ressymb); my $canvote = &discussion_vote_available($status,$realsymb); 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 $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,$seehidden,$canvote,$prevread,$sortposts,$encsymb,$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 %lt = &Apache::lonlocal::texthash( 'cuse' => 'My settings for this discussion', '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', 'discussions' => 'DISCUSSIONS' ); my %js_lt = &Apache::lonlocal::texthash( '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.', ); &js_escape(\%js_lt); 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.='{\tiny \vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'. '\textbf{'.$lt{'discussions'}.'}\makebox[2 cm][b]{\hrulefill}\vskip 0 mm'. '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'. '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}}'; } elsif ($outputtarget eq 'export') { # Create temporary directory if this is an export my $now = time; if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) { $tempexport = $$imsextras{'tempexport'}; if (!-e $tempexport) { mkdir($tempexport,0700); } $tempexport .= '/'.$$imsextras{'count'}; if (!-e $tempexport) { mkdir($tempexport,0700); } } else { $tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports'; if (!-e $tempexport) { mkdir($tempexport,0700); } $tempexport .= '/'.$now; if (!-e $tempexport) { mkdir($tempexport,0700); } $tempexport .= '/'.$env{'user.domain'}.'_'.$env{'user.name'}; } if (!-e $tempexport) { mkdir($tempexport,0700); } # open manifest file my $manifest = '/imsmanifest.xml'; my $manifestfilename = $tempexport.$manifest; if ($manifestfile = Apache::File->new('>'.$manifestfilename)) { $manifestok=1; print $manifestfile qq| $lt{'difo'} $ressymb\n|; } else { $discussion .= $lt{'aner'}.'
'; } } else { my $colspan=$maxdepth+1; $discussion.= &Apache::lonhtmlcommon::scripttag(qq| 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("$js_lt{'aysu'}\\n$js_lt{'dpwn'},\\n$js_lt{'bwco'}")) { document.location.href = "/adm/feedback?hide="+symbparm+prevparm+groupparm } } else { if (caller == 'seeiddelete') { if (confirm("$js_lt{'aysu'}\\n$js_lt{'depo'}")) { document.location.href = "/adm/feedback?deldisc="+symbparm+prevparm+groupparm } } } } |); $discussion.='
'. "\n".''; $discussion .= &action_links_bar($colspan,$ressymb,$visible, $newpostsflag,$group, $prevread,$markondisp,$seehidden); my $escsymb=&escape($ressymb); my $numhidden = keys(%notshown); if ($numhidden > 0) { my $colspan = $maxdepth+1; $discussion.="\n".''; } } # 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.unthreadeddiscussion'})) || ($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"; } my $thisdepth=$depth[$alldiscussion{$post}]; if ($outputtarget ne 'tex' && $outputtarget ne 'export') { for (1..$thisdepth) { $discussion.=''; } } my $colspan=$maxdepth-$thisdepth+1; if ($outputtarget eq 'tex') { #cleanup block $discussionitems[$alldiscussion{$post}]=~s/]*)>/
'; my $href = '/adm/feedback?allposts=1&symb='.$escsymb; if ($newpostsflag) { $href .= '&previous='.$prevread; } $href .= &group_args($group); if ($showunmark) { $discussion .= &mt('[_1]Show all posts[_2] to display [quant,_3,post] previously marked read', '','',$numhidden); } else { $discussion .= &mt('[_1]Show all posts[_2] to display [quant,_3,post] previously viewed', '','',$numhidden); } $discussion .= '
    
/; $discussionitems[$alldiscussion{$post}]=~s/]*)>]*)>/'; } } } unless ($outputtarget eq 'tex' || $outputtarget eq 'export') { my $colspan=$maxdepth+1; $discussion .= < END $discussion .= &action_links_bar($colspan,$ressymb,$visible, $newpostsflag,$group, $prevread,$markondisp,$seehidden); $discussion .= "
/; my $threadinsert=''; if ($thisdepth > 0) { $threadinsert='
Reply: '.$thisdepth.''; } $discussionitems[$alldiscussion{$post}]=~s/<\/td>]*)>/$threadinsert<\/td>
/; $discussionitems[$alldiscussion{$post}]=~s/(|<\/b>|<\/a>|]+)>)//g; $discussionitems[$alldiscussion{$post}]='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.$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 ' '."\n"; } $currdepth = $depth[$alldiscussion{$post}]; print $manifestfile "\n". ''. ''.$imsitems{$alldiscussion{$post}}{'title'}.''; $imsresources .= "\n". ''."\n". ''."\n". $imsfiles{$alldiscussion{$post}}{$imsitems{$alldiscussion{$post}}{'currversion'}}.''."\n". ''; } my $postingfile; my $postingfilename = $tempexport.'/'.$postfilename; if ($postingfile = Apache::File->new('>'.$postingfilename)) { print $postingfile ''.&mt('Discussion Post').''. $imsitems{$alldiscussion{$post}}{'title'}.' '. $imsitems{$alldiscussion{$post}}{'sender'}. $imsitems{$alldiscussion{$post}}{'timestamp'}.'

'. $imsitems{$alldiscussion{$post}}{'message'}.'
'. $imsitems{$alldiscussion{$post}}{'attach'}.''."\n"; close($postingfile); } else { $discussion .= $lt{'aerr'}.' '.$alldiscussion{$post}.'
'; } $copyresult.=&replicate_attachments($imsitems{$alldiscussion{$post}}{'allattachments'},$tempexport); } else { $discussion.='
'. $discussionitems[$alldiscussion{$post}]. '
END if ($sortposts) { my %sort_types = (); my %role_types = (); my %status_types = (); &sort_filter_names(\%sort_types,\%role_types,\%status_types,$crstype); $discussion .= ''; } if ($dischash{$toggkey}) { my $storebutton = &mt('Save read/unread changes'); $discussion.=''; } $discussion .= (<
$lt{'cuse'}:  END if ($newpostsflag) { $discussion .= '1. '.$lt{'disp'}.' - '.$currdisp.'  2. '.$lt{'nolo'}.' - '.$currmark.''; if ($dischash{$toggkey}) { $discussion .= '  3. '.$lt{'togg'}.' - '.$currtogg.''; } } else { if ($dischash{$toggkey}) { $discussion .= '1. '.$lt{'disp'}.' - '.$currdisp.' 2. '.$lt{'togg'}.' - '.$currtogg.''; } else { $discussion .= $lt{'disp'}.' - '.$currdisp.''; } } $discussion .= <$lt{'chgt'} '.&mt('Sorted by').': '.$sort_types{$sortposts}.'
'; 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 = ''.&mt('sections').'- '.$env{'form.sectionpick'}; $filterchoice .= '    '; } if (@grouppick > 0) { $filterchoice = ''.&mt('groups').'- '.$env{'form.grouppick'}; $filterchoice .= '    '; } if (@rolefilter > 0) { $filterchoice .= ''.&mt('roles').'-'; foreach my $role (@rolefilter) { $filterchoice .= ' '.$role_types{$role}.','; } $filterchoice =~ s/,$//; $filterchoice .= '
'.(' ' x8); } if ($statusfilter) { $filterchoice .= ''.&mt('status').'- '.$status_types{$statusfilter}; } if ($filterchoice) { $discussion .= ''.&mt('Filters').': '.$filterchoice; } } $discussion .= '
'. ''."\n". ''."\n". '
\n"; } if ($outputtarget eq 'export') { if ($manifestok) { while ($currdepth > 0) { print $manifestfile " \n"; $currdepth --; } print $manifestfile qq|
$imsresources
|; close($manifestfile); if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) { $discussion = $copyresult; } else { #Create zip file in prtspool if (($env{'user.name'} =~ /^$match_username$/) && ($env{'user.domain'} =~ /^$match_domain$/)) { my $now = time(); my $imszipfile = '/prtspool/'. join('_',$env{'user.name'},$env{'user.domain'},$now). '_'.rand(1000000000).'.zip'; my $zip = Archive::Zip->new(); $zip->addTree($tempexport); my $imszip = '/home/httpd/'.$imszipfile; if ($zip->writeToFileNamed($imszip) == AZ_OK) { $discussion .= &mt('Download the zip file from [_1]Discussion Posting Archive[_2]', '','').'
'; } else { $discussion .= &mt('Failed to create zip file').'
'; } if ($copyresult) { $discussion .= ''. &mt('The following errors occurred during export:'). '
'.$copyresult; } } else { $discussion .= '

'. &mt('Unfortunately you will not be able to retrieve an archive of the discussion posts at this time, because there was a problem creating the zip file.').'

'; } } } else { $discussion .= '

'. &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.').'

'; } 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)) && ($outputtarget ne 'tex')) { if (($group ne '') && ($mode eq 'board')) { if ((&check_group_priv($group,'pgd') eq 'ok') && ($ressymb =~ m{^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$})) { $discussion .= &postingform_display($mode,$ressymb,$now,$subject, $comment,$outputtarget,$attachnum, $currnewattach,$currdelold, $group,$crstype); } } else { if (&Apache::lonnet::allowed('pch',$env{'request.course.id'}. ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { $discussion.= &postingform_display($mode,$ressymb,$now,$subject, $comment,$outputtarget,$attachnum, $currnewattach,$currdelold,'',$crstype); } else { $discussion.= ''. &mt('This discussion is closed.').''; } } } if (!(&discussion_open($status)) && ($outputtarget ne 'tex')) { $discussion.= ''. &mt('This discussion is closed.').''; } } elsif ($outputtarget ne 'tex') { unless ($nofooter) { $discussion.=''; } } return $discussion; } sub check_menucoll { my ($nofooter,$nodisclink,$nofdbklink); my ($menucoll,$deeplinkmenu,$menuref) = &Apache::loncommon::menucoll_in_effect(); if ($menucoll) { if (ref($menuref) eq 'HASH') { if ($menuref->{'foot'} eq 'n') { $nofooter = 1; } else { unless ($menuref->{'disc'}) { $nodisclink = 1; } unless ($menuref->{'fdbk'}) { $nofdbklink = 1; } } } } return ($nofooter,$nodisclink,$nofdbklink); } sub can_see_hidden { my ($mode,$ressymb,$feedurl,$group,$cdom,$cnum,$crs) = @_; my $seehidden; if ($env{'request.course.id'}) { unless ($cdom ne '' && $cnum ne '') { $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; } if ($crs eq '') { $crs = '/'.$env{'request.course.id'}; if ($env{'request.course.sec'}) { $crs.='_'.$env{'request.course.sec'}; } $crs=~s{_}{/}g; } if ($mode eq '') { $mode='board'; if ($feedurl =~ /$LONCAPA::assess_re/) { $mode='problem'; } } if (($group ne '') && ($mode eq 'board') && ($ressymb =~ m{^bulletin___\d+\Q___adm/wrapper/adm/$cdom/$cnum/\E\d+/bulletinboard$})) { if (&check_group_priv($group,'dgp') eq 'ok') { $seehidden = 1; } } else { $seehidden=&Apache::lonnet::allowed('rin',$crs); } } return $seehidden; } sub discussion_link { my ($ressymb,$linktext,$cmd,$item,$flag,$prev,$adds,$title)=@_; my $link='/adm/feedback?inhibitmenu=yes&modal=yes&'.$cmd.'='.&escape($ressymb).':::'.$item; if ($flag) { $link .= '&previous='.$prev; } if ($adds) { $link .= $adds; } my $width=600; my $height=600; if (($cmd eq 'hide') || ($cmd eq 'unhide') || ($cmd eq 'like') || ($cmd eq 'unlike')) { $width=300; $height=200; } return &Apache::loncommon::modal_link($link,$linktext,$width,$height,undef,undef,$title); } sub send_feedback_link { my ($ressymb) = @_; return ''. &discussion_link($ressymb, ''.&mt('Post Discussion').'', 'replydisc'). ''; } sub send_message_link { my ($ressymb) = @_; my $output = ''. &discussion_link($ressymb, ''.&mt('Send Feedback').'', 'sendmessageonly'). ''; return $output; } sub action_links_bar { my ($colspan,$ressymb,$visible,$newpostsflag,$group,$prevread,$markondisp, $seehidden) = @_; my $discussion = ''. ''. ''; if ($newpostsflag) { if (!$markondisp) { $discussion .=''; } else { $discussion .= ''; } } else { $discussion .= ''; } $discussion .= '
'; my $escsymb=&escape($ressymb); if ($visible) { $discussion .= ''.&mt('Threaded View').'  '. ''.&mt('Chronological View').'  '; my $otherviewurl='/adm/feedback?cmd=sortfilter&symb='.$escsymb.'&inhibitmenu=yes&modal=yes'; if ($newpostsflag) { $otherviewurl .= '&previous='.$prevread; } $otherviewurl .= &group_args($group); $discussion .= &Apache::loncommon::modal_link($otherviewurl,&mt('Other Views ...'),800,340); $discussion .= '
'; } $discussion .=''.&mt('Export').''; if ($seehidden) { $discussion .= '  '; $discussion .=''.&mt('Undelete all deleted entries').''; } $discussion.='
'. &mt('My general preferences on what is marked as NEW'). '
'.&mt('Mark NEW posts no longer new').'
  
'; return $discussion; } sub postingform_display { my ($mode,$ressymb,$now,$subject,$comment,$outputtarget,$attachnum, $currnewattach,$currdelold,$group,$crstype) = @_; 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', ); if ($crstype eq 'Community') { $lt{'note'} = &mt('Note: in anonymous discussion, your name is visible only to community facilitators'); } my ($postingform,$textareaclass); if (&Apache::lonhtmlcommon::htmlareabrowser()) { $postingform = &Apache::lonhtmlcommon::htmlareaselectactive(); $textareaclass = 'class="LC_richDefaultOff"'; if ($env{'request.course.id'}) { unless (($env{'course.'.$env{'request.course.id'}.'.allow_limited_html_in_feedback'} =~ /^\s*yes\s*$/i) || ($env{'form.sendmessageonly'})) { undef($textareaclass); } } } $postingform .= (< $lt{'note'}
$lt{'title'}: 
ENDDISCUSS if ($env{'form.origpage'}) { $postingform .= ''."\n"; foreach my $att (@{$currnewattach}) { $postingform .= ''."\n"; } } if (exists($env{'form.ref'})) { $postingform .= ''; } if ($group ne '') { $postingform .=''; } my $blockblog = &Apache::loncommon::blocking_status('blogs'); if (!$blockblog) { $postingform .= &add_blog_checkbox($crstype); } $postingform .= "\n"; $postingform .= &generate_attachments_button('',$attachnum,$ressymb, $now,$currnewattach, $currdelold,'',$mode, $blockblog); if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) { $newattachmsg = '
'.$lt{'newa'}.'
'; if (@{$currnewattach} > 1) { $newattachmsg .= '
    '; foreach my $item (@{$currnewattach}) { $item =~ m#.*/([^/]+)$#; $newattachmsg .= '
  1. '.$1.'
  2. '."\n"; } $newattachmsg .= '
'."\n"; } else { $$currnewattach[0] =~ m#.*/([^/]+)$#; $newattachmsg .= ''.$1.'
'."\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,$seehidden,$canvote,$prevread,$sortposts,$ressymb,$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); # These are the discussion contributions 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 (%likes,%userlikes,%userunlikes,@theselikes,$oneplus,$twoplus,$oneminus,$twominus); my $thisuser=$env{'user.name'}.':'.$env{'user.domain'}; if ($seeid || $canvote) { # And these are the likes/unlikes %likes=&Apache::lonnet::dump('disclikes', $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}, '^'.$symb.':'); # Array with likes to figure out averages, etc. @theselikes=(); # Hashes containing likes and unlikes for this user. %userlikes=(); %userunlikes=(); } # Is the user allowed to see the real name behind anonymous postings? my $see_anonymous = &Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')); if ((@{$grouppick} == 0) || (grep(/^all$/,@{$grouppick}))) { $skip_group_check = 1; } # Deletions and hiddens are just lists. Split them up into a hash for quicker lookup my (%deletions,%hiddens); if ($contrib{'deleted'}) { my $deleted = $contrib{'deleted'}; $deleted =~ s/^\.//; $deleted =~ s/\.$//; %deletions = map { $_ => 1 } (split(/\.\./,$deleted)); } if ($contrib{'hidden'}) { my $hidden = $contrib{'hidden'}; $hidden =~ s/^\.//; $hidden =~ s/\.$//; %hiddens = map { $_ => 1 } (split(/\.\./,$hidden)); } # Versions if store/restore are used to actually store the messages. 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; } my %votestyle; if ($seeid || $canvote) { # We need to go through this twice, first to get the likes/dislikes, then to actually build the display for (my $id=1;$id<=$contrib{'version'};$id++) { my $idx=$id; next if ($contrib{$idx.':deleted'}); next if ($contrib{$idx.':hidden'}); unless ((($hiddens{$idx}) && (!$seehidden)) || ($deletions{$idx}) || (!$contrib{$idx.':message'})) { push(@theselikes,$likes{$symb.':'.$idx.':likes'}); if ($likes{$symb.':'.$idx.':likes'} ne '') { if (ref($likes{$symb.':'.$idx.':likers'}) eq 'HASH') { if (exists($likes{$symb.':'.$idx.':likers'}{$thisuser})) { $userlikes{$idx} = 1; } } if (ref($likes{$symb.':'.$idx.':unlikers'}) eq 'HASH') { if (exists($likes{$symb.':'.$idx.':unlikers'}{$thisuser})) { $userunlikes{$idx} = 1; } } } } } # Figure out average likes and standard deviation if there are enough # discussions to warrant that my $ave=0; my $stddev=10000; if ($#theselikes>1) { my $sum=0; my $num=$#theselikes+1; foreach my $thislike (@theselikes) { $sum+=$thislike; } $ave=$sum/$num; my $sumsq=0; foreach my $thislike (@theselikes) { $sumsq+=($thislike-$ave)*($thislike-$ave); } $stddev=sqrt($sumsq/$num); } # Now we know the average likes $ave and the standard deviation $stddev # Get the boundaries for markup $oneplus=$ave+$stddev; $twoplus=$ave+2.*$stddev; $oneminus=$ave-$stddev; $twominus=$ave-2.*$stddev; if ($#theselikes>1) { foreach my $class ('twoplus','oneplus','zero','oneminus','twominus') { my $fontstyle = $env{'course.'.$env{'request.course.id'}.'.discussion_post_fonts_'.$class}; if ($fontstyle ne '') { my ($size,$weight,$style,$other) = split(/,/,$fontstyle); if ($size ne '') { $votestyle{$class} .= 'font-size: '.$size.';'; } if ($weight ne '') { $votestyle{$class} .= 'font-weight: '.$weight.';'; } if ($style ne '') { $votestyle{$class} .= 'font-style: '.$style.';'; } if ($other ne '') { $votestyle{$class} .= $other; } if ($votestyle{$class} ne '') { $votestyle{$class} = 'style="'.$votestyle{$class}.'"'; } } } } } # # This is now the real loop. Go through all entries, pick up what we need # for (my $id=1;$id<=$contrib{'version'};$id++) { my $idx=$id; next if ($contrib{$idx.':deleted'}); next if ($contrib{$idx.':hidden'}); # If we get here, we are actually going to display the message - we don't know where and we don't know if we display # previous edits, but it counts as one entry my $posttime = $contrib{$idx.':timestamp'}; if ($prevread <= $posttime) { $$newpostsflag = 1; } my $studenthidden=($contrib{'studenthidden'}=~/\.$idx\./); my $origindex='0.'; my $numoldver=0; if ($contrib{$idx.':replyto'}) { if ( ((!$env{'environment.unthreadeddiscussion'}) && ($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 ((($hiddens{$idx}) && (!$seehidden)) || ($deletions{$idx})) { $$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,$showaboutme); 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,$seehidden,$outputtarget,\%messages,\%subjects,\%allattachments,\%attachtxt,$imsfiles,\$screenname,\$plainname,\$showaboutme,$numoldver); # Set up for sorting by subject unless ($outputtarget eq 'export') { $message=$messages{$numoldver}; $message.=$attachtxt{$numoldver}; $subject=$subjects{$numoldver}; if ($message) { if ($hiddens{$idx}) { $message=''.$message.''; if ($studenthidden) { $message .='

Deleted by poster (student).'; } } if ($subject eq '') { if (defined($$subjectsort{'__No subject'})) { push(@{$$subjectsort{'__No subject'}}, $idx); } else { @{$$subjectsort{'__No subject'}} = ("$idx"); } } else { if (defined($$subjectsort{$subject})) { push(@{$$subjectsort{$subject}}, $idx); } else { @{$$subjectsort{$subject}} = ("$idx"); } } if (!$contrib{$idx.':anonymous'} || $see_anonymous) { if ($showaboutme) { $sender = &Apache::loncommon::aboutmewrapper( $plainname, $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}); } else { $sender = $plainname; } if ($see_anonymous) { $sender .= ' ('.$contrib{$idx.':sendername'}.':'. $contrib{$idx.':senderdomain'}.')'; } $sender = ''.$sender.''; if ($contrib{$idx.':anonymous'}) { $sender.=' ['.$$anonhash{$key}.'] '. $screenname; } if ($see_anonymous) { $sender.=&Apache::loncommon::student_image_tag($contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'}); } # 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::loncommon::getnames($contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}); 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 ($outputtarget ne 'tex') { # Add karma stars my $karma=&userkarma($contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'}); for (my $i=1;$i<=$karma;$i++) { $sender.=''.&mt('Contributor Kudos').''; } # Can people edit this? if (&editing_allowed($escsymb.':::'.$idx,$group)) { if (($env{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($env{'user.name'} eq $contrib{$idx.':sendername'})) { $sender.=' '. &discussion_link($ressymb,&mt('Edit'),'editdisc',$idx,$$newpostsflag,$prevread,&group_args($group)); unless ($seehidden) { my $grpargs = &group_args($group); $sender.=" '; } } } if ($seehidden) { if ($hiddens{$idx}) { unless ($studenthidden) { $sender.=' '. &discussion_link($ressymb,&mt('Make Visible'),'unhide',$idx,$$newpostsflag,$prevread,&group_args($group)); } } else { $sender.=' '. &discussion_link($ressymb,&mt('Hide'),'hide',$idx,$$newpostsflag,$prevread,&group_args($group)); } my $grpargs = &group_args($group); $sender.= " "; $sender .= &mt('Delete').''; } } } else { if ($screenname) { $sender=''.$screenname.''; } else { $sender=''.$$anonhash{$key}.''; } $sender = ''.$sender.''; # 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 ($outputtarget ne 'tex') { if (&discussion_open($status)) { if (($group ne '') && (&check_group_priv($group,'pgd') eq 'ok')) { $sender.=' '. &discussion_link($ressymb,&mt('Reply'),'replydisc',$idx,$$newpostsflag,$prevread,&group_args($group)); } elsif (&Apache::lonnet::allowed('pch', $env{'request.course.id'}. ($env{'request.course.sec'}?'/'. $env{'request.course.sec'}:''))) { $sender.=' '. &discussion_link($ressymb,&mt('Reply'),'replydisc',$idx,$$newpostsflag,$prevread); } } if ($viewgrades) { $vgrlink=&Apache::loncommon::submlink(&mt('Submissions'), $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$ressymb); } if ($$dischash{$readkey}=~/\.$idx\./) { $ctlink = ''; } else { $ctlink = ''; } } } #figure out at what position this needs to print } if ($outputtarget eq 'export' || $message) { my $thisindex=$idx; if ( ((!$env{'environment.unthreadeddiscussion'}) && ($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 ($hiddens{$idx}) { $$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'}.':'. $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; my ($uname,$udom); if ($showonlyunread && $prevread > $posttime) { $$notshown{$idx} = 1; } elsif ($showunmark && $$dischash{$readkey}=~/\.$idx\./) { $$notshown{$idx} = 1; } else { # apply filters $uname = $contrib{$idx.':sendername'}; $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] .= ''.&mt('NEW').'  '; } else { $$newitem{$idx} = 0; } $$discussionitems[$idx] .= ''.$subject.'  '. $sender.' '.$vgrlink.' ('. &Apache::lonlocal::locallocaltime($posttime).')'; if ($$dischash{$toggkey}) { $$discussionitems[$idx].='  '.$ctlink; } my $thislikes=$likes{$symb.':'.$idx.':likes'}; my $likestyle; if ($seeid || $canvote) { # Figure out size based on likes my $class = 'zero'; my $thislikes=$likes{$symb.':'.$idx.':likes'}; if ($thislikes>$twoplus) { $class = 'twoplus'; } elsif ($thislikes>$oneplus) { $class = 'oneplus'; } if ($thislikes<$twominus) { $class = 'twominus'; } elsif ($thislikes<$oneminus) { $class = 'oneminus'; } $likestyle = $votestyle{$class}; } # Actually glue in the message itself $$discussionitems[$idx].= '
'. "
". $message. '
'; if ($canvote) { my $ownpost; if (($uname eq $env{'user.name'}) && ($udom eq $env{'user.domain'})) { $ownpost = 1; } # Put in the like and unlike buttons if ($ownpost || (($hiddens{$idx}) && ($seehidden))) { my $novote; if ($ownpost) { $novote = &mt('No voting for your own posts.'); } else { $novote = &mt('No voting for hidden posts.'); } &html_escape(\$novote); $$discussionitems[$idx].= ''. ''.$novote.' '. ''.$novote.''; } else { if ($userlikes{$idx}) { $$discussionitems[$idx].=''.&mt('You like this posting').''; } else { $$discussionitems[$idx].=' '.&discussion_link($ressymb,''.&mt('Like').'','like',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Like this posting")); } if ($userunlikes{$idx}) { $$discussionitems[$idx].=''.&mt('You unlike this posting').''; } else { $$discussionitems[$idx].=' '.&discussion_link($ressymb,''.&mt('Unlike').'','unlike',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Unlike this posting")); } } } if ($seeid || $canvote) { my $thislikes=$likes{$symb.':'.$idx.':likes'}; if ($thislikes>0) { $$discussionitems[$idx].=' ('.&mt("[_1] likes",$thislikes).')'; } elsif ($thislikes<0) { $$discussionitems[$idx].=' ('.&mt("[_1] unlikes",abs($thislikes)).')'; } } # If there is any history to this post, inform the reader if ($contrib{$idx.':history'}) { my @postversions = (); $$discussionitems[$idx] .= '  '.&mt('This post has been edited by the author.'); if ($seehidden) { $$discussionitems[$idx] .= '  '. &discussion_link($ressymb,&mt('Display all versions'),'allversions',$idx,$$newpostsflag,$prevread,&group_args($group)); } $$discussionitems[$idx].='
'.&mt('Earlier version(s) were posted on: '); if ($contrib{$idx.':history'} =~ m/:/) { @postversions = split(/:/,$contrib{$idx.':history'}); } else { @postversions = ("$contrib{$idx.':history'}"); } for (my $i=0; $i<@postversions; $i++) { my $version = $i+1; $$discussionitems[$idx] .= ''.$version.'. - '.&Apache::lonlocal::locallocaltime($postversions[$i]).' '; } } # end of unless ($$notshown ...) } # end of if ($message) ... } # end of the else-branch of target being export } # end of unless hidden or deleted } # end of the loop over all discussion entries } # end of "if there actually are any discussions } # end of subroutine "build_posting_display" } 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,$seehidden,$type,$messages,$subjects,$allattachments,$attachtxt,$imsfiles,$screenname,$plainname,$showaboutme,$numver) = @_; my $discussion = ''; my $start=$numver; my $end=$numver + 1; %{$$imsfiles{$idx}}=(); if ($type eq 'allversions') { unless($seehidden) { $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'}; $$showaboutme = &Apache::loncommon::aboutme_on($$contrib{$idx.':sendername'}, $$contrib{$idx.':senderdomain'}); my $sender = $$plainname; if ($$showaboutme) { $sender = &Apache::loncommon::aboutmewrapper( $$plainname, $$contrib{$idx.':sendername'}, $$contrib{$idx.':senderdomain'}); } if ($seeid) { $sender .= ' ('.$$contrib{$idx.':sendername'}.':'. $$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=(''.$sender.'
'; return $discussion; } else { return; } } sub replicate_attachments { my ($attachrefs,$tempexport) = @_; my $response; foreach my $id (keys(%{$attachrefs})) { if ($$attachrefs{$id}{'filename'} =~ m-^/uploaded/([^/]+)/([^/]+)(/feedback)?(/?\d*)/([^/]+)$-) { my $path = $tempexport; my $tail = $1.'/'.$2.$4; my @extras = split(/\//,$tail); my $destination = $tempexport.'/'.$1.'/'.$2.$4.'/'.$5; if (!-e $destination) { my $i= 0; while ($i<@extras) { $path .= '/'.$extras[$i]; if (!-e $path) { mkdir($path,0700); } $i ++; } my ($content,$rtncode); my $uploadreply = &Apache::lonnet::getuploaded('GET',$$attachrefs{$id}{'filename'},$1,$2,$content,$rtncode); if ($uploadreply eq 'ok') { my $attachcopy; if ($attachcopy = Apache::File->new('>'.$destination)) { print $attachcopy $content; close($attachcopy); } else { $response .= &mt('Error copying file attachment - [_1] to IMS package',$5).': '.$!.'
'."\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.'
'."\n"; } } } } return $response; } sub mail_screen { my ($r,$feedurl,$options,$caller_symb,$attachmaxtext) = @_; 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( 'myqu' => 'Question/comment/feedback:', 'reta' => 'Retained attachments', 'atta' => 'Attachment', ); if ($env{'form.editdisc'} || $env{'form.replydisc'}){ $lt{'myqu'} = &mt('Post Discussion'); } my $restitle = &get_resource_title($caller_symb,$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 = (< 0) { my (%msgversions,%subversions,$htmldecode); $htmldecode = 0; if ($env{'form.replydisc'}) { $htmldecode = 1; } &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); &get_post_versions(\%subversions,$contrib{$idx.':subject'},$htmldecode, $numoldver); $subject = $subversions{$numoldver}; if ($env{'form.replydisc'}) { $quote = $msgversions{$numoldver}; $subject = &HTML::Entities::encode(&mt('Re: ').$subject,'<>&"'); } else { $comment = $msgversions{$numoldver}; } } if ($env{'form.editdisc'}) { $attachmenturls = $contrib{$idx.':attachmenturl'}; if (defined($contrib{$idx.':replyto'})) { $parentmsg = $contrib{$idx.':replyto'}; } unless (exists($env{'form.origpage'})) { my $anonflag = 'nonanon'; if ($contrib{$idx.':anonymous'}) { $anonflag = 'anon'; } $anonscript = (<'; } } if ($env{'form.origpage'}) { $subject = &unescape($env{'form.subject'}); $comment = &unescape($env{'form.comment'}); &process_attachments(\@currnewattach,\@currdelold,\@keepold); } my $latexHelp=&Apache::loncommon::helpLatexCheatsheet(undef,undef,1,($env{'form.modal'}?'popup':0)); my $send=&mt('Send'); my $alert = &mt('Please select a feedback type.'); &js_escape(\$alert); my $js= < // END my ($textareaheader,$textareaclass); if (&Apache::lonhtmlcommon::htmlareabrowser()) { $textareaheader = &Apache::lonhtmlcommon::htmlareaselectactive(); $textareaclass = 'class="LC_richDefaultOff"'; if ($env{'request.course.id'}) { unless (($env{'course.'.$env{'request.course.id'}.'.allow_limited_html_in_feedback'} =~ /^\s*yes\s*$/i) || ($env{'form.sendmessageonly'})) { undef($textareaclass); } } } # Breadcrumbs my $brcrum = [{'href' => '', 'text' => 'Resource Feedback and Discussion'}]; my %onload = ('onload' => 'window.focus();setposttype();'); my %parms=('add_entries' => \%onload); if ($env{'form.modal'} ne 'yes') { $parms{'bread_crumbs'} = $brcrum; } my $start_page= &Apache::loncommon::start_page('Resource Feedback and Discussion',$js,\%parms); if ($quote ne '') { $quote = &HTML::Entities::decode($quote); unless (&contains_block_html($quote)) { &newline_to_br(\$quote); } $quote=&Apache::lonhtmlcommon::start_pick_box(). &Apache::lonhtmlcommon::row_title(&mt('Quote')). &Apache::lontexconvert::msgtexconverted($quote). &Apache::lonhtmlcommon::row_closure(1). &Apache::lonhtmlcommon::end_pick_box(); } my $header=''; unless ($env{'form.modal'}) { $header="

$restitle

"; } $r->print(<$lt{'myqu'} $header
$prevtag END if ($env{'form.replydisc'}) { $r->print(< END } elsif ($env{'form.editdisc'}) { $r->print(< END } $r->print(< END $r->print(&Apache::lonhtmlcommon::start_pick_box()); $r->print(< $textareaheader

$latexHelp

END $r->print(&Apache::lonhtmlcommon::row_title(&mt('Subject'))); $r->print('

'); $r->print(&Apache::lonhtmlcommon::row_closure()); $r->print(&Apache::lonhtmlcommon::row_title(&mt('Message'))); $r->print(''); $r->print(&Apache::lonhtmlcommon::row_closure(1)); $r->print(&Apache::lonhtmlcommon::end_pick_box()); if ( ($env{'form.editdisc'}) || ($env{'form.replydisc'}) ) { if ($env{'form.origpage'}) { foreach my $attach (@currnewattach) { $r->print(''."\n"); } foreach my $oldatt (@currdelold) { $r->print(''."\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(''."\n"); } } } } else { $r->print(< $lt{'atta'} $attachmaxtext:

END } if (exists($env{'form.group'})) { $r->print(''); } if (exists($env{'form.ref'})) { $r->print(''); } $r->print(< END if ($env{'form.editdisc'} || $env{'form.replydisc'}) { my $now = time; my $ressymb = $symb; &Apache::lonenc::check_encrypt(\$ressymb); my $postidx = ''; if ($env{'form.editdisc'}) { $postidx = $idx; } if (@currnewattach > 0) { $attachnum += @currnewattach; } my $blockblog = &Apache::loncommon::blocking_status('blogs'); if ($attachnum > 0) { if (@currnewattach > 0) { $newattachmsg .= '
'.&mt('New attachments').'
'; if (@currnewattach > 1) { $newattachmsg .= '
    '; foreach my $item (@currnewattach) { $item =~ m#.*/([^/]+)$#; $newattachmsg .= '
  1. '.$1.'
  2. '."\n"; } $newattachmsg .= '
'."\n"; } else { $currnewattach[0] =~ m#.*/([^/]+)$#; $newattachmsg .= ''.$1.'
'."\n"; } } if ($attachmsg) { $r->print("
$lt{'reta'}:$attachmsg
\n"); } if ($newattachmsg) { $r->print("$newattachmsg"); } } $r->print(&generate_attachments_button($postidx,$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,$numoldver,'',$blockblog)); } $r->print(&generate_preview_button(). &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 discussion 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 %js_lt = &Apache::lonlocal::texthash( '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.' ); &js_escape(\%js_lt); 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 = < 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("$js_lt{'yhni'}. \\n$js_lt{'ywbr'}")) { if (prev > 0) { location.href = "$feedurl?previous=$previous" } else { location.href = "$feedurl" } } } } END my $start_page = &Apache::loncommon::start_page('Discussion display options',$js); my $end_page = &Apache::loncommon::end_page(); $r->print(< $lt{'sdpf'}
$lt{'prca'}
  1. $lt{'whpo'}
  2. $lt{'unwh'}
  3. $lt{'wipa'}

END $r->print(&Apache::loncommon::start_data_table()); $r->print(< $lt{'pref'} $lt{'curr'} $lt{'actn'}? END $r->print(&Apache::loncommon::start_data_table_row()); $r->print(<$lt{'disa'} $lt{$discdisp}
END $r->print(&Apache::loncommon::end_data_table_row()); $r->print(&Apache::loncommon::start_data_table_row()); $r->print(<$lt{'npmr'} $lt{$discmark} END $r->print(&Apache::loncommon::end_data_table_row()); $r->print(&Apache::loncommon::start_data_table_row()); $r->print(<$lt{'dotm'} $lt{$disctogg} END my $save = &mt('Save'); $r->print(&Apache::loncommon::end_data_table_row()); $r->print(&Apache::loncommon::end_data_table()); $r->print(<
END if (exists($env{'form.group'})) { $r->print(''); } if (exists($env{'form.ref'})) { $r->print(''); } $r->print("

$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(); my @courseroles = qw(st ad ep ta in); my $crstype = &Apache::loncommon::course_type(); my $ccrole = 'cc'; if ($crstype eq 'Community') { $ccrole = 'co'; } push(@courseroles,$ccrole); 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 .= " \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 .= " \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' => 'Save changes', ); my %sort_types = (); my %role_types = (); my %status_types = (); &sort_filter_names(\%sort_types,\%role_types,\%status_types,$crstype); my $js = < function verifyFilter() { var rolenum = 0 for (var i=0; i END my $start_page= &Apache::loncommon::start_page('Discussion options',$js); my $end_page= &Apache::loncommon::end_page(); $r->print(< $lt{'diso'}
$lt{'prca'}
$lt{'soor'}   $lt{'sprs'}   $lt{'spur'}   $lt{'spse'}   $lt{'spgr'}   $lt{'psub'}
         

END if (exists($env{'form.group'})) { $r->print(''); } if (exists($env{'form.ref'})) { $r->print(''); } $r->print("

$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 $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); my $seehidden = &can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum); 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) && (!$seehidden)) || ($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(<
$table_start # $lt{'sele'} $lt{'full'} ($lt{'usdo'}) $lt{'post'} 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(). ''.$count.' '.$postcounts{$user}.''. &Apache::loncommon::end_data_table_row()); } } } } $r->print(&Apache::loncommon::end_data_table()); my $end_page = &Apache::loncommon::end_page(); $r->print(< $end_page END } sub get_post_versions { my ($versions,$incoming,$htmldecode,$numver) = @_; if ($incoming =~ /^/) { my $p = HTML::LCParser->new(\$incoming); my $done = 0; while ( (my $token = $p->get_tag("version")) && (!$done)) { my $num = $token->[1]{num}; my $text = $p->get_text("/version"); if (defined($numver)) { if ($num == $numver) { if ($htmldecode) { $text = &HTML::Entities::decode($text); } $$versions{$numver}=$text; $done = 1; } } else { if ($htmldecode) { $text = &HTML::Entities::decode($text); } $$versions{$num}=$text; } } } else { if (!defined($numver)) { $numver = 0; } if ($htmldecode) { $$versions{$numver} = $incoming; } else { $$versions{$numver} = &HTML::Entities::encode($incoming,'<>&"'); } } return; } sub get_post_attachments { my ($attachments,$attachmenturls) = @_; my $num; if ($attachmenturls =~ m/^/) { my $p = HTML::LCParser->new(\$attachmenturls); while (my $token = $p->get_tag("attachment","filename","post")) { if ($token->[0] eq "attachment") { $num = $token->[1]{id}; %{$$attachments{$num}} =(); } elsif ($token->[0] eq "filename") { $$attachments{$num}{'filename'} = $p->get_text("/filename"); } elsif ($token->[0] eq "post") { my $id = $token->[1]{id}; $$attachments{$num}{$id} = $p->get_text("/post"); } } } else { %{$$attachments{'0'}} = (); $$attachments{'0'}{'filename'} = $attachmenturls; $$attachments{'0'}{'0'} = 'n'; } return; } sub fail_redirect { my ($r,$feedurl,$delay) = @_; if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; my %lt = &Apache::lonlocal::texthash( 'sorr' => 'Sorry, no recipients ...', ); my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); my %parms=('only_body' => 1); if ($delay !~ /^\d+(|\.\d+)$/) { $delay = 2; } if ($env{'form.modal'}) { my $onload = 'document.forms.reldt.submit()'; if ($delay) { my $js_delay = int(1000 * $delay); $onload = "setTimeout(function(){ document.forms.reldt.submit(); },$js_delay);"; } $parms{'add_entries'}={'onload' => $onload}; } else { $parms{'redirect'}=[$delay,$feedurl]; } $r->print(&Apache::loncommon::start_page('Feedback not sent',undef,\%parms)); my $windowname = 'loncapaclient'; $r->print(<

$lt{'sorr'}

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,$toolarge,$delay) = @_; 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 = ''; } if (defined($sort)) { my $sortqry = 'sortposts='.$sort; if (($feedurl =~ /\?register=1/) || ($feedurl =~ /\?previous=/)) { $feedurl .= '&'.$sortqry; } else { $feedurl .= '?'.$sortqry; } $sorttag = ''; if (defined($numpicks)) { my $userpickqry = 'totposters='.$numpicks; $feedurl .= '&'.$userpickqry; $userpicktag = ''; } else { if (ref($sectionpick) eq 'ARRAY') { $feedurl .= '&sectionpick='; $sectag .= ''; } else { $feedurl .= '&sectionpick='.$sectionpick; $sectag = ''; } if (ref($grouppick) eq 'ARRAY') { $feedurl .= '&grouppick='; $sectag .= ''; } else { $feedurl .= '&grouppick='.$grouppick; $grptag = ''; } if (ref($rolefilter) eq 'ARRAY') { $feedurl .= '&rolefilter='; $roletag .= ''; } else { $feedurl .= '&rolefilter='.$rolefilter; $roletag = ''; } $feedurl .= '&statusfilter='.$statusfilter; $statustag =''; } } my $grouptag; if ($group ne '') { $grouptag = ''; my $refarg; if (exists($env{'form.ref'})) { $refarg = '&ref='.$env{'form.ref'}; $grouptag .= ''; } if ($feedurl =~ /\?/) { $feedurl .= '&group='.$group.$refarg; } else { $feedurl .= '?group='.$group.$refarg; } } &Apache::lonenc::check_encrypt(\$feedurl); my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); my %parms=('only_body' => 1); if ($delay !~ /^\d+(|\.\d+)$/) { $delay = 0; } if ($env{'form.modal'}) { my $onload = 'document.forms.reldt.submit()'; if ($delay) { my $js_delay = int(1000 * $delay); $onload = "setTimeout(function(){ document.forms.reldt.submit(); },$js_delay);"; } $parms{'add_entries'}={'onload' => $onload}; } else { $parms{'redirect'}=[$delay,$feedurl]; } my $start_page= &Apache::loncommon::start_page('Feedback sent',undef,\%parms); my $end_page = &Apache::loncommon::end_page(); $r->print(< $typestyle Sent $sendsomething message(s), and $sendposts post(s). $blog $toolarge $status
$prevtag $sorttag $statustag $roletag $sectag $grptag $userpicktag $grouptag
$end_page ENDREDIR } sub no_redirect_back { my ($r,$feedurl,$delay) = @_; my $nofeed=&mt('Sorry, no feedback possible on this resource ...'); my $form_for_modal; my %parms=('only_body' => 1, 'bgcolor' => '#FFFFFF',); if ($delay !~ /^\d+(|\.\d+)$/) { $delay = 0; } if ($env{'form.modal'}) { if (($feedurl !~ m{^/adm/feedback}) && ($feedurl ne '')) { my $onload = 'document.forms.reldt.submit()'; if ($delay) { my $js_delay = int(1000 * $delay); $onload = "setTimeout(function(){ document.forms.reldt.submit(); },$js_delay);"; } $parms{'add_entries'}={'onload' => $onload}; my $windowname = 'loncapaclient'; $form_for_modal = < ENDFORM } } else { if (($feedurl !~ m{^/adm/feedback}) && ($feedurl ne '')) { $parms{'redirect'}=[$delay,$feedurl]; } } my $start_page= &Apache::loncommon::start_page('Feedback not sent',undef, \%parms); my $end_page = &Apache::loncommon::end_page(); my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); $r->print (< $nofeed
$form_for_modal $end_page ENDNOREDIRTWO } sub screen_header { my ($feedurl,$symb,$group) = @_; my %default = &Apache::lonlocal::texthash ( question => 'Question about resource content', comment => 'Question/Comment/Feedback about course content', policy => 'Question/Comment/Feedback about course policy', ); my $contribdisc = &mt('Contribution to course discussion of resource'); my $anoncontrib = &mt('Anonymous contribution to course discussion of resource'); my $namevis = &mt('name only visible to course faculty'); my $crstype; if ($env{'request.course.id'}) { $crstype = &Apache::loncommon::course_type(); if ($crstype eq 'Community') { $default{'comment'} = &mt('Question/Comment/Feedback about community content'); $default{'policy'} = &mt('Question/Comment/Feedback about community policy'); $contribdisc = &mt('Contribution to community discussion of resource'); $anoncontrib = &mt('Anonymous contribution to community discussion of resource'); $namevis = &mt('name only visible to community facilitators'); } } my $msgoptions=''; my $discussoptions=''; my $checkradio = ''; my $blockblog; my (%fdbkoptions,%discoptions); unless (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/) && ($env{'user.adv'})) { $fdbkoptions{'author'} = 1; } if (&feedback_available(1)) { $fdbkoptions{'question'} = 1; } if (&feedback_available(0,1)) { $fdbkoptions{'course'} = 1; } if (&feedback_available(0,0,1)) { $fdbkoptions{'policy'} = 1; } } if (($env{'request.course.id'}) && (!$env{'form.sendmessageonly'})) { my ($blocked,$blocktext) = &Apache::loncommon::blocking_status('boards'); my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my $realsymb = &get_realsymb($symb); if (!$blocked && &discussion_open(undef,$realsymb) && (&Apache::lonnet::allowed('pch', $env{'request.course.id'}. ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')) || (($group ne '') && ($symb =~ m{^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$}) && (&check_group_priv($group,'pgd') eq 'ok')))) { $discoptions{'nonanon'} = 1; $discoptions{'anon'} = 1; $blockblog = &Apache::loncommon::blocking_status('blogs'); } } my $total = scalar(keys(%fdbkoptions)) + scalar(keys(%discoptions)); return if (!$total); if ($total == 1) { $checkradio = ' checked="checked"'; } if (keys(%fdbkoptions)) { if ($fdbkoptions{'author'}) { $msgoptions = '
'; } foreach my $item ('question','comment','policy') { my $type = $item; if ($item eq 'comment') { $type = 'course'; } my $optionhash=$env{'course.'.$env{'request.course.id'}.'.'.$item.'.email.text'}; if ($fdbkoptions{$type}) { $msgoptions .= '
'; } } } if (keys(%discoptions)) { if ($discoptions{'nonanon'}) { $discussoptions=''; } if ($discoptions{'anon'}) { $discussoptions .= '
'. ''.&mt('Change Screenname').''; } if (!$blockblog) { $discussoptions.= &add_blog_checkbox($crstype); } } if ($msgoptions) { $msgoptions='' .'
'.&mt('Send Feedback').'
'.&Apache::lonhtmlcommon::coursepreflink(&mt('Feedback Settings'),'feedback').''. ''.$msgoptions.''; } if ($discussoptions) { $discussoptions='' .'
'.&mt('Discussion Contributions').'
'.&Apache::lonhtmlcommon::coursepreflink(&mt('Discussion Settings'),'discussion').''. ''.$discussoptions.''; } return &Apache::loncommon::start_data_table().$msgoptions.$discussoptions.&Apache::loncommon::end_data_table(); } sub resource_output { my ($feedurl) = @_; my $usersaw=&Apache::lonnet::ssi_body($feedurl); $usersaw=~s/\]*\>//gi; $usersaw=~s/\<\/body\>//gi; $usersaw=~s/\//gi; $usersaw=~s/\<\/html\>//gi; $usersaw=~s/\//gi; $usersaw=~s/\<\/head\>//gi; $usersaw=~s/action\s*\=/would_be_action\=/gi; return $usersaw; } sub clear_out_html { my ($message,$override)=@_; # Always allow the -tag my %html=(M=>1); # Check if more is allowed my $cid=$env{'request.course.id'}; if (($env{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) || ($override)) { # allows


      • #

        # %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1, BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, PRE=>1, DIV=>1, IMG=>1, M=>1, CHEM=>1, ALGEBRA=>1, SUB=>1, SUP=>1, SPAN=>1, H1=>1, H2=>1, H3=>1, H4=>1, H5=>1, H6=>1, TABLE=>1, TR=>1, TD=>1, TH=>1, TBODY=>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/(\]*)\>/ {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge; return $message; } sub assemble_email { my ($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)', ); if (&Apache::loncommon::course_type() eq 'Community') { $lt{'prev'} = &mt('Previous attempts of member (if applicable)'); } my $email=<<"ENDEMAIL"; $message ENDEMAIL my $citations=<<"ENDCITE";

        $lt{'prev'}

        $prevattempts

        $lt{'orig'}

        $usersaw

        $lt{'corr'}

        $useranswer ENDCITE return ($email,$citations); } sub feedback_available { my ($question,$course,$policy)=@_; my ($typestyle,%to)=&Apache::lonmsg::decide_receiver('',0,$question, $course,$policy); return scalar(%to); } sub send_msg { my ($title,$feedurl,$email,$citations,$attachmenturl,$symb,$clientip,%to)=@_; my $status=''; my $sendsomething=0; my $delay; my $senthide; my %setters; my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = &Apache::loncommon::blockcheck(\%setters,'com',$clientip); if ($by_ip) { $senthide = 1; } my $restitle = &get_resource_title($symb,$feedurl); if ($title=~/^Error/) { $title=&mt('Feedback').': '.$title; } unless ($title=~/\w/) { $title=&mt('Feedback'); } foreach my $key (keys(%to)) { if ($key) { my ($user,$domain) = split(/\:/,$key,2); if (!defined($user)) { $status.='
        '.&mt('Error sending message to [_1], no user specified.',$key); } elsif (!defined($domain)) { $status.='
        '.&mt('Error sending message to [_1], no domain specified.',$key); } else { unless (&Apache::lonmsg::user_normal_msg($user,$domain, $title.' ['.$restitle.']',$email,$citations,$feedurl, $attachmenturl,undef,undef,$symb,$restitle,undef, undef,undef,undef,$senthide)=~/ok/) { $status.='
        '.&mt('Error sending message to').' '.$key.'
        '; } else { $sendsomething++; } } } } if ($sendsomething && $senthide) { if ($by_ip) { my $showdom = &Apache::lonnet::domain($blockdom); if ($showdom eq '') { $showdom = $blockdom; } $delay = 4; $status.='
        '.&mt("Message content of feedback you send to instructor(s) from your current IP address: [_1] will be unavailable in your 'Sent' folder.",$clientip). '
        • '. &mt('This does not affect delivery of feedback to your instructor(s).'). '
        • '. &mt('Note: some types of communication functionality are blocked for certain IP address(es).'). '
        • '. &mt('This restriction was set by an administrator in the [_1] LON-CAPA domain.', $showdom). '

        '; } } # Records of number of feedback messages are kept under the "symb" called "_feedback" # There are two entries within the framework of a course: # - the URLs for which feedback was provided # - the total number of contributions if ($sendsomething) { my %record=&getfeedbackrecords(); 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.='
        '.&mt('Not registered').'
        '; } } } return ($status,$sendsomething,$delay); } # Routine to get the complete feedback records sub getfeedbackrecords { my ($uname,$udom,$course)=@_; unless ($uname) { $uname=$env{'user.name'}; } unless ($udom) { $udom=$env{'user.domain'}; } unless ($course) { $course=$env{'request.course.id'}; } my %record=&Apache::lonnet::restore('_feedback',$course,$udom,$uname); return %record; } # Routine to get feedback statistics sub getfeedbackstats { my %record=&getfeedbackrecords(@_); return ($record{'subnumber'},$record{'points'},$record{'totallikes'}); } # Store feedback credit sub storefeedbackpoints { my ($points,$uname,$udom,$course)=@_; unless ($points) { $points=0; } unless ($uname) { $uname=$env{'user.name'}; } unless ($udom) { $udom=$env{'user.domain'}; } unless ($course) { $course=$env{'request.course.id'}; } my %record=('grader_user' => $env{'user.name'}, 'grader_domain' => $env{'user.domain'}, 'points' => $points); return &Apache::lonnet::cstore(\%record,'_feedback',$course,$udom,$uname); } # Store feedback "likes" sub storefeedbacklikes { my ($likes,$uname,$udom,$course)=@_; unless ($likes) { $likes=0; } if ($likes>0) { $likes=1; } if ($likes<0) { $likes=-1; } unless ($uname) { $uname=$env{'user.name'}; } unless ($udom) { $udom=$env{'user.domain'}; } unless ($course) { $course=$env{'request.course.id'}; } my %record=&getfeedbackrecords($uname,$udom,$course); my $totallikes=$record{'totallikes'}; $totallikes+=$likes; my %newrecord=('likes_user' => $env{'user.name'}, 'likes_domain' => $env{'user.domain'}, 'likes' => $likes, 'totallikes' => $totallikes); return &Apache::lonnet::cstore(\%newrecord,'_feedback',$course,$udom,$uname); } sub adddiscuss { my ($symb,$email,$anon,$attachmenturl,$subject,$group)=@_; my $status=''; my $realsymb = &get_realsymb($symb); my ($cnum,$cdom); if ($env{'request.course.id'}) { $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; } if (&discussion_open(undef,$realsymb) && (&Apache::lonnet::allowed('pch',$env{'request.course.id'}. ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')) || (($group ne '') && (&check_group_priv($group,'pgd') eq 'ok') && ($symb =~ m{^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$})))) { 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)) { my $now = time; if ($env{'form.editdisc'}) { $contrib{'ip'}=&Apache::lonnet::get_requestor_ip(); $contrib{'host'}=$Apache::lonnet::perlvar{'lonHostID'}; $contrib{'timestamp'} = $now; $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'} =~ /^/) { $contrib{'subject'} = ''.&HTML::Entities::encode($contrib{'subject'},'<>&"').''; $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.$contrib{'subject'}; } else { $contrib{'subject'} = ''.&HTML::Entities::encode($oldcontrib{$oldidx.':subject'},'<>&"').''.&HTML::Entities::encode($contrib{'subject'},'<>&"').''; } } if (defined($oldcontrib{$oldidx.':message'})) { if ($oldcontrib{$oldidx.':message'} =~ /^/) { $contrib{'message'} = ''.&HTML::Entities::encode($contrib{'message'},'<>&"').''; $contrib{'message'} = $oldcontrib{$oldidx.':message'}.$contrib{'message'}; } else { $contrib{'message'} = ''.&HTML::Entities::encode($oldcontrib{$oldidx.':message'},'<>&"').''.&HTML::Entities::encode($contrib{'message'},'<>&"').''; } } $contrib{'history'} .= $oldcontrib{$oldidx.':timestamp'}; 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 => $now); $status.='
        '.&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=&getdiscussionrecords(); my ($temp)=keys(%record); unless ($temp=~/^error\:/) { my %newrecord=(); $newrecord{'resource'}=$symb; $newrecord{'subnumber'}=$record{'subnumber'}+1; $status.='
        '.&mt('Registering').': '. &Apache::lonnet::cstore(\%newrecord,'_discussion'); &updatekarma(); } } else { $status.='Failed.'; } return $status.'
        '; } # Routine to get the complete discussion records sub getdiscussionrecords { my ($uname,$udom,$course)=@_; unless ($uname) { $uname=$env{'user.name'}; } unless ($udom) { $udom=$env{'user.domain'}; } unless ($course) { $course=$env{'request.course.id'}; } my %record=&Apache::lonnet::restore('_discussion',$course,$udom,$uname); return %record; } # Routine to get discussion statistics sub getdiscussionstats { my %record=&getdiscussionrecords(@_); my $totalvotes = $record{'totallikes'} + $record{'totalunlikes'}; return ($record{'subnumber'},$record{'points'},$record{'totallikes'},$totalvotes); } # Calculate discussion karma sub calcdiscussionkarma { my ($subs,$pts,$likes,$votes)=&getdiscussionstats(@_); my $karma=0; if ($votes>0) { $karma=int(.1+5.*(1.-exp(-$subs/10.))*$likes/$votes); if ($karma<0) { $karma=0; } if ($karma>5) { $karma=5; } } return $karma; } # Update karma sub updatekarma { my ($uname,$udom,$course)=@_; unless ($uname) { $uname=$env{'user.name'}; } unless ($udom) { $udom=$env{'user.domain'}; } unless ($course) { $course=$env{'request.course.id'}; } my $karma=&calcdiscussionkarma($uname,$udom,$course); &Apache::lonnet::cstore({ 'karma' => $karma },'_discussion',$course,$udom,$uname); &Apache::lonnet::do_cache_new('karma',$uname.':'.$udom.':'.$course,$karma,3600); return $karma; } # Retrieve karma sub userkarma { my ($uname,$udom,$course)=@_; unless ($uname) { $uname=$env{'user.name'}; } unless ($udom) { $udom=$env{'user.domain'}; } unless ($course) { $course=$env{'request.course.id'}; } my $hashkey=$uname.':'.$udom.':'.$course; my ($karma,$cached)=&Apache::lonnet::is_cached_new('karma',$hashkey); if ($cached) { return $karma; } my %userdisc=&getdiscussionrecords($uname,$udom,$course); $karma=$userdisc{'karma'}; &Apache::lonnet::do_cache_new('karma',$hashkey,$karma,3600); return $karma; } # Store discussion credit sub storediscussionpoints { my ($points,$uname,$udom,$course)=@_; unless ($points) { $points=0; } unless ($uname) { $uname=$env{'user.name'}; } unless ($udom) { $udom=$env{'user.domain'}; } unless ($course) { $course=$env{'request.course.id'}; } my %record=('grader_user' => $env{'user.name'}, 'grader_domain' => $env{'user.domain'}, 'points' => $points); return &Apache::lonnet::cstore(\%record,'_discussion',$course,$udom,$uname); } # Store discussion "likes" sub storediscussionlikes { my ($chglikes,$chgunlikes,$uname,$udom,$course,$context)=@_; unless ($uname) { $uname=$env{'user.name'}; } unless ($udom) { $udom=$env{'user.domain'}; } unless ($course) { $course=$env{'request.course.id'}; } my %record=&getdiscussionrecords($uname,$udom,$course); my $totallikes=$record{'totallikes'}; my $totalunlikes=$record{'totalunlikes'}; $totallikes += $chglikes; $totalunlikes += $chgunlikes; my %newrecord=('likes_user' => $env{'user.name'}, 'likes_domain' => $env{'user.domain'}, 'totallikes' => $totallikes, 'totalunlikes' => $totalunlikes, 'context' => $context); my $status=&Apache::lonnet::cstore(\%newrecord,'_discussion',$course,$udom,$uname); if ($status eq 'ok') { &updatekarma($uname,$udom,$course); } return $status; } sub get_discussion_info { my ($idx,%contrib) = @_; my $changelast = 0; my $count = 0; my $hiddenflag = 0; my $deletedflag = 0; my ($hidden,$deleted,%info,$newlastdisc); my $version = $contrib{'version'}; if ($version) { for (my $id=$version; $id>0; $id--) { my $vkeys=$contrib{$id.':keys'}; my @keys=split(/:/,$vkeys); if (grep(/^hidden$/,@keys)) { if (!$hiddenflag) { $hidden = $contrib{$id.':hidden'}; $hiddenflag = 1; } } elsif (grep(/^deleted$/,@keys)) { if (!$deletedflag) { $deleted = $contrib{$id.':deleted'}; $deletedflag = 1; } } else { if (($hidden !~/\.$id\./) && ($deleted !~/\.$id\./)) { $count++; $info{$count}{'id'} = $id; $info{$count}{'timestamp'}=$contrib{$id.':timestamp'}; } } } if ($info{'1'}{'id'} == $idx) { $changelast = 1; if ($count > 1) { $newlastdisc = $info{'2'}{'timestamp'}; } else { $newlastdisc = 0; } } } return ($changelast,$newlastdisc); } # ----------------------------------------------------------- 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'}); $subject=~s/\n/\
        /g; $subject=&Apache::lontexconvert::msgtexconverted($subject); my $end_page = &Apache::loncommon::end_page(); $r->print($start_page .'

        '.&mt('Preview').'

        ' .&Apache::lonhtmlcommon::start_pick_box() .&Apache::lonhtmlcommon::row_title(&mt('Subject')) .$subject .&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Message')) .$message .&Apache::lonhtmlcommon::row_closure(1) .&Apache::lonhtmlcommon::end_pick_box() .$end_page ); } sub contains_block_html { my ($message)=@_; return ($message =~ m{ <(br|h1|h2|h3|h4|h5|h6|p|ol|ul|table|pre|address|blockquote|center|div) \s* (\w+\=['"]\w+['"])* \s* ( \s*/>| >.* )}xs ); } sub tidy_html { my ($message)=@_; # my $tidy = HTML::Tidy::libXML->new(); # my $xhtml = $tidy->clean($message, 'utf-8', 1); # $xhtml =~ m/(.*)<\/body>/is; # my $clean = $1; # # remove any empty block-level tags # $clean =~ s/<(table|p|div|tbody|blockquote|m|pre|algebra|center|ol|ul|span|h1|h2|h3|h4|h5|h6)\s*\/>//i; # $message=$clean; return $message; } sub newline_to_br { my ($message)=@_; my $newmessage; my $parser=HTML::LCParser->new($message); while (my $token=$parser->get_token()) { if ($token->[0] eq 'T') { my $text=$token->[1]; $text=~s/\n/\
        /g; $newmessage.=$text; } elsif ($token->[0] eq 'D' || $token->[0] eq 'C') { $newmessage.=$token->[1]; } elsif ($token->[0] eq 'PI' || $token->[0] eq 'E') { $newmessage.=$token->[2]; } elsif ($token->[0] eq 'S') { $newmessage.=$token->[4]; } } $$message=$newmessage; } sub generate_preview_button { my ($formname,$fieldname)=@_; unless ($formname) { $formname='mailform'; } unless ($fieldname) { $fieldname='comment'; } my $pre=&mt("Show Preview and Check Spelling"); return(<
        ENDPREVIEW } sub modify_attachments { my ($r,$currnewattach,$currdelold,$symb,$idx,$attachmenturls, $attachmaxtext,$toolarge)=@_; my %lt = &Apache::lonlocal::texthash( 'subj' => 'Subject', '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' => 'Save Changes', 'clic' => 'Add/remove attachments', ); my $js = < function setAction () { document.modattachments.action = document.modattachments.origpage.value; document.modattachments.submit(); } END # Breadcrumbs my $brcrum = [{'href' => '', 'text' => 'Discussion Post Attachments'}]; my %parms=('only_body' => 1); if ($env{'form.modal'} ne 'yes') { $parms{'bread_crumbs'} = $brcrum; } my $start_page = &Apache::loncommon::start_page('Discussion Post Attachments',$js,\%parms); my $orig_subject = &unescape($env{'form.subject'}); my $subject=&clear_out_html($orig_subject); $subject=~s/\n/\
        /g; $subject=&Apache::lontexconvert::msgtexconverted($subject); my $timestamp=$env{'form.timestamp'}; my $numoldver=$env{'form.numoldver'}; my $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(<

        $lt{'clic'}

        END $r->print(&Apache::lonhtmlcommon::start_pick_box()); $r->print(&Apache::lonhtmlcommon::row_title(&mt('Subject'))); $r->print(''.$subject.''); $r->print(&Apache::lonhtmlcommon::row_closure()); $r->print(&Apache::lonhtmlcommon::row_title($lt{'adda'})); $r->print('' .'' .' '.$attachmaxtext); if(($idx)||(ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)){ $r->print(&Apache::lonhtmlcommon::row_closure()); $r->print(&Apache::lonhtmlcommon::row_title(&mt('Attachments'))); if ($idx) { if ($attachmenturls) { my @currold = keys(%currattach); if (@currold > 0) { $r->print($lt{'thfo'}.'
        '.$lt{'chth'}.'
        '."\n"); foreach my $id (@currold) { my $attachurl = &HTML::Entities::decode($attachments{$id}{'filename'}); $attachurl =~ m#/([^/]+)$#; $r->print('
        '."\n"); } $r->print("
        "); } } } if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) { $r->print($lt{'chth'}.'
        '."\n"); foreach my $attach (@{$currnewattach}) { $attach =~ m#/([^/]+)$#; $r->print('
        '."\n"); } } } $r->print(&Apache::lonhtmlcommon::row_closure(1)); $r->print(&Apache::lonhtmlcommon::end_pick_box()); $r->print(< END foreach my $item (@{$currnewattach}) { $r->print(''."\n"); } foreach my $item (@{$currdelold}) { $r->print(''."\n"); } $r->print(< $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' => 'Add/remove attachments', ); my $response = (<
        ENDATTACH if (defined($deloldattach)) { if (@{$deloldattach} > 0) { foreach my $delatt (@{$deloldattach}) { $response .= ''."\n"; } } } if (defined($currnewattach)) { if (@{$currnewattach} > 0) { foreach my $attach (@{$currnewattach}) { $response .= ''."\n"; } } } $response .= ''; return $response; } sub extract_attachments { my ($attachmenturls,$idx,$numoldver,$message,$attachments,$currattach,$currdelold) = @_; %{$attachments}=(); &get_post_attachments($attachments,$attachmenturls); foreach my $id (sort(keys(%{$attachments}))) { if (exists($$attachments{$id}{$numoldver})) { if (defined($currdelold)) { if (@{$currdelold} > 0) { unless (grep/^$id$/,@{$currdelold}) { $$currattach{$id} = $$attachments{$id}{$numoldver}; } } else { $$currattach{$id} = $$attachments{$id}{$numoldver}; } } else { $$currattach{$id} = $$attachments{$id}{$numoldver}; } } } my @attached = (sort { $a <=> $b } keys(%{$currattach})); if (@attached == 1) { my $id = $attached[0]; my $attachurl; if ($attachmenturls =~ m/^/) { $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); } else { $attachurl = $$attachments{$id}{'filename'}; } $attachurl=~m|/([^/]+)$|; $$message.='
        '. $1.'
        '; &Apache::lonnet::allowuploaded('/adm/feedback', $attachurl); } elsif (@attached > 1) { $$message.='
          '; foreach my $attach (@attached) { my $id = $attach; my $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); my ($fname) =($attachurl=~m|/([^/]+)$|); $$message .= '
        1. '. $fname.'
        2. '; &Apache::lonnet::allowuploaded('/adm/feedback', $attachurl); } $$message .= '
        '; } } sub construct_attachmenturl { my ($currnewattach,$keepold,$symb,$idx)=@_; my $oldattachmenturl; my $newattachmenturl; my $startnum = 0; my $currver = 0; if (($env{'form.editdisc'}) && ($idx)) { my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); $oldattachmenturl = $contrib{$idx.':attachmenturl'}; if ($contrib{$idx.':history'}) { if ($contrib{$idx.':history'} =~ /:/) { my @oldversions = split(/:/,$contrib{$idx.':history'}); $currver = 1 + scalar(@oldversions); } else { $currver = 2; } } else { $currver = 1; } if ($oldattachmenturl) { if ($oldattachmenturl =~ m/^/) { my %attachments = (); my $prevver = $currver-1; &get_post_attachments(\%attachments,$oldattachmenturl); my $numattach = scalar(keys(%attachments)); $startnum += $numattach; foreach my $num (sort {$a <=> $b} keys(%attachments)) { $newattachmenturl .= ''.$attachments{$num}{'filename'}.''; foreach my $item (sort {$a <=> $b} keys(%{$attachments{$num}})) { unless ($item eq 'filename') { $newattachmenturl .= ''.$attachments{$num}{$item}.''; } } if (grep/^$num$/,@{$keepold}) { $newattachmenturl .= ''.$attachments{$num}{$prevver}.''; } $newattachmenturl .= ''; } } else { $newattachmenturl = ''.&HTML::Entities::encode($oldattachmenturl).'n'; unless (grep/^0$/,@{$keepold}) { $newattachmenturl .= 'n'; } $newattachmenturl .= ''; $startnum ++; } } } for (my $i=0; $i<@{$currnewattach}; $i++) { my $attachnum = $startnum + $i; $newattachmenturl .= ''.&HTML::Entities::encode($$currnewattach[$i]).'n'; } return $newattachmenturl; } sub add_blog_checkbox { my ($crstype) = @_; my $checkstatus; if ($env{'form.blog'}) { $checkstatus = 'checked="checked"'; } my $output = '

        '."\n"; return $output; } sub has_discussion { my $resourcesref = shift; my $navmap = Apache::lonnavmaps::navmap->new(); if (defined($navmap)) { my @allres=$navmap->retrieveResources(); foreach my $resource (@allres) { if ($resource->hasDiscussion()) { my $ressymb = $resource->wrap_symb(); if (ref($resourcesref) eq 'ARRAY') { push(@{$resourcesref}, $ressymb); } } } } else { &Apache::lonnet::logthis('Has discussion check failed - could not create navmap object.'); } return; } sub sort_filter_names { my ($sort_types,$role_types,$status_types,$crstype) = @_; if (ref($sort_types) eq 'HASH') { %{$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' ); } my @courseroles = qw(st in ta ep ad); if ($crstype eq 'Community') { push(@courseroles,'co'); } else { push(@courseroles,'cc'); } if (ref($role_types) eq 'HASH') { foreach my $role (@courseroles) { $role_types->{$role} = &Apache::lonnet::plaintext($role,$crstype); } $role_types->{'all'} = 'All roles'; $role_types->{'cr'} = 'Custom role'; } if (ref($status_types) eq 'HASH') { %{$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'}, ['like','unlike','modal','hide','unhide','deldisc','undeleteall','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'}; my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my %attachmax = ( text => &mt('(128 KB max size)'), num => 131072, ); if ($env{'form.editdisc'}) { if (!(&editing_allowed($env{'form.editdisc'},$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').'
        ', '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').'
        ', '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; # Breadcrumbs my $brcrum = [{'href' => '', 'text' => 'Discussion Post Versions'}]; my %parms=(); if ($env{'form.modal'} ne 'yes') { $parms{'bread_crumbs'} = $brcrum; } $r->print(&Apache::loncommon::start_page('Discussion Post Versions',undef,\%parms)); my ($symb,$idx)=split(/\:\:\:/,$env{'form.allversions'}); ($symb, my $feedurl)=&get_feedurl_and_clean_symb($symb); my $ressymb = &wrap_symb($symb); my $seeid; if (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { $seeid = 1; } my $seehidden = &can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum); if ($idx > 0) { my %messages = (); my %subjects = (); my %attachmsgs = (); my %allattachments = (); my %imsfiles = (); my ($screenname,$plainname,$showaboutme); my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $cdom,$cnum); $r->print(&get_post_contents(\%contrib,$idx,$seeid,$seehidden,'allversions',\%messages,\%subjects,\%allattachments,\%attachmsgs,\%imsfiles,\$screenname,\$plainname,\$showaboutme)); } $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').'
        ','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').'
        ','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( 'twnp' => 'There are currently no resources or discussion 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 = ''. &mt('Marked "New" posts as read in a total of [_1] resources/discussion boards.', $numitems). ''; if ($numitems > 0) { &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', \%discinfo,$env{'user.domain'},$env{'user.name'}); } else { $textline = "$lt{'twnp'}"; } &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); my %onload; 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 (< $textline

        $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').'
        ', '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 $ressymb = &wrap_symb($symb); my $seehidden = &can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum); unless (($seehidden) || (&editing_allowed($env{'form.hide'},$group))) { &redirect_back($r,$feedurl,&mt('Hiding not permitted').'
        ', '0','0','','',$env{'form.previous'},'','','','', undef,undef,$group); return OK; } my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $cdom,$cnum); my $currenthidden=$contrib{'hidden'}; my $currentstudenthidden=$contrib{'studenthidden'}; if ($env{'form.hide'}) { $currenthidden.='.'.$idx.'.'; unless ($seehidden) { $currentstudenthidden.='.'.$idx.'.'; } } else { $currenthidden=~s/\.$idx\.//g; } my %newhash=('hidden' => $currenthidden); if ( ($env{'form.hide'}) && (!$seehidden) ) { $newhash{'studenthidden'} = $currentstudenthidden; } if ($env{'form.hide'}) { my $changelast = 0; my $newlast; ($changelast,$newlast) = &get_discussion_info($idx,%contrib); if ($changelast) { &Apache::lonnet::put('discussiontimes',{$symb => $newlast}, $cdom,$cnum); } } my $result; if (&Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'}, $cdom,$cnum) eq 'ok') { my $prefix=$symb.':'.$idx.':'; my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum, '^'.$prefix); my ($totallikes,$totalunlikes); if (ref($likes{$prefix.'likers'}) eq 'HASH') { $totallikes = scalar(keys(%{$likes{$prefix.'likers'}})); } if (ref($likes{$prefix.'unlikers'}) eq 'HASH') { $totalunlikes = scalar(keys(%{$likes{$prefix.'unlikers'}})); } if ($totallikes || $totalunlikes) { my ($chglikes,$chgunlikes,$context); if ($env{'form.hide'}) { $chglikes = -1 * $totallikes; $chgunlikes = -1 * $totalunlikes; $context = 'hide'; } else { $chglikes = $totallikes; $chgunlikes = $totalunlikes; $context = 'unhide'; } &storediscussionlikes($chglikes,$chgunlikes, $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}, $env{'request.course.id'}, $context); } $result = &mt('Changed discussion status'); } else { $result = &mt('Discussion status unchanged'); } &redirect_back($r,$feedurl,$result.'
        ','0','0','','', $env{'form.previous'},undef,undef,undef, undef,undef,undef,$group); return OK; } elsif (($env{'form.like'}) || ($env{'form.unlike'})) { # ----------------------------------------------------------------- Like/unlike my $entry=$env{'form.like'}?$env{'form.like'}:$env{'form.unlike'}; my ($symb,$idx)=split(/\:\:\:/,$entry); ($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb); my $result; if ($idx > 0) { my $realsymb = &get_realsymb($symb); my $status='OPEN'; if ($Apache::lonhomework::parsing_a_problem || $Apache::lonhomework::parsing_a_task) { $status=$Apache::inputtags::status[-1]; } if (&discussion_vote_available($status,$realsymb)) { my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $cdom,$cnum); my $ownpost; if (($contrib{$idx.':sendername'} eq $env{'user.name'}) && ($contrib{$idx.':senderdomain'} eq $env{'user.domain'})) { $ownpost = 1; } if ($ownpost || $contrib{$idx.':hidden'} || $contrib{$idx.':deleted'}) { $result = &mt('Vote not registered.').' '; } if ($ownpost) { $result .= &mt('No voting for your own posts.'); } elsif ($contrib{$idx.':hidden'}) { $result .= &mt('No voting for hidden posts.'); } elsif ($contrib{$idx.':deleted'}) { $result .= &mt('No voting for deleted posts.'); } else { # # Likes and unlikes are in db-file "disclikes" of the course # The prefix is the $symb to identify the resource discussion, # and the $idx to identify the entry # my $prefix=$symb.':'.$idx.':'; my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum, '^'.$prefix); # Get current like or unlike status for the $idx for this user. my $thisuser=$env{'user.name'}.':'.$env{'user.domain'}; my ($userlikes,$userunlikes); if (ref($likes{$prefix.'likers'}) eq 'HASH') { if (exists($likes{$prefix.'likers'}{$thisuser})) { $userlikes = 1; } } if (ref($likes{$prefix.'unlikers'}) eq 'HASH') { if (exists($likes{$prefix.'unlikers'}{$thisuser})) { $userunlikes = 1; } } # Get the current "likes" count my $likescount=$likes{$prefix.'likes'}; # Find out if they already voted # Users cannot like a post twice, or unlike it twice. # They can change their mind, though. my $alreadyflag=0; my $votetype; if ($env{'form.like'}) { if ($userlikes) { $alreadyflag=1; } elsif ($userunlikes) { delete($likes{$prefix.'unlikers'}{$thisuser}); $votetype = 'switch'; $likescount++; } else { if (ref($likes{$prefix.'likers'}) eq 'HASH') { $likes{$prefix.'likers'}{$thisuser} = 1; } else { $likes{$prefix.'likers'} = {$thisuser => 1}; } $likescount++; } } else { if ($userunlikes) { $alreadyflag=1; } elsif ($userlikes) { delete($likes{$prefix.'likers'}{$thisuser}); $votetype = 'switch'; $likescount--; } else { if (ref($likes{$prefix.'unlikers'}) eq 'HASH') { $likes{$prefix.'unlikers'}{$thisuser} = 1; } else { $likes{$prefix.'unlikers'} = {$thisuser => 1}; } $likescount--; } } # $alreadyflag would be 1 if they tried to double-like or double-unlike if ($alreadyflag) { if ($env{'form.like'}) { $result= &mt("'Like' already registered"); } else { $result= &mt("'Unlike' already registered"); } } else { my %newhash=($prefix.'likes' => $likescount, $prefix.'likers' => $likes{$prefix.'likers'}, $prefix.'unlikers' => $likes{$prefix.'unlikers'}); # Store data in db-file "disclikes" if (&Apache::lonnet::put('disclikes',\%newhash,$cdom,$cnum) eq 'ok') { # Also store with the person who posted the liked/unliked entry my ($chglike,$chgunlike); if ($env{'form.like'}) { if ($votetype eq 'switch') { $chglike = 0; $chgunlike = -1; } else { $chglike = 1; $chgunlike = 0; } &storediscussionlikes($chglike,$chgunlike, $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}, $env{'request.course.id'},'like'); $result=&mt("Registered 'Like'"); } else { if ($votetype eq 'switch') { $chglike = -1; $chgunlike = 0; } else { $chglike = 0; $chgunlike = 1; } &storediscussionlikes($chglike,$chgunlike, $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}, $env{'request.course.id'},'unlike'); $result=&mt("Registered 'Unlike'"); } } else { # Oops, something went wrong $result=&mt("Failed to register vote"); } } } } else { $result=&mt('Voting unavailable for this discussion'); } } else { $result=&mt('Invalid post number'); } &redirect_back($r,$feedurl,$result.'
        ', '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 'threadedoff') { &Apache::lonnet::put('environment',{'unthreadeddiscussion' => 'on'}); &Apache::lonnet::appenv({'environment.unthreadeddiscussion' => 'on'}); &Apache::lonnet::del('environment',['threadeddiscussion']); &Apache::lonnet::delenv('environment.threadeddiscussion'); } else { &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'}); &Apache::lonnet::appenv({'environment.threadeddiscussion' => 'on'}); &Apache::lonnet::del('environment',['unthreadeddiscussion']); &Apache::lonnet::delenv('environment.unthreadeddiscussion'); } &redirect_back($r,$feedurl,&mt('Changed discussion view mode').'
        ', '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 $ressymb=&wrap_symb($symb); unless (&can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum)) { &redirect_back($r,$feedurl,&mt('Deletion not permitted').'
        ', '0','0','','',$env{'form.previous'},'','','','', undef,undef,$group); return OK; } my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $cdom,$cnum); my ($changelast,$newlast) = &get_discussion_info($idx,%contrib); if ($changelast) { &Apache::lonnet::put('discussiontimes',{$symb => $newlast}, $cdom,$cnum); } my %newhash=('deleted' => $contrib{'deleted'}.".$idx."); my $result; if (&Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'}, $cdom,$cnum) eq 'ok') { $result = &mt('Changed discussion status'); my $prefix=$symb.':'.$idx.':'; my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum, '^'.$prefix); my ($totallikes,$totalunlikes); if (ref($likes{$prefix.'likers'}) eq 'HASH') { $totallikes = scalar(keys(%{$likes{$prefix.'likers'}})); } if (ref($likes{$prefix.'unlikers'}) eq 'HASH') { $totalunlikes = scalar(keys(%{$likes{$prefix.'unlikers'}})); } if ($totallikes || $totalunlikes) { my $chglikes = -1 * $totallikes; my $chgunlikes = -1 * $totalunlikes; &storediscussionlikes($chglikes,$chgunlikes, $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}, $env{'request.course.id'}, 'delete'); } } else { $result = &mt('Discussion status unchanged'); } &redirect_back($r,$feedurl,$result.'
        ','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,$toolarge); &process_attachments(\@currnewattach,\@currdelold,\@keepold); if (exists($env{'form.addnewattach.filename'})) { if (length($env{'form.addnewattach'})<=$attachmax{'num'}) { my $subdir = 'feedback/'.$env{'form.timestamp'}; my $newattachment=&Apache::lonnet::userfileupload('addnewattach',undef,$subdir); push(@currnewattach, $newattachment); } else { $toolarge = '

        '.&mt('Attachment not included - exceeded permitted length').'

        '; } } 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'}, $cdom,$cnum); $attachmenturls = $contrib{$idx.':attachmenturl'}; } &modify_attachments($r,\@currnewattach,\@currdelold,$symb,$idx, $attachmenturls,$attachmax{'text'},$toolarge); 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 =~ /$LONCAPA::assess_re/) { $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; } elsif ($env{'form.undeleteall'}) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.undeleteall'}); my $ressymb=&wrap_symb($symb); $r->print(&Apache::loncommon::start_page('Undelete all deleted discussion entries')); if (&can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum)) { my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $cdom,$cnum); $contrib{'deleted'} =~ s/^\.//; $contrib{'deleted'} =~ s/\.$//; my $confirm_msg; if ($contrib{'deleted'} ne '') { if (&Apache::lonnet::store({'deleted' => ''},$symb,$env{'request.course.id'}, $cdom,$cnum) eq 'ok') { my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum,'^'.$symb.':'); my @ids = split(/\.\./,$contrib{'deleted'}); my (%chglikes,%chgunlikes); foreach my $idx (@ids) { my $uname = $contrib{$idx.':sendername'}; my $udom = $contrib{$idx.':senderdomain'}; my ($totallikes,$totalunlikes); if (ref($likes{$symb.':'.$idx.':likers'}) eq 'HASH') { $totallikes = scalar(keys(%{$likes{$symb.':'.$idx.':likers'}})); } if (ref($likes{$symb.':'.$idx.':unlikers'}) eq 'HASH') { $totalunlikes = scalar(keys(%{$likes{$symb.':'.$idx.':unlikers'}})); } if ($totallikes || $totalunlikes) { $chglikes{$uname.':'.$udom} += $totallikes; $chgunlikes{$uname.':'.$udom} += $totalunlikes; } } foreach my $user (keys(%chglikes)) { my ($uname,$udom) = split(/:/,$user); &storediscussionlikes($chglikes{$user},$chgunlikes{$user}, $uname,$udom,$env{'request.course.id'}, 'undelete'); } $confirm_msg = &Apache::lonhtmlcommon::confirm_success(&mt("Undeleted all entries")); } else { $confirm_msg = &Apache::lonhtmlcommon::confirm_success(&mt("Failed to undelete entries"),1); } } else { $confirm_msg = &Apache::lonhtmlcommon::confirm_success(&mt("No entries to undelete"),1); } $r->print( '
        ' .&Apache::loncommon::confirmwrapper($confirm_msg) .&Apache::lonhtmlcommon::actionbox( ["".&mt("Return and reload").""]) ); } $r->print(&Apache::loncommon::end_page()); return OK; } else { # ------------------------------------------------------------- Normal feedback my $feedurl=$env{'form.postdata'}; $feedurl=~s/^https?\:\/\///; $feedurl=~s/^$ENV{'SERVER_NAME'}//; $feedurl=~s/^$ENV{'HTTP_HOST'}//; $feedurl=~s/\?.+$//; my $symb; if ($env{'form.replydisc'}) { $symb=(split(/\:\:\:/,$env{'form.replydisc'}))[0]; } elsif ($env{'form.editdisc'}) { $symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0]; } elsif ($env{'form.origpage'}) { $symb=""; } elsif ($env{'form.sendmessageonly'}) { $symb=(split(/\:\:\:/,$env{'form.sendmessageonly'}))[0]; } else { $symb=&Apache::lonnet::symbread($feedurl); } unless ($symb) { $symb=$env{'form.symb'}; } if (defined($symb)) { ($symb,$feedurl)=&get_feedurl_and_clean_symb($symb); } else { # backward compatibility (bulletin boards used to be 'wrapped') &Apache::lonenc::check_decrypt(\$feedurl); &dewrapper(\$feedurl); } my $goahead=1; if ($feedurl=~/$LONCAPA::assess_re/) { unless ($symb) { $goahead=0; } } if (!$goahead) { # Ambiguous Problem Resource $r->internal_redirect('/adm/ambiguous'); return OK; } if ($feedurl eq '') { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; &no_redirect_back($r); 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\_\_\_/)) || (($env{'request.course.id'}) && ($feedurl =~ /ext\.tool$/)) ) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; # Unable to give feedback &Apache::lonenc::check_encrypt(\$feedurl); &no_redirect_back($r,$feedurl,2); return OK; } # --------------------------------------------------- Print login screen header unless ($env{'form.sendit'}) { &Apache::lonenc::check_encrypt(\$feedurl); &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; if (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { my ($blocked,$blocktext) = &Apache::loncommon::blocking_status('boards'); if ($blocked) { $r->print(&blocked_reply_or_edit($blocktext)); return OK; } } my $options=&screen_header($feedurl,$symb,$group); if ($options) { &mail_screen($r,$feedurl,$options,$symb,$attachmax{'text'}); } else { &fail_redirect($r,$feedurl,2); } 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 &Apache::lonenc::check_encrypt(\$feedurl); 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 $usersymb = &Apache::lonenc::check_encrypt($symb); my $useranswer= &Apache::loncommon::get_student_answers( $usersymb,$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=''; my $toolarge=''; 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'}) { if (length($env{'form.attachment'})<=$attachmax{'num'}) { my $now = time; my $subdir = 'feedback/'.$now; $attachmenturl=&Apache::lonnet::userfileupload('attachment',undef,$subdir); } else { $toolarge = '

        '.&mt('Attachment not included - exceeded permitted length').'

        '; } } # Filter HTML out of message (could be nasty) my $override; if ($env{'form.discuss'} =~ /^(?:author|question|course|policy)$/) { $override = 1; } my $message=&clear_out_html($env{'form.comment'},$override); # Assemble email my ($email,$citations)=&assemble_email($message,$prevattempts, $usersaw,$useranswer); # Who gets this? my ($typestyle,%to) = &Apache::lonmsg::decide_receiver($feedurl); # Actually send mail my $clientip = &Apache::lonnet::get_requestor_ip($r); my ($status,$numsent,$delay)=&send_msg(&clear_out_html($env{'form.subject'}), $feedurl,$email,$citations, $attachmenturl,$usersymb,$clientip,%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'}); my $anonmode=($env{'form.discuss'} eq 'anon' || $env{'form.anondiscuss'} ); $typestyle.=&adddiscuss($symb,$message,$anonmode,$attachmenturl, $subject,$group); $numpost++; } # Add to blog? my $blog=''; if ($env{'form.blog'}) { my $subject = &clear_out_html($env{'form.subject'}); $status.=&Apache::lonrss::addentry($env{'user.name'}, $env{'user.domain'}, 'CourseBlog_'.$env{'request.course.id'}, $subject,$message,$feedurl,'public'); if (&Apache::loncommon::course_type() eq 'Community') { $blog='
        '.&mt('Added to my community blog').'
        '; } else { $blog='
        '.&mt('Added to my course blog').'
        '; } } # 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,$toolarge,$delay); } return OK; } sub blocked_reply_or_edit { my ($blocktext) = @_; return &Apache::loncommon::start_page('Resource Feedback and Discussion'). $blocktext.'

        '. &mt('Back to previous page'). &Apache::loncommon::end_page(); } 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; } sub get_resource_title { my ($symb,$feedurl) = @_; my ($restitle,$plainurl); if (defined($symb)) { my $plain_symb = &Apache::lonenc::check_decrypt($symb); $restitle = &Apache::lonnet::gettitle($plain_symb); } if (defined($feedurl)) { $plainurl = &Apache::lonenc::check_decrypt($feedurl); } if (!defined($restitle)) { if (defined($feedurl)) { $restitle = &Apache::lonnet::gettitle($plainurl); } } if ($plainurl ne $feedurl) { my ($plain_filename) = ($plainurl =~ m-/([^/]+)$-); if ($plain_filename eq $restitle) { $restitle = &mt('Untitled resource'); } } if ($restitle eq '') { $restitle = &mt('Untitled resource'); } return $restitle; } 1; __END__ =pod =head1 NAME Apache::lonfeedback.pm =head1 SYNOPSIS Handles feedback from students to instructors and system administrators. Provides a screenshot of the current resource, as well as previous attempts if the resource was a homework. Used by lonmsg.pm. This is part of the LearningOnline Network with CAPA project described at http://www.lon-capa.org. =head1 OVERVIEW None =head1 SUBROUTINES =over =item discussion_open() =item discussion_visible() =item discussion_vote_available() =item get_realsymb() =item list_discussion() =item can_see_hidden() =item discussion_link() =item send_feedback_link() =item send_message_link() =item action_links_bar() =item postingform_display() =item build_posting_display =item filter_regexp() =item get_post_contents() =item replicate_attachments() =item mail_screen() =item print_display_options() =item print_sortfilter_options() =item print_showposters() =item get_post_versions() =item get_post_attachments() =item fail_redirect() =item redirect_back() =item no_redirect_back() =item screen_header() =item resource_output() =item clear_out_html() =item assemble_email() =item feedback_available() =item send_msg() =item adddiscuss() =item get_discussion_info() =item show_preview() =item newline_to_br() =item tidy_html() =item generate_preview_button() =item modify_attachments() =item process_attachments() =item generate_attachments_button() =item extract_attachments() =item construct_attachmenturl() =item add_blog_checkbox() =item has_discussion() =item sort_filter_names() =item handler() =item blocked_reply_or_edit() =item wrap_symb() =item dewrapper() =item get_feedurl() =item get_feedurl_and_clean_symb() =item editing_allowed() =item check_group_priv() =item group_args() =item get_resource_title() =back =cut 500 Internal Server Error

        Internal Server Error

        The server encountered an internal error or misconfiguration and was unable to complete your request.

        Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

        More information about this error may be available in the server error log.