--- loncom/interface/lonfeedback.pm 2012/01/04 00:08:29 1.316 +++ loncom/interface/lonfeedback.pm 2012/03/15 21:55:13 1.344 @@ -1,7 +1,7 @@ # The LearningOnline Network # Feedback # -# $Id: lonfeedback.pm,v 1.316 2012/01/04 00:08:29 www Exp $ +# $Id: lonfeedback.pm,v 1.344 2012/03/15 21:55:13 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -82,6 +82,26 @@ sub discussion_visible { 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(); } @@ -265,6 +285,11 @@ sub list_discussion { } else { $seeid=&Apache::lonnet::allowed('rin',$crs); } + +# Is voting on discussions available + my $realsymb = &get_realsymb($ressymb); + my $canvote = &discussion_vote_available($status,$realsymb); + my @discussionitems=(); my %shown = (); my @posteridentity=(); @@ -286,7 +311,7 @@ sub list_discussion { $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,$readkey,$showunmark,$showonlyunread,$totposters,\@rolefilter,\@sectionpick,\@grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,\%anonhash,$anoncnt,$group); + &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,$canvote,$prevread,$sortposts,$encsymb,$readkey,$showunmark,$showonlyunread,$totposters,\@rolefilter,\@sectionpick,\@grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,\%anonhash,$anoncnt,$group); my $discussion=''; my $manifestfile; @@ -296,8 +321,6 @@ sub list_discussion { 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' => 'My settings for this discussion', 'allposts' => 'All posts', @@ -504,7 +527,7 @@ imscp_v1p1.xsd http://www.imsglobal.org/ my $thisdepth=$depth[$alldiscussion{$post}]; if ($outputtarget ne 'tex' && $outputtarget ne 'export') { for (1..$thisdepth) { - $discussion.='   '; + $discussion.='    '; } } my $colspan=$maxdepth-$thisdepth+1; @@ -746,9 +769,15 @@ END $discussion.= &send_feedback_link($ressymb); if ($env{'request.role.adv'}) { my $close = &Apache::lonnet::EXT('resource.0.discussend',$ressymb); + my $canvote = &Apache::lonnet::EXT('resource.0.discussvote',$ressymb); if (defined($close) && $close ne '' && $close < time) { - $discussion .= ' '.&mt('(Closed for [_1] roles)', - &Apache::lonnet::plaintext('st',$crstype)); + if ($canvote eq 'notended') { + $discussion .= ' '.&mt('(Posting and voting closed for [_1] roles)', + &Apache::lonnet::plaintext('st',$crstype)); + } else { + $discussion .= ' '.&mt('(Closed for [_1] roles)', + &Apache::lonnet::plaintext('st',$crstype)); + } } } } else { @@ -761,11 +790,17 @@ END sub discussion_link { - my ($ressymb,$linktext,$cmd,$item,$flag,$prev,$adds)=@_; + 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; } - return &Apache::loncommon::modal_link($link,$linktext,600,600); + 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); } @@ -783,10 +818,12 @@ sub send_feedback_link { sub send_message_link { my ($ressymb) = @_; my $output = ''. - ' '.&mt('Send Feedback').''; + &discussion_link($ressymb, + ''.&mt('Send Feedback').'', + 'sendmessageonly'). + ''; return $output; } @@ -823,7 +860,17 @@ sub action_links_bar { $discussion .= '&previous='.$prevread; } $discussion .= &group_args($group); - $discussion .= '">'.&mt('Export').''; + $discussion .= '">'.&mt('Export').''; + if (&Apache::lonnet::allowed('rin',$env{'request.course.id'})) { + $discussion .= '  '; + $discussion .=''.&mt('Undelete all deleted entries').''; + } + $discussion.=''; if ($newpostsflag) { if (!$markondisp) { $discussion .=' -
 + $lt{'note'}
-$lt{'title'}: 

