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

www www at source.lon-capa.org
Wed Jul 11 20:21:09 EDT 2012


www		Thu Jul 12 00:21:09 2012 EDT

  Added files:                 
    /modules/gerd/harvesting	lonrecommender.pm 

  Modified files:              
    /modules/gerd/harvesting	lonindexer.pm 
  Log:
  Put recommender routines into separate file - lonindexer just becomes too messy
  
  
-------------- next part --------------
Index: modules/gerd/harvesting/lonindexer.pm
diff -u modules/gerd/harvesting/lonindexer.pm:1.11 modules/gerd/harvesting/lonindexer.pm:1.12
--- modules/gerd/harvesting/lonindexer.pm:1.11	Wed Jul 11 22:51:52 2012
+++ modules/gerd/harvesting/lonindexer.pm	Thu Jul 12 00:21:09 2012
@@ -1,11 +1,7 @@
 # The LearningOnline Network with CAPA
 # Directory Indexer
 #
-# PROTOTYPE VERSION FOR RECOMMENDER
-#
-# MODIFY $datapath VARIABLE FOR LOCATION OF DATA FILES
-#
-# $Id: lonindexer.pm,v 1.11 2012/07/11 22:51:52 www Exp $
+# $Id: lonindexer.pm,v 1.12 2012/07/12 00:21:09 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -49,10 +45,7 @@
 # ------------------------------------------------- modules used by this module
 use strict;
 
-# PROTOTYPE USE --- will need to be modified
-
-use GDBM_File;
-my $datapath='/home/www/loncapa/modules/gerd/harvesting/';
+use Apache::lonrecommender();
 
 use Apache::lonnet;
 use Apache::loncommon();
@@ -64,7 +57,6 @@
 use Apache::lonlocal;
 use Apache::lonsource();
 use Apache::groupsort();
-use LONCAPA::map();
 use GDBM_File;
 use LONCAPA qw(:match);
 
@@ -85,219 +77,8 @@
 my @Only = ();
 my @Omit = ();
 
