--- loncom/interface/lonfeedback.pm 2012/03/06 21:24:01 1.290.2.7.2.1
+++ loncom/interface/lonfeedback.pm 2012/03/09 15:09:39 1.290.2.7.2.3
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Feedback
#
-# $Id: lonfeedback.pm,v 1.290.2.7.2.1 2012/03/06 21:24:01 raeburn Exp $
+# $Id: lonfeedback.pm,v 1.290.2.7.2.3 2012/03/09 15:09:39 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -777,6 +777,17 @@ END
return $discussion;
}
+sub discussion_link {
+ my ($ressymb,$linktext,$cmd,$item,$flag,$prev,$adds,$title) = @_;
+ my $link = '';
+ return $link;
+}
+
sub send_feedback_link {
my ($ressymb,$target) = @_;
my $output = ''.
@@ -933,10 +944,22 @@ 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=();
+# Hashes containing likes and unlikes for this user.
+ my %userlikes=();
+ my %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'}:''));
@@ -966,7 +989,54 @@ 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'})) {
+ 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
+ my $oneplus=$ave+$stddev;
+ my $twoplus=$ave+2.*$stddev;
+ my $oneminus=$ave-$stddev;
+ my $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'});
@@ -999,7 +1069,7 @@ sub build_posting_display {
} else {
$$replies[$$depth[$idx]]=1;
}
- unless ((($hiddens{$idx}) && (!$seeid)) || ($deletions{$idx})) {
+ unless ((($hiddens{$idx}) && (!$seeid)) || ($deletions{$idx})) {
$$visible++;
if ($contrib{$idx.':history'}) {
if ($contrib{$idx.':history'} =~ /:/) {
@@ -1317,8 +1387,41 @@ sub build_posting_display {
$$discussionitems[$idx].='| '.
$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";
+ }
+# Actually glue in the message itself
$$discussionitems[$idx].= ''.
- $message.'
';
+ "".
+ $message.
+ '
';
+# Put in the like and unlike buttons
+ if ($userlikes{$idx}) {
+ $$discussionitems[$idx].='
';
+ } else {
+ $$discussionitems[$idx].=' '.&discussion_link($symb,'
','like',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Like this posting"));
+ }
+ if ($userunlikes{$idx}) {
+ $$discussionitems[$idx].='
';
+ } else {
+ $$discussionitems[$idx].=' '.&discussion_link($symb,'
','unlike',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Unlike this posting"));
+ }
+ 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 ($contrib{$idx.':history'}) {
my @postversions = ();
$$discussionitems[$idx] .= &mt('This post has been edited by the author.');
@@ -1426,12 +1529,12 @@ sub get_post_contents {
my $sender = $$plainname;
if ($$showaboutme) {
$sender = &Apache::loncommon::aboutmewrapper(
- $$plainname,
- $$contrib{$idx.':sendername'},
- $$contrib{$idx.':senderdomain'});
+ $$plainname,
+ $$contrib{$idx.':sendername'},
+ $$contrib{$idx.':senderdomain'});
}
if ($seeid) {
- $sender .= ' ('. $$contrib{$idx.':sendername'}.':'.
+ $sender .= ' ('.$$contrib{$idx.':sendername'}.':'.
$$contrib{$idx.':senderdomain'}.')';
}
my $attachmenturls = $$contrib{$idx.':attachmenturl'};
@@ -2855,6 +2958,26 @@ sub send_msg {
return ($status,$sendsomething);
}
+# 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='';
@@ -2953,7 +3076,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=();
@@ -2968,6 +3091,41 @@ 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;
+}
+
+# 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);
+ return $status;
+}
+
sub get_discussion_info {
my ($idx,%contrib) = @_;
my $changelast = 0;
@@ -3494,7 +3652,7 @@ sub handler {
# --------------------------- Get query string for limited number of parameters
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
- ['hide','unhide','deldisc','postdata','preview','replydisc','editdisc','cmd','symb','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navtime','navmaps','navurl','sortposts','applysort','rolefilter','statusfilter','sectionpick','groupick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export','sendmessageonly','group','ref']);
+ ['like','unlike','hide','unhide','deldisc','postdata','preview','replydisc','editdisc','cmd','symb','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navtime','navmaps','navurl','sortposts','applysort','rolefilter','statusfilter','sectionpick','groupick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export','sendmessageonly','group','ref']);
my $group = $env{'form.group'};
my %attachmax = (
text => &mt('(128 KB max size)'),
@@ -3772,6 +3930,100 @@ 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 current like or unlike status for the $idx for this user.
+ my $thisuser=$env{'user.name'}.':'.$env{'user.domain'};
+ my ($userlikes,$userunlikes);
+ if (ref($contrib{$prefix.'likers'}) eq 'HASH') {
+ if (exists($contrib{$prefix.'likers'}{$thisuser})) {
+ $userlikes = 1;
+ }
+ }
+ if (ref($contrib{$prefix.'unlikers'}) eq 'HASH') {
+ if (exists($contrib{$prefix.'unlikers'}{$thisuser})) {
+ $userunlikes = 1;
+ }
+ }
+
+# 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 ($userlikes) {
+ $alreadyflag=1;
+ } elsif ($userunlikes) {
+ delete($contrib{$prefix.'unlikers'}{$thisuser});
+ $likes++;
+ } else {
+ if (ref($contrib{$prefix.'likers'}) eq 'HASH') {
+ $contrib{$prefix.'likers'}{$thisuser} = 1;
+ } else {
+ $contrib{$prefix.'likers'} = {$thisuser => 1};
+ }
+ $likes++;
+ }
+ } else {
+ if ($userunlikes) {
+ $alreadyflag=1;
+ } elsif ($userlikes) {
+ delete($contrib{$prefix.'likers'}{$thisuser});
+ $likes--;
+ } else {
+ if (ref($contrib{$prefix.'unlikers'}) eq 'HASH') {
+ $contrib{$prefix.'unlikers'}{$thisuser} = 1;
+ } else {
+ $contrib{$prefix.'unlikers'} = {$thisuser => 1};
+ }
+ $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' => $contrib{$prefix.'likers'},
+ $prefix.'unlikers' => $contrib{$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");
+ }
+ }
+ &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') {
@@ -3983,6 +4235,7 @@ ENDREDIR
$override = 1;
}
my $message=&clear_out_html($env{'form.comment'},$override);
+
# Assemble email
my ($email,$citations)=&assemble_email($message,$prevattempts,