+$lt{'title'}: 
ENDDISCUSS if ($env{'form.origpage'}) { @@ -921,22 +968,38 @@ ENDDISCUSS } 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,$readkey,$showunmark,$showonlyunread,$totposters,$rolefilter,$sectionpick,$grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,$anonhash,$anoncnt,$group) = @_; + my ($usernamesort,$subjectsort,$namesort,$notshown,$newitem,$dischash,$shown,$alldiscussion,$imsitems,$imsfiles,$roleinfo,$discussionitems,$replies,$depth,$posters,$maxdepth,$visible,$newpostsflag,$current,$status,$viewgrades,$seeid,$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'}; @@ -950,6 +1013,7 @@ sub build_posting_display { $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') { @@ -960,11 +1024,62 @@ sub build_posting_display { ($skiptest,$roleregexp,$secregexp,$statusregexp) = &filter_regexp($rolefilter,$sectionpick,$statusfilter); $rolematch = $roleregexp.':'.$secregexp.':'.$statusregexp; - } + } + 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}) && (!$seeid)) || ($deletions{$idx}) || (!$contrib{$idx.':message'})) { + if ($likes{$symb.':'.$idx.':likes'} ne '') { + push(@theselikes,$likes{$symb.':'.$idx.':likes'}); + 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; + } +# +# 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; @@ -1008,7 +1123,7 @@ sub build_posting_display { my %subjects = (); my %attachtxt = (); my %allattachments = (); - my ($screenname,$plainname); + 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. @@ -1018,7 +1133,7 @@ sub build_posting_display { $$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); + &get_post_contents(\%contrib,$idx,$seeid,$outputtarget,\%messages,\%subjects,\%allattachments,\%attachtxt,$imsfiles,\$screenname,\$plainname,\$showaboutme,$numoldver); # Set up for sorting by subject @@ -1048,12 +1163,18 @@ sub build_posting_display { } } if (!$contrib{$idx.':anonymous'} || $see_anonymous) { - $sender=&Apache::loncommon::aboutmewrapper( - $plainname, - $contrib{$idx.':sendername'}, - $contrib{$idx.':senderdomain'}).' ('. - $contrib{$idx.':sendername'}.':'. - $contrib{$idx.':senderdomain'}.')'; + 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}.'] '. @@ -1092,6 +1213,12 @@ sub build_posting_display { @{$$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.=' '. @@ -1274,11 +1401,52 @@ sub build_posting_display { if ($$dischash{$toggkey}) { $$discussionitems[$idx].='  '.$ctlink; } + my $thislikes=$likes{$symb.':'.$idx.':likes'}; + my $likesize="100"; + if ($seeid || $canvote) { +# Figure out size based on likes + my $thislikes=$likes{$symb.':'.$idx.':likes'}; + if ($thislikes>$twoplus) { + $likesize="200"; + } elsif ($thislikes>$oneplus) { + $likesize="150"; + } + if ($thislikes<$twominus) { + $likesize="50"; + } elsif ($thislikes<$oneminus) { + $likesize="75"; + } + } +# Actually glue in the message itself $$discussionitems[$idx].= '
'. - $message.'
'; + "
". + $message. + '
'; + if ($canvote) { +# Put in the like and unlike buttons + if ($userlikes{$idx}) { + $$discussionitems[$idx].=''.&mt('You like this posting').''; + } else { + $$discussionitems[$idx].=' '.&discussion_link($symb,''.&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($symb,''.&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.'); + $$discussionitems[$idx] .= '  '.&mt('This post has been edited by the author.'); if ($seeid) { $$discussionitems[$idx] .= '  '. &discussion_link($symb,&mt('Display all versions'),'allversions',$idx,$$newpostsflag,$prevread,&group_args($group)); @@ -1294,12 +1462,19 @@ sub build_posting_display { $$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 { @@ -1358,7 +1533,7 @@ sub filter_regexp { sub get_post_contents { - my ($contrib,$idx,$seeid,$type,$messages,$subjects,$allattachments,$attachtxt,$imsfiles,$screenname,$plainname,$numver) = @_; + my ($contrib,$idx,$seeid,$type,$messages,$subjects,$allattachments,$attachtxt,$imsfiles,$screenname,$plainname,$showaboutme,$numver) = @_; my $discussion = ''; my $start=$numver; my $end=$numver + 1; @@ -1376,13 +1551,20 @@ sub get_post_contents { $$contrib{$idx.':sendername'}, $$contrib{$idx.':senderdomain'}); $$screenname=$$contrib{$idx.':screenname'}; - - my $sender=&Apache::loncommon::aboutmewrapper( + $$showaboutme = &Apache::lonnet::usertools_access($$contrib{$idx.':sendername'}, + $$contrib{$idx.':senderdomain'}, + 'aboutme'); + my $sender = $$plainname; + if ($$showaboutme) { + $sender = &Apache::loncommon::aboutmewrapper( $$plainname, $$contrib{$idx.':sendername'}, - $$contrib{$idx.':senderdomain'}).' ('. - $$contrib{$idx.':sendername'}.':'. - $$contrib{$idx.':senderdomain'}.')'; + $$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') { @@ -1498,11 +1680,16 @@ sub mail_screen { } my %lt = &Apache::lonlocal::texthash( - 'myqu' => 'My question/comment/feedback:', + 'myqu' => 'Question/comment/feedback:', 'title' => 'Title', 'reta' => 'Retained attachments', 'atta' => 'Attachment', ); + if($env{'form.editdisc'} || $env{'form.replydisc'}){ + %lt = &Apache::lonlocal::texthash( + 'myqu' => 'Post Discussion', + ); + } my $restitle = &get_resource_title($caller_symb,$feedurl); my $quote=''; my $subject = ''; @@ -1713,6 +1900,7 @@ END } $r->print(<$lt{'myqu'} $header
@@ -1733,18 +1921,28 @@ END $r->print(<$lt{'myqu'} +

$textareaheader

+

$latexHelp

-$lt{'title'}:

-

-

END + + $r->print(&Apache::lonhtmlcommon::start_pick_box()); + $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) { @@ -2585,7 +2783,7 @@ sub no_redirect_back { 'add_entries' => \%onload,); if ($feedurl !~ m{^/adm/feedback}) { - $body_options{'rediect'} = [2,$feedurl]; + $body_options{'redirect'} = [2,$feedurl]; } my $start_page= &Apache::loncommon::start_page('Feedback not sent',undef, @@ -2627,8 +2825,8 @@ sub screen_header { 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') { @@ -2636,32 +2834,27 @@ sub screen_header { } 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'); my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $realsymb = $symb; - if ($symb=~/^bulletin___/) { - my $filename=(&Apache::lonnet::decode_symb($symb))[2]; - $filename=~s|^adm/wrapper/||; - $realsymb=&Apache::lonnet::symbread($filename); - } + my $realsymb = &get_realsymb($symb); if (!$blocked && &discussion_open(undef,$realsymb) && (&Apache::lonnet::allowed('pch', $env{'request.course.id'}. @@ -2789,30 +2982,82 @@ sub send_msg { } } - - my %record=&Apache::lonnet::restore('_feedback'); - my ($temp)=keys(%record); - unless ($temp=~/^error\:/) { - my %newrecord=(); - $newrecord{'resource'}=$feedurl; - $newrecord{'subnumber'}=$record{'subnumber'}+1; - unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') { - $status.='
'.&mt('Not registered').'
'; - } +# 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); } +# 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; - if ($symb=~/^bulletin___/) { - my $filename=(&Apache::lonnet::decode_symb($symb))[2]; - $filename=~s|^adm/wrapper/||; - $realsymb=&Apache::lonnet::symbread($filename); - } + my $realsymb = &get_realsymb($symb); my ($cnum,$cdom); if ($env{'request.course.id'}) { $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; @@ -2902,7 +3147,7 @@ sub adddiscuss { $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); } - my %record=&Apache::lonnet::restore('_discussion'); + my %record=&getdiscussionrecords(); my ($temp)=keys(%record); unless ($temp=~/^error\:/) { my %newrecord=(); @@ -2910,6 +3155,7 @@ sub adddiscuss { $newrecord{'subnumber'}=$record{'subnumber'}+1; $status.='
'.&mt('Registering').': '. &Apache::lonnet::cstore(\%newrecord,'_discussion'); + &updatekarma(); } } else { $status.='Failed.'; @@ -2917,6 +3163,110 @@ sub adddiscuss { 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(@_); + return ($record{'subnumber'},$record{'points'},$record{'totallikes'},$record{'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 ($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=&getdiscussionrecords($uname,$udom,$course); + my $totallikes=$record{'totallikes'}; + my $totalvotes=$record{'totalvotes'}; + $totallikes+=$likes; + $totalvotes++; + my %newrecord=('likes_user' => $env{'user.name'}, + 'likes_domain' => $env{'user.domain'}, + 'likes' => $likes, + 'totallikes' => $totallikes, + 'totalvotes' => $totalvotes); + 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; @@ -3062,11 +3412,11 @@ sub modify_attachments { my %lt = &Apache::lonlocal::texthash( 'subj' => 'Subject', - 'thfo' => 'The following attachments were part of the most recent saved version of this posting.', 'chth' => 'Check the checkboxes for any you wish to remove.', 'thef' => 'The following attachments have been uploaded for inclusion with this posting.', - 'adda' => 'Add a new attachment to this post.', + 'adda' => 'Add a new attachment to this post', 'stch' => 'Save Changes', + 'clic' => 'Add/remove attachments', ); my $js = < @@ -3080,7 +3430,7 @@ END # Breadcrumbs my $brcrum = [{'href' => '', 'text' => 'Discussion Post Attachments'}]; - my %parms=(); + my %parms=('only_body' => 1); if ($env{'form.modal'} ne 'yes') { 'bread_crumbs' => $brcrum } my $start_page = @@ -3109,44 +3459,42 @@ $start_page $toolarge
- - - - - - - - - -
- Subject: $subject

+

$lt{'clic'}

END - 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(&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("
"); } - $r->print("
"); } } - } - if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) { - $r->print($lt{'thef'}.'
'.$lt{'chth'}.'
'."\n"); - foreach my $attach (@{$currnewattach}) { - $attach =~ m#/([^/]+)$#; - $r->print('
'."\n"); + if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) { + $r->print($lt{'chth'}.'
'."\n"); + foreach my $attach (@{$currnewattach}) { + $attach =~ m#/([^/]+)$#; + $r->print('
'."\n"); + } } - $r->print("
"); } + $r->print(&Apache::lonhtmlcommon::row_closure(1)); + $r->print(&Apache::lonhtmlcommon::end_pick_box()); $r->print(<
- $lt{'adda'} -
$attachmaxtext
@@ -3204,12 +3552,12 @@ sub generate_attachments_button { my $origpage = $ENV{'REQUEST_URI'}; my $att=$attachnum.' '.&mt("attachments"); my %lt = &Apache::lonlocal::texthash( - 'clic' => 'Click to add/remove attachments', + 'clic' => 'Add/remove attachments', ); my $response = (< -$lt{'clic'}:  1}; + } + $likescount++; + } + } else { + if ($userunlikes) { + $alreadyflag=1; + } elsif ($userlikes) { + delete($likes{$prefix.'likers'}{$thisuser}); + $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 + unless ($alreadyflag) { + 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, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}) eq 'ok') { +# Also store with the person who posted the liked/unliked entry + if ($env{'form.like'}) { + &storediscussionlikes(1,$contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'}); + $result=&mt("Registered 'Like'"); + } else { + &storediscussionlikes(-1,$contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'}); + $result=&mt("Registered 'Unlike'"); + } + } else { +# Oops, something went wrong + $result=&mt("Failed to register vote"); + } + } + } else { + $result=&mt('Voting unavailable for this discussion'); + } + &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 'threadedon') { @@ -3803,6 +4257,24 @@ ENDREDIR &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'}); + $r->print(&Apache::loncommon::start_page('Undelete all deleted discussion entries')); + if (&Apache::lonnet::allowed('rin',$env{'request.course.id'})) { + if (&Apache::lonnet::store({'deleted' => ''},$symb,$env{'request.course.id'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}) eq 'ok') { + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt("Undeleted all entries"))); + } else { + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt("Failed to undelete entries"),1)); + } + $r->print("
".&mt("Return and reload").""); + } + $r->print(&Apache::loncommon::end_page()); + return OK; } else { # ------------------------------------------------------------- Normal feedback my $feedurl=$env{'form.postdata'}; @@ -3818,6 +4290,8 @@ ENDREDIR $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); } @@ -4149,6 +4623,10 @@ None =item discussion_visible() +=item discussion_vote_available() + +=item get_realsymb() + =item list_discussion() =item send_feedback_link()