[LON-CAPA-cvs] cvs: modules /gerd/harvesting lonrecommender.pm

[www]

www		Mon Jul 16 14:55:52 2012 EDT

  Modified files:              
    /modules/gerd/harvesting	lonrecommender.pm 
  Log:
  Listing routines
  
  
Index: modules/gerd/harvesting/lonrecommender.pm
diff -u modules/gerd/harvesting/lonrecommender.pm:1.9 modules/gerd/harvesting/lonrecommender.pm:1.10
--- modules/gerd/harvesting/lonrecommender.pm:1.9	Sun Jul 15 18:47:26 2012
+++ modules/gerd/harvesting/lonrecommender.pm	Mon Jul 16 14:55:52 2012
@@ -5,7 +5,7 @@
 #
 # MODIFY $datapath VARIABLE FOR LOCATION OF DATA FILES
 #
-# $Id: lonrecommender.pm,v 1.9 2012/07/15 18:47:26 www Exp $
+# $Id: lonrecommender.pm,v 1.10 2012/07/16 14:55:52 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -304,6 +304,32 @@
 }
 
 # =================================================================================
+#
+# Filter by resource type
+# Take search string and hash of resids
+# Return filtered hash
+#
+
+sub type_filter {
+   my ($skey,%urls)=@_;
+   my %output=();
+   $skey=~s/^\W+//gs;
+   $skey=~s/\W+$//gs;
+   $skey=~s/\W+/\|/gs;
+   $skey=lc($skey);
+   my $pattern=qr/$skey/;
+   my %hash=();
+   tie(%hash, 'GDBM_File', $datapath.'dbfiles/res_types.db',&GDBM_READER(),0640);
+   foreach my $key (keys(%urls)) {
+      if ($urls{$key}=~$pattern) {
+         $output{$key}=$urls{$key};
+      }
+   }
+   untie(%hash);
+   return(%output);
+}
+
+# =================================================================================
 # Return the resource keys for URLs
 # and vice versa. The dbfile is double-hashed
 
@@ -382,23 +408,58 @@
 #
 
 sub edit_commands {
-   my @urls=@_;
-# logic will go here
+   my ($cmd, at urls)=@_;
+   my ($action,$which)=split(/\:/,$cmd);
+   if ($action eq 'add') {
+      push(@urls,$which);
+   } elsif ($action eq 'rem') {
+      my @newurls=();
+      foreach my $url (@urls) {
+         if ($url ne $which) {
+            push(@newurls,$url);
+         }
+      }
+      @urls=@newurls;
+   }
    return @urls;
 }
 
 # =================================================================================
+# Display a list of URLs
+#
+
+sub display_list {
+   my ($r,$editflag,$taxocats, at urls)=@_;
+   my %urlids=&urlres(@urls);
+   foreach my $key (keys(%urlids)) {
+      $r->print($key.' -> '.$urlids{$key}."<br />\n");
+   }
+   my %taxoids=&taxoids(values(%urlids));
+   foreach my $key (keys(%taxoids)) {
+      $r->print($key.' in '.$taxoids{$key}." --> ".$$taxocats{'cleartext_'.$taxoids{$key}}."<br />\n");
+   }
+
+   $r->print("\n<table border='1'>\n");
+   foreach my $url (@urls) {
+      $r->print(&display_line($url,$$taxocats{'cleartext_'.$taxoids{$urlids{$url}}},$editflag));
+   }
+   $r->print("\n</table>\n");
+}
+
+# =================================================================================
 # A display line for a URL
 # Edit flag: remove instead of add
 #
 
 sub display_line {
-   my ($url,$editflag)=@_;
+   my ($url,$taxonomy,$editflag)=@_;
    return "\n<tr><td>".
           &submit_link(($editflag?'Remove':'Add'),($editflag?'rem_':'add_'.$url)).
           "</td><td>".
           &Apache::lonnet::gettitle($url).
           "</td><td>".
+          &showtaxo($taxonomy).
+          "</td><td>".
           &showurl($url).
           "</td></tr>\n";
 }
@@ -422,6 +483,25 @@
 }
 
 # =================================================================================
+# Showing a taxonomy with links for taxonomy jumps
+#
+
+sub showtaxo {
+   my ($taxo)=@_;
+   my @parts=split(/\:/,$taxo);
+   my $output='';
+   my $thusfar='';
+   for (my $i=0; $i<=$#parts; $i++) {
+       $thusfar.=':'.$parts[$i];
+       $output.=':'.&submit_link($parts[$i],'taxo:'.$thusfar);
+   }
+   $output=~s/^\://;
+   return $output;
+}
+
+
+
+# =================================================================================
 # A submitting link
 # 
 
@@ -468,7 +548,7 @@
 # ------ Pick up commands
     my $cmd=&unescape($env{'form.cmd'});
 # ------ ... and execute any editing commands
-    if ($cmd=~/^(del|rem)\:/) {
+    if ($cmd=~/^(add|rem)\:/) {
        @selectedurls=&edit_commands($cmd, at selectedurls);
     }
 # ------ Add the resource IDs of the selected URLs to the existing ones
@@ -477,7 +557,7 @@
 # ------ Now @baseids has the IDs of the URLs the user selected for the folder,
 # ------ prior and during this call, with possible duplicates 
 # ------ if same URL selected twice
-
+# ------ @selectedurls has the current basket
 
 
 
@@ -488,20 +568,25 @@
     $r->print('<input type="hidden" name="basket" value="cached" />');
     $r->print('<input type="hidden" name="basketcache" value="'.$basketcache.'" />');
     $r->print('<input type="hidden" name="cmd" value="" />');
-    $r->print("<h1>Hello World!</h1>");
+# ------ Page opened
 
-    my %taxos=&taxoids(3,5,8,90,900,1450,13624,31415);
-    my %urls=&urlres(3,5,8,90,900,1450,13624,31415);
-    my ($max,%counts)=&counts(3,5,8,90,900,1450,13624,31415);
-
-    $r->print("<table>");
-    foreach my $key (keys(%taxos)) {
-       $r->print(&display_line($urls{$key}));
+    &display_list($r,0,\%taxonomy_categories,
+      ('/res/bsu/physicstir3/Conceptual Questions/002 Car Path on Curve Ice Patch.problem',
+       '/res/purdue/liten/Biology III Cell Structure and Function/Prob_033_Transcription_Translation.problem',
+       '/res/mio/ehlertr/accounting 14 and 15/payrollprocedures.problem',
+       '/res/msu/physicslib/msuphysicslib/05_1D_Motion/msu-prob48.problem',
+       '/res/msu/physicslib/msuphysicslib/05_1D_Motion/msu-prob39.problem',
+       '/res/msu/physicslib/msuphysicslib/05_1D_Motion/msu-prob49.problem')
+    );
+
+    if ($cmd eq 'showbasket') {
+    } elsif ($cmd eq 'search') {
+    } elsif ($cmd=~/^taxo\:/) {
+    } elsif ($cmd=~/^dir\:/) {
+    } elsif ($cmd=~/^indiv\:/) {
     }
-    $r->print("</table>");
-    $r->print('<br />Got: '.$cmd.'<br />');
-    $r->print(&submit_link('My link','res_1234'));
-# ------ Close form, done with page
+
+# ------ Close page
     $r->print('</form>');
     $r->print(&Apache::loncommon::end_page());
     return 1;