[LON-CAPA-cvs] cvs: modules /gerd/harvesting lonrecommender.pm
droeschl
droeschl at source.lon-capa.org
Mon Aug 5 09:13:28 EDT 2013
droeschl Mon Aug 5 13:13:28 2013 EDT
Modified files:
/modules/gerd/harvesting lonrecommender.pm
Log:
Added: user suggestions for classification. Suggestions are stored in usersuggestion.db
Changed: user stays on the same page after adding a resource to the cart.
-------------- next part --------------
Index: modules/gerd/harvesting/lonrecommender.pm
diff -u modules/gerd/harvesting/lonrecommender.pm:1.36 modules/gerd/harvesting/lonrecommender.pm:1.37
--- modules/gerd/harvesting/lonrecommender.pm:1.36 Thu Aug 16 02:31:42 2012
+++ modules/gerd/harvesting/lonrecommender.pm Mon Aug 5 13:13:28 2013
@@ -5,7 +5,7 @@
#
# MODIFY $datapath VARIABLE FOR LOCATION OF DATA FILES
#
-# $Id: lonrecommender.pm,v 1.36 2012/08/16 02:31:42 www Exp $
+# $Id: lonrecommender.pm,v 1.37 2013/08/05 13:13:28 droeschl Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -58,13 +58,15 @@
use LONCAPA::map();
use GDBM_File;
use LONCAPA qw(:DEFAULT :match);
+use Time::HiRes qw(time);
# Logging
sub elog {
unless ($logfile) { return; }
open(OUT,">>$logfile");
- print OUT time.'&'.$env{'request.course.id'}.'&'.join('&', at _)."\n";
+ ( caller 1 )[3] =~ /::(\w+)$/ if ( caller 1 )[3];
+ print OUT time.'&'.($1?$1:caller).$env{'request.course.id'}.'&'.join('&', at _)."\n";
close(OUT);
return;
}
@@ -187,7 +189,7 @@
#
sub taxonomy_members {
- my (@which)=@_;
+ my (@which)=@_; # contains taxonomy labels, e.g. physics:mechanics:angularmomentum
my %taxcut;
my %lookup=();
my %level=();
@@ -204,7 +206,7 @@
foreach my $twhich (@which) {
my $tcat=$taxcut{$twhich};
if ($taxcut{$twhich}) {
- $lookup{$twhich}=$tcat;
+ $lookup{$twhich}=$tcat; # $lookup{physics:mechanics:angularmomentum} = 49
my @subcats=split(/\:/,$twhich);
$level{$twhich}=$#subcats+1;
if ($#subcats==0) {
@@ -405,7 +407,7 @@
$output{$url}=$hash{$url};
}
untie(%hash);
- return(%output);
+ return %output;
}
# =================================================================================
@@ -501,8 +503,8 @@
sub edit_commands {
my ($cmd, at urls)=@_;
my ($action,$which)=split(/\:/,$cmd);
- if ($action eq 'add') {
- push(@urls,$which);
+ if ($action =~ /^add(indiv)?/) {
+ push(@urls,$which) unless grep { $_ eq $which } @urls;
} elsif ($action eq 'rem') {
my @newurls=();
foreach my $url (@urls) {
@@ -575,10 +577,18 @@
sub display_line {
my ($url,$taxocats,$taxonomy,$editflag)=@_;
+ #my $time = time;
unless ((&Apache::lonnet::allowed('bre',$url)) ||
- (&Apache::lonnet::allowed('bro',$url))) { return ''; }
+ (&Apache::lonnet::allowed('bro',$url))) { #return ''; }
+ #$time = sprintf("%.2f", time - $time);
+ return "\n". Apache::loncommon::start_data_table_row().
+ #"<th></th><td>FORBIDDEN: $time</td>".Apache::loncommon::end_data_table_row()."\n";
+ "<th></th>".Apache::loncommon::end_data_table_row()."\n";
+ }
+ #$time = sprintf("%.2f", time - $time);
return "\n".&Apache::loncommon::start_data_table_row().'<th>'.
&submit_link(($editflag?'Remove':'Add'),($editflag?'rem:':'add:').$url).
+ #"</th><td>$time</td><td>".
"</th><td>".
&submit_link(&Apache::lonnet::gettitle($url),'indiv:'.$url).
"</td><td>".
@@ -884,7 +894,7 @@
my $lower=$1;
unless ($lower) { $lower=0; }
# ------ ... and execute any editing commands
- if ($cmd=~/^(add|rem)\:/) {
+ if ($cmd=~/^(add(indiv)?|rem)\:/) {
@selectedurls=&edit_commands($cmd, at selectedurls);
&write_groupimportfile(@selectedurls);
}
@@ -908,7 +918,7 @@
# ------ Make header row
my $searchterm=$env{'form.searchterm'};
$searchterm=~s/[\"\']//gs;
- if ($cmd ne 'search') { $searchterm=''; }
+ if ($cmd ne 'search' && $cmd !~ /^add\:/) { $searchterm=''; }
$r->print(&Apache::loncommon::start_data_table().'<tr>');
$r->print("<th>".&mt('Search by Keyword')."</th>".
"<td><input type='text' size='40' name='searchterm' value='$searchterm'".
@@ -924,28 +934,66 @@
$r->print("<th>".&mt("Filter Lists").'</th><td>'.&filter_menu($filter)."</td>");
$r->print("\n</tr>".&Apache::loncommon::end_data_table());
# ------ End header row
- if (($cmd eq 'showbasket') || ($cmd=~/^(add|rem)\:/)) {
+
+ if (($cmd eq 'showbasket') || ($cmd=~/^rem\:/)) {
$r->print("\n<h1>".&mt("Current Cart")."</h1>\n");
&display_list($r,1,\%taxonomy_categories, at selectedurls);
&display($r,\%taxonomy_categories,\%selectedids,$filter,$lower,20,&associated(values(%selectedids)));
- } elsif ($cmd eq 'search') {
+ } elsif ($cmd eq 'search' || $cmd =~ /^add\:/ && $env{'form.searchterm'}) {
$r->print('<p>'.&mt('Searching for [_1] ...',$env{'form.searchterm'}).'</p>');
$r->rflush();
&display($r,\%taxonomy_categories,\%selectedids,$filter,$lower,20,&keyword_search($env{'form.searchterm'}));
- } elsif ($cmd=~/^taxo\:(.*)$/) {
+ } elsif ($cmd=~/^taxo\:(.*)$/ || $cmd =~ /^add\:/ && $env{'form.taxocat'}) {
my $taxocat=$1;
+ if($cmd=~/^add/){
+ $taxocat=$env{'form.taxocat'};
+ }
+ $r->print('<input type="hidden" name="taxocat" value="'.$taxocat.'"/>');
$r->print(&list_nextlevel_cats($taxocat,\%taxonomy_categories));
$r->rflush();
&display($r,\%taxonomy_categories,\%selectedids,$filter,$lower,20,&taxonomy_members($taxocat));
- } elsif ($cmd=~/^dir\:(.*)$/) {
- &show_dir_list($r,\%taxonomy_categories,$filter,$1);
- } elsif ($cmd=~/^indiv\:/) {
+ } elsif ($cmd=~/^dir\:(.*)$/ || $cmd =~ /^add\:/ && $env{'form.dir'}) {
+ my $dir = $1;
+ if($cmd=~/^add/){
+ $dir = $env{'form.dir'};
+ }
+ $r->print('<input type="hidden" name="dir" value="'.$dir.'"/>');
+ &show_dir_list($r,\%taxonomy_categories,$filter,$dir);
+ } elsif ($cmd=~/^(add)?indiv\:/ || $cmd=~/^classification(dis)?agree:/) {
if ($cmd=~/\:(.+)$/) {
my $url=$1;
- $r->print('<h2>'.&Apache::lonnet::gettitle($url).'</h2>'.&big_submit_link(&mt('Add this resource'),'add:'.$url));
+ if ($cmd=~/^classificationagree/){
+ &store_suggestion($url, 1);
+ } elsif ($cmd=~/^classificationdisagree/){
+ my $suggestion;
+ $suggestion = $env{'form.class_category'} if $env{'form.class_category'};
+ $suggestion = $env{'form.class_suggestion'} if $env{'form.class_suggestion'}; # user input overrides
+ $suggestion =~ s/[^\w\:\,]//g;
+ $suggestion = $suggestion;
+ &store_suggestion($url, $suggestion);
+ &elog('suggestion', $suggestion, $url);
+ }
+
+ $r->print('<h2>'.&Apache::lonnet::gettitle($url).'</h2>'.&big_submit_link(&mt('Add this resource'),'addindiv:'.$url));
$r->print('<iframe src="'.$url.'?inhibitmenu=yes" width="100%" height="50%"></iframe>'."\n");
my %urlid=&urlres($url);
if ($urlid{$url}) {
+ $r->print(classification_form(join(',',map {&showtaxo($taxonomy_categories{'cleartext_'.$_})} split(/\,/,${[&taxoids($urlid{$url})]}[1])), $url));
+ my %suggestions = get_suggestion($url);
+ my $usug = get_user_suggestion($url);
+ $usug = $usug == 1 ? "You agreed." : "You suggested: $usug";
+ if(%suggestions){
+ my $sug = join("\n", map{ sprintf("<li>%s (%d)</li>", $_, $suggestions{$_}) } keys %suggestions );
+ $sug = "<ul style='list-style-type:none;padding:0;margin:0;'>$sug</ul>";
+ $r->print(<<ENDSUG);
+<div style="width:35%;display:inline-block;vertical-align:top;padding:1em 0.5em">
+<p>$usug</p>
+$sug
+</div>
+ENDSUG
+ }else{
+ $r->print(q|<div style="width:35%;display:inline-block;vertical-align:top;padding:1em 0.5em"><p>No suggestions yet.</p></div>|);
+ }
&display($r,\%taxonomy_categories,\%selectedids,$filter,$lower,10,&associated($urlid{$url}));
}
}
@@ -993,4 +1041,73 @@
ENDCONSENT
$r->print(&big_submit_link(&mt('I agree'),'gaveconsent'));
}
+
+# return the classification suggestion html snippet
+sub classification_form {
+ my ($category, $url) = @_;
+ my ($agree, $disagree) = (&submit_link("Agree!", "classificationagree:$url"), &submit_link("Submit", "classificationdisagree:$url"));
+ my %tax = taxonomy_categories();
+ my $tax = join("\n", sort map {"<option>$tax{$_}</option>"} grep { /cleartext_/ } keys %tax);
+ $category = join(" and ", split(/,/, $category));
+
+ return <<ENDFORM;
+<div style="display:inline-block;vertical-align:top;width:60%;padding:1em 0.5em;">
+<p>This resource has been classified as: $category <span style="font-weight:bold;">$agree</span></p>
+<p>Choose a different category or provide your own:</p>
+<select name="class_category">
+<option></option>
+$tax
+</select>
+<input type="text" size="40" name="class_suggestion" value=""/>
+<span style="font-weight:bold;">$disagree</span>
+</div>
+ENDFORM
+}
+# stores user suggested classification in usersuggestion.db: <url> => <udom>&<uname>&<suggestion>[,<udom>&<uname>&<suggestion>]
+sub store_suggestion {
+ my ($url, $suggestion) = @_;
+ my %hash=();
+ tie(%hash,'GDBM_File',$datapath.'dbfiles/usersuggestion.db',&GDBM_WRCREAT(), 0640) or die;
+ my @suggestions = grep {
+ my ($user, $sug) = split /&/;
+ $user ne crypt($env{'user.domain'}.$env{'user.name'}, $user)
+ #$_ !~ /^$env{'user.domain'}&$env{'user.name'}/
+ } split /,/, $hash{$url};
+
+ $hash{$url} = join(',', @suggestions);
+ my $salt = join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64];
+ $hash{$url} .= "," . join("&", (crypt($env{'user.domain'} . $env{'user.name'}, $salt), escape($suggestion))) ;
+ untie(%hash);
+}
+# returns suggestion for the resource given by $url for the current user
+sub get_user_suggestion {
+ my ($url) = @_;
+ my %hash=();
+ tie(%hash,'GDBM_File',$datapath.'dbfiles/usersuggestion.db',&GDBM_READER(), 0640) or return;
+ for my $suggestion (split /,/, $hash{$url}){
+ my ($user, $s) = split /&/, $suggestion;
+ next unless $s;
+ next if (crypt($env{'user.domain'} . $env{'user.name'}, $user) ne $user);
+ untie(%hash);
+ return unescape($s);
+ }
+ untie(%hash);
+ return;
+}
+# returns hash containing suggestions and frequencies for a given $url
+sub get_suggestion {
+ my ($url) = @_;
+ my %hash=();
+ tie(%hash,'GDBM_File',$datapath.'dbfiles/usersuggestion.db',&GDBM_READER(), 0640) or return;
+ my %output;
+ for my $suggestions (split /,/, $hash{$url}){
+ my (undef, $s) = split /&/, $suggestions;
+ next unless $s;
+ $s = 'agree' if $s == 1;
+ $output{unescape($s)}++;
+ }
+ untie(%hash);
+ return %output;
+}
+
1;
More information about the LON-CAPA-cvs
mailing list