[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