[LON-CAPA-cvs] cvs: modules /gerd/harvesting recommender.pl

www www at source.lon-capa.org
Thu Oct 6 21:52:50 EDT 2011


www		Fri Oct  7 01:52:50 2011 EDT

  Modified files:              
    /modules/gerd/harvesting	recommender.pl 
  Log:
  More work on toy recommender
  
  
Index: modules/gerd/harvesting/recommender.pl
diff -u modules/gerd/harvesting/recommender.pl:1.1 modules/gerd/harvesting/recommender.pl:1.2
--- modules/gerd/harvesting/recommender.pl:1.1	Thu Oct  6 22:13:04 2011
+++ modules/gerd/harvesting/recommender.pl	Fri Oct  7 01:52:50 2011
@@ -38,6 +38,23 @@
    $basket{$line}=1;
 }
 close(IN);
+my $rewrite=0;
+if ($env{'form.add'}) {
+   $basket{$env{'form.add'}}=1;
+   $rewrite=1;
+}
+if ($env{'form.del'}) {
+   delete($basket{$env{'form.del'}});
+   $rewrite=1;
+}
+if ($rewrite) {
+   open(OUT,'>'.$datapath.'mycart.data') || print("Could not write basket ...\n");
+   foreach my $key (sort(keys(%basket))) {
+      print OUT $key."\n";
+   }
+   close(OUT);
+}
+
 
 print("Resource data ...\n");
 my @url=();
@@ -53,47 +70,177 @@
 
 # Get keywords
 
-print("Keywords ...\n");
 my @keywords=();
 
-my $i=0;
+if ($env{'form.search'}) {
+   print("Keywords ...\n");
+   my $keystr='';
+   my ($id,$key)=(1,'');
+   open(IN,$datapath.'keywords.dat') || print("Could not read keywords ...\n");
+   while (my $line=<IN>) {
+      my $oid=$id;
+      chomp($line);
+      ($id,$key)=split(/\t/,$line);
+      if ($id!=$oid) {
+         $keystr=~s/^\,//;
+         $keywords[$oid]=$keystr;
+         $keystr='';
+      }
+      $keystr.=','.lc($key);
+}
+close(IN);
+}
+
+# Get combined problems
+print("Associations ...\n");
+my @seqs=();
+open(IN,$datapath.'probs_in_seq.dat') || print("Could not read associations ...\n");
+while (my $line=<IN>) {
+   my @entries=split(/\t/,$line);
+   push(@seqs,$entries[1]);
+}
+close(IN);
 
