--- loncom/interface/lonfeedback.pm	2012/01/04 00:08:29	1.316
+++ loncom/interface/lonfeedback.pm	2012/01/07 03:01:11	1.327
@@ -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.327 2012/01/07 03:01:11 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -296,8 +296,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 +502,7 @@ imscp_v1p1.xsd http://www.imsglobal.org/
 	        my $thisdepth=$depth[$alldiscussion{$post}];
                 if ($outputtarget ne 'tex' && $outputtarget ne 'export') {
 		    for (1..$thisdepth) {
-			$discussion.='<td>&nbsp;&nbsp;&nbsp;</td>';
+			$discussion.='<td>&nbsp;&nbsp;&nbsp;&nbsp;</td>';
 		    }
 		}
 	        my $colspan=$maxdepth-$thisdepth+1;
@@ -765,7 +763,13 @@ sub discussion_link {
    my $link='/adm/feedback?inhibitmenu=yes&modal=yes&'.$cmd.'='.&escape($ressymb).':::'.$item;
    if ($flag) { $link .= '&amp;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);
 }
 
 
@@ -823,7 +827,17 @@ sub action_links_bar {
         $discussion .= '&amp;previous='.$prevread;
     }
     $discussion .= &group_args($group);
-    $discussion .= '">'.&mt('Export').'</a></td>';
+    $discussion .= '">'.&mt('Export').'</a>';
+    if (&Apache::lonnet::allowed('rin',$env{'request.course.id'})) {
+        $discussion .= '&nbsp;&nbsp;';
+        $discussion .='<a href="/adm/feedback?undeleteall='.$escsymb;
+        if ($newpostsflag) {
+            $discussion .= '&amp;previous='.$prevread;
+        }
+        $discussion .= &group_args($group);
+        $discussion .= '">'.&mt('Undelete all deleted entries').'</a>';
+    }
+    $discussion.='</td>';
     if ($newpostsflag) {
         if (!$markondisp) {
             $discussion .='<td class="LC_disc_action_right"><a href="/adm/preferences?action=changediscussions';
@@ -927,16 +941,26 @@ sub build_posting_display {
     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'});
-
+# And these are the likes/unlikes
+    my %likes=&Apache::lonnet::dump('disclikes',
+                          $env{'course.'.$env{'request.course.id'}.'.domain'},
+                          $env{'course.'.$env{'request.course.id'}.'.num'},
+                          '^'.$symb.':');
+    my $thisuser=$env{'user.name'}.':'.$env{'user.domain'};
+# Array with likes to figure out averages, etc.
+    my @theselikes=();
+# 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 +974,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 +985,48 @@ sub build_posting_display {
             ($skiptest,$roleregexp,$secregexp,$statusregexp) = 
                      &filter_regexp($rolefilter,$sectionpick,$statusfilter);
             $rolematch = $roleregexp.':'.$secregexp.':'.$statusregexp;
-        } 
+        }
+# 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'})) {
+                push(@theselikes,$likes{$symb.':'.$idx.':likes'});
+            }
+        }
+# 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
+        my $oneplus=$ave+$stddev;
+        my $twoplus=$ave+2.*$stddev;
+        my $oneminus=$ave-$stddev;
+        my $twominus=$ave-2.*$stddev;
+#            &Apache::lonnet::logthis(join(',',@theselikes)." Ave $ave StdDev $stddev $twominus $oneminus $oneplus $twoplus");
+#
+# 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;
@@ -1092,6 +1154,18 @@ sub build_posting_display {
                                 @{$$namesort{$lastname}{$firstname}} = ("$idx");
                             }
                             if ($outputtarget ne 'tex') {
+                                unless ($likes{$symb.':'.$idx.':likers'}=~/\,\Q$thisuser\E\,/) {
+                                    $sender.='&nbsp;'.&discussion_link($symb,&mt('Like'),'like',$idx,$$newpostsflag,$prevread,&group_args($group));
+                                }
+                                unless ($likes{$symb.':'.$idx.':unlikers'}=~/\,\Q$thisuser\E\,/) {
+                                    $sender.='&nbsp;'.&discussion_link($symb,&mt('Unlike'),'unlike',$idx,$$newpostsflag,$prevread,&group_args($group));
+                                }
+                                my $thislikes=$likes{$symb.':'.$idx.':likes'};
+                                if ($thislikes>0) { 
+                                    $sender.='&nbsp;('.&mt("[_1] likes",$thislikes).')';
+                                } elsif ($thislikes<0) {
+                                    $sender.='&nbsp;('.&mt("[_1] unlikes",abs($thislikes)).')';
+                                }
                                 if (&editing_allowed($escsymb.':::'.$idx,$group)) {
                                     if (($env{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($env{'user.name'} eq $contrib{$idx.':sendername'})) {
                                         $sender.=' '.
@@ -1274,8 +1348,23 @@ sub build_posting_display {
                             if ($$dischash{$toggkey}) {
                                 $$discussionitems[$idx].='&nbsp;&nbsp;'.$ctlink;
                             }
+# Figure out size based on likes
+                            my $thislikes=$likes{$symb.':'.$idx.':likes'};
+                            my $likesize="100";
+                            if ($thislikes>$twoplus) {
+                                $likesize="200";
+                            } elsif ($thislikes>$oneplus) {
+                                $likesize="150";
+                            }
+                            if ($thislikes<$twominus) {
+                                $likesize="50";
+                            } elsif ($thislikes<$oneminus) {
+                                $likesize="75";
+                            }
                             $$discussionitems[$idx].= '<br /><blockquote>'.
-                                    $message.'</blockquote>';
+                                    "<div style='font-size:$likesize%'>".
+                                    $message.
+                                    '</div></blockquote>';
                             if ($contrib{$idx.':history'}) {
                                 my @postversions = ();
                                 $$discussionitems[$idx] .= &mt('This post has been edited by the author.');
@@ -1294,12 +1383,19 @@ sub build_posting_display {
                                     $$discussionitems[$idx] .= '<b>'.$version.'.</b> - '.&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 {
@@ -2789,21 +2885,78 @@ 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.='<br />'.&mt('Not registered').'<br />';
-	}
+# 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.='<br />'.&mt('Not registered').'<br />';
+	    }
+        }
     }
-    
     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');
+}
+
+# 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');
+}
+
+
 sub adddiscuss {
     my ($symb,$email,$anon,$attachmenturl,$subject,$group)=@_;
     my $status='';
@@ -2902,7 +3055,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=();
@@ -2917,6 +3070,60 @@ sub adddiscuss {
     return $status.'<br />';   
 }
 
+
+# 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'});
+}
+
+
+# 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');
+}
+
+# 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'};
+    $totallikes+=$likes;
+    my %newrecord=('likes_user'   => $env{'user.name'},
+                   'likes_domain' => $env{'user.domain'},
+                   'likes' => $likes,
+                   'totallikes' => $totallikes);
+    return &Apache::lonnet::cstore(\%newrecord,'_discussion');
+}
+
 sub get_discussion_info {
     my ($idx,%contrib) = @_;
     my $changelast = 0;
@@ -3445,7 +3652,7 @@ sub handler {
 # --------------------------- Get query string for limited number of parameters
 
   &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
-         ['modal','hide','unhide','deldisc','postdata','preview','replydisc','editdisc','cmd','symb','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navtime','navmaps','navurl','sortposts','applysort','rolefilter','statusfilter','sectionpick','groupick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export','sendmessageonly','group','ref']);
+         ['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 %attachmax = (
                     text => &mt('(128 KB max size)'),
@@ -3720,6 +3927,81 @@ ENDREDIR
 		     '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);
+#
+# 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 %contrib=&Apache::lonnet::dump('disclikes',
+                                        $env{'course.'.$env{'request.course.id'}.'.domain'},
+                                        $env{'course.'.$env{'request.course.id'}.'.num'},
+                                        '^'.$prefix);
+# Get all who like or unlike this
+      my $currentlikers=$contrib{$prefix.'likers'};
+      my $currentunlikers=$contrib{$prefix.'unlikers'};
+# Get the current "likes" count
+      my $likes=$contrib{$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 $thisuser=$env{'user.name'}.':'.$env{'user.domain'};
+      if ($env{'form.like'}) {
+          if ($currentlikers=~/\,\Q$thisuser\E\,/) {
+              $alreadyflag=1;
+          } else {
+              if ($currentunlikers=~/\,\Q$thisuser\E\,/) {
+                  $currentunlikers=~s/\,\Q$thisuser\E\,//g;
+              } else {
+                  $currentlikers.=','.$thisuser.',';
+              }
+              $likes++;
+          } 
+      } else {
+          if ($currentunlikers=~/\,\Q$thisuser\E\,/) {
+              $alreadyflag=1;
+          } else {
+              if ($currentlikers=~/\,\Q$thisuser\E\,/) {
+                  $currentlikers=~s/\,\Q$thisuser\E\,//g;
+              } else {
+                  $currentunlikers.=','.$thisuser.',';
+              }
+              $likes--;
+          } 
+      }
+      my $result;
+# $alreadyflag would be 1 if they tried to double-like or double-unlike
+      unless ($alreadyflag) {
+          my %newhash=($prefix.'likes'    => $likes,
+                       $prefix.'likers'   => $currentlikers,
+                       $prefix.'unlikers' => $currentunlikers);
+# 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");
+          }
+      }
+      &redirect_back($r,$feedurl,$result.'<br />',
+                     '0','0','','',$env{'form.previous'},undef,undef,undef,
+                     undef,undef,undef,$group);
+      return OK;
   } elsif ($env{'form.cmd'}=~/^(threadedoff|threadedon)$/) {
       my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'});
       if ($env{'form.cmd'} eq 'threadedon') {
@@ -3803,6 +4085,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("<br /><a href='$feedurl'>".&mt("Return and reload")."</a>");
+      }
+      $r->print(&Apache::loncommon::end_page());
+      return OK;
   } else {
 # ------------------------------------------------------------- Normal feedback
       my $feedurl=$env{'form.postdata'};