-# PROTOTYPE ROUTINES --- These are the routines needed to run the prototype
-# Accessing the data files in $datapath
-
-# =================================================================================
-#
-# Read what already was in the folder
-#
-
-sub mapread {
-   my ($coursenum,$coursedom,$map)=@_;
-   &LONCAPA::map::mapread('/uploaded/'.$coursedom.'/'.$coursenum.'/'.$map);
-   my @basket=();
-   foreach my $res (@LONCAPA::map::resources) {
-      my ($title,$id)=split(/\:/,$res);
-      if ($id=~/\/res\//) {
-         push(@basket,$id);
-      }
-   }
-   return @basket;
-}
-
-#
-#
-# Return the resources that the resources in the argument are associated with
-# by having been used in the same folder
-# Takes an array of resource keys, returns a hash with resource keys as keys
-# and frequency as values
-#
-
-sub associated {
-   my (@with)=@_;
-   my %output=();
-   my %hash=();
-#
-# The associations database has entries: key -> other1:weight1,other2:weight2
-# to show which other resources have been used in the same context
-#
-   tie(%hash, 'GDBM_File', $datapath.'dbfiles/associations.db',&GDBM_READER(),0640);
-   foreach my $key (@with) {
-       my $assoc=$hash{$key};
-       foreach my $other (split(/\,/,$assoc)) {
-          my ($tother,$tweight)=split(/\:/,$other);
-          if ($tweight) {
-             $output{$tother}+=$tweight;
-          }
-       }
-   }
-   untie(%hash);
-   foreach my $key (@with) { delete($output{$key}); }
-   return %output;
-}
-
-# =================================================================================
-#
-#  Return the resource keys that are catalogued with a set of taxonomies
-#
-
-sub taxonomy_members {
-   my (@which)=@_;
-   my %taxcut;
-   my %lookup=();
-   my %level=();
-   my $minlevel=3;
-   my %output=();
-# 
-# Find out the taxonomy indices
-# taxo_categories has taxonomy names as keys and taxonomy indices as values
-# also has taxonomy indices as keys and frequency as values
-# minlevel is going to be smallest taxonomy level in the set, %lookup contains what to look up
-# minlevel=1 is the most work
-   my @checkon=();
-   tie(%taxcut, 'GDBM_File', $datapath.'dbfiles/taxo_categories.db',&GDBM_READER(),0640);
-   foreach my $twhich (@which) {
-      my $tcat=$taxcut{$twhich};
-      if ($taxcut{$twhich}) {
-         $lookup{$twhich}=$tcat;
-         my @subcats=split(/\:/,$twhich);
-         $level{$twhich}=$#subcats+1;
-         if ($#subcats==0) { 
-            $minlevel=1;
-         } elsif (($#subcats==1) && ($minlevel==3)) {
-            $minlevel=2;
-         }
-      }
-   }
-   untie(%taxcut);
-   my %taxo1;
-   my %taxo2;
-   my %taxo3;
-# Tie only the levels we need
-   tie(%taxo3, 'GDBM_File', $datapath.'dbfiles/taxo_level3.db',&GDBM_READER(),0640);
-   if ($minlevel<3) {
-      tie(%taxo2, 'GDBM_File', $datapath.'dbfiles/taxo_level2.db',&GDBM_READER(),0640);
-   }
-   if ($minlevel<2) {
-      tie(%taxo1, 'GDBM_File', $datapath.'dbfiles/taxo_level1.db',&GDBM_READER(),0640);
-   }
-# Business logic, finding stuff for each key that is supposed to be looked up
-   foreach my $key (keys(%lookup)) {
-      my $keystr='';
-      if ($level{$key}==3) {
-         $keystr=$taxo3{$lookup{$key}};
-      } elsif ($level{$key}==2) {
-         $keystr=$taxo2{$lookup{$key}};
-      } elsif ($level{$key}==1) {
-         $keystr=$taxo1{$lookup{$key}}
-      }
-# Put into unique output
-      foreach my $c (split(/\s*\,\s*/,$keystr)) {
-         if ($c) { $output{$c}++; }
-      }
-   }
-# Now resolve dependencies, etc
-   my $again=0;
-   if ($minlevel<3) {
-      foreach my $c (keys(%output)) {
-         if ($c=~/\:/) {
-# something to resolve
-            my ($tlevel,$tsub)=split(/\:/,$c);
-            delete($output{$c});
-            my $keystr='';
-            if ($tlevel==3) {
-               $keystr=$taxo3{$tsub};
-            } else {
-               $keystr=$taxo2{$tsub};
-            }
-            foreach my $key (split/\,/,$keystr) {
-               if ($key) { $output{$key}++; }
-            }
-            $again=1;
-         }
-         if ($c=~/\-/) {
-            my ($start,$end)=split(/\-/,$c);
-            delete($output{$c});
-            if ($end>$start) {
-               for (my $i=$start;$i<=$end;$i++) {
-                  $output{$i}++;
-               }
-            }
-         }
-      }
-   }
-# If dependencies had been resolved and we were on the lowest level,
-# we might have to resolve second-level dependencies
-   if (($again) && ($minlevel<2)) {
-      foreach my $c (keys(%output)) {
-         if ($c=~/\:/) {
-# something to resolve
-            my ($tlevel,$tsub)=split(/\:/,$c);
-            delete($output{$c});
-# has to be level 3 now
-            if ($tlevel==2) { print "\n=== Wow!!! === $c\n" };
-            my $keystr=$taxo3{$tsub};
-            foreach my $key (split/\,/,$keystr) {
-               if ($key) { $output{$key}++; }
-            }
-         }
-      }
-   }
-# Untie the levels we opened
-   untie(%taxo3);
-   if ($minlevel<3) {
-      untie(%taxo2);
-   }   
-   if ($minlevel<2) {
-      untie(%taxo1);
-   }
-   return %output;
-}
-
-# =================================================================================
-#
-#  Return the resource keys that match the keywords
-#
 
-sub keyword_search {
-   my @keywords=@_;
-   my %output=();
-   my $skey=join(',', at keywords);
-   $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/keywords.db',&GDBM_READER(),0640);
-   foreach my $key (keys(%hash)) {
-      if ($hash{$key}=~$pattern) {
-         $output{$key}=1;
-      }
-   }
-   untie(%hash);
-   return(%output);
-}
 
-# =================================================================================
-# Return the resource keys for URLs
-# and vice versa. The dbfile is double-hashed
-
-sub urlres {
-   my @urls=@_;
-   my %output=();
-   my $hash=();
-   tie(%hash, 'GDBM_File', $datapath.'dbfiles/url.db',&GDBM_READER(),0640);
-   foreach my $url (@urls) {
-      $output{$url}=$hash{$url}; 
-   }
-   untie(%hash);
-   return(%output);
-}
-
-# =================================================================================
-#
 
 # ----------------------------- Handling routine called via Apache and mod_perl
 sub handler {
@@ -315,7 +96,7 @@
     undef (@Only);
     undef (@Omit);
     %fieldnames=&Apache::lonmeta::fieldnames();
-    
+
 # ------------------------------------- read in machine configuration variables
     my $iconpath= $r->dir_config('lonIconsURL') . "/";
     my $domain  = $r->dir_config('lonDefDomain');
@@ -336,24 +117,19 @@
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
 	     ['catalogmode','launch','acts','mode','form','element',
               'only','omit','titleelement','basket']);
-
     #-------------------------------------------------------------------
 #
-# Get the current basket if being called from londocs
+# Get out of here asap if called in recommender mode (i.e., with basket)
+#
+   if ($env{'form.basket'}) {
+      &Apache::lonrecommender::handle_request($r,$c);
+      return OK;
+   }
+#
+# Okay, remainder like normal
 #
-    my ($cnum,$cdom,$folder)=split(/\,/,$env{'form.basket'});
-    my %existingres=();
-    if ($folder) {
-       %existingres=&urlres(&mapread($cnum,$cdom,$folder));
-    }
-# Existing and new stuff
-    my $basket='';
-    foreach my $importbasket (values(%existingres)) {
-       if ($importbasket) {
-          $basket.=','.$importbasket;
-       }
-    }
-    $basket=~s/^\,//;
+
+
 
 
     my $closebutton='';
@@ -361,8 +137,8 @@
     my $colspan=''; 
     
     $extrafield='';
-    my $diropendb = '/home/httpd/perl/tmp/' .
-	"$env{'user.domain'}_$env{'user.name'}_sel_res.db";
+    my $diropendb = 
+	"/home/httpd/perl/tmp/$env{'user.domain'}_$env{'user.name'}_sel_res.db";
     %hash = ();
     {
 	my %dbfile;
@@ -376,10 +152,6 @@
 	    untie(%dbfile);
 	}
     }
-    if ($basket) {
-       $hash{'basket'}=$basket;
-    }
-
 # - Evaluate actions from previous page (both cumulatively and chronologically)
         if ($env{'form.catalogmode'} eq 'import' || $hash{'form.catalogmode'} eq 'import') {
 	    &Apache::groupsort::update_actions_hash(\%hash);
@@ -410,7 +182,6 @@
 ENDSUBM
        $r->print(&Apache::loncommon::start_page(undef,$js,
 						{'only_body'   =>1,
-                                                 'add_modal' => 1,
 						 'add_entries' =>
 						     {'onload' => "load();"},}
 						).
@@ -636,7 +407,6 @@
         }
     }
 }
