# The LearningOnline Network # Feedback # # $Id: lonfeedback.pm,v 1.247 2007/05/02 01:33:49 albertel Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # ### package Apache::lonfeedback; use strict; use Apache::Constants qw(:common); use Apache::lonmsg(); use Apache::loncommon(); use Apache::lontexconvert(); use Apache::lonlocal; # must not have () use Apache::lonnet; use Apache::lonhtmlcommon(); use Apache::lonnavmaps; use Apache::lonenc(); use Apache::lonrss(); use HTML::LCParser(); use Apache::lonspeller(); use Apache::longroup; use Cwd; use LONCAPA; sub discussion_open { my ($status,$symb)=@_; if ($env{'request.role.adv'}) { return 1; } if (defined($status) && !($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER' || $status eq 'OPEN')) { return 0; } my $close=&Apache::lonnet::EXT('resource.0.discussend',$symb); if (defined($close) && $close ne '' && $close < time) { return 0; } return 1; } sub discussion_visible { my ($status)=@_; if (not &discussion_open($status)) { my $hidden=&Apache::lonnet::EXT('resource.0.discusshide'); if (lc($hidden) eq 'yes' or $hidden eq '' or !defined($hidden)) { if (!$env{'request.role.adv'}) { return 0; } } } return 1; } sub list_discussion { my ($mode,$status,$ressymb,$imsextras,$group)=@_; 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'; } } if (not &discussion_visible($status)) { if ($mode ne 'board') { &Apache::lonenc::check_encrypt(\$ressymb); return &send_message_link($ressymb); } } if ($group ne '' && $mode eq 'board') { if (&check_group_priv($group,'vgb') ne 'ok') { return ''; } } my ($blocked,$blocktext) = &Apache::loncommon::blocking_status('boards'); if ($blocked) { &Apache::lonenc::check_encrypt(\$ressymb); if ($mode ne 'board') { $blocktext.='
'.&send_message_link($ressymb); } return $blocktext; } my @bgcols = ("#cccccc","#eeeeee"); my $discussiononly=0; if ($mode eq 'board') { $discussiononly=1; } unless ($env{'request.course.id'}) { return ''; } my $crs='/'.$env{'request.course.id'}; my $cid=$env{'request.course.id'}; if ($env{'request.course.sec'}) { $crs.='_'.$env{'request.course.sec'}; } $crs=~s/\_/\//g; my $encsymb=&Apache::lonenc::check_encrypt($ressymb); my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) && ($ressymb=~/\.(problem|exam|quiz|assess|survey|form|task)$/)); my %usernamesort = (); my %namesort =(); my %subjectsort = (); # Get discussion display settings for this discussion my $lastkey = $ressymb.'_lastread'; my $showkey = $ressymb.'_showonlyunread'; my $markkey = $ressymb.'_showonlyunmark', my $visitkey = $ressymb.'_visit'; my $ondispkey = $ressymb.'_markondisp'; my $userpickkey = $ressymb.'_userpick'; my $toggkey = $ressymb.'_readtoggle'; my $readkey = $ressymb.'_read'; $ressymb=$encsymb; my %dischash = &Apache::lonnet::get('nohist_'.$cid.'_discuss',[$lastkey,$showkey,$markkey,$visitkey,$ondispkey,$userpickkey,$toggkey,$readkey],$env{'user.domain'},$env{'user.name'}); my %discinfo = (); my $showonlyunread = 0; my $showunmark = 0; my $markondisp = 0; my $prevread = 0; my $previous = 0; my $visit = 0; my $newpostsflag = 0; my @posters = split(/\&/,$dischash{$userpickkey}); # Retain identification of "NEW" posts identified in last display, if continuing 'previous' browsing of posts. &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['previous','sortposts','rolefilter','statusfilter','sectionpick','grouppick','totposters']); my $sortposts = $env{'form.sortposts'}; my $statusfilter = $env{'form.statusfilter'}; my @sectionpick = split(/,/,$env{'form.sectionpick'}); my @grouppick = split(/,/,$env{'form.grouppick'}); my @rolefilter = split(/,/,$env{'form.rolefilter'}); my $totposters = $env{'form.totposters'}; $previous = $env{'form.previous'}; if ($previous > 0) { $prevread = $previous; } elsif (defined($dischash{$lastkey})) { unless ($dischash{$lastkey} eq '') { $prevread = $dischash{$lastkey}; } } my $cdom = $env{'course.'.$cid.'.domain'}; my $cnum = $env{'course.'.$cid.'.num'}; # Get information about students and non-students in course for filtering display of posts my %roleshash = (); my %roleinfo = (); my ($classgroups,$studentgroups); if ($env{'form.rolefilter'}) { %roleshash = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum); foreach my $rolekey (keys(%roleshash)) { my ($role,$uname,$udom,$sec) = split(/:/,$rolekey); if ($role =~ /^cr/) { $role = 'cr'; } my ($end,$start) = split(/:/,$roleshash{$rolekey}); my $now = time; my $status = 'Active'; if (($now < $start) || ($end > 0 && $now > $end)) { $status = 'Expired'; } if ($uname && $udom) { push(@{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status); } } my ($classlist,$keylist) = &Apache::loncoursedata::get_classlist($cdom,$cnum); my $sec_index = &Apache::loncoursedata::CL_SECTION(); my $status_index = &Apache::loncoursedata::CL_STATUS(); while (my ($student,$data) = each %$classlist) { my ($section,$status) = ($data->[$sec_index], $data->[$status_index]); push(@{$roleinfo{$student}}, 'st:'.$section.':'.$status); } ($classgroups,$studentgroups) = &Apache::loncoursedata::get_group_memberships($classlist,$keylist, $cdom,$cnum); } # Get discussion display default settings for user if ($env{'environment.discdisplay'} eq 'unread') { $showonlyunread = 1; } if ($env{'environment.discmarkread'} eq 'ondisp') { $markondisp = 1; } # Override user's default if user specified display setting for this discussion if (defined($dischash{$ondispkey})) { unless ($dischash{$ondispkey} eq '') { $markondisp = $dischash{$ondispkey}; } } if ($markondisp) { $discinfo{$lastkey} = time; } if (defined($dischash{$showkey})) { unless ($dischash{$showkey} eq '') { $showonlyunread = $dischash{$showkey}; } } if (defined($dischash{$markkey})) { unless ($dischash{$markkey} eq '') { $showunmark = $dischash{$markkey}; } } if (defined($dischash{$visitkey})) { unless ($dischash{$visitkey} eq '') { $visit = $dischash{$visitkey}; } } $visit ++; my $seeid; if (($group ne '') && ($mode eq 'board') && ($ressymb =~ m|^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$|)) { if (&check_group_priv($group,'dgp') eq 'ok') { $seeid = 1; } } else { $seeid=&Apache::lonnet::allowed('rin',$crs); } my @discussionitems=(); my %shown = (); my @posteridentity=(); my $current=0; my $visible=0; my @depth=(); my @replies = (); my %alldiscussion=(); my %imsitems=(); my %imsfiles=(); my %notshown = (); my %newitem = (); my $maxdepth=0; my %anonhash=(); my $anoncnt=0; my $target=''; unless ($env{'browser.interface'} eq 'textual' || $env{'environment.remote'} eq 'off' ) { $target='target="LONcom"'; } my $now = time; $discinfo{$visitkey} = $visit; &Apache::lonnet::put('nohist_'.$cid.'_discuss',\%discinfo,$env{'user.domain'},$env{'user.name'}); &build_posting_display(\%usernamesort,\%subjectsort,\%namesort,\%notshown,\%newitem,\%dischash,\%shown,\%alldiscussion,\%imsitems,\%imsfiles,\%roleinfo,\@discussionitems,\@replies,\@depth,\@posters,\$maxdepth,\$visible,\$newpostsflag,\$current,$status,$viewgrades,$seeid,$prevread,$sortposts,$encsymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,\@rolefilter,\@sectionpick,\@grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,\%anonhash,$anoncnt,$group); my $discussion=''; my $manifestfile; my $manifestok=0; my $tempexport; my $imsresources; my $copyresult; my $function = &Apache::loncommon::get_users_function(); my $color = &Apache::loncommon::designparm($function.'.tabbg', $env{'user.domain'}); my %lt = &Apache::lonlocal::texthash( 'cuse' => 'Current discussion settings', 'allposts' => 'All posts', 'unread' => 'New posts only', 'unmark' => 'Unread only', 'ondisp' => 'Once displayed', 'onmark' => 'Once marked not NEW', 'toggoff' => 'Off', 'toggon' => 'On', 'disa' => 'Posts to be displayed', 'npce' => 'Posts cease to be marked "NEW"', 'epcb' => 'Each post can be toggled read/unread', 'chgt' => 'Change', 'disp' => 'Display', 'nolo' => 'Not new', 'togg' => 'Toggle read/unread', 'aner' => 'An error occurred opening the manifest file.', 'difo' => 'Discussion for', 'aerr' => 'An error occurred opening the export file for posting', 'aysu' => 'Are you sure you want to delete this post?', 'dpwn' => 'Deleted posts will no longer be visible to you and other students', 'bwco' => 'but will continue to be visible to your instructor', 'depo' => 'Deleted posts will no longer be visible to you or anyone else.', ); my $currdisp = $lt{'allposts'}; my $currmark = $lt{'onmark'}; my $currtogg = $lt{'toggoff'}; my $dispchange = $lt{'unread'}; my $markchange = $lt{'ondisp'}; my $toggchange = $lt{'toggon'}; my $chglink = '/adm/feedback?modifydisp='.$ressymb; my $displinkA = 'onlyunread'; my $displinkB = 'onlyunmark'; my $marklink = 'markondisp'; my $togglink = 'toggon'; if ($markondisp) { $currmark = $lt{'ondisp'}; $markchange = $lt{'onmark'}; $marklink = 'markonread'; } if ($showonlyunread) { $currdisp = $lt{'unread'}; $dispchange = $lt{'allposts'}; $displinkA = 'allposts'; } if ($showunmark) { $currdisp = $lt{'unmark'}; $dispchange = $lt{'unmark'}; $displinkA='allposts'; $displinkB='onlyunread'; $showonlyunread = 0; } if ($dischash{$toggkey}) { $currtogg = $lt{'toggon'}; $toggchange = $lt{'toggoff'}; $togglink = 'toggoff'; } $chglink .= '&changes='.$displinkA.'_'.$displinkB.'_'.$marklink.'_'.$togglink; if ($newpostsflag) { $chglink .= '&previous='.$prevread; } $chglink.=&group_args($group); if ($visible) { # Print the discusssion if ($outputtarget eq 'tex') { $discussion.='{\tiny \vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'. '\textbf{DISCUSSIONS}\makebox[2 cm][b]{\hrulefill}'. '\vskip 0 mm\noindent\textbf{'.$lt{'cuse'}.'}:\vskip 0 mm'. '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'. '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}}'; } elsif ($outputtarget eq 'export') { # Create temporary directory if this is an export my $now = time; if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) { $tempexport = $$imsextras{'tempexport'}; if (!-e $tempexport) { mkdir($tempexport,0700); } $tempexport .= '/'.$$imsextras{'count'}; if (!-e $tempexport) { mkdir($tempexport,0700); } } else { $tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports'; if (!-e $tempexport) { mkdir($tempexport,0700); } $tempexport .= '/'.$now; if (!-e $tempexport) { mkdir($tempexport,0700); } $tempexport .= '/'.$env{'user.domain'}.'_'.$env{'user.name'}; } if (!-e $tempexport) { mkdir($tempexport,0700); } # open manifest file my $manifest = '/imsmanifest.xml'; my $manifestfilename = $tempexport.$manifest; if ($manifestfile = Apache::File->new('>'.$manifestfilename)) { $manifestok=1; print $manifestfile qq| $lt{'difo'} $ressymb\n|; } else { $discussion .= $lt{'aner'}.'
'; } } else { my $colspan=$maxdepth+1; $discussion.= qq| |; $discussion.='
'; $discussion .= &action_links_bar($colspan,$ressymb,$visible, $newpostsflag,$group, $prevread,$markondisp); my $escsymb=&escape($ressymb); my $numhidden = keys(%notshown); if ($numhidden > 0) { my $colspan = $maxdepth+1; $discussion.="\n".''; } } # Choose sort mechanism my @showposts = (); if ($sortposts eq 'descdate') { @showposts = (sort { $b <=> $a } keys(%alldiscussion)); } elsif ($sortposts eq 'thread') { @showposts = (sort { $a <=> $b } keys(%alldiscussion)); } elsif ($sortposts eq 'subject') { foreach my $key (sort(keys(%subjectsort))) { push(@showposts, @{$subjectsort{$key}}); } } elsif ($sortposts eq 'username') { foreach my $domain (sort(keys(%usernamesort))) { foreach my $key (sort(keys(%{$usernamesort{$domain}}))) { push(@showposts, @{$usernamesort{$domain}{$key}}); } } } elsif ($sortposts eq 'lastfirst') { foreach my $last (sort(keys(%namesort))) { foreach my $key (sort(keys(%{$namesort{$last}}))) { push(@showposts, @{$namesort{$last}{$key}}); } } } else { @showposts = (sort { $a <=> $b } keys(%alldiscussion)); } my $currdepth = 0; my $firstidx = $alldiscussion{$showposts[0]}; foreach my $post (@showposts) { unless (($sortposts eq 'thread') || (($sortposts eq '') && ($env{'environment.threadeddiscussion'})) || ($outputtarget eq 'export')) { $alldiscussion{$post} = $post; } unless ( ($notshown{$alldiscussion{$post}} eq '1') || ($shown{$alldiscussion{$post}} == 0) ) { if ($outputtarget ne 'tex' && $outputtarget ne 'export') { $discussion.="\n"; } 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/]*)>/
'. ''.&mt('Show all posts').' '.&mt('to display').' '. $numhidden.' '; if ($showunmark) { $discussion .= &mt('posts previously marked read'); } else { $discussion .= &mt('previously viewed posts'); } $discussion .= '
   
/; $discussionitems[$alldiscussion{$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); $discussion .= "
/; my $threadinsert=''; if ($thisdepth > 0) { $threadinsert='
Reply: '.$thisdepth.''; } $discussionitems[$alldiscussion{$post}]=~s/<\/td>]*)>/$threadinsert<\/td>
/; $discussionitems[$alldiscussion{$post}]=~s/]+)>(Edit|Hide|Delete|Reply|Submissions)<\/a>//g; $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 '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); $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 .= '
        '; } 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 my $imszipfile = '/prtspool/'. $env{'user.name'}.'_'.$env{'user.domain'}.'_'. time.'_'.rand(1000000000).'.zip'; my $cwd = &getcwd(); my $imszip = '/home/httpd/'.$imszipfile; chdir $tempexport; open(OUTPUT, "zip -r $imszip * 2> /dev/null |"); close(OUTPUT); chdir $cwd; $discussion .= &mt('Download the zip file from [_1]Discussion Posting Archive','').'
'; 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 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)) { if (($group ne '') && ($mode eq 'board')) { if (&check_group_priv($group,'pgd') eq 'ok') { $discussion .= &postingform_display($mode,$ressymb,$now,$subject, $comment,$outputtarget,$attachnum, $currnewattach,$currdelold, $group); } } else { $discussion.= &postingform_display($mode,$ressymb,$now,$subject, $comment,$outputtarget,$attachnum, $currnewattach,$currdelold); } } } else { $discussion.=''; } return $discussion; } sub send_feedback_link { my ($ressymb,$target) = @_; my $output = ''. ' '. ''.&mt('Post Discussion').''; return $output; } sub send_message_link { my ($ressymb) = @_; my $output = ''. ' '.&mt('Send Message').''; return $output; } sub action_links_bar { my ($colspan,$ressymb,$visible,$newpostsflag,$group,$prevread,$markondisp) = @_; my $discussion = ''. ''; my $escsymb=&escape($ressymb); if ($visible>2) { $discussion .= ''; if ($newpostsflag) { if (!$markondisp) { $discussion .=''; } } else { $discussion .= ''; } $discussion .= '
'. ''.&mt('Threaded View').'  '. ''.&mt('Chronological View').'   '.&mt('Sorting/Filtering options').'  '; } else { $discussion .= ''; } $discussion .=''.&mt('Export').'?  '. &mt('Preferences on what is marked as NEW'). '
'.&mt('Mark NEW posts no longer new').''; } else { $discussion .= '
  
'; return $discussion; } sub postingform_display { my ($mode,$ressymb,$now,$subject,$comment,$outputtarget,$attachnum, $currnewattach,$currdelold,$group) = @_; my $newattachmsg; my %lt = &Apache::lonlocal::texthash( 'note' => 'Note: in anonymous discussion, your name is visible only to course faculty', 'title' => 'Title', 'podi' => 'Post Discussion', 'poan' => 'Post Anonymous Discussion', 'newa' => 'New attachments', ); my $postingform = (<
$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(); } $postingform .= "\n"; if ($outputtarget ne 'tex') { $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,$prevread,$sortposts,$ressymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,$rolefilter,$sectionpick,$grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,$anonhash,$anoncnt,$group) = @_; my @original=(); my @index=(); my $skip_group_check = 0; my $symb=&Apache::lonenc::check_decrypt($ressymb); my $escsymb=&escape($ressymb); my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); if ((@{$grouppick} == 0) || (grep(/^all$/,@{$grouppick}))) { $skip_group_check = 1; } if ($contrib{'version'}) { my $oldest = $contrib{'1:timestamp'}; if ($prevread eq '0') { $prevread = $oldest-1; } my ($skiptest,$rolematch,$roleregexp,$secregexp,$statusregexp); if ($sortposts) { ($skiptest,$roleregexp,$secregexp,$statusregexp) = &filter_regexp($rolefilter,$sectionpick,$statusfilter); $rolematch = $roleregexp.':'.$secregexp.':'.$statusregexp; } for (my $id=1;$id<=$contrib{'version'};$id++) { my $idx=$id; my $posttime = $contrib{$idx.':timestamp'}; if ($prevread <= $posttime) { $$newpostsflag = 1; } my $hidden=($contrib{'hidden'}=~/\.$idx\./); my $studenthidden=($contrib{'studenthidden'}=~/\.$idx\./); my $deleted=($contrib{'deleted'}=~/\.$idx\./); my $origindex='0.'; my $numoldver=0; if ($contrib{$idx.':replyto'}) { if ( (($env{'environment.threadeddiscussion'}) && ($sortposts eq '')) || ($sortposts eq 'thread') || ($outputtarget eq 'export')) { # this is a follow-up message $original[$idx]=$original[$contrib{$idx.':replyto'}]; $$depth[$idx]=$$depth[$contrib{$idx.':replyto'}]+1; $origindex=$index[$contrib{$idx.':replyto'}]; if ($$depth[$idx]>$$maxdepth) { $$maxdepth=$$depth[$idx]; } } else { $original[$idx]=0; $$depth[$idx]=0; } } else { # this is an original message $original[$idx]=0; $$depth[$idx]=0; } if ($$replies[$$depth[$idx]]) { $$replies[$$depth[$idx]]++; } else { $$replies[$$depth[$idx]]=1; } unless ((($hidden) && (!$seeid)) || ($deleted)) { $$visible++; if ($contrib{$idx.':history'}) { if ($contrib{$idx.':history'} =~ /:/) { my @oldversions = split(/:/,$contrib{$idx.':history'}); $numoldver = @oldversions; } else { $numoldver = 1; } } $$current = $numoldver; my %messages = (); my %subjects = (); my %attachtxt = (); my %allattachments = (); my ($screenname,$plainname); my $sender = &mt('Anonymous'); # Anonymous users getting number within a discussion # Since idx is in static order, this should give the same sequence every time. my $key=$contrib{$idx.':sendername'}.'@'.$contrib{$idx.':senderdomain'}; unless ($$anonhash{$key}) { $anoncnt++; $$anonhash{$key}=&mt('Anonymous').' '.$anoncnt; } my ($message,$subject,$vgrlink,$ctlink); &get_post_contents(\%contrib,$idx,$seeid,$outputtarget,\%messages,\%subjects,\%allattachments,\%attachtxt,$imsfiles,\$screenname,\$plainname,$numoldver); # Set up for sorting by subject unless ($outputtarget eq 'export') { $message=$messages{$numoldver}; $message.=$attachtxt{$numoldver}; $subject=$subjects{$numoldver}; if ($message) { if ($hidden) { $message=''.$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'}) || (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { $sender=&Apache::loncommon::aboutmewrapper( $plainname, $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}).' ('. $contrib{$idx.':sendername'}.' at '. $contrib{$idx.':senderdomain'}.')'; if ($contrib{$idx.':anonymous'}) { $sender.=' ['.$$anonhash{$key}.'] '. $screenname; } $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::lonnet::get('environment', ['firstname','lastname'],$contrib{$idx.':senderdomain'}, ,$contrib{$idx.':sendername'}); my $lastname = $names{'lastname'}; my $firstname = $names{'firstname'}; if ($lastname eq '') { $lastname = '_'; } if ($firstname eq '') { $firstname = '_'; } unless (defined($$namesort{$lastname})) { %{$$namesort{$lastname}} = (); } if (defined($$namesort{$lastname}{$firstname})) { push(@{$$namesort{$lastname}{$firstname}}, $idx); } else { @{$$namesort{$lastname}{$firstname}} = ("$idx"); } if (&editing_allowed($escsymb.':::'.$idx,$group)) { if (($env{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($env{'user.name'} eq $contrib{$idx.':sendername'})) { $sender.=' '.&mt('Edit').''; unless ($seeid) { my $grpargs = &group_args($group); $sender.=" '; } } } if ($seeid) { if ($hidden) { unless ($studenthidden) { $sender.=' '.&mt('Make Visible').''; } } else { $sender.=' '.&mt('Hide').''; } my $grpargs = &group_args($group); $sender.= " "; $sender .= &mt('Delete').''; } } else { if ($screenname) { $sender=''.$screenname.''; } else { $sender=''.$$anonhash{$key}.''; } # Set up for sorting by domain, then username for anonymous unless (defined($$usernamesort{'__anon'})) { %{$$usernamesort{'__anon'}} = (); } if (defined($$usernamesort{'__anon'}{'__anon'})) { push(@{$$usernamesort{'__anon'}{'__anon'}}, $idx); } else { @{$$usernamesort{'__anon'}{'__anon'}} = ("$idx"); } # Set up for sorting by last name, then first name for anonymous unless (defined($$namesort{'__anon'})) { %{$$namesort{'__anon'}} = (); } if (defined($$namesort{'__anon'}{'__anon'})) { push(@{$$namesort{'__anon'}{'__anon'}}, $idx); } else { @{$$namesort{'__anon'}{'__anon'}} = ("$idx"); } } if (&discussion_open($status)) { if (($group ne '') && (&check_group_priv($group,'pgd') eq 'ok')) { $sender.=' '.&mt('Reply').''; } elsif (&Apache::lonnet::allowed('pch', $env{'request.course.id'}. ($env{'request.course.sec'}?'/'. $env{'request.course.sec'}:''))) { $sender.=' '.&mt('Reply').''; } } if ($viewgrades) { $vgrlink=&Apache::loncommon::submlink('Submissions', $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$ressymb); } if ($$dischash{$readkey}=~/\.$idx\./) { $ctlink = ''; } else { $ctlink = ''; } } #figure out at what position this needs to print } if ($outputtarget eq 'export' || $message) { my $thisindex=$idx; if ( (($env{'environment.threadeddiscussion'}) && ($sortposts eq '')) || ($sortposts eq 'thread') || ($outputtarget eq 'export')) { $thisindex=$origindex.substr('00'.$$replies[$$depth[$idx]],-2,2); } $$alldiscussion{$thisindex}=$idx; $$shown{$idx} = 0; $index[$idx]=$thisindex; } if ($outputtarget eq 'export') { %{$$imsitems{$idx}} = (); $$imsitems{$idx}{'isvisible'}='true'; if ($hidden) { $$imsitems{$idx}{'isvisible'}='false'; } $$imsitems{$idx}{'title'}=$subjects{$numoldver}; $$imsitems{$idx}{'message'}=$messages{$numoldver}; $$imsitems{$idx}{'attach'}=$attachtxt{$numoldver}; $$imsitems{$idx}{'timestamp'}=$contrib{$idx.':timestamp'}; $$imsitems{$idx}{'sender'}=$plainname.' ('. $contrib{$idx.':sendername'}.' at '. $contrib{$idx.':senderdomain'}.')'; $$imsitems{$idx}{'isanonymous'}='false'; if ($contrib{$idx.':anonymous'}) { $$imsitems{$idx}{'isanonymous'}='true'; } $$imsitems{$idx}{'currversion'}=$numoldver; %{$$imsitems{$idx}{'allattachments'}}=%allattachments; unless ($messages{$numoldver} eq '' && $attachtxt{$numoldver} eq '') { $$shown{$idx} = 1; } } else { if ($message) { my $spansize = 2; if ($showonlyunread && $prevread > $posttime) { $$notshown{$idx} = 1; } elsif ($showunmark && $$dischash{$readkey}=~/\.$idx\./) { $$notshown{$idx} = 1; } else { # apply filters my $uname = $contrib{$idx.':sendername'}; my $udom = $contrib{$idx.':senderdomain'}; my $poster = $uname.':'.$udom; if ($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] .= '

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

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

'. $message.'

'; if ($contrib{$idx.':history'}) { my @postversions = (); $$discussionitems[$idx] .= &mt('This post has been edited by the author.'); if ($seeid) { $$discussionitems[$idx] .= '  '.&mt('Display all versions').''; } $$discussionitems[$idx].='
'.&mt('Earlier version(s) were posted on: '); if ($contrib{$idx.':history'} =~ m/:/) { @postversions = split(/:/,$contrib{$idx.':history'}); } else { @postversions = ("$contrib{$idx.':history'}"); } for (my $i=0; $i<@postversions; $i++) { my $version = $i+1; $$discussionitems[$idx] .= ''.$version.'. - '.&Apache::lonlocal::locallocaltime($postversions[$i]).' '; } } } } } } } } } sub filter_regexp { my ($rolefilter,$sectionpick,$statusfilter) = @_; my ($roleregexp,$secregexp,$statusregexp); my $skiptest = 1; if (@{$rolefilter} > 0) { my @okrolefilter = (); foreach my $role (@{$rolefilter}) { unless ($role eq '') { push(@okrolefilter, $role); } } if (@okrolefilter > 0) { if (grep/^all$/,@okrolefilter) { $roleregexp='[^:]+'; } else { if (@okrolefilter == 1) { $roleregexp=$okrolefilter[0]; } else { $roleregexp='('.join('|',@okrolefilter).')'; } $skiptest = 0; } } } if (@{$sectionpick} > 0) { my @oksectionpick = (); foreach my $sec (@{$sectionpick}) { unless ($sec eq '') { push(@oksectionpick, $sec); } } if ((@oksectionpick > 0) && (!grep/^all$/,@oksectionpick)) { if (@oksectionpick == 1) { $secregexp = $oksectionpick[0]; } else { $secregexp .= '('.join('|',@oksectionpick).')'; } $skiptest = 0; } else { $secregexp .= '[^:]*'; } } if (defined($statusfilter) && $statusfilter ne '') { if ($statusfilter eq 'all') { $statusregexp = '[^:]+'; } else { $statusregexp = $statusfilter; $skiptest = 0; } } return ($skiptest,$roleregexp,$secregexp,$statusregexp); } sub get_post_contents { my ($contrib,$idx,$seeid,$type,$messages,$subjects,$allattachments,$attachtxt,$imsfiles,$screenname,$plainname,$numver) = @_; my $discussion = ''; my $start=$numver; my $end=$numver + 1; %{$$imsfiles{$idx}}=(); if ($type eq 'allversions') { unless($seeid) { $discussion=&mt('You do not have privileges to view all versions of posts.').' '.&mt('Please select a different role.'); return $discussion; } } # $$screenname=&Apache::loncommon::screenname( # $$contrib{$idx.':sendername'}, # $$contrib{$idx.':senderdomain'}); $$plainname=&Apache::loncommon::nickname( $$contrib{$idx.':sendername'}, $$contrib{$idx.':senderdomain'}); $$screenname=$$contrib{$idx.':screenname'}; my $sender=&Apache::loncommon::aboutmewrapper( $$plainname, $$contrib{$idx.':sendername'}, $$contrib{$idx.':senderdomain'}).' ('. $$contrib{$idx.':sendername'}.' at '. $$contrib{$idx.':senderdomain'}.')'; my $attachmenturls = $$contrib{$idx.':attachmenturl'}; my @postversions = (); if ($type eq 'allversions' || $type eq 'export') { $start = 0; if ($$contrib{$idx.':history'}) { @postversions = split(/:/,$$contrib{$idx.':history'}); } &get_post_versions($messages,$$contrib{$idx.':message'},1); &get_post_versions($subjects,$$contrib{$idx.':subject'},1); push(@postversions,$$contrib{$idx.':timestamp'}); $end = @postversions; } else { &get_post_versions($messages,$$contrib{$idx.':message'},1,$numver); &get_post_versions($subjects,$$contrib{$idx.':subject'},1,$numver); } if ($$contrib{$idx.':anonymous'}) { $sender.=' ['.&mt('anonymous').'] '.$$screenname; } if ($type eq 'allversions') { $discussion=(''.$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) = @_; if (exists($env{'form.origpage'})) { &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','currnewattach','addnewattach','deloldattach','delnewattach','timestamp','idx','anondiscuss','discuss','blog','group','ref']); } my %lt = &Apache::lonlocal::texthash( 'plch' => 'Please check at least one of the following feedback types:', 'myqu' => 'My question/comment/feedback:', 'title' => 'Title', 'reta' => 'Retained attachments', 'atta' => 'Attachment (128 KB max size)', ); my $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 = (); &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); $quote = $msgversions{$numoldver}; } if ($idx > 0) { my %subversions = (); &get_post_versions(\%subversions,$contrib{$idx.':subject'},1,$numoldver); $subject = &mt('Re: ').$subversions{$numoldver}; } $subject = &HTML::Entities::encode($subject,'<>&"'); } else { $attachmenturls = $contrib{$idx.':attachmenturl'}; if ($idx > 0) { my %msgversions = (); &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); $comment = $msgversions{$numoldver}; my %subversions = (); &get_post_versions(\%subversions,$contrib{$idx.':subject'},0,$numoldver); $subject = $subversions{$numoldver}; } if (defined($contrib{$idx.':replyto'})) { $parentmsg = $contrib{$idx.':replyto'}; } unless (exists($env{'form.origpage'})) { my $anonflag = 'nonanon'; if ($contrib{$idx.':anonymous'}) { $anonflag = 'anon'; } $anonscript = (<'; } } if ($env{'form.origpage'}) { $subject = &unescape($env{'form.subject'}); $comment = &unescape($env{'form.comment'}); &process_attachments(\@currnewattach,\@currdelold,\@keepold); } my $latexHelp=&Apache::loncommon::helpLatexCheatsheet(); my $send=&mt('Send'); my $alert = &mt('Please select a feedback type.'); my $js= < // END my %onload = ('onload' => 'window.focus();setposttype();'); my $start_page= &Apache::loncommon::start_page('Resource Feedback and Discussion',$js, {'add_entries' => \%onload}); if ($quote ne '') { &newline_to_br(\$quote); $quote='
'.&Apache::lontexconvert::msgtexconverted($quote).'
'; } $r->print(<$restitle
$prevtag END if ($env{'form.replydisc'}) { $r->print(< END } elsif ($env{'form.editdisc'}) { $r->print(< END } $r->print(< $quote

$lt{'myqu'}

$latexHelp $lt{'title'}:

END 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(<

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'); $r->print(&generate_attachments_button($postidx,$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,$numoldver,'',$blockblog)); 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_preview_button(). &Apache::lonhtmlcommon::htmlareaselectactive('comment'). &Apache::loncommon::end_page()); } sub print_display_options { my ($r,$symb,$previous,$dispchgA,$dispchgB,$markchg,$toggchg,$feedurl) = @_; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $function = &Apache::loncommon::get_users_function(); my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg', $env{'user.domain'}); my %lt = &Apache::lonlocal::texthash( 'pref' => 'Display Preference', 'curr' => 'Current setting ', 'actn' => 'Action', 'deff' => 'Default for all discussions', 'prca' => 'Preferences can be set for this discussion that determine ....', 'whpo' => 'Which posts are displayed when you display this bulletin board or resource, and', 'unwh' => 'Under what circumstances posts are identified as "NEW", and', 'wipa' => 'Whether individual posts can be marked as read/unread', 'allposts' => 'All posts', 'unread' => 'New posts only', 'unmark' => 'Posts not marked read', 'ondisp' => 'Once displayed', 'onmark' => 'Once marked not NEW ', 'toggon' => 'Shown', 'toggoff' => 'Not shown', 'disa' => 'Posts displayed?', 'npmr' => 'New posts cease to be identified as "NEW"?', 'dotm' => 'Option to mark each post as read/unread?', 'chgt' => 'Change to ', 'mkdf' => 'Set to ', 'yhni' => 'You have not indicated that you wish to change any of the discussion settings', 'ywbr' => 'You will be returned to the previous page if you click OK.' ); my $dispchangeA = $lt{'unread'}; my $dispchangeB = $lt{'unmark'}; my $markchange = $lt{'ondisp'}; my $toggchange = $lt{'toggon'}; my $currdisp = $lt{'allposts'}; my $currmark = $lt{'onmark'}; my $discdisp = 'allposts'; my $discmark = 'onmark'; my $currtogg = $lt{'toggoff'}; my $disctogg = 'toggoff'; if ($dispchgA eq 'allposts') { $dispchangeA = $lt{'allposts'}; $currdisp = $lt{'unread'}; $discdisp = 'unread'; } if ($markchg eq 'markonread') { $markchange = $lt{'onmark'}; $currmark = $lt{'ondisp'}; $discmark = 'ondisp'; } if ($dispchgB eq 'onlyunread') { $dispchangeB = $lt{'unread'}; $currdisp = $lt{'unmark'}; $discdisp = 'unmark'; } if ($toggchg eq 'toggoff') { $toggchange = $lt{'toggoff'}; $currtogg = $lt{'toggon'}; $disctogg = 'toggon'; } my $js = < function discdispChk(caller) { var disctogg = '$toggchg' if (caller == 0) { if (document.modifydisp.discdisp[0].checked == true) { if (document.modifydisp.discdisp[1].checked == true) { document.modifydisp.discdisp[1].checked = false } } } if (caller == 1) { if (document.modifydisp.discdisp[1].checked == true) { if (document.modifydisp.discdisp[0].checked == true) { document.modifydisp.discdisp[0].checked = false } if (disctogg == 'toggon') { document.modifydisp.disctogg.checked = true } if (disctogg == 'toggoff') { document.modifydisp.disctogg.checked = false } } } if (caller == 2) { var dispchgB = '$dispchgB' if (disctogg == 'toggoff') { if (document.modifydisp.disctogg.checked == true) { if (dispchgB == 'onlyunmark') { document.modifydisp.discdisp[1].checked = false } } } } } function setDisp() { var prev = "$previous" var chktotal = 0 if (document.modifydisp.discdisp[0].checked == true) { document.modifydisp.$dispchgA.value = "$symb" chktotal ++ } if (document.modifydisp.discdisp[1].checked == true) { document.modifydisp.$dispchgB.value = "$symb" chktotal ++ } if (document.modifydisp.discmark.checked == true) { document.modifydisp.$markchg.value = "$symb" chktotal ++ } if (document.modifydisp.disctogg.checked == true) { document.modifydisp.$toggchg.value = "$symb" chktotal ++ } if (chktotal > 0) { document.modifydisp.submit() } else { if(confirm("$lt{'yhni'}. \\n$lt{'ywbr'}")) { if (prev > 0) { location.href = "$feedurl?previous=$previous" } else { location.href = "$feedurl" } } } } 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 $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(); 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); 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 $crs='/'.$env{'request.course.id'}; if ($env{'request.course.sec'}) { $crs.='_'.$env{'request.course.sec'}; } $crs=~s/\_/\//g; my $seeid; my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my $group = $env{'form.group'}; my $ressymb = &wrap_symb($symb); if (($group ne '') && ($ressymb =~ m|^bulletin___ \d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$|)) { if (&check_group_priv($group,'dgp') eq 'ok') { $seeid = 1; } } else { $seeid=&Apache::lonnet::allowed('rin',$crs); } my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $cdom,$cnum); my %namesort = (); my %postcounts = (); my %lt = &Apache::lonlocal::texthash( sele => 'Select', full => 'Fullname', usdo => 'Username:domain', post => 'Posts', ); if ($contrib{'version'}) { for (my $idx=1;$idx<=$contrib{'version'};$idx++) { my $hidden=($contrib{'hidden'}=~/\.$idx\./); my $deleted=($contrib{'deleted'}=~/\.$idx\./); unless ((($hidden) && (!$seeid)) || ($deleted)) { if ((!$contrib{$idx.':anonymous'}) || (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { my %names = &Apache::lonnet::get('environment',['firstname','lastname'],$contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'}); my $lastname = $names{'lastname'}; my $firstname = $names{'firstname'}; if ($lastname eq '') { $lastname = '_'; } if ($firstname eq '') { $firstname = '_'; } unless (defined($namesort{$lastname})) { %{$namesort{$lastname}} = (); } my $poster = $contrib{$idx.':sendername'}.':'.$contrib{$idx.':senderdomain'}; $postcounts{$poster} ++; if (defined($namesort{$lastname}{$firstname})) { if (!grep/^$poster$/,@{$namesort{$lastname}{$firstname}}) { push(@{$namesort{$lastname}{$firstname}}, $poster); } } else { @{$namesort{$lastname}{$firstname}} = ("$poster"); } } } } } my $start_page = &Apache::loncommon::start_page('Discussion options'); my $table_start =&Apache::loncommon::start_data_table(); $r->print(<
$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) = @_; if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; my %lt = &Apache::lonlocal::texthash( 'sorr' => 'Sorry, no recipients ...', ); my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); $r->print(&Apache::loncommon::start_page('Feedback not sent',undef, {'redirect' => [2,$feedurl], 'only_body' => 1,})); $r->print(< $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) = @_; 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 .= '§ionpick='; $sectag .= ''; } else { $feedurl .= '§ionpick='.$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 %onload; if ($env{'environment.remote'} ne 'off') { $onload{'onload'} = "if (window.name!='loncapaclient') { this.document.reldt.submit(); self.window.close(); }"; } my $start_page= &Apache::loncommon::start_page('Feedback sent',undef, {'redirect' => [0,$feedurl], 'only_body' => 1, 'add_entries' => \%onload}); my $end_page = &Apache::loncommon::end_page(); $r->print(< $typestyle Sent $sendsomething message(s), and $sendposts post(s). $blog $status
$prevtag $sorttag $statustag $roletag $sectag $grptag $userpicktag $grouptag
$end_page ENDREDIR } sub no_redirect_back { my ($r,$feedurl) = @_; my $nofeed=&mt('Sorry, no feedback possible on this resource ...'); my %onload; if ($env{'environment.remote'} ne 'off') { $onload{'onload'} = "if (window.name!='loncapaclient') { self.window.close(); }"; } my %body_options = ('only_body' => 1, 'bgcolor' => '#FFFFFF', 'add_entries' => \%onload,); if ($feedurl !~ m{^/adm/feedback}) { $body_options{'rediect'} = [2,$feedurl]; } my $start_page= &Apache::loncommon::start_page('Feedback not sent',undef, \%body_options); my $end_page = &Apache::loncommon::end_page(); &Apache::lonenc::check_encrypt(\$feedurl); my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); $r->print (< $nofeed
$end_page ENDNOREDIRTWO } sub screen_header { my ($feedurl,$symb) = @_; my $msgoptions=''; my $discussoptions=''; unless (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/) && ($env{'user.adv'})) { $msgoptions= '

'; } my %optionhash=(); foreach my $type ('question','comment','policy') { $optionhash{$type}=$env{'course.'.$env{'request.course.id'}.'.'.$type.'.email.text'}; } if (&feedback_available(1)) { $msgoptions.= '

'; } if (&feedback_available(0,1)) { $msgoptions.= '

'; } if (&feedback_available(0,0,1)) { $msgoptions.= '

'; } } if (($env{'request.course.id'}) && (!$env{'form.sendmessageonly'})) { my ($blocked,$blocktext) = &Apache::loncommon::blocking_status('boards'); if (!$blocked && &discussion_open(undef,$symb) && &Apache::lonnet::allowed('pch', $env{'request.course.id'}. ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { $discussoptions='
'. ''.&mt('Change Screenname').''; my $blockblog = &Apache::loncommon::blocking_status('blogs'); if (!$blockblog) { $discussoptions.= &add_blog_checkbox(); } } } if ($msgoptions) { $msgoptions='

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

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

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

'.$discussoptions; } return $msgoptions.$discussoptions; } 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,$ignore_htmlarea)=@_; if (!$ignore_htmlarea && !&Apache::lonhtmlcommon::htmlareablocked()) { return $message; } # 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