-my $keystr='';
-my ($id,$key)=(1,'');
-open(IN,$datapath.'keywords.dat') || print("Could not read keywords ...\n");
+# Get taxonomy
+
+print("Taxonomies ...\n");
+my @taxo=();
+my %subs=();
+open(IN,$datapath.'res_taxonomy.dat') || print("Could not read taxonomy ...\n");
 while (my $line=<IN>) {
-   my $oid=$id;
    chomp($line);
-   ($id,$key)=split(/\t/,$line);
-   if ($id!=$oid) {
-      $keystr=~s/^\,//;
-      $keywords[$oid]=$keystr;
-      $keystr='';
+   my @entries=split(/\t/,$line);
+   $taxo[$entries[0]]=$entries[1];
+   foreach my $indi (split(/\,/,$entries[1])) {
+      my @sub=split(/\:/,$indi);
+      if ($sub[0]) {
+         $subs{$sub[0]}++;
+         if ($sub[1]) {
+            $subs{$sub[0].':'.$sub[1]}++;
+            if ($sub[2]) {
+               $subs{$sub[0].':'.$sub[1].':'.$sub[2]}++;
+            }
+         }
+      }
    }
-   $keystr.=','.lc($key);
 }
 close(IN);
 
-# Commands
+
 if ($env{'form.focus'}) {
+#
+# This is the focus on one resource
+#
   print "<h3>Focus: <tt>$env{'form.focus'}</tt></h3>\n";
+  print "<a href='/cgi-bin/recommender.pl' target='_top'>Back to Basket</a>";
 } else {
-# List basket
+  print "\n<hr />\n";
+  foreach my $thissub (sort(keys(%subs))) {
+     unless ($thissub=~/\:/) {
+        &taxolink($thissub);
+     }
+  }
+  if ($env{'form.taxsearch'}) {
+    print "<hr />";
+    foreach my $thissub (sort(keys(%subs))) {
+        if ($thissub=~/^\Q$env{'form.taxsearch'}\E/) {
+           &taxolink($thissub);
+        }
+     }
+  }
+  
+  print("<hr /><form>Search: <input type='text' name='search' /></form>");
 
+
+
+
+
+#
+# List basket
+#
    print("\n<h3>Current Basket</h3>\n");
+   my %baskettaxos=();
    foreach my $key (sort(keys(%basket))) {
-      &outputlink($key,$basket{$key});
+      &outputlink($key,'edit');
+      $baskettaxos{$taxo[$key]}++;
+   }
+
+# Show taxonomies
+   print "<hr />Basket taxonomies:";
+   my $last='';
+   foreach my $thistax (sort(keys(%baskettaxos))) {
+      if ($thistax=~/^\Q$last\E\:/) {
+         delete($baskettaxos{$last});
+      }
+      $last=$thistax;
+   }
+   foreach my $thistax (sort(keys(%baskettaxos))) {
+      &taxolink($thistax);
    }
-}
 
+# Search results
+   if (($env{'form.search'}) || ($env{'form.taxsearch'})) {
+      print("<h3>Search Results</h3>");
+      my @results=();
+      if ($env{'form.search'}) {
+          for (my $i=0; $i<=$#keywords; $i++) {
+              if ($basket{$i}) { next; }
+              if ($keywords[$i]=~/\Q$env{'form.search'}\E/is) {
+                 push(@results,$i);
+              }
+          }
+      }
+      if ($env{'form.taxsearch'}) {
+          for (my $i=0; $i<=$#taxo; $i++) {
+              if ($basket{$i}) { next; }
+              foreach my $thistax (split(/\,/,$taxo[$i])) {
+                 if ($thistax=~/\Q$env{'form.taxsearch'}\E/) {
+                    push(@results,$i);
+                 }
+              }
+          }
+      }
+      for (my $i=0; $i<=20; $i++) {
+         if ($results[$i]) {
+            &outputlink($results[$i],'view');
+         }
+      }
+   }
+}
 print("</body></html>");
 exit;
 
 sub outputlink {
-   my ($key,$url)=@_;
-   print("<br /><tt>$key &nbsp<a href='$datahost/$url' target='preview'>$url</a>");
+   my ($i,$mode)=@_;
+   my (@parts)=split(/\//,$url[$i]);
+   my $build='/';
+   print("<br /><tt>");
+   for (my $j=1;$j<=$#parts-1;$j++) {
+       $build.=$parts[$j].'/';
+       print("/<a href='/cgi-bin/recommender.pl?browse=".&escape($build)."' target='_top'>$parts[$j]</a>");
+   }
+   print("</tt>");
+   print("/<a href='/cgi-bin/recommender.pl?preview=".$url[$i]."' target='_top'>$parts[-1]</a>");
+   if ($mode eq 'view') {
+      print("&nbsp<a href='/cgi-bin/recommender.pl?add=$i'>Add</a>");
+   }
+   if ($mode eq 'edit') {
+      print("&nbsp<a href='/cgi-bin/recommender.pl?del=$i'>Remove</a>");
+   }
+
 } 
 
+sub taxolink {
+   my ($thistax)=@_;
+   my $level='';
+   foreach my $thislevel (split(/\:/,$thistax)) {
+      $level.=':'.$thislevel;
+      $level=~s/^\://;
+      print "<a href='/cgi-bin/recommender.pl?taxsearch=$level' target='_top'>$thislevel</a>:";
+   }
+   print "($subs{$thistax}) ";
+}
+
 sub escape {
    my ($arg)=@_;
    return &HTML::Entities::encode($arg,'"<>&')




More information about the LON-CAPA-cvs mailing list