-
 function openWindow(url, wdwName, w, h, toolbar,scrollbar,locationbar) {
     var xpos = (screen.width-w)/2;
     xpos = (xpos < 0) ? '0' : xpos;
@@ -648,7 +418,6 @@
     var newWin = window.open(url, wdwName, options);
     newWin.focus();
 }
-
 function gothere(val) {
     window.location=val+'?acts='+document.forms.fileattr.acts.value$inhibit_menu;
 }
@@ -661,7 +430,7 @@
         if ($env{'form.catalogmode'}) {
             # "Popup mode"
             $r->print(&Apache::loncommon::start_page('Browse published resources',$js,
-                                                     {'only_body' => 1, 'add_modal' =>1, 
+                                                     {'only_body' => 1,
                                                       'domain' => $headerdom,}));
         } else {
             # Only display page header and breadcrumbs in non-popup mode
@@ -728,13 +497,51 @@
 					   'at' => 'All types',
 					   'hd' => 'Display Options'
 					   );
+        my @disp_order = ('0','4','5','6','13','1','2','3','10','14','8','11','7','12','15','16');
+        my %disp_options = &Apache::lonlocal::texthash (
+                              0  => 'Title',
+                              4  => 'Author',
+                              5  => 'Keywords',
+                              6  => 'Language',
+                              13 => 'Notes',
+                              1  => 'Size',
+                              2  => 'Last access',
+                              3  => 'Last modified',
+                              10 => 'Source Available',
+                              14 => 'Abstract',
+                              8  => 'Statistics',
+                              11 => 'Linked/Related Resources',
+                              7  => 'Show resource',
+                              12 => 'Subject',
+                              15 => 'Grade Level',
+                              16 => 'Standards',
+                           );
         my $cell = 0;
         my $numinrow = 4;
 	$r->print('
 <form method="post" name="fileattr" action="'.$uri.'" enctype="application/x-www-form-urlencoded">
 <fieldset>
 <legend>'.$lt{'hd'}.'</legend>
-<table style=" border-collapse: collapse; border-style: none;">');
+<table style=" border-collapse: collapse; border-style: none;">'."\n");
+        foreach my $item (@disp_order) {
+            my $style = 'padding-left: 12px; padding-right: 8px;';
+            if ($cell%$numinrow == 0) {
+                $r->print('<tr>');
+            }
+            $cell ++;
+            if ($cell > 3 * $numinrow) {
+                $style .= ' padding-bottom: 6px;'; 
+            }
+            if (defined($disp_options{$item})) {
+                $r->print('<td style="'.$style.'"><span class="LC_nobreak">'.
+                          '<label><input type="checkbox" name="attr'.$item.'" value="1" '.
+                          $attrchk[$item].' onclick="this.form.submit();" /> '.$disp_options{$item}.
+                          '</label></span></td>'."\n");
+            }
+            if ($cell > 1 && $cell%$numinrow == 0) {
+                $r->print('</tr>');
+            }
+        }
         $r->print(<<END);
 <tr>
 <td style="font-style: italic; border-top: 1px solid black; padding-top: 6px"> 
@@ -745,6 +552,7 @@
 </table>
 <input type="hidden" name="attrs" value="1" />
 </fieldset>
+<input type="submit" name="updatedisplay" value="$lt{'ud'}" />
 <input type="hidden" name="acts" value="" />
 $closebutton $groupimportbutton
 END
@@ -791,13 +599,45 @@
 	    $r->print('<input type="button" value="'.&mt("Uncheck All").'" id="uncheckallbutton" onclick="javascript:uncheckAll()" /></p>');
 	}
 # ----------------- output starting row to the indexed file/directory hierarchy
+        #$r->print(&initdebug());
+        #$r->print(&writedebug("Omit:@Omit")) if (@Omit);
+        #$r->print(&writedebug("Only:@Only")) if (@Only);
         $r->print(&Apache::loncommon::start_data_table("LC_tableBrowseRes")
                  .&Apache::loncommon::start_data_table_header_row());
 	$r->print("<th $colspan>".&mt('Name')."</th>\n");
-	$r->print("<th>".&mt('Title')."</th>\n"); 
-	$r->print("<th>".&mt("Author(s)")."</th>\n");
-	$r->print("<th>".&mt("Source Available")."</th>\n");
-	$r->print("<th>".&mt("Resource")."</th>\n");
+	$r->print("<th>".&mt('Title')."</th>\n") 
+	    if ($hash{'display_attrs_0'} == 1);
+	$r->print('<th class="LC_right">'.&mt("Size")." (".&mt("bytes").") ".
+		  "</th>\n") if ($hash{'display_attrs_1'} == 1);
+	$r->print("<th>".&mt("Last accessed")."</th>\n") 
+	    if ($hash{'display_attrs_2'} == 1);
+	$r->print("<th>".&mt("Last modified")."</th>\n")
+	    if ($hash{'display_attrs_3'} == 1);
+	$r->print("<th>".&mt("Author(s)")."</th>\n")
+	    if ($hash{'display_attrs_4'} == 1);
+	$r->print("<th>".&mt("Keywords")."</th>\n")
+	    if ($hash{'display_attrs_5'} == 1);
+	$r->print("<th>".&mt("Language")."</th>\n")
+	    if ($hash{'display_attrs_6'} == 1);
+	$r->print("<th>".&mt("Usage Statistics")." <br />(".
+		  &mt("Courses/Network Hits").") ".&mt('updated periodically')."</th>\n")
+	    if ($hash{'display_attrs_8'} == 1);
+	$r->print("<th>".&mt("Source Available")."</th>\n")
+	    if ($hash{'display_attrs_10'} == 1);
+	$r->print("<th>".&mt("Linked/Related Resources")."</th>\n")
+	    if ($hash{'display_attrs_11'} == 1);
+	$r->print("<th>".&mt("Resource")."</th>\n")
+	    if ($hash{'display_attrs_7'} == 1);
+	$r->print("<th>".&mt("Subject")."</th>\n")
+	    if ($hash{'display_attrs_12'} == 1);
+	$r->print("<th>".&mt("Notes")."</th>\n")
+	    if ($hash{'display_attrs_13'} == 1);
+	$r->print("<th>".&mt("Abstract")."</th>\n")
+	    if ($hash{'display_attrs_14'} == 1);
+	$r->print("<th>".&mt("Grade Level")."</th>\n")
+	    if ($hash{'display_attrs_15'} == 1);
+	$r->print("<th>".&mt("Standards")."</th>\n")
+	    if ($hash{'display_attrs_16'} == 1);
 	    
     $r->print(&Apache::loncommon::end_data_table_header_row());
     
@@ -931,11 +771,18 @@
 sub get_list {
     my ($r,$uri)=@_;
     my @list=();
-    my $listerror;
-    
     (my $luri = $uri) =~ s/\//_/g;
+    if ($env{'form.updatedisplay'}) {
+	foreach (keys %hash) {
+	    delete $hash{$_} if ($_ =~ /^dirlist_files_/);
+	    delete $hash{$_} if ($_ =~ /^dirlist_timestamp_files_/);
+	}
+    }
 
-    if ($uri=~/\.(page|sequence)\/$/) {
+    if (defined($hash{'dirlist_files_'.$luri}) &&
+	$hash{'dirlist_timestamp_files_'.$luri}+600 > (time)) {
+	@list = split(/\n/,$hash{'dirlist_files_'.$luri});
+    } elsif ($uri=~/\.(page|sequence)\/$/) {
 # is a page or a sequence
 	$uri=~s/\/$//;
 	$uri='/'.(split(/\.(page|sequence)\/\//,$uri))[-1];
@@ -944,11 +791,13 @@
 	    my @ratpart=split(/\:/,$_);
 	    push(@list,&LONCAPA::map::qtescape($ratpart[1]));
 	} 
+	$hash{'dirlist_files_'.$luri} = join("\n", at list);
     } else {
 # is really a directory
 	@list = &Apache::lonnet::dirlist($uri);
+	$hash{'dirlist_files_'.$luri} = join("\n", at list);
+	$hash{'dirlist_timestamp_files_'.$luri} = time;
     }
-
     return @list=&match_ext($r, at list);    
 }
 
@@ -1057,7 +906,14 @@
     my $nowOpen = ($diropen eq 'opened' ? 1 : 0);
 
     my $tabtag='</td>';
-    my $valign = 'top';
+    my $i=0;
+    while ($i<=16) {
+	$tabtag=join('',$tabtag,"<td> </td>")
+	    if ($i != 9 &&
+		$hash{'display_attrs_'.$i} == 1);
+	$i++;
+    }
+    my $valign = ($hash{'display_attrs_7'} == 1 ? 'top' : 'bottom');
 
 # display uplink arrow
     if ($filecom[1] eq 'viewOneUp') {
@@ -1071,17 +927,19 @@
         $r->print($extrafield);
 	$r->print("<td>\n");
 	$r->print ('<form method="post" name="dirpathUP" action="'.$updir.
-		   '/" enctype="application/x-www-form-urlencoded"'.
+		   '/" '.
+		   'onsubmit="return rep_dirpath(\'UP\','.
+		   'document.forms.fileattr.acts.value)" '.
+		   'enctype="application/x-www-form-urlencoded"'.
                    '>'."\n");
 	$r->print(&Apache::loncommon::inhibit_menu_check('input'));
 	$r->print ('<input type="hidden" name="openuri" value="'.
 		   $startdir.'" />'."\n");
         $r->print ('<input type="hidden" name="acts" value="" />'."\n");
-	$r->print ('<a href="#" onclick="rep_dirpath(\'UP\','.
-                   'document.forms.fileattr.acts.value); document.dirpathUP.submit()"><img src="'.$iconpath.'arrow.up.gif"');
+	$r->print ('<a href="#" onclick="document.dirpathUP.submit()"><img src="'.$iconpath.'arrow.up.gif"');
 	$r->print (' alt="'.$msg.'" class="LC_fileicon" />'.
 		   "\n");
-	$r->print(&mt("Up")."</a></form></td><td>$tabtag");
+	$r->print(&mt("Up")."</a></form>$tabtag");
         $r->print(&Apache::loncommon::end_data_table_row());
 	return OK;
     }
@@ -1104,8 +962,7 @@
 	$anchor =~ s/\W//g;
 	$r->print ('<a name="'.$anchor.'"></a>');
 $r->print ('<input type="hidden" name="acts" value="" />');
-	$r->print ('<a href="#" onclick="rep_dirpath(\''.($dnum-1).'\''.
-               ',document.forms.fileattr.acts.value); document.dirpath'.($dnum-1).'.submit()"><img src="'.$iconpath.'arrow.'.($nowOpen ? "open" : "closed" ).'.gif"'); 
+	$r->print ('<a href="#" onclick="document.dirpath'.($dnum-1).'.submit()"><img src="'.$iconpath.'arrow.'.($nowOpen ? "open" : "closed" ).'.gif"'); 
 	$r->print (' alt="'.$msg.'" class="LC_fileicon" /></a>'.
 		   "\n");
 	my $quotable_filecom = &Apache::loncommon::escape_single($filecom[0]);
@@ -1117,7 +974,7 @@
 	    $r->print("<br />(".&Apache::lonnet::domain($listname,'description').
 		      ")");
 	}
-	$r->print("</form></td><td>$tabtag");
+	$r->print("</form>$tabtag");
          $r->print(&Apache::loncommon::end_data_table_row());
 	return OK;
 
@@ -1135,8 +992,7 @@
 	$r->print ('<a name="'.$anchor.'"></a><img alt="" src="'.$iconpath.
 		   'whitespace_21.gif" class="LC_icon" />'."\n");
 	$r->print ('<input type="hidden" name="acts" value="" />');
-	$r->print ('<a href="#" onclick="rep_dirpath(\''.($dnum-1).'\''.
-               ',document.forms.fileattr.acts.value); document.dirpath'.($dnum-1).'.submit()">');
+	$r->print ('<a href="#" onclick="document.dirpath'.($dnum-1).'.submit()">');
         $r->print ('<img src="'.$iconpath.'arrow.'.($nowOpen ? "open" : "closed" ).
 		   '.gif" class="LC_fileicon"'); 
 	$r->print (' alt="'.$msg.'"/></a>'.
@@ -1150,7 +1006,6 @@
         $r->print ($listname.'</a>');
 
         if (defined($plainname) && $plainname) { $r->print(" ($plainname) "); }
-# Wishlistlink
         $r->print('</form>'.$tabtag);
         $r->print(&Apache::loncommon::end_data_table_row());
         return OK;
@@ -1158,8 +1013,11 @@
 
 # display file
         if (($fnptr == 0 and $filecom[3] ne '') or $absolute) {
+            my $title;
             my $filelink = $pathprefix.$filecom[0];
-            my $title = &Apache::lonnet::gettitle($filelink);
+            if ($hash{'display_attrs_0'} == 1) {
+                $title = &Apache::lonnet::gettitle($filelink);
+            }
             my @file_ext = split (/\./,$listname);
             my $curfext = $file_ext[-1];
             if (@Omit) {
@@ -1220,8 +1078,7 @@
 	    $anchor =~ s/\W//g;
 	    $r->print ('<input type="hidden" name="acts" value="" />');
 	    $r->print ('<a name="'.$anchor.'"></a>');
-            $r->print ('<a href="#" onclick="rep_dirpath(\''.($dnum-1).'\''.
-               ',document.forms.fileattr.acts.value); document.dirpath'.($dnum-1).'.submit()">');
+            $r->print ('<a href="#" onclick="document.dirpath'.($dnum-1).'.submit()">');
             $r->print ('<img src="'.$iconpath.'arrow.'.($nowOpen ? "open" : "closed" ).
                        '.gif" class="LC_fileicon"');
 	    $r->print (' alt="'.$msg.'" /></a>'.
@@ -1231,21 +1088,67 @@
 	$r->print("<img alt=\"\" src='$iconname' class='LC_fileicon' />\n");
 	my $quotable_filelink = &Apache::loncommon::escape_single($filelink);
 
-	$r->print (" <a href=\"javascript:openMyModal('".$quotable_filelink."?inhibitmenu=yes',500,500,'yes');\">$listname</a> ");
+	$r->print (" <a href=\"javascript:openWindow('".$quotable_filelink.
+		   "?inhibitmenu=yes','previewfile','450','500','no','yes','yes');\"".
+		   " target=\"_self\">$listname</a> ");
 	$quotable_filelink = &Apache::loncommon::escape_single($filelink.'.meta');
 	&Apache::loncommon::inhibit_menu_check(\$quotable_filelink);
-	$r->print (" (<a href=\"javascript:openMyModal('".$quotable_filelink."?inhibitmenu=yes',500,500,'yes');\">".&mt('metadata')."</a>) ");
+	$r->print (" (<a href=\"javascript:openWindow('".$quotable_filelink.
+		   "?inhibitmenu=yes','metadatafile','500','550','no','yes','no');\" ".
+		   " target=\"_self\">".&mt('metadata')."</a>) ");
 # Close form to open/close sequence
 	if ($filelink=~/\.(page|sequence)$/) {
 	    $r->print('</form>');
 	}
 	$r->print("</td>\n");
+	if ($hash{'display_attrs_0'} == 1) {
 	    $r->print('<td> '.($title eq '' ? ' ' : $title).
 		      ' </td>'."\n");
-	my $author = &Apache::lonnet::metadata($filelink,'author');
-	$r->print('<td class="LC_nobreak"> '.($author eq '' ? ' ' : $author).
+	}
+	$r->print('<td class="LC_right"> ',
+		  $filecom[8]," </td>\n") 
+	    if $hash{'display_attrs_1'} == 1;
+	$r->print('<td class="LC_nobreak"> '.
+                  (&Apache::lonlocal::locallocaltime($filecom[9]))." </td>\n")
+	    if $hash{'display_attrs_2'} == 1;
+	$r->print('<td class="LC_nobreak"> '.
+                  (&Apache::lonlocal::locallocaltime($filecom[10]))." </td>\n")
+	    if $hash{'display_attrs_3'} == 1;
+
+	if ($hash{'display_attrs_4'} == 1) {
+	    my $author = &Apache::lonnet::metadata($filelink,'author');
+	    $r->print('<td class="LC_nobreak"> '.($author eq '' ? ' ' : $author).
+		      " </td>\n");
+	}
+	if ($hash{'display_attrs_5'} == 1) {
+	    my $keywords = &Apache::lonnet::metadata($filelink,'keywords');
+	    # $keywords = ' ' if (!$keywords);
+	    $r->print('<td> '.($keywords eq '' ? ' ' : $keywords).
 		      " </td>\n");
-	my $source = &Apache::lonnet::metadata($filelink,'sourceavail');
+	}
+
+	if ($hash{'display_attrs_6'} == 1) {
+	    my $lang = &Apache::lonnet::metadata($filelink,'language');
+	    $lang = &Apache::loncommon::languagedescription($lang);
+	    $r->print('<td> '.($lang eq '' ? ' ' : $lang).
+		      " </td>\n");
+	}
+	if ($hash{'display_attrs_8'} == 1) {
+# statistics
+	    &dynmetaread($filelink);
+	    $r->print("<td>");
+
+        for (qw(count course stdno avetries difficulty disc clear technical
+            correct helpful depth)) {
+
+            dynmetaprint($r,$filelink,$_);
+        }
+
+	    $r->print(" </td>\n");
+
+	}
+	if ($hash{'display_attrs_10'} == 1) {
+	    my $source = &Apache::lonnet::metadata($filelink,'sourceavail');
 	    if($source eq 'open') {
 		my $sourcelink = &Apache::lonsource::make_link($filelink,$listname);
 		my $quotable_sourcelink = &Apache::loncommon::escape_single($sourcelink);
@@ -1257,10 +1160,56 @@
 	    } else { #A cuddled else. :P
 		$r->print("<td> </td>\n");
 	    }
+	}
+	if ($hash{'display_attrs_11'} == 1) {
+# links
+	   &dynmetaread($filelink);
+	   $r->print('<td>');
+	   &coursecontext($r,$filelink);
+       for (qw(goto_list comefrom_list sequsage_list dependencies course_list)) {
+             dynmetaprint($r,$filelink,$_);
+       }
+	   $r->print('</td>');
+        }
+        
+   
+	
+	if ($hash{'display_attrs_7'} == 1) {
 # Show resource
 	   my $output=&showpreview($filelink);
            $r->print('<td class="LC_fontsize_medium">'.($output eq '' ? ' ':$output).
 		      " </td>\n");
+    }
+    
+    if ($hash{'display_attrs_12'} == 1) {
+	    my $subject = &Apache::lonnet::metadata($filelink,'subject');
+	    $r->print('<td> '.($subject eq '' ? ' ' : $subject).
+		      " </td>\n");
+	}
+	
+	if ($hash{'display_attrs_13'} == 1) {
+	    my $notes = &Apache::lonnet::metadata($filelink,'notes');
+	    $r->print('<td> '.($notes eq '' ? ' ' : $notes).
+		      " </td>\n");
+	}
+	
+	if ($hash{'display_attrs_14'} == 1) {
+	    my $abstract = &Apache::lonnet::metadata($filelink,'abstract');
+	    $r->print('<td> '.($abstract eq '' ? ' ' : $abstract).
+		      " </td>\n");
+	}
+	
+	if ($hash{'display_attrs_15'} == 1) {
+	    my $gradelevel = &Apache::lonnet::metadata($filelink,'gradelevel');
+	    $r->print('<td> '.($gradelevel eq '' ? ' ' : $gradelevel).
+		      " </td>\n");
+	}
+	
+	if ($hash{'display_attrs_16'} == 1) {
+	    my $standards = &Apache::lonnet::metadata($filelink,'standards');
+	    $r->print('<td> '.($standards eq '' ? ' ' : $standards).
+		      " </td>\n");
+	}
 	
 	$r->print(&Apache::loncommon::end_data_table_row());
 }
@@ -1286,8 +1235,7 @@
 	}
 	$r->print ('<input type="hidden" name="acts" value="" />');
 	$r->print ('<a name="'.$anchor.'"></a>');
-        $r->print ('<a href="#" onclick="rep_dirpath(\''.($dnum-1).'\''.
-               ',document.forms.fileattr.acts.value); document.dirpath'.($dnum-1).'.submit()"><img src="'.$iconpath.
+        $r->print ('<a href="#" onclick="document.dirpath'.($dnum-1).'.submit()"><img src="'.$iconpath.
 		   'arrow.'.($nowOpen ? "open" : "closed" ).'.gif"');
 	$r->print (' alt="'.$msg.'" class="LC_fileicon" /></a>'.
 		   "\n");
@@ -1300,8 +1248,7 @@
                   .'<img class="LC_fileicon" alt="'.&mt('Open Folder').'" src="'
                   .$location.'/'.$icon.'" />'
                   ."\n");
-	$r->print ("$listname</a></form>");
-        $r->print('</td>');
+	$r->print ("$listname</a></form></td>\n");
 # Attributes
 	my $filelink = $startdir.$filecom[0].'/default';
 
@@ -1405,12 +1352,29 @@
     my $output='';
     my $embstyle=&Apache::loncommon::fileembstyle($curfext);
     if ($embstyle eq 'ssi') {
-       $output=&Apache::lonnet::ssi_body($filelink);
+       my $cache=$Apache::lonnet::perlvar{'lonDocRoot'}.$filelink.
+                    '.tmp';
+       if ((!$env{'form.updatedisplay'}) &&
+                    (-e $cache)) {
+          open(FH,$cache);
+          $output=join("\n",<FH>);
+          close(FH);
+       } else {
+# In update display mode, remove old cache. This is done to retroactively
+# clean up course context renderings.
+	  if (-e $cache) {
+	       unlink($cache);
+	  }
+          $output=&Apache::lonnet::ssi_body($filelink);
 # Is access denied? Don't render, don't store
-       $output=~s/\<applet(.+)\<\/applet(.*)\>/\<br \/\>Applet\<br \/\>/gsi;
-       $output=~s/\<embed(.+)\<\/embed(.*)\>/\<br \/\>Embedded Multimedia\<br \/\>/gsi;
-       if ($output=~/LONCAPAACCESSCONTROLERRORSCREEN/s) {
-           $output='';
+          if ($output=~/LONCAPAACCESSCONTROLERRORSCREEN/s) {
+             $output='';
+# Was this rendered in course content? Don't store
+          } elsif (!&Apache::lonnet::symbread($filelink)) {
+             open(FH,">$cache");
+             print FH $output;
+             close(FH);
+          }
        }
     } elsif ($embstyle eq 'img') {
        $output='<img alt="'.&mt('Preview').'" src="'.$filelink.'" />';
@@ -1442,7 +1406,9 @@
     $uri=&Apache::loncommon::escape_single($uri);
     $r->print ('<form method="post" name="dirpath'.$dnum.'" action="'.$uri.
 	       '#'.$anchor.
-	       '" enctype="application/x-www-form-urlencoded">'."\n");
+	       '" onsubmit="return rep_dirpath(\''.$dnum.'\''.
+	       ',document.forms.fileattr.acts.value)" '.
+	       'enctype="application/x-www-form-urlencoded">'."\n");
     $r->print ('<input type="hidden" name="openuri" value="'.$uri.'" />'.
 	       "\n");
     $r->print ('<input type="hidden" name="dirPointer" value="on" />'."\n");
@@ -1485,3 +1451,148 @@
     }
     return OK;
 }
+
+
+
+
+
+=head1 NAME
+
+Apache::lonindexer - mod_perl module for cross server filesystem browsing
+
+=head1 SYNOPSIS
+
+Invoked by /etc/httpd/conf/srm.conf:
+
+ <LocationMatch "^/res.*/$">
+ SetHandler perl-script
+ PerlHandler Apache::lonindexer
+ </LocationMatch>
+
+=head1 INTRODUCTION
+
+This module enables a scheme of browsing across a cross server.
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+=head1 BEGIN SUBROUTINE
+
+This routine is only run once after compilation.
+
+=over 4
+
+=item *
+
+Initializes %language hash table.
+
+=back
+
+=head1 HANDLER SUBROUTINE
+
+This routine is called by Apache and mod_perl.
+
+=over 4
+
+=item *
+
+read in machine configuration variables
+
+=item *
+
+see if called from an interactive mode
+
+=item *
+
+refresh environment with user database values (in %hash)
+
+=item *
+
+define extra fields and buttons in case of special mode
+
+=item *
+
+set catalogmodefunctions to have extra needed javascript functionality
+
+=item *
+
+print header
+
+=item *
+
+evaluate actions from previous page (both cumulatively and chronologically)
+
+=item *
+
+output title
+
+=item *
+
+get state of file attributes to be showing
+
+=item *
+
+output state of file attributes to be showing
+
+=item *
+
+output starting row to the indexed file/directory hierarchy
+
+=item *
+
+read in what directories have previously been set to "open"
+
+=item *
+
+if not at top level, provide an uplink arrow
+
+=item *
+
+recursively go through all the directories and output as appropriate
+
+=item *
+
+information useful for group import
+
+=item *
+
+end the tables
+
+=item *
+
+end the output and return
+
+=back
+
+=head1 OTHER SUBROUTINES
+
+=over 4
+
+=item *
+
+scanDir - recursive scan of a directory
+
+=item *
+
+get_list - get complete matched list based on the uri (returns an array)
+
+=item *
+
+match_ext - filters out files based on extensions (returns an array)
+
+=item *
+
+display_line - displays one line in appropriate table format
+
+=item *
+
+begin_form - prints the beginning of a form for directory or file link
+
+=item *
+
+start_fresh_session - settings whenever the user causes the indexer window
+to be launched
+
+=back
+
+=cut

Index: modules/gerd/harvesting/lonrecommender.pm
+++ modules/gerd/harvesting/lonrecommender.pm
# The LearningOnline Network with CAPA
# Recommender
#
# PROTOTYPE VERSION FOR RECOMMENDER
#
# MODIFY $datapath VARIABLE FOR LOCATION OF DATA FILES
#
# $Id: lonrecommender.pm,v 1.1 2012/07/12 00:21:09 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###

###############################################################################
##                                                                           ##
## ORGANIZATION OF THIS PERL MODULE                                          ##
##                                                                           ##
## 1. Description of functions                                               ##
## 2. Modules used by this module                                            ##
## 3. Choices for different output views (detailed, summary, xml, etc)       ##
## 4. BEGIN block (to be run once after compilation)                         ##
## 5. Handling routine called via Apache and mod_perl                        ##
## 6. Other subroutines                                                      ##
##                                                                           ##
###############################################################################

package Apache::lonrecommender;

# ------------------------------------------------- modules used by this module
use strict;

# PROTOTYPE USE --- will need to be modified

use GDBM_File;
my $datapath='/home/www/loncapa/modules/gerd/harvesting/';

use Apache::lonnet;
use Apache::lonindexer();
use Apache::loncommon();
use Apache::lonhtmlcommon();
use Apache::lonsequence();
use Apache::Constants qw(:common);
use Apache::lonmeta;
use Apache::File;
use Apache::lonlocal;
use Apache::lonsource();
use Apache::groupsort();
use LONCAPA::map();
use GDBM_File;
use LONCAPA qw(:match);

# PROTOTYPE ROUTINES --- These are the routines needed to run the prototype
# Accessing the data files in $datapath

# =================================================================================
#
# Read what already was in the folder
#

sub mapread {
   my ($coursenum,$coursedom,$map)=@_;
   &LONCAPA::map::mapread('/uploaded/'.$coursedom.'/'.$coursenum.'/'.$map);
   my @basket=();
   foreach my $res (@LONCAPA::map::resources) {
      my ($title,$id)=split(/\:/,$res);
      if ($id=~/\/res\//) {
         push(@basket,$id);
      }
   }
   return @basket;
}

#
#
# Return the resources that the resources in the argument are associated with
# by having been used in the same folder
# Takes an array of resource keys, returns a hash with resource keys as keys
# and frequency as values
#

sub associated {
   my (@with)=@_;
   my %output=();
   my %hash=();
#
# The associations database has entries: key -> other1:weight1,other2:weight2
# to show which other resources have been used in the same context
#
   tie(%hash, 'GDBM_File', $datapath.'dbfiles/associations.db',&GDBM_READER(),0640);
   foreach my $key (@with) {
       my $assoc=$hash{$key};
       foreach my $other (split(/\,/,$assoc)) {
          my ($tother,$tweight)=split(/\:/,$other);
          if ($tweight) {
             $output{$tother}+=$tweight;
          }
       }
   }
   untie(%hash);
   foreach my $key (@with) { delete($output{$key}); }
   return %output;
}

# =================================================================================
#
#  Return the resource keys that are catalogued with a set of taxonomies
#

sub taxonomy_members {
   my (@which)=@_;
   my %taxcut;
   my %lookup=();
   my %level=();
   my $minlevel=3;
   my %output=();
# 
# Find out the taxonomy indices
# taxo_categories has taxonomy names as keys and taxonomy indices as values
# also has taxonomy indices as keys and frequency as values
# minlevel is going to be smallest taxonomy level in the set, %lookup contains what to look up
# minlevel=1 is the most work
   my @checkon=();
   tie(%taxcut, 'GDBM_File', $datapath.'dbfiles/taxo_categories.db',&GDBM_READER(),0640);
   foreach my $twhich (@which) {
      my $tcat=$taxcut{$twhich};
      if ($taxcut{$twhich}) {
         $lookup{$twhich}=$tcat;
         my @subcats=split(/\:/,$twhich);
         $level{$twhich}=$#subcats+1;
         if ($#subcats==0) { 
            $minlevel=1;
         } elsif (($#subcats==1) && ($minlevel==3)) {
            $minlevel=2;
         }
      }
   }
   untie(%taxcut);
   my %taxo1;
   my %taxo2;
   my %taxo3;
# Tie only the levels we need
   tie(%taxo3, 'GDBM_File', $datapath.'dbfiles/taxo_level3.db',&GDBM_READER(),0640);
   if ($minlevel<3) {
      tie(%taxo2, 'GDBM_File', $datapath.'dbfiles/taxo_level2.db',&GDBM_READER(),0640);
   }
   if ($minlevel<2) {
      tie(%taxo1, 'GDBM_File', $datapath.'dbfiles/taxo_level1.db',&GDBM_READER(),0640);
   }
# Business logic, finding stuff for each key that is supposed to be looked up
   foreach my $key (keys(%lookup)) {
      my $keystr='';
      if ($level{$key}==3) {
         $keystr=$taxo3{$lookup{$key}};
      } elsif ($level{$key}==2) {
         $keystr=$taxo2{$lookup{$key}};
      } elsif ($level{$key}==1) {
         $keystr=$taxo1{$lookup{$key}}
      }
# Put into unique output
      foreach my $c (split(/\s*\,\s*/,$keystr)) {
         if ($c) { $output{$c}++; }
      }
   }
# Now resolve dependencies, etc
   my $again=0;
   if ($minlevel<3) {
      foreach my $c (keys(%output)) {
         if ($c=~/\:/) {
# something to resolve
            my ($tlevel,$tsub)=split(/\:/,$c);
            delete($output{$c});
            my $keystr='';
            if ($tlevel==3) {
               $keystr=$taxo3{$tsub};
            } else {
               $keystr=$taxo2{$tsub};
            }
            foreach my $key (split/\,/,$keystr) {
               if ($key) { $output{$key}++; }
            }
            $again=1;
         }
         if ($c=~/\-/) {
            my ($start,$end)=split(/\-/,$c);
            delete($output{$c});
            if ($end>$start) {
               for (my $i=$start;$i<=$end;$i++) {
                  $output{$i}++;
               }
            }
         }
      }
   }
# If dependencies had been resolved and we were on the lowest level,
# we might have to resolve second-level dependencies
   if (($again) && ($minlevel<2)) {
      foreach my $c (keys(%output)) {
         if ($c=~/\:/) {
# something to resolve
            my ($tlevel,$tsub)=split(/\:/,$c);
            delete($output{$c});
# has to be level 3 now
            if ($tlevel==2) { print "\n=== Wow!!! === $c\n" };
            my $keystr=$taxo3{$tsub};
            foreach my $key (split/\,/,$keystr) {
               if ($key) { $output{$key}++; }
            }
         }
      }
   }
# Untie the levels we opened
   untie(%taxo3);
   if ($minlevel<3) {
      untie(%taxo2);
   }   
   if ($minlevel<2) {
      untie(%taxo1);
   }
   return %output;
}

# =================================================================================
#
#  Return the resource keys that match the keywords
#

sub keyword_search {
   my @keywords=@_;
   my %output=();
   my $skey=join(',', at keywords);
   $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/keywords.db',&GDBM_READER(),0640);
   foreach my $key (keys(%hash)) {
      if ($hash{$key}=~$pattern) {
         $output{$key}=1;
      }
   }
   untie(%hash);
   return(%output);
}

# =================================================================================
# Return the resource keys for URLs
# and vice versa. The dbfile is double-hashed

sub urlres {
   my @urls=@_;
   my %output=();
   my %hash=();
   tie(%hash, 'GDBM_File', $datapath.'dbfiles/url.db',&GDBM_READER(),0640);
   foreach my $url (@urls) {
      $output{$url}=$hash{$url}; 
   }
   untie(%hash);
   return(%output);
}

# =================================================================================
#

sub handle_request {
    my ($r,$c)=@_;
#
# Get the existing basket
#
    my ($cnum,$cdom,$folder)=split(/\,/,$env{'form.basket'});
    my %existingres=();
    if ($folder) {
       %existingres=&urlres(&mapread($cnum,$cdom,$folder));
    }
    my @existingbasket=();
    foreach my $importbasket (values(%existingres)) {
       if ($importbasket) {
          push(@existingbasket,$importbasket);
       }
    }
    $r->print(&Apache::loncommon::start_page("Recommender"));
    $r->print("<h1>Hello World!</h1>");
    $r->print(join("<br />\n", at existingbasket));
    $r->print(&Apache::loncommon::end_page());
    return 1;
}
1;


More information about the LON-CAPA-cvs mailing list