[LON-CAPA-cvs] cvs: modules /hoeppner lonsearch.pm lonsearchcat.pm
hoeppner
lon-capa-cvs-allow@mail.lon-capa.org
Sat, 28 Jun 2008 20:00:04 -0000
This is a MIME encoded message
--hoeppner1214683204
Content-Type: text/plain
hoeppner Sat Jun 28 16:00:04 2008 EDT
Added files:
/modules/hoeppner lonsearch.pm lonsearchcat.pm
Log:
prototype for community-aware search
--hoeppner1214683204
Content-Type: text/plain
Content-Disposition: attachment; filename="hoeppner-20080628160004.txt"
Index: modules/hoeppner/lonsearch.pm
+++ modules/hoeppner/lonsearch.pm
#!/usr/local/bin/perl
#
# to get all coordinators for a resource: use UsedResources
# 'SELECT USER_IDENTITY from UsedResources where RESOURCE_IDENTITY = ?'
#
# input: keyword, user, degree
# 0: all with keyword by user
# 1: additionally all resources by other users that used a certain resource with keyword
# algorithm:
# A) get all resources that match the keyword
# B) filter the results by reused authors
# C) display
package Apache::lonsearch;
use strict;
use DBI;
use Apache::lonmysql;
# database DEBUGrmation
my $dsn = 'DBI:mysql:communities:localhost';
my $db_user_name = 'root';
my $db_password = 'password';
my ($id, $password);
# $dbh is the database handle object
my $dbh = DBI->connect($dsn, $db_user_name, $db_password) || die "couldn't connect to DB";
# params
my $keyword = $ARGV[0];
my $user = $ARGV[1];
my $user_id = &getUserId($user);
# branching out $degree steps (for all algorithms)
my $degree = $ARGV[2];
# algorithm: 0 = authors used; 1 = parallel (common) coordinators ; 2 = WAC with degree
my $algorithm = $ARGV[3];
# sort: 0 = standard (reuse) 1 = author names alphabetically 2 = Access Count
my $sort = $ARGV[4];
my $connectivity = $ARGV[5];
my $extend_url = $ARGV[6];
my @keywords = ();
# global vars
my %user_resources = ();
my %keyword_resources = ();
my @result_list = ();
my @keyword_resources = ();
my %coordinators_hash = (); # TODO refactor name
my %reuse_data = ();
my %reuse_author = ();
my $rank = 0;
my %rank_data = ();
my %author_degree = ();
my $currentdegree = $degree + 1; # to determine the importance of every author (author reuse)
my %all_user_resources = (); # user_id -> %resources
my %resource_id = (); # resource url -> resource_identity
my %access_data = (); # resource url -> access count
my %res = ();
# new for integration into lon-capa
my $r;
my $table;
my %Fields;
my $instances = 50; # initialized to allow command line use..
my $related = 20;
my %title_data = ();
my %comefrom_data = ();
my %goto_data = ();
my %course_data = ();
my $un; # initiating users name
my $ud; # initiating users domain
my %similarity = (); # to save the similarity per coordinator
my %simdata = (); # holds the similarity per resource url
# get the user id ... TODO remove
#my $sti = $dbh->prepare("SELECT USER_IDENTITY FROM UserEntity WHERE username=?")
# or die "Couldn't prepare statement: " . $dbh->errstr;
# $sti->execute($user)
#my @userdata = $sti->fetchrow_array();
#my $user_identity = $userdata[0];
my $file = '/home/httpd/perl/logs/search.log'; # Name the file
open(DEBUG, ">$file"); # Open the file
DEBUG->autoflush(1);
print DEBUG "logfile in search..\n";
# main
sub main() {
print DEBUG "main subroutine...\n";
if ($algorithm eq 'create') {
createCommonReuseData();
}
if ($algorithm eq 'std') { # standard simple keyword search
%res = &getKeywordResources();
@result_list = keys %res;
# doSort();
# print DEBUG @result_list . " now \n";
storeResultList()
}
# compute the result list
# A) get keyword resources
getKeywordResources(); # TODO-remove: only to show the number of orig results
if ($algorithm eq 'usedauthors') { # LIMIT
print DEBUG "using used-author relationship \n";
computeAuthors();
%res = &getResources();
# print DEBUG %res . "\n";
@result_list = keys %res;
doSort();
# print DEBUG @result_list . " now \n";
storeResultList();
# printResultList(); # prints all results that match keywords and community-selection
} elsif ($algorithm eq "relatedcoordinators") { # LIMIT
print DEBUG "using related-coordinator relationship \n";
# who else used that resource? TODO thats for specific resources
computeCoordinators();
%res = &getResources();
@result_list = keys %res;
doSort();
storeResultList();
# printResultList(); # prints all results that match keywords and community-selection
} elsif ($algorithm eq "expandprepost" ) { # EXPAND TODO these branches are never called, the methods get called directly by lonsearchcat
# %res = &getKeywordResources(); # thats all resources regardless of authors/reuse
$res{$extend_url} = 'yep';
# $extend_url = '/res/pickerington/phscphysics/Honors Physics/Chapter 18 Electrical Energy and Capacitance/Chapter 18 Electrical Energy and Capacitance Study Sheet 6.problem';
expandPrePost($resource_id{$extend_url});
# print %res . "\n";
@result_list = keys %res;
# print @result_list . "\n";
# print "@result_list \n";
# doSort();
storeResultList();
# printResultList(); # prints all results that match keywords and community-selection
} elsif ($algorithm eq "unextend") { # TODO retrieve the previous results and display them
} elsif ($algorithm eq "extendwac") { # extend by WAC # need connectivity param
print DEBUG "extend by wac not implemented yet";
} elsif ($algorithm eq "extendsac") { # extend by WAC # need connectivity param
# idea: extend by course and SAC
$res{$extend_url} = 'yep';
expandSAC($resource_id{$extend_url});
@result_list = keys %res;
# print @result_list . "\n";
# print "@result_list \n";
# doSort();
storeResultList();
# OLD idea
# present all users in a SAC with high connectivity , e.g. 50
# (that way we only consider few users that are strongly related to an
# interesting resource)
# then allow to click each of these users to additionally show resources by this user
# problem: this is still not very specific -> a lot of results then that might
# not be related to the originating resource at all
# -> present all keywords this users has used (potentially in proportional
# size to the number of occurences)
} elsif ($algorithm eq "sac") { # limit by SAC
print DEBUG "using SAC relationship with connectivity " . $connectivity . "\n";
filterByAuthorCommunity(); # identifier is irritating .. this selects the authors we restrict to
%res = &getResources();
@result_list = keys %res;
doSort();
storeResultList();
# printResultList();
} elsif ($algorithm eq 'wac') { # limit by WAC
print DEBUG "using WAC relationship with connectivity " . $connectivity . "\n";
filterByAuthorCommunity(); # identifier is irritating .. this selects the authors we restrict to
%res = &getResources();
@result_list = keys %res;
doSort();
storeResultList();
# printResultList();
}
}
sub splitKeywords() {
@keywords = split(/:/, $keyword);
# add wildcards around the keywords (all keywords currently stored in a string in DB)
for (my $i=0; $i<@keywords; $i++) {
# TODO i actually have to consider the separators later
$keywords[$i] = "%$keywords[$i]%";
}
}
sub clearResults() {
my $table = $_[0];
my $sql = "DELETE from loncapa.$table";
my $stb = $dbh->prepare($sql)
or die "Couldn't prepare statement: " . $dbh->errstr;
$stb->execute();
print DEBUG "on clearing old results table:". $stb->err() . " ". $stb->errstr() ."\n" ;
}
sub saveRating() {
my $rating = $_[0];
my $comment = $_[1];
my $user = $_[2];
my $numberOfResults = $_[3];
# print DEBUG "----saving rating from: $user \n";
# 1) get the highest id for that user
my $id = &getCurrentId($user);
# 2) update row with that id
my $sql = "UPDATE communities.Evaluation SET rating=?, comment=?, results=? WHERE id=$id";
my $stb = $dbh->prepare($sql)
or die "Couldn't prepare statement: " . $dbh->errstr;
$stb->execute($rating, $comment,$numberOfResults);
print DEBUG "saved rating: $user";
print DEBUG $stb->errstr ."\n";
}
# to retrieve the keywords of the last search (that didnt extend)
sub getKeywords() {
my $user = $_[0];
my $logged_in_userid = &getLastId($user);
print DEBUG "getting keywords from DB $user $logged_in_userid \n";
my $sql = "select action from communities.Evaluation where user=? and id=?";
my $stb = $dbh->prepare($sql)
or die "Couldn't prepare statement: " . $dbh->errstr;
$stb->execute($user, $logged_in_userid);
my $data = $stb->fetchrow_array();
print DEBUG $data ."\n";
my @split_data = split(/;/,$data);
my $keywords = @split_data[2];
print DEBUG "got keywords from DB: $keywords \n";
return $keywords;
}
sub createEvaluationRow() {
my $user = $_[0]; # is that the start user or the issuing user?
# for filter: it's the start user ... another param for the issuing one..
# for a filter search...otherwise they're ''
my $keywords = $_[1];
my $algorithm = $_[2];
my $degree = $_[3];
my $connectivity = $_[4];
my $similarity = $_[5];
my $reuseinstances = $_[6];
# for expand
my $expand = $_[7]; # direct or sac
my $issuing_user = $_[8];
# print DEBUG "in search creating with $issuing_user \n";
# create the columns ...
my $search_type = ''; #
if ($expand eq '') {
$search_type .= "search;$user;$keywords;$algorithm;$degree;$connectivity;$similarity;$reuseinstances";
} else {
$search_type .= "expand;$expand;$keywords";
}
my $rating = 0;
my $comment = 'none';
# create the row
my $insert = "INSERT INTO communities.Evaluation VALUES (?, ?, ?, ?, ?, ?, ?)";
my $stj = $dbh->prepare($insert)
or die "Couldn't prepare statement: " . $dbh->errstr;
my @params = (&getCurrentId($issuing_user)+1,$issuing_user, $search_type, $rating, $comment, -1, -1);
# print DEBUG "---eval row with: @params \n";
$stj->execute(@params);
print DEBUG $stj->err . $stj->errstr;
# print DEBUG " created eval row\n";
}
sub getCurrentId() {
my $sta = $dbh->prepare("SELECT user, MAX(id) from communities.Evaluation WHERE user=? GROUP BY user")
or die "Couldn't prepare statement: " . $dbh->errstr;
$sta->execute($_[0]);
# print DEBUG $sta->errstr ."\n";
my $id;
if (my @id_data = $sta->fetchrow_array()) {
print DEBUG "retrieved $id_data[1] id is: " . $id_data[0] . " for $_[0]\n";
$id = $id_data[1];
} else {
print DEBUG "nothing ...retrieved $id_data[1] id is: " . $id_data[0] . " for $_[0]\n";
$id = 0;
}
# print DEBUG "chosen id is: " . $id . "\n";
return $id;
}
sub standard() {
print "started.\n";
createResultRow();
}
sub getLastId() {
my $user = $_[0];
my $sql = "select max(id) from communities.Evaluation where user=? and action LIKE 'search;%'";
my $stb = $dbh->prepare($sql)
or die "Couldn't prepare statement: " . $dbh->errstr;
$stb->execute($user);
my $logged_in_userid = $stb->fetchrow_array(); # this is not user id but the current Evaluation id for the user
print DEBUG "query result: $logged_in_userid; status?:" .$stb->err . " ".$stb->errstr ." " . $dbh->errstr . "\n";
return $logged_in_userid;
}
# extends the result list with all resources, that
# were used in the same course and were authored by a member of the start users SAC
sub expandSAC() {
my $community = $_[6];
$user = $_[5]; # this holds the logged in user, not the start user, contrary to the user_id in this case!!
print DEBUG "user is $user \n";
$user_id = &getUserId($_[3]); # using the start user here!!
my $keywords = $_[4];
if ($keywords eq '') {
my $logged_in_userid = &getLastId($user);
print DEBUG "getting keywords from DB $user $logged_in_userid \n";
my $sql = "select action from communities.Evaluation where user=? and id=?";
my $stb = $dbh->prepare($sql)
or die "Couldn't prepare statement: " . $dbh->errstr;
$stb->execute($user, $logged_in_userid);
my $data = $stb->fetchrow_array();
print DEBUG $data ."\n";
my @split_data = split(/;/,$data);
$keywords = @split_data[2];
print DEBUG "got keywords from DB: $keywords \n";
}
my @keys = split(/ /, $keywords);
print DEBUG "extending for $user_id by course+SAC+keys: " . $_[0] . " @keys \n";
my $resource_id = $_[0];
$table = $_[1];
$r = $_[2];
# 0) get the SAC for the start user $user_id
my @SAC = ();
my $sql_string = "SELECT MEMBER from $community WHERE USER_ID=?";
my $sta = $dbh->prepare($sql_string)
or die "Couldn't prepare statement: " . $dbh->errstr;
$sta->execute($user_id);
while (my $member = $sta->fetchrow_array()) {
push(@SAC, $member);
}
if (@SAC>0) {
# 1) get the courses from ResourceEntity for $resource_id
my @courses = ();
my $stb = $dbh->prepare("SELECT courses from ResourceEntity WHERE RESOURCE_IDENTITY=?")
or die "Couldn't prepare statement: " . $dbh->errstr;
$stb->execute($resource_id);
while (my $course = $stb->fetchrow_array()) {
my @c = split(/,/, $course);
foreach my $co (@c) {
push(@courses, $co);
}
}
if (@courses>0) {
# print DEBUG "courses: @courses \n";
print DEBUG "SAC for $user_id: ".@SAC. "\n";
for (my $i = 0; $i<@courses ; $i++) {
$courses[$i] = '%'.$courses[$i].'%';
}
for (my $i = 0; $i<@keys ; $i++) {
$keys[$i] = '%'.$keys[$i].'%';
}
my $actr = 1;
my $cctr = 1;
my $kctr = 1;
my $sql = "SELECT * FROM ResourceEntity WHERE (author=?";
for (my $i = 1; $i<@SAC ; $i++) {
$sql .= " OR author=?";
$actr++;
}
$sql .= ") and (courses LIKE ?";
for (my $i = 1; $i<@courses ; $i++) {
$sql .= " OR courses LIKE ?";
$cctr++;
}
$sql .= ")";
$sql .= " and (keywords LIKE ? ";
for (my $i = 1; $i<@keys ; $i++) {
$sql .= " OR keywords LIKE ?";
$kctr++;
}
$sql .= ")";
# print DEBUG "query: " . $sql . "\n";
my $sth = $dbh->prepare($sql)
or print DEBUG "Couldn't prepare statement: " . $dbh->errstr;
my @params = ();
foreach my $author (@SAC) {
push(@params, &getUserName($author));
}
push(@params, @courses);
push(@params, @keys);
print DEBUG "arguments: $actr authors and $cctr courses and $kctr keywords for slots " . @params ."\n";
# print DEBUG "parameters ". @keys ." ". @courses . " " . @SAC .": @params";
$sth->execute(@params);
print DEBUG "...\n";
print DEBUG "on selecting the resource entities:" .$sth->err();
print DEBUG $sth->errstr() ."\n";
# for each resource: saveExtend
while (my @result = $sth->fetchrow_array()) {
# print "- result: @result \n";
# save necessary data into hashes ... TODO this can be done way
# more efficiently than with handleExtendUrl...
# handleExtendUrl($result[1]);
$access_data{$result[2]} = $result[4];
$res{$result[2]} = 'yep';
# data for url before..
$title_data{$result[2]} = $result[8];
$comefrom_data{$result[2]} = $result[5];
$goto_data{$result[2]} = $result[6];
$course_data{$result[2]} = $result[7];
$resource_id{$result[2]} = $result[0];
saveExtend($result[2]);
}
} else {
print DEBUG "no courses found...\n";
}
} else {
print DEBUG "no community found for user!\n";
}
setFinishedExtend($table,$user);
}
sub getUserName() {
my $sti = $dbh->prepare("SELECT username FROM UserEntity WHERE USER_IDENTITY=?")
or die "Couldn't prepare statement: " . $dbh->errstr;
$sti->execute($_[0]);
my @userdata = $sti->fetchrow_array();
return $userdata[0];
}
# extends the result list with all resources, that
# were used before or after the resources
sub expandPrePost() {
$user = $_[3];
print DEBUG "user is $user \n";
# print "extending by pre/post: " . $_[0] . "\n";
my $resource_id = $_[0];
$table = $_[1];
$r = $_[2];
print DEBUG 'r in search expand: '.$r . "\n";
# print $resource_id . " \n";
my $stj = $dbh->prepare("SELECT comefrom, goto FROM ResourceEntity WHERE RESOURCE_IDENTITY=?")
or die "Couldn't prepare statement: " . $dbh->errstr;
$stj->execute($resource_id);
# additional resources go to the bottom by default
print DEBUG "pre/post for: " . $resource_id . "\n";
# add the access counts for the original and extended urls
my $sta = $dbh->prepare("SELECT url, ACCESS FROM ResourceEntity WHERE RESOURCE_IDENTITY=?")
or die "Couldn't prepare statement: " . $dbh->errstr;
$sta->execute($resource_id);
my @access = $sta->fetchrow_array();
$access_data{$access[0]} = @access[1];
#
while (my @data = $stj->fetchrow_array()) {
# print DEBUG "bef1: " . $data[0] ."\n";
# print DEBUG "aft1: " . $data[1] ."\n";
# print DEBUG "----------\n";
my @beforedata = split(/,/, $data[0]); # TODO if there is NO separator, the array remains empty!?
my @afterdata = split(/,/, $data[1]); # TODO if there is NO separator, the array remains empty!?
# print DEBUG "bef: " . @beforedata ."\n";
# print DEBUG "aft: " . @afterdata ."\n";
foreach my $before (@beforedata) {
handleExtendUrl($before);
}
foreach my $after (@afterdata) {
handleExtendUrl($after);
}
}
my @userda = split(/:/,$user);
setFinishedExtend($table,$userda[0],$userda[1]);
}
## saves the statistics about the search and the user satisfaction into the DB
#sub saveReport() {
# my $user = $user_id; # the user performing the search
# my $satisfaction = $_[0]; # 1-5
# my $comment = $_[1]; # text comment by the user
# my $searchaction = $_[2]; # the action (search by filter / extend) that led to that report
# # get the last reports id, increase and save a new report
#
#
# my $sth = $dbh->prepare("SELECT ACCESS, title, goto, comefrom, courses, RESOURCE_IDENTITY FROM ResourceEntity WHERE url=?")
# or die "Couldn't prepare statement: " . $dbh->errstr;
# $sth->execute($before);
#}
# handles one url that is added by the extension of the original url
sub handleExtendUrl() {
my $before = $_[0];
# attach the /res/ in front of the url
$before = '/res/' . $before;
# print DEBUG "extending by url: " . $before ."\n";
my $sth = $dbh->prepare("SELECT ACCESS, title, goto, comefrom, courses, RESOURCE_IDENTITY FROM ResourceEntity WHERE url=?")
or die "Couldn't prepare statement: " . $dbh->errstr;
$sth->execute($before);
my @access_before = $sth->fetchrow_array();
$access_data{$before} = $access_before[0];
$res{$before} = 'yep';
# data for url before..
$title_data{$before} = $access_before[1];
$comefrom_data{$before} = $access_before[3];
$goto_data{$before} = $access_before[2];
$course_data{$before} = $access_before[4];
$resource_id{$before} = $access_before[5];
# save both results...currently all resources only have one before and one after..!?
# print DEBUG "extended url is: " . $before . "\n";
saveExtend($before);
}
sub saveExtend() {
my $url = $_[0];
my @usernamedata = split(/:/, $user);
my $shorturl = substr $url, 5; # TODO why did I use this one in select clause???
# print DEBUG "looking for: " . $shorturl . " in $table\n";
# print DEBUG "looking for: " . $url . "\n";
# only save if the url is not already present ...
my $sql = "SELECT url FROM loncapa.$usernamedata[0]_$usernamedata[1]_$table WHERE url=?";
# print DEBUG "sql: " . $sql ."\n";
my $sth = $dbh->prepare($sql)
or die "Couldn't prepare statement: " . $dbh->errstr;
$sth->execute($url);
print DEBUG $sth->err;
print DEBUG $sth->errstr;
my $already_present = $sth->fetchrow_array();
# print DEBUG "result: " . $already_present ."\n";
unless ($already_present) {
# print DEBUG $already_present . " url fetched ... saving $url \n";
my $returned_fields = &createResultRow($url, 'extension', 0); # TODO put them into proper position
# Store the result in the mysql database
my $result = &Apache::lonmysql::store_row($table,\%$returned_fields);
# $r->print("<br>one result stored<br>");
# $r->rflush();
if (! defined($result)) {
$r->print(&Apache::lonmysql::get_error());
}
}
}
# only leaves resources that have been authored by the users assigned
# WAC with connectivity set by parameter 5: $connectivity
# TODO 'natural sort' = ?
# (one might argue they're all of the same importance)
# only sortable by author-names and access count for now
sub filterByAuthorCommunity() {
print "author community for: " . $user_id . "\n";
$coordinators_hash{$user_id} = 'included'; # should this be excluded?
my $sql = "";
if ($algorithm eq 'wac') {
$sql = "SELECT MEMBER FROM AssignedWAC". $connectivity ." WHERE USER_ID=?";
} else { # sac
$sql = "SELECT MEMBER FROM AssignedSAC". $connectivity ." WHERE USER_ID=?";
}
my $sth = $dbh->prepare($sql)
or die "Couldn't prepare statement: " . $dbh->errstr;
$sth->execute($user_id);
while (my $member = $sth->fetchrow_array()) {
$coordinators_hash{$member} = 'included';
print $member ."\n";
}
my @coordgroup = keys %coordinators_hash;
# print @coordgroup . " authors considered due to chosen degree\n";
}
sub doSort() {
if ($sort eq '') {
# dont sort.
} elsif ($sort eq 'sortbyreuse') {
sortResultsByReuse();
} elsif ($sort eq 'sortbyauthor') {
sortResultsByAuthor();
} elsif ($sort eq 'sortbyaccess') {
sortByAccessCount();
} elsif ($sort eq 'sortbysimilarity') {
sortBySimilarity();
}
}
sub sortBySimilarity() {
print DEBUG "sorting by similarity \n";
# top ones are the ones used by coordinators with highest similarity
@result_list = sort { print DEBUG $simdata{$b} . " " . $simdata{$b} . "\n"; $simdata{$a} <=> $simdata{$a} } keys %simdata;
print DEBUG "sorted list: \n";
print DEBUG "@result_list\n";
}
# extracts the author name and domain name:domain from an url
sub getAuthor() {
my $url = $_[0];
my @authordata = split(/\//, $url);
my $author = $authordata[3] . ':' . $authordata[2];
return $author;
}
# sorts the resources in the result set by access count
sub sortByAccessCount() {
print "sorting by access count\n";
@result_list = sort { $access_data{$b} <=> $access_data{$a} } keys %access_data;
}
sub createCommonReuseData() {
my $sth = $dbh->prepare("SELECT USER_IDENTITY FROM UserEntity")
or die "Couldn't prepare statement: " . $dbh->errstr;
$sth->execute();
while (my $userx = $sth->fetchrow_array()) {
# get the resources
my $stj = $dbh->prepare("SELECT RESOURCE_IDENTITY FROM UsedResources WHERE USER_IDENTITY=?")
or die "Couldn't prepare statement: " . $dbh->errstr;
$stj->execute($userx);
# $all_user_resources{$userx} = ();
while (my $resourcex = $stj->fetchrow_array()) {
$all_user_resources{$userx}{$resourcex} = 'true';
# print "size: " . $resourcex . " " .$all_user_resources{$userx}{$resourcex}. "\n";
}
# if ($userx == 1296) {
# my $user_resources = $all_user_resources{$userx};
# print "user \n";
## print %$user_resources;
# print "######## \n";
# foreach my $res (keys %$user_resources) {
# print "$res" ."\n";
# }
# }
# $all_user_resources{$userx} = %user_resources;
}
# print $all_user_resources{1296}{268730};
# exit();
my @users = keys %all_user_resources;
my $ctr = 0;
foreach $user (@users) {
if ($ctr % 10 == 0) {
print $ctr . "\n";
}
cr($user);
$ctr++;
}
# while (my $userx = $sth->fetchrow_array()) { # for every user ...
# if ($userx > $keyword && $userx <= $degree) {
# print $userx . " comp \n";
# $|++;
# commonReuse($userx);
# }
# }
exit;
}
# A) get all resources matching keyword(s)
sub getKeywordResources() {
my %keyword_resources_hash = ();
my $sql_query = "SELECT * FROM ResourceEntity WHERE keywords LIKE ?";
# add clauses for every keyword given
# - start at 1 since the first keyword is taken care of in original query
for (my $i=1 ; $i<@keywords ; $i++) {
$sql_query = $sql_query . " AND keywords LIKE ?";
}
# print "query: $sql_query \n";
# print "used with keywords: @keywords \n";
# technical explanation: prepare returns a statement handle object
my $sth = $dbh->prepare($sql_query)
or die "Couldn't prepare statement: " . $dbh->errstr;
$sth->execute(@keywords); # TODO match this with the user filtered resources
while (my @resource_by_keyword = $sth->fetchrow_array()) {
my $url = $resource_by_keyword[2];
$access_data{$url} = $resource_by_keyword[4];
$title_data{$url} = $resource_by_keyword[8];
$comefrom_data{$url} = $resource_by_keyword[5];
$goto_data{$url} = $resource_by_keyword[6];
$course_data{$url} = $resource_by_keyword[7];
push(@keyword_resources, $url); # push url to the keyword res
$keyword_resources_hash{$url} = 'yep';
# if ($url =~ m/^\/res\/lakefenton/) {
# print "adding resource id for: " . $url . "\n";
$resource_id{$url} = $resource_by_keyword[0];
}
my @num_keyword_res = keys %keyword_resources_hash;
print @num_keyword_res . " resources for $keyword \n";
my $number_results = @num_keyword_res;
saveNumberOfResources($number_results);
return %keyword_resources_hash;
}
sub saveNumberOfResources() {
my $count = $_[0];
my $user = $un.":".$ud;
my $last_id = &getLastId($user);
print DEBUG "saving total for ".$user. " " . $count . " " .$last_id."\n";
my $sth = $dbh->prepare("UPDATE communities.Evaluation set total=? where id=? and user=? and action LIKE 'search;%'")
or die "Couldn't prepare statement: " . $dbh->errstr;;
$sth->execute($count,$last_id,$user);
print DEBUG "---on saving total: " .$sth->err() . $sth->errstr() ."\n";
}
sub initReuseData() {
my @authors = keys %coordinators_hash;
foreach my $author (@authors) {
$reuse_data{$author} = -1;
}
}
sub getResourceAuthors() {
my %res_authors_hash = ();
foreach my $url (@result_list) {
my @authordata = split(/\//, $url);
my $author_name = $authordata[3] . ':' . $authordata[2];
$res_authors_hash{&getUserId($author_name)} = 'included';
}
my @res_authors = keys %res_authors_hash;
return @res_authors;
}
# multiply by 2 to indicate importance of reuse instances
# corresponding to the degree the user was included by
sub computeReuseInstancesWeighted() {
# for each author
my @coordinators = keys %coordinators_hash;
my @authors = getResourceAuthors();
# initialize weighted reuse-instances of authors
foreach my $author (@authors) {
$reuse_author{$author} = 0;
}
foreach my $user (@coordinators) {
foreach my $author (@authors) {
# print "looking for: " . $user . " " . $author . "\n";
my $stj = $dbh->prepare("SELECT COUNT FROM UsedAuthors WHERE USER_IDENTITY=? AND USED_IDENTITY=?")
or die "Couldn't prepare statement: " . $dbh->errstr;;
$stj->execute($user, $author);
if (my $reuse_instances = $stj->fetchrow_array()) {
# increase reuse instances
# print "setting author instances: " . $author;#
# $|++;
# print "to: 0 + " . $reuse_instances;
# $|++;
# print "+ " . $author_degree{$author} . "\n";
$reuse_author{$author} = $reuse_author{$author} + $reuse_instances * $author_degree{$user};
# print "set " . $author . " to : " . $reuse_author{$author} . " \n";
$|++;
}
}
}
}
# TODO-deprecated
sub computeReuseInstances() {
my @users = $_[0];
# cumulative reuse instances ...
foreach my $user (@users) {
# for each author that hasn't been ranked yet: get the number of reuse instances
my @authors = keys %coordinators_hash;
foreach my $author (@authors) {
my $stj = $dbh->prepare("SELECT COUNT FROM UsedAuthors WHERE USER_IDENTITY=? AND USED_IDENTITY=?")
or die "Couldn't prepare statement: " . $dbh->errstr;;
$stj->execute($user, $author);
my $reuse_instances = -1;
$reuse_instances = $stj->fetchrow_array();
if ($reuse_instances != -1) {
# increase reuse instances
$reuse_data{$author} = 0 + $reuse_instances;
$rank_data{$author} = $rank;
}
}
}
$rank++; # increase rank for every iteration
}
sub sortResultsByReuse() {
print "sorting by reuse \n";
computeReuseInstancesWeighted();
# reuse_author contains author_id => weightedImportance
my $c = 0;
foreach my $url (@result_list) {
my @authordata = split(/\//, $url);
my $author_name = $authordata[3] . ':' . $authordata[2];
$reuse_data{$url} = &getUserId($author_name);
$c++;
}
my @urls = keys %reuse_data;;
my $ctr = 0;
# add the reuse instances to reuse_data
foreach my $url (@urls) {
$reuse_data{$url} = $reuse_author{$reuse_data{$url}};
}
@result_list = sort { $reuse_data{$a} <=> $reuse_data{$b} } keys %reuse_data;
# my @authors = keys %reuse_author;
# foreach my $author (@authors) {
# print "importance of " . $author . " " . $reuse_author{$author} . "\n ";
# }
}
# TODO deprecated
# sorted by number of reuse instances (starting user -> author -> author...)
sub sortResultsByReuseDeprecated() {
# @result_list contains all urls ...
# i need the authors (contained in url)
# i need the number every author was reused by a user (from DB UsedAuthors)
# my %reuse_data = (); # contains the reuse instances per url
# then sort every url by author
foreach my $url (@result_list) {
my @authordata = split(/\//, $url);
# print $authordata[3] . ':' . $authordata[2] . "\n";
my $author_name = $authordata[3] . ':' . $authordata[2];
my $sql = "";
my $stj = $dbh->prepare("SELECT COUNT FROM UsedAuthors WHERE USER_IDENTITY=? AND USED_IDENTITY=?")
or die "Couldn't prepare statement: " . $dbh->errstr;;
$stj->execute(&getUserId($user), &getUserId($author_name));
my $reuse_instances = -1;
$reuse_instances = $stj->fetchrow_array();
if ($reuse_instances == -1) {
# prepare to add it later...
# $finish = 0; # not finished yet;
} else {
$reuse_data{$url} = $reuse_instances;
}
# print $author_name. " reused " .$reuse_instances . " times \n";
}
@result_list = sort { $reuse_data{$b} <=> $reuse_data{$a} } keys %reuse_data;
}
# alphabetical sort
# TODO should toLowerCase the author names for alphabetical order
sub sortResultsByAuthor() {
print "sorting alphabetically by author\n";
foreach my $url (@result_list) {
my @authordata = split(/\//, $url);
my $author_name = $authordata[3] . ':' . $authordata[2];
$reuse_data{$url} = $author_name;
}
@result_list = sort { $reuse_data{$a} cmp $reuse_data{$b} } keys %reuse_data;
}
# extend the result list with all resources that were also
# used in the courses the directly found results were used in
sub extendByCourse() {
}
# this will extend the result list by adding all resources of authors
# that are in the users community
#
# possible bonus:
# the user sees a list of additional keywords to narrow down those results again
sub extendByRecommendation() {
}
sub computeCoordinators() {
# add the starting user
$coordinators_hash{&getUserId($user)} = 'included';
for (my $i=0; $i<$degree ; $i++) {
# print "degree $i+1\n";
addCommonCoordinators();
}
# print "finished adding others..\n";
my @coordgroup = keys %coordinators_hash;
print @coordgroup . " coordinators considered due to chosen degree\n";
foreach my $c (@coordgroup) {
print $c . " ";
}
print "\n";
}
# TODO-remove deprecated
sub filterByCommonReuse() {
# get all users from CommonReuse for my ID
# - show only those resources that have been reused by these users (first level)
getKeywordResources();
getResources(); # for all users
# (second level... depending on outcome for first level -- alternative is before/after)
}
sub getUserId() {
# get the user id
my $sti = $dbh->prepare("SELECT USER_IDENTITY FROM UserEntity WHERE username=?")
or die "Couldn't prepare statement: " . $dbh->errstr;
$sti->execute($_[0]);
my @userdata = $sti->fetchrow_array();
return $userdata[0];
}
# get all of users resource ids
# TODO-cleanup: only save resources if keywords match?
sub getResources {
my @coordinators = keys %coordinators_hash;
# print "---\n";
# print @coordinators;
# print "---\n";
# print %coordinators_hash;
# print "---\n";
my %user_resources_local = ();
for (my $j=0; $j<@coordinators ; $j++) {
my $c1 = 0;
my $user_id = $coordinators[$j];
my $sql_query = "SELECT U.RESOURCE_IDENTITY, R.url, R.ACCESS, R.title, R.goto, R.comefrom, R.courses FROM UsedResources U, ResourceEntity R WHERE (U.USER_IDENTITY=? AND U.RESOURCE_IDENTITY = R.RESOURCE_IDENTITY AND R.keywords LIKE ?)";
for (my $i=1 ; $i<@keywords ; $i++) {
$sql_query = $sql_query . " AND R.keywords LIKE ?";
}
# old query: "SELECT RESOURCE_IDENTITY FROM UsedResources WHERE USER_IDENTITY=?"
my $stj = $dbh->prepare($sql_query)
or die "Couldn't prepare statement: " . $dbh->errstr;
my @param = ();#@keywords;
push(@param, $user_id);
foreach my $keyword (@keywords) {
push(@param, $keyword);
}
#splice @param, 1, 0, $user_id;
#print DEBUG "@param search \n";
$stj->execute(@param);
while (my @user_resource = $stj->fetchrow_array()) {
$c1++;
my $res_url = $user_resource[1]; # &getUrl($user_resource); # inefficient..replaced with diff sql
#print "adding url $res_url \n";
#print $user_resource;
$user_resources_local{$res_url} = 'yep'; # probably could put ID here...
$resource_id{$res_url} = $user_resource[0];
$access_data{$res_url} = $user_resource[2];
$title_data{$res_url} = $user_resource[3];
$comefrom_data{$res_url} = $user_resource[5];
$goto_data{$res_url} = $user_resource[4];
$course_data{$res_url} = $user_resource[6];
# get previous simdata, only replace if new value is higher than the old one
if ($simdata{$res_url} < $similarity{$user_id}) {
$simdata{$res_url} = $similarity{$user_id}; # holds the similarity-ranking for the current user
}
}
# my @test = keys %user_resources_local;
#print @test ." $c1 resources for user $user_id\n";
}
return %user_resources_local;
}
# only used by commonReuse()
sub getUserResources() {
my %user_resources = ();
my $stj = $dbh->prepare("SELECT RESOURCE_IDENTITY FROM UsedResources WHERE USER_IDENTITY=?")
or die "Couldn't prepare statement: " . $dbh->errstr;
$stj->execute($_[0]);
while (my $user_resource = $stj->fetchrow_array()) {
$user_resources{&getUrl($user_resource)} = 'yep';
}
return %user_resources;
}
# gets the url for a resource id
sub getUrl() {
my $resource_id = $_[0];
# print "searching url for: " . $resource_id;
my $stj = $dbh->prepare("SELECT r.url FROM ResourceEntity r WHERE RESOURCE_IDENTITY=?")
or die "Couldn't prepare statement: " . $dbh->errstr;
$stj->execute($resource_id);
my $url = $stj->fetchrow_array();
# print $url . " is the current url. \n";
return $url;
}
# as coordinators in community (not the authors of the found resources)
sub computeAuthors {
# add the starting user
$coordinators_hash{$user_id} = 'included';
$author_degree{&getUserId($user_id)} = 2 ** $currentdegree;
# print "set author_degree " . &getUserId($user) . " to: " . $author_degree{&getUserId($user)} . " for " . $currentdegree . " \n";
for (my $i=0; $i<$degree ; $i++) {
$currentdegree--;
addUsedAuthors();
}
my @coordgroup = keys %coordinators_hash;
print @coordgroup . " authors considered due to chosen degree\n";
}
sub addUsedAuthors() {
my @coordgroup = keys %coordinators_hash;
foreach my $coordinator (@coordgroup) {
# get used authors
my $stj = $dbh->prepare("SELECT USED_IDENTITY FROM UsedAuthors WHERE USER_IDENTITY=? AND COUNT>?")
or die "Couldn't prepare statement: " . $dbh->errstr;
$stj->execute($coordinator,$instances);
my $ctr = 0;
while (my @author_identities = $stj->fetchrow_array()) {
# push(@usedAuthors, $author_identities[0]);
$coordinators_hash{$author_identities[0]} = 'included';
$author_degree{$author_identities[0]} = 2 ** $currentdegree;
# print "set author_degree " . $author_identities[0] . " to: " . $author_degree{$author_identities[0]} . " for " . $currentdegree . " \n";
#print DEBUG "added used author: $author_identities[0] \n";
$ctr++;
}
}
}
# TODO waiting for the base data to complete ...
sub addCommonCoordinators() {
my @coordgroup = keys %coordinators_hash;
foreach my $coordinator (@coordgroup) {
# print "for coord: $coordinator\n";
# get used authors
my $stj = $dbh->prepare("SELECT USED_IDENTITY, CRA FROM CommonReuse WHERE USER_IDENTITY=? AND CRA>?")
or die "Couldn't prepare statement: " . $dbh->errstr;
$stj->execute($coordinator,$related/100);
my $ctr = 0;
while (my @coord_identities = $stj->fetchrow_array()) {
# print "@author_identities \n";
# push(@usedAuthors, $author_identities[0]);
$coordinators_hash{$coord_identities[0]} = 'included';
$similarity{$coord_identities[0]} = $coord_identities[1];
#print "added used author: $author_identities[0] \n";
$ctr++;
}
}
}
# TODO-cleanup remove returns etc.
sub filterByUsedAuthors {
# match keyword-results and user-results
# my @user_keyword_resources = ();
my $counter = 0;
my $counter_match = 0;
my @keyword_urls = keys %keyword_resources;
# print @keyword_urls . " urls so far \n";
my @user_urls = keys %user_resources;
# print @user_urls . " user-res so far \n";
# check each keyword-filtered resource whether it's in the list of reused resources
foreach my $url (@keyword_urls) {
my $counter++;
#print "trying $resource_id with ";
# print "$url contained: $user_resources{$url} : $keyword_resources{$url} \n";
if (($user_resources{$url} eq 'yep') && $keyword_resources{$url} eq 'yep') {
$counter_match++;
# print "$counter_match -$used_resources[$resource_id]- $data[2] \n";
push(@result_list, $url);
};
};
#print @user_keyword_resources . " resources for keyword + user \n";
# return @user_keyword_resources;
}
# TODO sorting with degree of importance for WAC and CommonCoordinators!!
sub getWAC() {
my $sql = "SELECT MEMBER FROM " . $_[0] . " WHERE ID=?";
my $stj = $dbh->prepare($sql)
or die "Couldn't prepare statement: " . $dbh->errstr;
$stj->execute(&getUserId($user));
while (my $member = $stj->fetchrow_array()) {
$coordinators_hash{member} = 'included';
}
}
sub cr() {
my @users = keys %all_user_resources;
my $ctr = 0;
my $resources = $all_user_resources{$_[0]}; # calling user
my %user_res = %$resources;
my @rescount = keys %user_res;
if (@rescount > 0) {
foreach my $user (@users) {
# compute the cra and save
my $cra = 0.0;
# get the resources
my $other_resources = $all_user_resources{$user};
my @othercount = keys %$other_resources;
my $sum = @rescount + @othercount;
# if ($user == 1296) {
# print "user \n";
# print @othercount;
# print "-----------\n";
# print $all_user_resources{$user} . "\n";
# my $c = 0;
# find the identical ones ...
foreach my $res (@othercount) {
# print $c. " ". $res . "\n"; #
if ($user_res{$res} eq 'true') {
$cra++;
}
# $c++;
}
# exit(); #
# } #
$cra = $cra / $sum;
# print $cra . " " . $sum . "\n";
if ($cra > 0) { # only insert for a minimum cra of x,yz% commonly reused
my $insert = "INSERT INTO CommonReuse VALUES (?, ?, ?)";
$cra = round($cra*1000)/1000;
my $stj = $dbh->prepare($insert)
or die "Couldn't prepare statement: " . $dbh->errstr;
my @params = ($_[0], $user, $cra);
$stj->execute(@params);
}
}
}
}
sub round {
my($number) = shift;
return int($number + .5);
}
sub printResultList {
my $counter_match = 0;
foreach my $resource (@result_list) {
$counter_match++;
print "\t $resource $access_data{$resource}\n";
}
print "$counter_match results \n";
# print "$counter_match / $counter results (match / all)\n";
}
sub storeResultList() {
# print DEBUG "storing results ..." . @result_list . "\n";
my $ctr = 0;
foreach my $resource (@result_list) {
my $returned_fields = &createResultRow($resource,'',$ctr);
# Store the result in the mysql database
my $result = &Apache::lonmysql::store_row($table,\%$returned_fields);
# $r->print("<br>one result stored<br>");
$r->rflush();
if (! defined($result)) {
$r->print(&Apache::lonmysql::get_error());
}
$ctr++;
}
}
sub validateParameters() {
# validate the number of arguments
if (@ARGV<5) {
print "5 arguments necessary: \n";
print "keyword startinguser degree algorithm sort\n";
print "f.e. \n";
print "perl search.pl energy:capacitor kortemey:msu 1 relatedcoordinators sortbyaccess\n";
exit;
}
}
# how do I know
# - which user startet the search
# - what he entered ...
sub search() {
$keyword = $_[0];
# print DEBUG $keyword . "\n";
$keyword =~ s/ /:/g;
$keyword = lc($keyword);
$user = $_[1];
$user_id = &getUserId($user);
$algorithm = $_[2];
$sort = $_[3];
$degree = $_[4];
$connectivity = $_[5];
$extend_url = $_[6]; # for extend with predecessors/successors
$table = $_[7];
$r = $_[8];
$instances = $_[9];
$related = $_[10];
$un = $_[11];
$ud = $_[12];
print DEBUG "user: $user with $user_id degree: $degree connectivity: $connectivity instances: $instances related: $related\n";
splitKeywords();
main();
setFinished($table,$un,$ud);
return 'true';
}
sub setFinishedExtend() {
my $num = 0;
my $user = $_[1];
my @table_data = split (/:/,$user);
my $sql = "SELECT count(id) from loncapa.$table_data[0]_$table_data[1]_$_[0]";
print DEBUG $sql . " sql query \n";
my $sth = $dbh->prepare($sql)
or print DEBUG "Couldn't prepare statement: " . $dbh->errstr;
$sth->execute();
$num = $sth->fetchrow_array();
# print DEBUG "----saving rating from: $user \n";
# 1) get the highest id for that user
my $id = &getCurrentId($user);
# 2) update row with that id
my $sql = "UPDATE communities.Evaluation set results=? WHERE id=$id";
my $stb = $dbh->prepare($sql)
or die "Couldn't prepare statement: " . $dbh->errstr;
$stb->execute($num);
print DEBUG "saved rating: $user";
print DEBUG $stb->errstr ."\n";
print DEBUG "$num results \n" ;
}
sub setFinished() {
my $num = 0;
my $sql = "SELECT count(id) from loncapa.$_[1]_$_[2]_$_[0]";
print DEBUG $sql . " sql query \n";
my $sth = $dbh->prepare($sql)
or print DEBUG "Couldn't prepare statement: " . $dbh->errstr;
$sth->execute();
$num = $sth->fetchrow_array();
if ($num==0) {
$sql = "INSERT INTO loncapa.$_[1]_$_[2]_$_[0] values (0,'no results found.',null,null,'invalid',null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null,null)";
print DEBUG $sql . "\n";
$sth = $dbh->prepare($sql)
or print DEBUG "Couldn't prepare statement: " . $dbh->errstr;
$sth->execute();
print DEBUG "0 results: " . $sth->err . " " .$sth->errstr ."\n";
}
my $user = $_[1] . ":".$_[2];
# print DEBUG "----saving rating from: $user \n";
# 1) get the highest id for that user
my $id = &getCurrentId($user);
# 2) update row with that id
my $sql = "UPDATE communities.Evaluation set results=? WHERE id=$id";
my $stb = $dbh->prepare($sql)
or die "Couldn't prepare statement: " . $dbh->errstr;
$stb->execute($num);
print DEBUG "saved rating: $user";
print DEBUG $stb->errstr ."\n";
print DEBUG "$num results \n" ;
}
sub createResultRow() {
my $url = $_[0];
my $extension = $_[1];
my $sort_id = $_[2];
my $access = $access_data{$url};
my $author = &getAuthor($url);
%Fields = (
title => $title_data{$url},
author => $author,
subject =>'unknown',
url =>$url,
restrictions => 'NOT NULL',
keywords =>'',
version =>'',
notes =>'',
abstract=>'',
mime =>'',
language =>'',
creationdate=>'01.01.1900',
lastrevisiondate=>'DATETIME',
owner=>'',
copyright=>'',
domain =>'',
#--------------------------------------------------
dependencies=>'',
modifyinguser=>'',
authorspace =>'',
lowestgradelevel =>0,
highestgradelevel =>0,
standards =>$extension,
count =>$access,
course =>0,
course_list =>$course_data{$url},
goto => $resource_id{$url}, # this should work since our IDs are all small enough to fit into int
goto_list => $goto_data{$url},
comefrom =>0,
comefrom_list =>$comefrom_data{$url},
sequsage =>0,
sequsage_list =>'',
stdno =>$sort_id,
stdno_list =>'',
avetries =>0,
avetries_list =>'',
difficulty =>0,
difficulty_list=>'',
disc =>0,
disc_list =>'',
clear =>0,
technical =>0,
correct =>0,
helpful => 0,
depth => 0,
hostname => '',
);
# while ( my ($k,$v) = each %table_row ) {
# print "$k => $v\n";
# }
return \%Fields;
#my $ref = \%table_row;
# print "log in search..\n";
# my @keys = keys %$ref;
# print @keys . "\n";
# foreach my $key (@keys) {
# print "for $key : $ref->{$key} \n"
# }
# return $ref;
# # open a log file
# my $file = '/home/httpd/perl/logs/search.log'; # Name the file
# open(DEBUG, ">$file"); # Open the file
## DEBUG->autoflush(1);
# print DEBUG "logfile in search..\n";
# my @keys = keys %$ref;
# print DEBUG @keys . "\n";
# foreach my $key (@keys) {
# print DEBUG "for $key : $ref->{$key} \n"
# }
# return $ref;
}
1;
Index: modules/hoeppner/lonsearchcat.pm
+++ modules/hoeppner/lonsearchcat.pm
# The LearningOnline Network with CAPA
# Search Catalog
#
# $Id: lonsearchcat.pm,v 1.1 2008/06/28 20:00:01 hoeppner 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/
#
###############################################################################
###############################################################################
=pod
=head1 NAME
lonsearchcat - LONCAPA Search Interface
=head1 SYNOPSIS
Search interface to LON-CAPAs digital library
=head1 DESCRIPTION
This module enables searching for a distributed browseable catalog.
This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.
lonsearchcat presents the user with an interface to search the LON-CAPA
digital library. lonsearchcat also initiates the execution of a search
by sending the search parameters to LON-CAPA servers. The progress of
search (on a server basis) is displayed to the user in a separate window.
=head1 Internals
=over 4
=cut
###############################################################################
###############################################################################
package Apache::lonsearchcat;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::File();
use CGI qw(:standard);
use Text::Query;
use GDBM_File;
use Apache::loncommon();
use Apache::lonmysql();
use Apache::lonmeta;
use Apache::lonhtmlcommon;
use Apache::lonlocal;
use LONCAPA::lonmetadata();
use HTML::Entities();
use Parse::RecDescent;
use Apache::lonnavmaps;
use Apache::lonindexer();
use LONCAPA;
use Apache::lonsearch;
######################################################################
######################################################################
##
## Global variables
##
######################################################################
######################################################################
my %groupsearch_db; # Database hash used to save values for the
# groupsearch RAT interface.
my %persistent_db; # gdbm hash which holds data which is supposed to
# persist across calls to lonsearchcat.pm
# The different view modes and associated functions
my %Views = (#"detailed" => \&detailed_citation_view,
#"detailedpreview" => \&detailed_citation_preview,
"summary" => \&summary_view
#"summarypreview" => \&summary_preview,
#"fielded" => \&fielded_format_view,
#"xml" => \&xml_sgml_view,
#"compact" => \&compact_view
);
######################################################################
######################################################################
sub handler {
my $r = shift;
# &s<>et_defaults();
my $file = '/home/httpd/perl/logs/test.log'; # Name the file
open(INFO, ">>$file"); # Open the file
INFO->autoflush(1);
print INFO "handler: " . $ENV{'form.phase'} . "\n";
print INFO "#### before handler: " . $env{'form.table'};
#
# set form defaults
#
my $hidden_fields;# Hold all the hidden fields used to keep track
# of the search system state
my $importbutton; # button to take the selected results and go to group
# sorting
my $diropendb; # The full path to the (temporary) search database file.
# This is set and used in &handler() and is also used in
# &output_results().
my $loaderror=&Apache::lonnet::overloaderror($r);
if ($loaderror) { return $loaderror; }
#
my $closebutton; # button that closes the search window
# This button is different for the RAT compared to
# normal invocation.
#
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
return OK if $r->header_only;
##
## Prevent caching of the search interface window. Hopefully this means
## we will get the launch=1 passed in a little more.
&Apache::loncommon::no_cache($r);
##
## Pick up form fields passed in the links.
##
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['catalogmode','launch','acts','mode','form','element','pause',
'phase','persistent_db_id','table','start','show',
'cleargroupsort','titleelement','area','inhibitmenu', 'algorithm', 'degree', 'connectivitywac',
'connectivitysac', 'instances', 'proximity', 'username','sort', 'url_id', 'rating', 'comment']);
##
## The following is a trick - we wait a few seconds if asked to so
## the daemon running the search can get ahead of the daemon
## printing the results. We only need (theoretically) to do
## this once, so the pause indicator is deleted
##
if (exists($env{'form.pause'})) {
sleep(1);
delete($env{'form.pause'});
}
##
## Initialize global variables
##
my $domain = $r->dir_config('lonDefDomain');
$diropendb= "/home/httpd/perl/tmp/".
"$env{'user.domain'}_$env{'user.name'}_sel_res.db";
#
# set the name of the persistent database
# $env{'form.persistent_db_id'} can only have digits in it.
if (! exists($env{'form.persistent_db_id'}) ||
($env{'form.persistent_db_id'} =~ /\D/) ||
($env{'form.launch'} eq '1')) {
$env{'form.persistent_db_id'} = time;
}
my $persistent_db_file = "/home/httpd/perl/tmp/".
&escape($domain).
'_'.&escape($env{'user.name'}).
'_'.$env{'form.persistent_db_id'}.'_persistent_search.db';
##
# print INFO $env{'form.phase'} ." phase entered ... \n";
# if ($env{'form.phase'} ne 'rate') { # to preserve everything else...
&Apache::lonhtmlcommon::clear_breadcrumbs();
my @allowed_searches = ('portfolio');
if (&Apache::lonnet::allowed('bre',$env{'request.role.domain'})) {
push(@allowed_searches,'res');
}
if (exists($env{'request.course.id'}) && $env{'request.course.id'} ne '') {
push(@allowed_searches,'course');
}
my $crumb_text = 'Portfolio Search';
if (@allowed_searches == 3) {
$crumb_text = 'Course, Portfolio and Catalog Search';
} elsif (@allowed_searches ==2) {
if (grep(/^res$/,@allowed_searches)) {
$crumb_text = 'Portfolio and Catalog Search';
} elsif (grep(/^course$/,@allowed_searches)) {
$crumb_text = 'Portfolio and Course Search';
}
}
&Apache::lonhtmlcommon::add_breadcrumb
({href=>'/adm/searchcat?'.
&Apache::loncommon::inhibit_menu_check().
'&catalogmode='.$env{'form.catalogmode'}.
'&launch='.$env{'form.launch'}.
'&mode='.$env{'form.mode'},
text=>"$crumb_text",
target=>'_top',
bug=>'Searching',});
#
if ($env{'form.phase'} !~ m/(basic|adv|course)_search/) {
if (! &get_persistent_form_data($persistent_db_file)) {
if ($env{'form.phase'} =~ /(run_search|results)/) {
&Apache::lonnet::logthis('lonsearchcat:'.
'Unable to recover data from '.
$persistent_db_file);
my $msg =
'We were unable to retrieve data describing your search. '.
'This is a serious error and has been logged. '.
'Please alert your LON-CAPA administrator.';
&Apache::loncommon::simple_error_page($r,'Search Error',
$msg);
return OK;
}
}
} else {
print INFO "cleaning up ...\n";
&clean_up_environment();
}
##
## Clear out old values from groupsearch database
##
# if ($env{'form.phase'} =~ m/^extend/i) {
untie %groupsearch_db if (tied(%groupsearch_db));
if (($env{'form.cleargroupsort'} eq '1') ||
(($env{'form.launch'} eq '1') &&
($env{'form.catalogmode'} eq 'import'))) {
if (tie(%groupsearch_db,'GDBM_File',$diropendb,&GDBM_WRCREAT(),0640)) {
&start_fresh_session();
untie %groupsearch_db;
delete($env{'form.cleargroupsort'});
} else {
# This is a stupid error to give to the user.
# It really tells them nothing.
my $msg = 'Unable to tie hash to db file.';
&Apache::loncommon::simple_error_page($r,'Search Error',
$msg);
return OK;
}
}
# }
##
## Configure hidden fields
##
$hidden_fields = '<input type="hidden" name="persistent_db_id" value="'.
$env{'form.persistent_db_id'}.'" />'."\n";
if (exists($env{'form.catalogmode'})) {
$hidden_fields .= &hidden_field('catalogmode');
}
if (exists($env{'form.form'})) {
$hidden_fields .= &hidden_field('form');
}
if (exists($env{'form.element'})) {
$hidden_fields .= &hidden_field('element');
}
if (exists($env{'form.titleelement'})) {
$hidden_fields .= &hidden_field('titleelement');
}
if (exists($env{'form.mode'})) {
$hidden_fields .= &hidden_field('mode');
}
if (exists($env{'form.area'})) {
$hidden_fields .= &hidden_field('area');
}
if (exists($env{'form.inhibitmenu'})) {
$hidden_fields .= &hidden_field('inhibitmenu');
}
##
## Configure dynamic components of interface
##
if ($env{'form.catalogmode'} eq 'interactive') {
$closebutton="<input type='button' name='close' value='".&mt('CLOSE')."' ";
if ($env{'form.phase'} =~ /(results|run_search)/) {
$closebutton .="onClick='parent.close()'";
} else {
$closebutton .="onClick='self.close()'";
}
$closebutton .=">\n";
} elsif ($env{'form.catalogmode'} eq 'import') {
$closebutton="<input type='button' name='close' value='".&mt('CLOSE')."' ";
if ($env{'form.phase'} =~ /(results|run_search)/) {
$closebutton .="onClick='parent.close()'";
} else {
$closebutton .="onClick='self.close()'";
}
$closebutton .= ">";
$importbutton=<<END;
<input type='button' name='import' value='IMPORT'
onClick='javascript:select_group()'>
END
} else {
$closebutton = '';
$importbutton = '';
}
##
## Sanity checks on form elements
##
if (!defined($env{'form.viewselect'})) {
$env{'form.viewselect'} ="summary";
}
$env{'form.phase'} = 'disp_basic' if (! exists($env{'form.phase'}));
$env{'form.show'} = 20 if (! exists($env{'form.show'}));
#
$env{'form.searchmode'} = 'basic' if (! exists($env{'form.searchmode'}));
if ($env{'form.phase'} eq 'adv_search' ||
$env{'form.phase'} eq 'disp_adv') {
$env{'form.searchmode'} = 'advanced';
} elsif ($env{'form.phase'} eq 'course_search') {
$env{'form.searchmode'} = 'course_search';
}
#
if ($env{'form.searchmode'} eq 'advanced') {
my $srchtype = 'Catalog';
if ($env{'form.area'} eq 'portfolio') {
$srchtype = 'Portfolio';
}
&Apache::lonhtmlcommon::add_breadcrumb
({href=>'/adm/searchcat?'.&Apache::loncommon::inhibit_menu_check().
'&phase=disp_adv'.
'&catalogmode='.$env{'form.catalogmode'}.
'&launch='.$env{'form.launch'}.
'&mode='.$env{'form.mode'},
text=>"Advanced $srchtype Search",
bug=>'Searching',});
} elsif ($env{'form.searchmode'} eq 'course search') {
&Apache::lonhtmlcommon::add_breadcrumb
({href=>'/adm/searchcat?'.&Apache::loncommon::inhibit_menu_check().
'&phase=disp_adv'.
'catalogmode='.$env{'form.catalogmode'}.
'&launch='.$env{'form.launch'}.
'&mode='.$env{'form.mode'},
text=>"Course Search",
bug=>'Searching',});
}
print INFO "#### before switch: " . $env{'form.table'} ;
##
## Switch on the phase
##
if ($env{'form.phase'} eq 'disp_basic') {
&print_basic_search_form($r,$closebutton,$hidden_fields);
} elsif ($env{'form.phase'} eq 'disp_adv') {
&print_advanced_search_form($r,$closebutton,$hidden_fields);
} elsif ($env{'form.phase'} eq 'extenddirect') {
# TODO first ...use implementation and write results
my $table = $env{'form.table'};
print INFO 'calling expand with r: ' .$r ."\n";
print INFO 'calling expand with table: ' .$table ."\n";
# need to give the keywords as parameter for all extends..where do i get them TODO
&Apache::lonsearch::createEvaluationRow('startuser', $env{'form.basicexp'}, 'a', 'd', 'c', 's', 'r','direct', $env{'user.name'}.':'.$env{'user.domain'});
&Apache::lonsearch::expandPrePost($env{'form.url_id'}, $table, $r, $env{'user.name'}.':'.$env{'user.domain'});
# then display again
print INFO "phase extenddirect: " .$env{'form.user'} . " " . $env{'form.domain'} . "\n";
&display_results($r,$importbutton,$closebutton,$diropendb,
$env{'form.area'},$env{'form.user'},$env{'form.domain'});
} elsif ($env{'form.phase'} eq 'extendsac') {
# TODO first ...use implementation and write results
my $table = $env{'form.table'};
print INFO 'calling expand sac with r: ' .$r ."\n";
print INFO 'calling expand sac with table: ' .$table ."\n";
print INFO 'keywords ' . $env{'form.basicexp'}."\n";
print INFO 'createrow with ' . $env{'user.name'}.':'.$env{'user.domain'} ."\n";
&Apache::lonsearch::createEvaluationRow('startuser', $env{'form.basicexp'}, 'a', 'd', 'c', 's', 'r','sac',$env{'user.name'}.':'.$env{'user.domain'});
my $startuser;
print INFO "++++++####++++++username: " . $env{'form.username'} ."\n";
if ($env{'form.username'} ne '') { # if no explicit start user mentioned, assume the logged in user
$startuser = $env{'form.username'};
} else {
$startuser = $env{'user.name'}.':'.$env{'user.domain'};
}
print INFO "+++++++++++++commuser " .$startuser ."\n";
my $keywords = &Apache::lonsearch::getKeywords($env{'user.name'}.':'.$env{'user.domain'});
print INFO "# # # # # # key: $keywords\n";
&Apache::lonsearch::expandSAC($env{'form.url_id'}, $table, $r, $startuser, $keywords,$env{'user.name'}.':'.$env{'user.domain'},'AssignedSAC20');
# then display again
# print INFO "phase extendsac: " .$env{'form.user'} . " " . $env{'form.domain'} . "\n";
&display_results($r,$importbutton,$closebutton,$diropendb,
$env{'form.area'});
} elsif ($env{'form.phase'} eq 'extendwac') {
#&display_results($r,$importbutton,$closebutton,$diropendb,
# $env{'form.area'},"working");
#&print_sort_form($r,"whatsthis", "working ... please stand by");
my $table = $env{'form.table'};
print INFO 'calling expand sac with r: ' .$r ."\n";
print INFO 'calling expand sac with table: ' .$table ."\n";
print INFO 'keywords ' . $env{'form.basicexp'}."\n";
my $keywords = &Apache::lonsearch::getKeywords($env{'user.name'}.':'.$env{'user.domain'});
print INFO "# # # # # # key: $keywords\n";
print INFO 'createrow with ' . $env{'user.name'}.':'.$env{'user.domain'} ."\n";
&Apache::lonsearch::createEvaluationRow('startuser', $keywords, 'a', 'd', 'c', 's', 'r','wac',$env{'user.name'}.':'.$env{'user.domain'});
my $startuser;
print INFO "++++++####++++++username: " . $env{'form.username'} ."\n";
if ($env{'form.username'} ne '') { # if no explicit start user mentioned, assume the logged in user
$startuser = $env{'form.username'};
} else {
$startuser = $env{'user.name'}.':'.$env{'user.domain'};
}
print INFO "+++++++++++++commuser " .$startuser ."\n";
&Apache::lonsearch::expandSAC($env{'form.url_id'}, $table, $r, $startuser, $env{'form.basicexp'},$env{'user.name'}.':'.$env{'user.domain'},'AssignedWAC50');
# then display again
# print INFO "phase extendsac: " .$env{'form.user'} . " " . $env{'form.domain'} . "\n";
&display_results($r,$importbutton,$closebutton,$diropendb,
$env{'form.area'});
} elsif ($env{'form.phase'} eq 'results') {
print INFO "phase results: " .$env{'form.user'} . " " . $env{'form.domain'} . "\n";
&display_results($r,$importbutton,$closebutton,$diropendb,
$env{'form.area'});
} elsif ($env{'form.phase'} =~ /^(sort|run_search)$/) {
my ($query,$customquery,$customshow,$libraries,$pretty_string) =
&get_persistent_data($persistent_db_file,
['query','customquery','customshow',
'libraries','pretty_string']);
if ($env{'form.phase'} eq 'sort') {
&print_sort_form($r,$pretty_string);
} elsif ($env{'form.phase'} eq 'run_search') {
# 'degree', 'connectivitywac','connectivitysac', 'instances'
$env{'finished'} = 'false';
# clean out old results
my $table = $env{'form.table'};
print INFO "YYYYYYYYYYYYY table $table \n"; #
&Apache::lonsearch::clearResults($env{'user.name'}."_".$env{'user.domain'}."_".$table);
&run_search($r,$query,$customquery,$customshow,
$libraries,$pretty_string,$env{'form.area'}, $env{'form.algorithm'},
$env{'form.degree'},$env{'form.connectivitywac'},$env{'form.connectivitysac'},
$env{'form.instances'},$env{'form.proximity'});
&display_results($r,$importbutton,$closebutton,$diropendb,
$env{'form.area'},$env{'user.name'},$env{'user.domain'});
# &display_results($r,$importbutton,$closebutton,$diropendb,
# $env{'form.area'},$env{'form.user'},$env{'form.domain'});
}
} elsif ($env{'form.phase'} eq 'rate') { # save rating
&Apache::lonsearch::saveRating( # 1) rating
$env{'form.rating'},
# 2) comment
$env{'form.comment'},
# 3) issuing user (data will be added to the last row of this user (i.e. with highest id for this user))
$env{'user.name'}.':'.$env{'user.domain'},
&Apache::lonmysql::number_of_rows($env{'form.table'})
);
print INFO "after rating username is: " . $env{'form.username'} ."\n";
&display_results($r,$importbutton,$closebutton,$diropendb,
$env{'form.area'}, $env{'form.username'});
} elsif ($env{'form.phase'} eq 'course_search') {
&course_search($r);
} elsif(($env{'form.phase'} eq 'basic_search') ||
($env{'form.phase'} eq 'adv_search')) {
#
# We are running a search, try to parse it
my ($query,$customquery,$customshow,$libraries) =
(undef,undef,undef,undef);
my $pretty_string;
if ($env{'form.phase'} eq 'basic_search') {
($query,$pretty_string,$libraries) =
&parse_basic_search($r,$closebutton,$hidden_fields);
return OK if (! defined($query));
&make_persistent({ basicexp => $env{'form.basicexp'}},
$persistent_db_file);
} else { # Advanced search
($query,$customquery,$customshow,$libraries,$pretty_string)
= &parse_advanced_search($r,$closebutton,$hidden_fields);
return OK if (! defined($query));
}
&make_persistent({ query => $query,
customquery => $customquery,
customshow => $customshow,
libraries => $libraries,
pretty_string => $pretty_string },
$persistent_db_file);
#
# Set up table
if (! defined(&create_results_table($env{'form.area'}))) {
my $errorstring=&Apache::lonmysql::get_error();
&Apache::lonnet::logthis('lonsearchcat.pm: Unable to create '.
'needed table. lonmysql error:'.
$errorstring);
my $msg =
'Unable to create table in which to save search results. '.
'The search has been aborted.';
&Apache::loncommon::simple_error_page($r,'Search Error',
$msg);
return OK;
}
delete($env{'form.launch'});
if (! &make_form_data_persistent($r,$persistent_db_file)) {
my $msg=
'Unable to properly save search information. '.
'The search has been aborted.';
&Apache::loncommon::simple_error_page($r,'Search Error',
$msg);
return OK;
}
##
## Print out the frames interface
##
if (defined($query)) {
&print_frames_interface($r);
}
}
close(INFO);
return OK;
}
#sub saveRating() {
# my $rating = $_[0];
# my $comment = $_[1];
# my $user = $_[2];
# # 1) get the highest id for that user
# my $sta = $dbh->prepare("SELECT max(id) from communities.Evaluation WHERE user=?")
# or die "Couldn't prepare statement: " . $dbh->errstr;
# $sta->execute($user);
# print INFO $sta->errstr ."\n";
# my $id = $sta->fetchrow_array());
# # 2) update row with that id
# my $stb = $dbh->prepare("UPDATE communities.Evaluation SET rating=?, comment=?, WHERE id=?")
# or die "Couldn't prepare statement: " . $dbh->errstr;
# $stb->execute($rating, $comment, $id);
# print INFO $stb->errstr ."\n";
#}
#
#sub createEvaluationRow() {
# my $user = $_[0]; # is that the start user or the issuing user?
# # for filter: it's the start user ... another param for the issuing one..
#
# # for a filter search...otherwise they're ''
# my $keywords = $_[1];
# my $algorithm = $_[2];
# my $degree = $_[3];
# my $connectivity = $_[4];
# my $similarity = $_[5];
# my $reuseinstances = $_[6];
# # for expand
# my $expand = $_[7]; # direct or sac
# my $issuing_user = $_[8];
# # create the columns ...
# my $search_type = '';
# if ($expand eq '') {
# $search_type .= "search;$user;$keywords;$algorithm;$degree;$connectivity;$similarity;$reuseinstances";
# } else {
# $search_type .= "expand;$expand";
# }
# my $rating = 0;
# my $comment = 'none';
# # create the row
# my $insert = "INSERT INTO communities.Evaluation VALUES (?, ?, ?, ?)";
# my $stj = $dbh->prepare($insert)
# or die "Couldn't prepare statement: " . $dbh->errstr;
# my @params = ($issuing_user, $search_type, $rating, $comment);
# $stj->execute(@params);
# print INFO $stj->err;
# print INFO $stj->errstr;
# print INFO " created eval row\n";
#}
#
# The mechanism used to store values away and retrieve them does not
# handle the case of missing environment variables being significant.
#
# This routine sets non existant checkbox form elements to ''.
#
sub clean_up_environment {
if ($env{'form.phase'} eq 'basic_search') {
if (! exists($env{'form.related'})) {
$env{'form.related'} = '';
}
if (! exists($env{'form.domains'})) {
$env{'form.domains'} = '';
}
if (! exists($env{'form.algorithm'})) {
$env{'form.algorithm'} = '';
}
} elsif ($env{'form.phase'} eq 'adv_search') {
foreach my $field ('title','keywords','notes',
'abstract','standards','mime') {
if (! exists($env{'form.'.$field.'_related'})) {
$env{'form.'.$field.'_related'} = '';
}
}
} elsif ($env{'form.phase'} eq 'course_search') {
if (! exists($env{'form.crsrelated'})) {
$env{'form.crsrelated'} = '';
}
}
}
sub hidden_field {
my ($name,$value) = @_;
if (! defined($value)) {
$value = $env{'form.'.$name};
}
return '<input type="hidden" name="'.$name.'" value="'.$value.'" />'.$/;
}
######################################################################
######################################################################
##
## Course Search
##
######################################################################
######################################################################
{ # Scope the course search to avoid global variables
#
# Variables For course search
my %alreadyseen;
my %hash;
my $totalfound;
sub make_symb {
my ($id)=@_;
my ($mapid,$resid)=split(/\./,$id);
my $map=$hash{'map_id_'.$mapid};
my $res=$hash{'src_'.$id};
my $symb=&Apache::lonnet::encode_symb($map,$resid,$res);
return $symb;
}
sub course_search {
my $r=shift;
my $pretty_search_string = '<b>'.$env{'form.courseexp'}.'</b>';
my $search_string = $env{'form.courseexp'};
my @New_Words;
undef(%alreadyseen);
if ($env{'form.crsrelated'}) {
($search_string,@New_Words) = &related_version($env{'form.courseexp'});
if (@New_Words) {
$pretty_search_string .= ' '.&mt("with related words").": <b>@New_Words</b>.";
} else {
$pretty_search_string .= ' '.&mt('with no related words').".";
}
}
my $fulltext=$env{'form.crsfulltext'};
my $discuss=$env{'form.crsdiscuss'};
my @allwords=($search_string,@New_Words);
$totalfound=0;
$r->print(&Apache::loncommon::start_page('Course Search').
'<hr /><center><font size="+2" face="arial">'.
$pretty_search_string.'</font></center>'.
'<hr /><b>'.&mt('Course content').':</b><br />');
$r->rflush();
# ======================================================= Go through the course
my $c=$r->connection;
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.".db",
&GDBM_READER(),0640)) {
foreach (sort(keys(%hash))) {
if ($c->aborted()) { last; }
if (($_=~/^src\_(.+)$/)) {
if ($hash{'randomout_'.$1} & !$env{'request.role.adv'}) {
next;
}
my $symb=&make_symb($1);
&checkonthis($r,$1,$hash{$_},0,&Apache::lonnet::gettitle($symb),
$fulltext,$symb,@allwords);
}
}
untie(%hash);
}
unless ($totalfound) {
$r->print('<p>'.&mt('No matches found in resources').'.</p>');
}
# Check discussions if requested
if ($discuss) {
my $totaldiscussions = 0;
$r->print('<br /><br /><b>'.&mt('Discussion postings').':</b><br />');
my $navmap = Apache::lonnavmaps::navmap->new();
my @allres=$navmap->retrieveResources();
my %discussiontime = &Apache::lonnet::dump('discussiontimes',
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
foreach my $resource (@allres) {
my $result = '';
my $applies = 0;
my $symb = $resource->symb();
my $ressymb = $symb;
if ($symb =~ m#(___adm/$LONCAPA::domain_re/$LONCAPA::username_re)/(\d+)/bulletinboard$#) {
$ressymb = 'bulletin___'.$2.$1.'/'.$2.'/bulletinboard';
unless ($ressymb =~ m#bulletin___\d+___adm/wrapper#) {
$ressymb=~s#(bulletin___\d+___)#$1adm/wrapper/#;
}
}
if (defined($discussiontime{$ressymb})) {
my %contrib = &Apache::lonnet::restore($ressymb,$env{'request.course.id'},
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
if ($contrib{'version'}) {
for (my $id=1;$id<=$contrib{'version'};$id++) {
unless (($contrib{'hidden'}=~/\.$id\./) || ($contrib{'deleted'}=~/\.$id\./)) {
if ($contrib{$id.':subject'}) {
$result .= $contrib{$id.':subject'};
}
if ($contrib{$id.':message'}) {
$result .= $contrib{$id.':message'};
}
if ($contrib{$id,':attachmenturl'}) {
if ($contrib{$id,':attachmenturl'} =~ m-/([^/]+)$-) {
$result .= $1;
}
}
$applies = &checkwords($result,$applies,@allwords);
}
}
}
}
# Does this discussion apply?
if ($applies) {
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($ressymb);
my $disctype = &mt('resource');
if ($url =~ m#/bulletinboard$#) {
if ($url =~m#^adm/wrapper/adm/.*/bulletinboard$#) {
$url =~s#^adm/wrapper##;
}
$disctype = &mt('bulletin board');
} else {
$url = '/res/'.$url;
}
if ($url =~ /\?/) {
$url .= '&symb=';
} else {
$url .= '?symb=';
}
$url .= &escape($resource->symb());
my $title = $resource->compTitle();
$r->print('<br /><a href="'.$url.'" target="cat">'.
($title?$title:$url).'</a> - '.$disctype.'<br />');
$totaldiscussions++;
} else {
$r->print(' .');
}
}
unless ($totaldiscussions) {
$r->print('<p>'.&mt('No matches found in postings').'.</p>');
}
}
# =================================================== Done going through course
$r->print(&Apache::loncommon::end_page());
}
# =============================== This pulls up a resource and its dependencies
sub checkonthis {
my ($r,$id,$url,$level,$title,$fulltext,$symb,@allwords)=@_;
$alreadyseen{$id}=1;
if (&Apache::loncommon::connection_aborted($r)) { return; }
$r->rflush();
my $result=$title.' ';
if ($env{'request.role.adv'} || !$hash{'encrypted_'.$id}) {
$result.=&Apache::lonnet::metadata($url,'title').' '.
&Apache::lonnet::metadata($url,'subject').' '.
&Apache::lonnet::metadata($url,'abstract').' '.
&Apache::lonnet::metadata($url,'keywords');
}
my ($extension)=($url=~/\.(\w+)$/);
if (&Apache::loncommon::fileembstyle($extension) eq 'ssi' &&
($url) && ($fulltext)) {
$result.=&Apache::lonnet::ssi_body($url.'?symb='.&escape($symb));
}
$result=~s/\s+/ /gs;
my $applies = 0;
$applies = &checkwords($result,$applies,@allwords);
# Does this resource apply?
if ($applies) {
$r->print('<br />');
for (my $i=0;$i<=$level*5;$i++) {
$r->print(' ');
}
my $href=$url;
if ($hash{'encrypted_'.$id} && !$env{'request.role.adv'}) {
$href=&Apache::lonenc::encrypted($href)
.'?symb='.&Apache::lonenc::encrypted($symb);
} else {
$href.='?symb='.&escape($symb);
}
$r->print('<a href="'.$href.'" target="cat">'.($title?$title:$url).
'</a><br />');
$totalfound++;
} elsif ($fulltext) {
$r->print(' .');
}
$r->rflush();
# Check also the dependencies of this one
my $dependencies=
&Apache::lonnet::metadata($url,'dependencies');
foreach (split(/\,/,$dependencies)) {
if (($_=~/^\/res\//) && (!$alreadyseen{$id})) {
&checkonthis($r,$id,$_,$level+1,'',$fulltext,undef,@allwords);
}
}
}
sub checkwords {
my ($result,$applies,@allwords) = @_;
foreach (@allwords) {
if ($_=~/\w/) {
if ($result=~/$_/si) {
$applies++;
}
}
}
return $applies;
}
sub untiehash {
if (tied(%hash)) {
untie(%hash);
}
}
} # End of course search scoping
######################################################################
######################################################################
=pod
=item &print_basic_search_form()
Prints the form for the basic search. Sorry the name is so cryptic.
=cut
######################################################################
######################################################################
sub print_basic_search_form {
my ($r,$closebutton,$hidden_fields) = @_;
my $result = ($env{'form.catalogmode'} ne 'import');
my $bread_crumb =
&Apache::lonhtmlcommon::breadcrumbs('Searching','Search_Basic',
$env{'form.catalogmode'} ne 'import');
my $scrout = &Apache::loncommon::start_page('Search').$bread_crumb;
# Search form for resource space
if (&Apache::lonnet::allowed('bre',$env{'request.role.domain'})) {
$scrout .= &setup_basic_search($r,'res',$hidden_fields,$closebutton);
$scrout .= '<hr /><br />';
}
# Search form for accessible portfolio files
# $scrout.= &setup_basic_search($r,'portfolio',$hidden_fields,$closebutton);
# if ($env{'request.course.id'}) {
# my %lt=&Apache::lonlocal::texthash('srch' => 'Search',
# 'header' => 'Course Search',
# 'note' => 'Enter terms or phrases, then press "Search" below',
# 'use' => 'use related words',
# 'full' =>'fulltext search (time consuming)',
# 'disc' => 'search discussion postings (resources and bulletin boards)',
# );
# $scrout.=(<<ENDCOURSESEARCH);
#<form name="loncapa_search" method="post" action="/adm/searchcat">
#<center>
#<hr />
#<h1> Community-Aware Search </h1>
#<input type="hidden" name="phase" value="course_search" />
#$hidden_fields
#<p>
#$lt{'note'}.
#</p>
#<p>
#<table>
#<tr><td>
#ENDCOURSESEARCH
# $scrout.=' '.
# &Apache::lonhtmlcommon::textbox('courseexp',
# $env{'form.courseexp'},40);
# my $crscheckbox =
# &Apache::lonhtmlcommon::checkbox('crsfulltext',
# $env{'form.crsfulltext'});
# my $relcheckbox =
# &Apache::lonhtmlcommon::checkbox('crsrelated',
# $env{'form.crsrelated'});
# my $discheckbox =
# &Apache::lonhtmlcommon::checkbox('crsdiscuss',
# $env{'form.crsrelated'});
# $scrout.=(<<ENDENDCOURSE);
#</td></tr>
#<tr><td><label>$relcheckbox $lt{'use'}</label></td><td></td></tr>
#<tr><td><label>$crscheckbox $lt{'full'}</label></td><td></td></tr>
#<tr><td><label>$discheckbox $lt{'disc'}</label></td><td></td></tr>
#</table><p>
# <input type="submit" name="coursesubmit" value='$lt{'srch'}' />
#</p>
#</center>
#</form>
#ENDENDCOURSE
# }
$scrout .= &Apache::loncommon::end_page();
$r->print($scrout);
return;
}
sub setup_basic_search {
my ($r,$area,$hidden_fields,$closebutton) = @_;
# Define interface components
my %lt = &Apache::lonlocal::texthash (
res => 'LON-CAPA Catalog Search (Prototype)',
# portfolio => 'Portfolio Search',
);
my ($algo_usedauthors,$algo_relatedcoordinators,$inclext,$adv_search_link,$scrout,
$algo_wac, $algo_sac, $algo_std);
# to choose the algorithm - column 0
$algo_usedauthors = '<label> <input type="radio" name="algorithm" value="usedauthors" checked="1"> (1) Used Authors </label>';
$algo_relatedcoordinators = '<label> <input type="radio" name="algorithm" value="relatedcoordinators"> (2) Related Coordinators </label>';
$algo_wac = '<label> <input type="radio" name="algorithm" value="wac"> (3) Weak Author Communities </label>';
$algo_sac = '<label> <input type="radio" name="algorithm" value="sac"> (4) Strong Author Communities </label>';
$algo_std = '<label> <input type="radio" name="algorithm" value="std"> (5) Only Keywords </label>';
# parameters separately for every algorithm - Used Authors
my $degree1_usedauthors = '<label> <font color="red">de</font><font color="#FF8040">gr</font><font color="#00FF00">ee:</font> <input type="radio" name="degree" value="1" checked="1"> 1 </label>';
my $degree2_usedauthors = '<label> <input type="radio" name="degree" value="2"> 2 </label>';
my $degree3_usedauthors = '<label> <input type="radio" name="degree" value="3"> 3 </label>';
# $startuser_usedauthors = textfield
my $reuseinstances1_usedauthors = '<label> <font color="red">reuse instances: </font> <input type="radio" name="instances" value="1"> 1 </label>';
my $reuseinstances5_usedauthors = '<label> <input type="radio" name="instances" value="5"> 5 </label>';
my $reuseinstances10_usedauthors = '<label> <input type="radio" name="instances" value="10" checked="1"> 10 </label>';
my $reuseinstances20_usedauthors = '<label> <input type="radio" name="instances" value="20"> 20 </label>';
my $reuseinstances50_usedauthors = '<label> <input type="radio" name="instances" value="50"> 50 </label>';
# wac!
my $connectivity10 = '<label> <font color="#00FF00">connectivity: </font> <input type="radio" name="connectivitywac" value="10"> 10 </label>';
my $connectivity20 = '<label> <input type="radio" name="connectivitywac" value="20" checked="1"> 20 </label>';
my $connectivity50 = '<label> <input type="radio" name="connectivitywac" value="50"> 50 </label>';
# sac!
my $connectivity15 = '<label> <font color="#FF00FF">connectivity: </font> <input type="radio" name="connectivitysac" value="15" checked="1"> 15 </label>';
my $connectivity20sac = '<label> <input type="radio" name="connectivitysac" value="20"> 20 </label>';
# degree
my $params_relatedcoordinators = '<label> <input type="radio" name="degree" value="relatedcoordinators"> Related Coordinators </label>';
# connectivity
my $params_wac = '<label> <input type="radio" name="algorithm" value="wac"> Weak Author Communities </label>';
#connectivity
my $params_sac = '<label> <input type="radio" name="algorithm" value="sac"> Strong Author Communities </label>';
# related coordninators reuse instances:
my $proximity5 = '<label> <font color="#FF8040"> similarity in % :</font> <input type="radio" name="proximity" value="5"> 5 </label>';
my $proximity20 ='<label> <input type="radio" name="proximity" value="20" checked="1"> 20 </label>';
my $proximity40 ='<label> <input type="radio" name="proximity" value="40"> 40 </label>';
# sort
my $sort1 = '<label> sort by: <input type="radio" name="sort" value="sortbyaccess" checked="1"> Access Count </label>';
my $sort2 ='<label> <input type="radio" name="sort" value="sortbyauthor"> Author Names </label>';
my $sort3 ='<label> <input type="radio" name="sort" value="sortbyreuse"> Relative Importance </label>';
# startuser
my $start = &Apache::lonhtmlcommon::textbox('username', $env{'form.username'},50);
# explanation for the parameters
my $explanation = '<p /><hr><font size=-1> <b>Explanation of the parameters: </b> <br>
<b>Algorithm:</b> There are five different algorithms which compute different communities -
this affects the choice of interesting resources in your search. All algorithms try to identify
a group of users that has a high relevance to you and then use that to influence the results
you receive in your search. Ideally, this should let you identify the resources that are
relevant to you without having to scroll through and evaluate the complete list of resources that match
your keywords.
<br>
(1) is based on information about which users\' resources you (or the start user you type in) have
used in the past. Those users\' resources will then be preferred in the search process.
The parameter <b>"reuse instances"</b> defines how many times the resources of an author have to be
used so that it is considered.
<br>
(2) is based on information about how the resources you have used in the past compare
to the resources others have used - the parameter <b>"similarity"</b> describes how close
your reuse profile is to that of other course coordinators. Only the resources that
have been used by course coordinators you have at least "similarity" percent similarity with
will be shown in the results. <br>
(3) is based on information about how authors\' resources have been used together in courses;
this is used to create author communities which provide content for certain topics.
Each user is then (in his coordinator role) assigned to one of these communities corresponding
by his interest in the authors the communities consist of - this interest again is defined
by the use of resources provided by these authors.<br>
(4) is based on the same principle as (3), but has a different and more restrictive
way of constructing the author communities.
<br>
(5) is a simple keyword search which gives you the complete result list of resources that are a match for your keywords
; you can use this to compare which resources are filtered out / selected by the different algorithms and
how they are sorted by relevance.<br>
<b>Connectivity:</b> Describes for the Author Communities (algorithms 3 and 4) how many times the involved authors\'
resources have been used together in a course. These options are different and separate for each Author Community type.<br>
<b>Degree:</b> Describes to which level the relationships will be considered. <br>
at 0, only information available about you will be used. <br>
at 1, all information available about the users you are related to (according to the selected algorithm) will be used.<br>
at 2, all information available about the users will be used that all users of degree 1 are related to.
...<br> </font>';
if ($area eq 'res') {
$inclext= '<label>'.&mt('[_1] include external resources',
&Apache::lonhtmlcommon::checkbox('inclext',$env{'form.inclext'})).
'</label>';
}
$adv_search_link = '<a href="/adm/searchcat?'.
&Apache::loncommon::inhibit_menu_check().
'&phase=disp_adv'.
'&catalogmode='.$env{'form.catalogmode'}.
'&launch='.$env{'form.launch'}.
'&mode='.$env{'form.mode'}.
'&area='.$area.
'&form='.$env{'form.form'}.
'&titleelement='.$env{'form.titleelement'}.
'&element='.$env{'form.element'}.
'">'.&mt('Advanced Search').'</a>';
#
my $user = $env{'form.user'};
my $domain = $env{'form.domain'};
print INFO "user/domain at search: $user $domain \n";
print INFO "user/domain at search: " .$user .":". $domain .".\n";
$scrout.='<form name="loncapa_search" method="post" '.
'action="/adm/searchcat">'.
'<input type="hidden" name="phase" value="basic_search" />'.
'<input type="hidden" name="user" value="$user" />'.
'<input type="hidden" name="user" value="$domain" />'.
$hidden_fields;
if (!exists($env{'form.area'})) {
$scrout .= '<input type="hidden" name="area" value="'.$area.'" />';
}
#
$scrout .= '<center>'.$/;
# if ($env{'request.course.id'}) {
$scrout .= '<h1>'.$lt{$area}.'</h1> <br> </center>
<hr><font size=-1>
Thank you for contributing to this research by using the search prototype!<br>
To get started, you can simply type in keywords you\'re interested in and click search. If you are a new user who hasn\'t used the LON-CAPA as a coordinator before, you need to type in
a start user that works in the area you\'re interested in (format is username:domain, f.e. kortemey:msu). This does not notify or bother the user you typed in in any way but is just
a way to explicitly state an author of interest to you for this particular search.<br>
<br>
By varying the parameters on the right, you will receive a different result set.
The options all filter the results you would receive by a simple keyword search, and hopefully
only show the most relevant resources to you. Once you have started a search, you might have
to wait a while for the search results (the search is finished when you see the line "There are x matches to your query." in the header). For every resource found, you will have
the possibility to extend the search results by related resources or by community - extending is pretty slow too, so please be patient. The resources that have been added by the extension will be marked in red font.<br>
<br>
For the algorithms "Used Authors" and "Related Coordinators" you can sort the results by relevance which should provide another way of
determining the best results (you have to click on reload after selecting the sorting algorithm).
Please use the "comments" field to give feedback on whether the relevance sorting is useful.
<br><br>
Further explanations for the parameters are given below the search form. <br>
If you\'re interested in more information or need help in using this prototype, please
contact me at L (dot) hoeppner (at) gmx (dot) net <br>
This is also the address any additional feedback should go to. We are especially interested in whether you found
any of the filter algorithms and/or the extend-mechanisms as well as relevance sorting useful .<br> </font><hr> <p /> <center>';
# } else {
# No need to tell them they are searching
# $scrout.= ('<br />'x2);
# }
$scrout.='<table>'.
'<tr><td align="center" valign="top">'.
&Apache::lonhtmlcommon::textbox('basicexp',
$env{'form.basicexp'},50).
'<br />'.
'<font size="-1">'.&searchhelp().'</font>'.
'<br />'.
$start.
'<br />'.
'<font size="-1"> start user (optional), format <b>user:domain</b> </font>'.
'</td>'.
# column 0
'<td><font size="-1">'.
'<nobr>'.(' 'x1).'<label> Algorithm: </label>'.'</nobr>'.'<br />'.
'<nobr>'.(' 'x1).'<label> (choose one of the five) </label>'.'</nobr>'.'<br /><hr>'.
'<nobr><font color="red">'.(' 'x1).$algo_usedauthors.'</font></nobr>'.'<br />'.
'<nobr><font color="#FF8040">'.(' 'x1).$algo_relatedcoordinators.'</font></nobr>'.'<br /><hr>'.
'<nobr><font color="#00FF00">'.(' 'x1).$algo_wac.'</nobr>'.'</font><br />'.
'<nobr><font color="#FF00FF">'.(' 'x1).$algo_sac.'</nobr>'.'</font><br />'.
'<nobr>'.(' 'x1).$algo_std.'</nobr>'.'<br />'.
'</font></td>'.
# column 1
'<td><font size="-1">'.
'<nobr>'.(' 'x1).'<label> Parameters per algorithm: </label>'.'</nobr>'.'<br />'.
'<nobr>'.(' 'x1).'<label> (colors indicate which parameter is effective for which algorithm) </label>'.'</nobr>'.'<br /><hr>'.
'<nobr>'.(' 'x1).$reuseinstances1_usedauthors.$reuseinstances10_usedauthors.$reuseinstances20_usedauthors.$reuseinstances50_usedauthors.'</nobr>'.'<br />'.
'<nobr>'.(' 'x1).$proximity5.$proximity20.$proximity40.'</nobr>'.'<br /><hr>'.
'<nobr>'.(' 'x1).$connectivity10.$connectivity20.$connectivity50.'</nobr>'.'<br />'.
'<nobr>'.(' 'x1).$connectivity15.$connectivity20sac.'</nobr>'.'<br />'.
'<nobr>'.(' 'x1).$degree1_usedauthors.$degree2_usedauthors.$degree3_usedauthors.'</nobr>'.'<br />'.
# '<nobr>'.(' 'x1).$reuseinstances1_usedauthors.$reuseinstances5_usedauthors.$reuseinstances10_usedauthors.'</nobr>'.'<br /><hr>'.
# '<nobr>'.(' 'x1).$params_sac.'</nobr>'.'<br />'.
'</font></td>'.
# column 2
# '<td><font size="-1">'.
# '<nobr>'.(' 'x1).'<label> Parameter for algorithms 1-3: </label>'.'</nobr>'.'<br />'.
# '<nobr>'.(' 'x1).'<label> (applies to algorithm 1-3) </label>'.'</nobr>'.'<br /><hr>'.
# '<nobr>'.(' 'x1).'</nobr>'.'<br /><hr>'.
# '<nobr>'.(' 'x1).'</nobr>'.'<br />'.
# '<nobr>'.(' 'x1).'</nobr>'.'<br />'.
# '<nobr>'.(' 'x1).'<label> Sort by: </label>'.</nobr>'.'<br />'.
# '<nobr>'.(' 'x1).$sort1.'</nobr>'.'<br />'.
# '<nobr>'.(' 'x1).$sort2.'</nobr>'.'<br />'.
# '<nobr>'.(' 'x1).$sort3.'</nobr>'.'<br />'.
# '<nobr>'.(' 'x1).$params_wac.'</nobr>'.'<br /><hr>'.
# '<nobr>'.(' 'x1).$params_sac.'</nobr>'.'<br />'.
# '</font></td>'.
'</tr>'.$/;
#
$scrout .= '<tr><td align="center" colspan="2">'.
'<font size="-1">'.
'<input type="submit" name="basicsubmit" '.
'value="'.&mt('Search').'" />'.
(' 'x2).$closebutton.(' 'x2). &viewoptions().
'</font>'.
'</td></tr>'.$/;
# $scrout .= '<tr>' .
# '<td><font size="-1">'.
# '<br>'.$explanation.'<br> </td><font size="-1"></tr> '.$/;
$scrout .= '</table>'.$/.'</center>'.$explanation .'</form>';
return $scrout;
}
######################################################################
######################################################################
=pod
=item &advanced_search_form()
Prints the advanced search form.
=cut
######################################################################
######################################################################
sub print_advanced_search_form{
my ($r,$closebutton,$hidden_fields) = @_;
my $bread_crumb =
&Apache::lonhtmlcommon::breadcrumbs('Searching','Search_Advanced',
$env{'form.catalogmode'} ne 'import');
my %lt=&Apache::lonlocal::texthash('srch' => 'Search',
'reset' => 'Reset',
'help' => 'Help');
my $advanced_buttons=<<"END";
<input type="submit" name="advancedsubmit" value='$lt{"srch"}' />
<input type="reset" name="reset" value='$lt{"reset"}' />
$closebutton
END
my $srchtype = 'Catalog';
my $jscript;
if ($env{'form.area'} eq 'portfolio') {
$srchtype = 'Portfolio';
$jscript = '<script type="text/javascript">
function additional_metadata() {
if (document.advsearch.newfield.checked) {
document.advsearch.phase.value = "disp_adv";
document.advsearch.numaddedfields.value = parseInt(document.advsearch.numaddedfields.value) +1;
document.advsearch.submit();
}
}
</script>';
}
my $scrout= &Apache::loncommon::start_page("Advanced $srchtype Search",
$jscript);
$scrout .= <<"ENDHEADER";
$bread_crumb
<form method="post" action="/adm/searchcat" name="advsearch">
<p>
$advanced_buttons
ENDHEADER
$scrout.=(' 'x2).&viewoptions().'</p>'.$hidden_fields.
'<input type="hidden" name="phase" value="adv_search" />';
my %fields=&Apache::lonmeta::fieldnames();
#
$scrout .= '<h3>'.&mt("Standard $srchtype Metadata").'</h3>';
$scrout .= "<table>\n";
$scrout .= '<tr><td> </td><td colspan="2"><font size="-1">'.
(' 'x2).&searchhelp()."</font></td></tr>\n";
my %related_word_search =
('title' => 1,
'author' => 0,
'owner' => 0,
'authorspace' => 0,
'modifyinguser'=> 0,
'keywords' => 1,
'notes' => 1,
'abstract' => 1,
'standards'=> 1,
'mime' => 1,
'subject' => 1,
);
#
foreach my $field ('title','author','subject','owner','authorspace',
'modifyinguser','keywords','notes','abstract',
'standards','mime') {
$scrout.='<tr><td align="right">'.&titlefield($fields{$field}).'</td><td>'.
&Apache::lonmeta::prettyinput($field,
$env{'form.'.$field},
$field,
'advsearch',
$related_word_search{$field},
'</td><td align="left">',
$env{'form.'.$field.'_related'},
50);
if ($related_word_search{$field}) {
$scrout .= &mt('related words');
} else {
$scrout .= '</td><td> ';
}
$scrout .= '</td></tr>'.$/;
}
foreach my $field ('lowestgradelevel','highestgradelevel') {
$scrout.='<tr>'.
'<td align="right">'.&titlefield($fields{$field}).'</td>'.
'<td colspan="2">'.
&Apache::lonmeta::prettyinput($field,
$env{'form.'.$field},
$field,
'advsearch',
0).
'</td></tr>'.$/;
}
$scrout.='<tr><td align="right">'.
&titlefield(&mt('MIME Type Category')).'</td><td colspan="2">'.
&Apache::loncommon::filecategoryselect('category',
$env{'form.category'}).
'</td></tr>'.$/;
$scrout.='<tr><td align="right" valign="top">'.
&titlefield(&mt('Domains')).'</td><td colspan="2">'.
&Apache::loncommon::domain_select('domains',
$env{'form.domains'},1).
'<br /><label>';
if ($env{'form.area'} ne 'portfolio') {
$scrout .= &mt('[_1] include external resources',
&Apache::lonhtmlcommon::checkbox
('inclext',$env{'form.inclext'})).'</label>'
}
$scrout .= '</td></tr>'.$/;
#
# Misc metadata
if ($env{'form.area'} ne 'portfolio') {
$scrout.='<tr><td align="right" valign="top">'.
&titlefield(&mt('Copyright/Distribution')).
'</td><td colspan="2">'.
&Apache::lonmeta::selectbox('copyright',
$env{'form.copyright'},
\&Apache::loncommon::copyrightdescription,
( undef,
&Apache::loncommon::copyrightids)
).'</td></tr>'.$/;
}
$scrout.='<tr><td align="right" valign="top">'.
&titlefield(&mt('Language')).'</td><td colspan="2">'.
&Apache::lonmeta::selectbox('language',
$env{'form.language'},
\&Apache::loncommon::languagedescription,
('any',&Apache::loncommon::languageids)
).'</td></tr>';
$scrout .= "</table>\n";
if ($env{'form.area'} eq 'portfolio') {
# Added fields
my $curnumadd = $env{'form.numaddedfields'};
if ($curnumadd eq '') {
$curnumadd = 1;
}
$scrout .= '<h3>'.&mt('Custom Metadata fields').'</h3>';
$scrout .= "<table>\n";
$scrout .= '<tr><td> </td><td align="center">'.
&mt('Field Name').'</td>'.'<td align="center">'.
&mt('Field Value(s)').'</td></tr>';
for (my $j=0; $j<$curnumadd; $j++) {
my $num = $j+1;
$scrout .= '<tr><td>'.&mt('Custom metadata [_1]: ',$num).
'</td><td align="center">'.
'<input type="text" name="addedfield_'.$j.
'" size="10" value="'.$env{'form.addedfield_'.$j}.
'" /></td>'.
'<td align="center"><input type="text" '.
'name="addedvalues_'.$j.'" size="15" value="'.
$env{'form.addedvalues_'.$j}.'" /></td></tr>';
}
$scrout .= '<tr><td align="left" colspan="3"><label>'.
'<input type="checkbox" name="newfield" '.
'value="1" onclick="javascript:additional_metadata()" />'.
&mt('Another custom field/value pair?').'</label>'.
'<input type="hidden" name="numaddedfields" value="'.
$curnumadd.'" /></td></tr></table>';
} else {
#
# Dynamic metadata
$scrout .= '<h3>'.&mt('Problem Statistics').'</h3>';
$scrout .= "<table>\n";
$scrout .= '<tr><td> </td><td align="center">'.
&mt('Minimum').'</td>'.'<td align="center">'.
&mt('Maximum').'</td></tr>'."\n";
foreach my $statistic
({ name=>'count',
description=>'Network-wide number of accesses (hits)',},
{ name=>'stdno',
description=>
'Statistics calculated for number of students',},
{ name => 'avetries',
description=>'Average number of tries till solved',},
{ name => 'difficulty',
description=>'Degree of difficulty',},
{ name => 'disc',
description=>'Degree of discrimination'}) {
$scrout .= '<tr><td align="right">'.
&titlefield(&mt($statistic->{'description'})).
'</td><td align="center">'.
'<input type="text" name="'.$statistic->{'name'}.
'_min" value="" size="6" /></td><td align="center">'.
'<input type="text" name="'.$statistic->{'name'}.
'_max" value="" size="6" /></td></tr>'.$/;
}
$scrout .= "</table>\n";
$scrout .= '<h3>'.&mt('Evaluation Data').'</h3>';
$scrout .= "<table>\n";
$scrout .= '<tr><td> </td><td align="center">'.
&mt('Minimum').'</td>'.'<td align="center">'.
&mt('Maximum').'</td></tr>'."\n";
foreach my $evaluation
( { name => 'clear',
description => 'Material presented in clear way'},
{ name =>'depth',
description => 'Material covered with sufficient depth'},
{ name => 'helpful',
description => 'Material is helpful'},
{ name => 'correct',
description => 'Material appears to be correct'},
{ name => 'technical',
description => 'Resource is technically correct'}){
$scrout .= '<tr><td align="right">'.
&titlefield(&mt($evaluation->{'description'})).
'</td><td align="center">'.
'<input type="text" name="'.
$evaluation->{'name'}.'_min" value="" size="6" />'.
'</td><td align="center"><input type="text" name="'.
$evaluation->{'name'}.'_max" value="" size="6" />'.
'</td></tr>'.$/;
}
$scrout .= "</table>\n";
}
#
# Creation/Modification date limits
$scrout .= '<h3>'.&mt('Creation and Modification dates').'</h3>';
$scrout .= "\n<table>\n";
$scrout .= "<tr><td> </td><td>".&mt('Month[_1]Day[_2]Year',' 'x14,' 'x6)."</td></tr>\n";
my $cafter =
&Apache::lonhtmlcommon::date_setter('advsearch', # formname
'creationdate1', # fieldname
0, # current value
'', # special
1, # includeempty
'', # state
1, # no_hh_mm_ss
);
my $cbefore =
&Apache::lonhtmlcommon::date_setter('advsearch', # formname
'creationdate2', # fieldname
0, # current value
'', # special
1, # includeempty
'', # state
1, # no_hh_mm_ss
);
$scrout .= '<tr><td align="right">'.&mt('Created between').'</td>'
.'<td>'.$cafter.'</td></tr>'
.'<tr><td align="right">'.&mt('and').'</td>'
.'<td>'.$cbefore.'</td></tr>';
my $lafter =
&Apache::lonhtmlcommon::date_setter('advsearch',
'revisiondate1',
0, # current value
'', # special
1, # includeempty
'', # state
1, # no_hh_mm_ss
);
my $lbefore =
&Apache::lonhtmlcommon::date_setter('advsearch',
'revisiondate2',
0, # current value
'', # special
1, # includeempty
'', # state
1, # no_hh_mm_ss
);
$scrout .= '<tr><td align="right">'.&mt('Last modified between').'</td>'
.'<td>'.$lafter.'</td></tr>'
.'<tr><td align="right">'.&mt('and').'</td>'
.'<td>'.$lbefore.'</td></tr>';
$scrout.="</table>\n";
$scrout.=<<ENDDOCUMENT;
$advanced_buttons
</form>
ENDDOCUMENT
$scrout .= &Apache::loncommon::end_page();
$r->print($scrout);
return;
}
######################################################################
######################################################################
=pod
=item &titlefield()
Inputs: title text
Outputs: titletext with font wrapper
=cut
######################################################################
######################################################################
sub titlefield {
my $title=shift;
return $title;
}
######################################################################
######################################################################
=pod
=item viewoptiontext()
Inputs: codename for view option
Outputs: displayed text
=cut
######################################################################
######################################################################
sub viewoptiontext {
my $code=shift;
my %desc=&Apache::lonlocal::texthash
('detailed' => "Detailed Citation View",
'xml' => 'XML/SGML',
'compact' => 'Compact View',
'fielded' => 'Fielded Format',
'summary' => 'Summary View',
'summarypreview' => 'Summary Preview',
'detailedpreview' => 'Detailed Citation Preview');
return $desc{$code};
}
######################################################################
######################################################################
=pod
=item viewoptions()
Inputs: none
Outputs: text for box with view options
=cut
######################################################################
######################################################################
sub viewoptions {
my $scrout;
if (! defined($env{'form.viewselect'})) {
$env{'form.viewselect'}='detailed';
}
$scrout.=&Apache::lonmeta::selectbox('viewselect',
$env{'form.viewselect'},
\&viewoptiontext,
sort(keys(%Views)));
$scrout.= ' ';
my $countselect = &Apache::lonmeta::selectbox('show',
$env{'form.show'},
undef,
(10,20,50,100,1000,10000));
$scrout .= (' 'x2).&mt('[_1] Records per Page',$countselect).
'</nobr>'.$/;
return $scrout;
}
######################################################################
######################################################################
=pod
=item searchhelp()
Inputs: none
Outputs: return little blurb on how to enter searches
=cut
######################################################################
######################################################################
sub searchhelp {
return &mt('enter keywords (no boolean expressions)');
}
######################################################################
######################################################################
=pod
=item &get_persistent_form_data()
Inputs: filename of database
Outputs: returns undef on database errors.
This function is the reverse of &make_persistent() for form data.
Retrieve persistent data from %persistent_db. Retrieved items will have their
values unescaped. If a form value already exists in $env, it will not be
overwritten. Form values that are array references may have values appended
to them.
=cut
######################################################################
######################################################################
sub get_persistent_form_data {
my $filename = shift;
return 0 if (! -e $filename);
return undef if (! tie(%persistent_db,'GDBM_File',$filename,
&GDBM_READER(),0640));
#
# These make sure we do not get array references printed out as 'values'.
my %arrays_allowed = ('form.domains'=>1);
#
# Loop through the keys, looking for 'form.'
foreach my $name (keys(%persistent_db)) {
next if ($name !~ /^form./);
# Kludgification begins!
if ($name eq 'form.domains' &&
$env{'form.searchmode'} eq 'basic' &&
$env{'form.phase'} ne 'disp_basic') {
next;
}
# End kludge (hopefully)
next if (exists($env{$name}));
my @values = map {
&unescape($_);
} split(',',$persistent_db{$name});
next if (@values <1);
if ($arrays_allowed{$name}) {
$env{$name} = [@values];
} else {
$env{$name} = $values[0] if ($values[0]);
}
}
untie (%persistent_db);
return 1;
}
######################################################################
######################################################################
=pod
=item &get_persistent_data()
Inputs: filename of database, ref to array of values to recover.
Outputs: array of values. Returns undef on error.
This function is the reverse of &make_persistent();
Retrieve persistent data from %persistent_db. Retrieved items will have their
values unescaped. If the item contains commas (before unescaping), the
returned value will be an array pointer.
=cut
######################################################################
######################################################################
sub get_persistent_data {
my $filename = shift;
my @Vars = @{shift()};
my @Values; # Return array
return undef if (! -e $filename);
return undef if (! tie(%persistent_db,'GDBM_File',$filename,
&GDBM_READER(),0640));
foreach my $name (@Vars) {
if (! exists($persistent_db{$name})) {
push @Values, undef;
next;
}
my @values = map {
&unescape($_);
} split(',',$persistent_db{$name});
if (@values <= 1) {
push @Values,$values[0];
} else {
push @Values,\@values;
}
}
untie (%persistent_db);
return @Values;
}
######################################################################
######################################################################
=pod
=item &make_persistent()
Inputs: Hash of values to save, filename of persistent database.
Store variables away to the %persistent_db.
Values will be escaped. Values that are array pointers will have their
elements escaped and concatenated in a comma separated string.
=cut
######################################################################
######################################################################
sub make_persistent {
my %save = %{shift()};
my $filename = shift;
return undef if (! tie(%persistent_db,'GDBM_File',
$filename,&GDBM_WRCREAT(),0640));
foreach my $name (keys(%save)) {
my @values = (ref($save{$name}) ? @{$save{$name}} : ($save{$name}));
# We handle array references, but not recursively.
my $store = join(',', map { &escape($_); } @values );
$persistent_db{$name} = $store;
}
untie(%persistent_db);
return 1;
}
######################################################################
######################################################################
=pod
=item &make_form_data_persistent()
Inputs: filename of persistent database.
Store most form variables away to the %persistent_db.
Values will be escaped. Values that are array pointers will have their
elements escaped and concatenated in a comma separated string.
=cut
######################################################################
######################################################################
sub make_form_data_persistent {
my $r = shift;
my $filename = shift;
my %save;
foreach (keys(%env)) {
next if (!/^form/ || /submit/);
$save{$_} = $env{$_};
}
return &make_persistent(\%save,$filename);
}
######################################################################
######################################################################
=pod
=item &parse_advanced_search()
Parse advanced search form and return the following:
=over 4
=item $query Scalar containing an SQL query.
=item $customquery Scalar containing a custom query.
=item $customshow Scalar containing commands to show custom metadata.
=item $libraries_to_query Reference to array of domains to search.
=back
=cut
######################################################################
######################################################################
sub parse_advanced_search {
my ($r,$closebutton,$hidden_fields)=@_;
my @BasicFields = ('title','author','subject','keywords','url','version',
'notes','abstract','extension','owner','authorspace',
# 'custommetadata','customshow',
'modifyinguser','standards','mime');
my @StatsFields = &statfields();
my @EvalFields = &evalfields();
my $fillflag=0;
my $pretty_search_string = "";
# Clean up fields for safety
for my $field (@BasicFields,
'creationdatestart_month','creationdatestart_day',
'creationdatestart_year','creationdateend_month',
'creationdateend_day','creationdateend_year',
'lastrevisiondatestart_month','lastrevisiondatestart_day',
'lastrevisiondatestart_year','lastrevisiondateend_month',
'lastrevisiondateend_day','lastrevisiondateend_year') {
$env{'form.'.$field}=~s/[^\w\/\s\(\)\=\-\"\'.]//g;
}
foreach ('mode','form','element') {
# is this required? Hmmm.
next if (! exists($env{'form.'.$_}));
$env{'form.'.$_}=&unescape($env{'form.'.$_});
$env{'form.'.$_}=~s/[^\w\/\s\(\)\=\-\"\']//g;
}
# Preprocess the category form element.
$env{'form.category'} = 'any' if (! defined($env{'form.category'}) ||
ref($env{'form.category'}));
#
# Check to see if enough information was filled in
foreach my $field (@BasicFields) {
if (&filled($env{'form.'.$field})) {
$fillflag++;
}
}
foreach my $field (@StatsFields,@EvalFields) {
if (&filled($env{'form.'.$field.'_max'})) {
$fillflag++;
}
if (&filled($env{'form.'.$field.'_min'})) {
$fillflag++;
}
}
for my $field ('lowestgradelevel','highestgradelevel') {
if ( $env{'form.'.$field} =~ /^\d+$/ &&
$env{'form.'.$field} > 0) {
$fillflag++;
}
}
if ($env{'form.area'} eq 'portfolio') {
# Added metadata fields
for (my $i=0; $i<$env{'form.numaddedfields'} ; $i++) {
my $field = $env{'form.addedfield_'.$i};
$field =~ s/^\s*(\S*)\s*$/$1/;
$field =~ s/\W/_/g;
if ($field ne '') {
$fillflag++;
}
}
}
if (! $fillflag) {
&output_blank_field_error($r,$closebutton,
'phase=disp_adv',$hidden_fields);
return ;
}
# Turn the form input into a SQL-based query
my $query='';
my @queries;
my $font = '<font color="#800000" face="helvetica">';
# Evaluate logical expression AND/OR/NOT phrase fields.
foreach my $field (@BasicFields) {
next if (!defined($env{'form.'.$field}) || $env{'form.'.$field} eq '');
my ($error,$SQLQuery) =
&process_phrase_input($env{'form.'.$field},
$env{'form.'.$field.'_related'},$field);
if (defined($error)) {
&output_unparsed_phrase_error($r,$closebutton,'phase=disp_adv',
$hidden_fields,$field);
return;
} else {
$pretty_search_string .=
$font.$field.'</font>: '.$env{'form.'.$field};
if ($env{'form.'.$field.'_related'}) {
my @Words =
&Apache::loncommon::get_related_words
($env{'form.'.$field});
if (@Words) {
$pretty_search_string.= ' with related words: '.
join(', ',@Words[0..4]);
} else {
$pretty_search_string.= ' with related words.';
}
}
$pretty_search_string .= '<br />';
push (@queries,$SQLQuery);
}
}
#
# Make the 'mime' from 'form.category' and 'form.extension'
#
my $searchphrase;
if (exists($env{'form.category'}) &&
$env{'form.category'} !~ /^\s*$/ &&
$env{'form.category'} ne 'any') {
my @extensions = &Apache::loncommon::filecategorytypes
($env{'form.category'});
if (scalar(@extensions) > 0) {
$searchphrase = join(' OR ',@extensions);
}
}
if (defined($searchphrase)) {
my ($error,$SQLsearch) = &process_phrase_input($searchphrase,0,'mime');
push @queries,$SQLsearch;
$pretty_search_string .=$font.'mime</font> contains <b>'.
$searchphrase.'</b><br />';
}
#
# Evaluate option lists
if ($env{'form.lowestgradelevel'} &&
$env{'form.lowestgradelevel'} ne '0' &&
$env{'form.lowestgradelevel'} =~ /^\d+$/) {
push(@queries,
'(lowestgradelevel>='.$env{'form.lowestgradelevel'}.')');
$pretty_search_string.="lowestgradelevel>=".
$env{'form.lowestgradelevel'}."<br />\n";
}
if ($env{'form.highestgradelevel'} &&
$env{'form.highestgradelevel'} ne '0' &&
$env{'form.highestgradelevel'} =~ /^\d+$/) {
push(@queries,
'(highestgradelevel<='.$env{'form.highestgradelevel'}.')');
$pretty_search_string.="highestgradelevel<=".
$env{'form.highestgradelevel'}."<br />\n";
}
if ($env{'form.language'} and $env{'form.language'} ne 'any') {
push @queries,"(language like \"$env{'form.language'}\")";
$pretty_search_string.=$font."language</font>= ".
&Apache::loncommon::languagedescription($env{'form.language'}).
"<br />\n";
}
if ($env{'form.copyright'} and $env{'form.copyright'} ne 'any') {
push @queries,"(copyright like \"$env{'form.copyright'}\")";
$pretty_search_string.=$font."copyright</font> = ".
&Apache::loncommon::copyrightdescription($env{'form.copyright'}).
"<br />\n";
}
if ($env{'form.area'} eq 'portfolio') {
#
# Added metadata fields
for (my $i=0; $i<$env{'form.numaddedfields'} ; $i++) {
my $field = $env{'form.addedfield_'.$i};
$field =~ s/^\s*(\S*)\s*$/$1/;
$field =~ s/\W/_/g;
$field =~ tr/A-Z/a-z/;
if ($field ne '') {
my $value = $env{'form.addedvalues_'.$i};
if ($value ne '') {
$value =~ s/'/''/g; #' stupid emacs
my ($error,$query) =
&process_phrase_input($value,0,'pf.value');
if (!defined($error)) {
push(@queries,"pf.field = '$field' AND $query");
$pretty_search_string .=
$font.$field.'</font>: '.
$env{'form.addedvalues_'.$i}.'<br />';
}
} else {
push(@queries,"pf.field = '$field' AND pf.value IS NULL");
}
}
}
} else {
#
# Statistics
foreach my $field (@StatsFields,@EvalFields) {
my ($min,$max);
if (exists($env{'form.'.$field.'_min'}) &&
$env{'form.'.$field.'_min'} ne '') {
$min = $env{'form.'.$field.'_min'};
}
if (exists($env{'form.'.$field.'_max'}) &&
$env{'form.'.$field.'_max'} ne '') {
$max = $env{'form.'.$field.'_max'};
}
next if (! defined($max) && ! defined($min));
if (defined($min) && defined($max)) {
($min,$max) = sort {$a <=>$b} ($min,$max);
}
if (defined($min) && $min =~ /^(\d+\.\d+|\d+|\.\d+)$/) {
push(@queries,'('.$field.'>'.$min.')');
$pretty_search_string.=$font.$field.'</font>>'.$min.'<br />';
}
if (defined($max) && $max =~ /^(\d+\.\d+|\d+|\.\d+)$/) {
push(@queries,'('.$field.'<'.$max.')');
$pretty_search_string.=$font.$field.'</font><'.$max.'<br />';
}
}
}
#
# Evaluate date windows
my $cafter =
&Apache::lonhtmlcommon::get_date_from_form('creationdate1');
my $cbefore =
&Apache::lonhtmlcommon::get_date_from_form('creationdate2');
if ($cafter > $cbefore) {
my $tmp = $cafter;
$cafter = $cbefore;
$cbefore = $tmp;
}
my $mafter =
&Apache::lonhtmlcommon::get_date_from_form('revisiondate1');
my $mbefore =
&Apache::lonhtmlcommon::get_date_from_form('revisiondate2');
if ($mafter > $mbefore) {
my $tmp = $mafter;
$mafter = $mbefore;
$mbefore = $tmp;
}
my ($datequery,$error,$prettydate)=&build_date_queries($cafter,$cbefore,
$mafter,$mbefore);
if (defined($error)) {
&output_date_error($r,$error,$closebutton,$hidden_fields);
} elsif (defined($datequery)) {
# Here is where you would set up pretty_search_string to output
# date query information.
$pretty_search_string .= '<br />'.$prettydate.'<br />';
push @queries,$datequery;
}
#
# Process form information for custom metadata querying
my $customquery=undef;
##
## The custom metadata search was removed q long time ago mostly
## because I was unable to figureout exactly how it worked and could
## not imagine people actually using it. MH
##
# if ($env{'form.custommetadata'}) {
# $pretty_search_string .=$font."Custom Metadata Search</font>: <b>".
# $env{'form.custommetadata'}."</b><br />\n";
# $customquery=&build_custommetadata_query('custommetadata',
# $env{'form.custommetadata'});
# }
my $customshow=undef;
# if ($env{'form.customshow'}) {
# $pretty_search_string .=$font."Custom Metadata Display</font>: <b>".
# $env{'form.customshow'}."</b><br />\n";
# $customshow=$env{'form.customshow'};
# $customshow=~s/[^\w\s]//g;
# my @fields=split(/\s+/,$customshow);
# $customshow=join(" ",@fields);
# }
##
## Deal with restrictions to given domains
##
my ($libraries_to_query,$pretty_domains_string) = &parse_domain_restrictions();
if ($pretty_domains_string) {
$pretty_search_string .= $pretty_domains_string."<br />\n";
}
#
if (@queries) {
if ($env{'form.area'} eq 'portfolio') {
$query ="SELECT pm.*,pa.keynum,pa.scope FROM portfolio_metadata pm, portfolio_access pa, portfolio_addedfields pf WHERE (pm.url = pa.url AND pf.url = pm.url AND (pa.start < NOW() AND (pa.end IS NULL OR pa.end > NOW())) AND (".join(') AND (',@queries).'))';
} else {
$query="SELECT * FROM metadata WHERE (".join(") AND (",@queries).')';
}
} elsif ($customquery) {
$query = '';
}
#&Apache::lonnet::logthis('advanced query = '.$/.$query);
return ($query,$customquery,$customshow,$libraries_to_query,
$pretty_search_string);
}
sub parse_domain_restrictions {
my $libraries_to_query = undef;
# $env{'form.domains'} can be either a scalar or an array reference.
# We need an array.
if (! exists($env{'form.domains'}) || $env{'form.domains'} eq '') {
return (undef,'',undef);
}
my @allowed_domains = &Apache::loncommon::get_env_multiple('form.domains');
#
my %domain_hash = ();
my $pretty_domains_string;
foreach (@allowed_domains) {
$domain_hash{$_}++;
}
if ($domain_hash{'any'}) {
$pretty_domains_string = &mt("in all LON-CAPA domains.");
} else {
if (@allowed_domains > 1) {
$pretty_domains_string = &mt("in LON-CAPA domains:");
} else {
$pretty_domains_string = &mt("in LON-CAPA domain ");
}
foreach (sort @allowed_domains) {
$pretty_domains_string .= "<b>".$_."</b> ";
}
my %servers = &Apache::lonnet::get_servers(\@allowed_domains,
'library');
$libraries_to_query = [keys(%servers)];
}
return ($libraries_to_query,
$pretty_domains_string);
}
######################################################################
######################################################################
=pod
=item &parse_basic_search()
Parse the basic search form and return a scalar containing an sql query.
=cut
######################################################################
######################################################################
sub parse_basic_search {
my ($r,$closebutton)=@_;
#
# Clean up fields for safety
for my $field ('basicexp') {
$env{"form.$field"}=~s/[^\w\s\'\"\!\(\)\-]//g;
}
foreach ('mode','form','element') {
# is this required? Hmmm.
next unless (exists($env{"form.$_"}));
$env{"form.$_"}=&unescape($env{"form.$_"});
$env{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
}
my ($libraries_to_query,$pretty_domains_string) = &parse_domain_restrictions();
#
# Check to see if enough of a query is filled in
my $search_string = $env{'form.basicexp'};
if (! &filled($search_string)) {
&output_blank_field_error($r,$closebutton,'phase=disp_basic');
return OK;
}
my $pretty_search_string=$search_string;
my @Queries;
my @fields = ('title','author','subject','notes','abstract','keywords');
my $searchfield;
if ($env{'form.area'} eq 'portfolio') {
$searchfield = 'concat_ws(" ",pm.'.join(',pm.',@fields).')';
} else {
$searchfield = 'concat_ws(" ",'.join(',',@fields).')';
}
my ($error,$SQLQuery) = &process_phrase_input($search_string,
$env{'form.related'},
$searchfield);
if ($error) {
&output_unparsed_phrase_error($r,$closebutton,'phase=disp_basic',
'','basicexp');
return;
}
push(@Queries,$SQLQuery);
#foreach my $q (@Queries) {
# &Apache::lonnet::logthis(' '.$q);
#}
my $final_query;
if ($env{'form.area'} eq 'portfolio') {
$final_query = 'SELECT pm.*,pa.keynum,pa.scope FROM portfolio_metadata pm, portfolio_access pa WHERE (pm.url = pa.url AND (pa.start < NOW() AND (pa.end IS NULL OR pa.end > NOW())) AND '.join(" AND ",@Queries).')';
} else {
$final_query = 'SELECT * FROM metadata WHERE '.join(" AND ",@Queries);
}
#
if ($env{'form.related'}) {
$pretty_search_string.=' '.&mt('(including related words)');
}
if (defined($pretty_domains_string) && $pretty_domains_string ne '') {
$pretty_search_string .= ' '.$pretty_domains_string;
}
$pretty_search_string .= "<br />\n";
$pretty_search_string =~ s:^<br /> and ::;
&Apache::lonnet::logthis('simple search final query = '.$/.$final_query);
return ($final_query,$pretty_search_string,
$libraries_to_query);
}
###############################################################
###############################################################
my @Phrases;
sub concat {
my ($item) = @_;
my $results = '';
foreach (@$item) {
if (ref($_) eq 'ARRAY') {
$results .= join(' ',@$_);
}
}
return $results;
}
sub process_phrase_input {
my ($phrase,$related,$field)=@_;
#&Apache::lonnet::logthis('phrase = :'.$phrase.':');
my $grammar = <<'ENDGRAMMAR';
searchphrase:
expression /^\Z/ {
# &Apache::lonsearchcat::print_item(\@item,0);
[@item];
}
expression:
phrase(s) {
[@item];
}
phrase:
orword {
[@item];
}
| andword {
[@item];
}
| minusword {
unshift(@::Phrases,$item[1]->[0]);
unshift(@::Phrases,$item[1]->[1]);
[@item];
}
| word {
unshift(@::Phrases,$item[1]);
[@item];
}
#
orword:
word 'OR' phrase {
unshift(@::Phrases,'OR');
unshift(@::Phrases,$item[1]);
[@item];
}
| word 'or' phrase {
unshift(@::Phrases,'OR');
unshift(@::Phrases,$item[1]);
[@item];
}
| minusword 'OR' phrase {
unshift(@::Phrases,'OR');
unshift(@::Phrases,$item[1]->[0]);
unshift(@::Phrases,$item[1]->[1]);
[@item];
}
| minusword 'or' phrase {
unshift(@::Phrases,'OR');
unshift(@::Phrases,$item[1]->[0]);
unshift(@::Phrases,$item[1]->[1]);
[@item];
}
andword:
word phrase {
unshift(@::Phrases,'AND');
unshift(@::Phrases,$item[1]);
[@item];
}
| minusword phrase {
unshift(@::Phrases,'AND');
unshift(@::Phrases,$item[1]->[0]);
unshift(@::Phrases,$item[1]->[1]);
[@item];
}
#
minusword:
'-' word {
[$item[2],'NOT'];
}
word:
"'" term(s) "'" {
&Apache::lonsearchcat::concat(\@item);
}
| '"' term(s) '"' {
&Apache::lonsearchcat::concat(\@item);
}
| term {
$item[1];
}
term:
/[\w\Q:!@#$%^&*()+_=|{}<>,.;\\\/?\E\-]+/ {
$item[1];
}
ENDGRAMMAR
#
# The end result of parsing the phrase with the grammar is an array
# @::Phrases.
# $phrase = "gene splicing" or cat -> "gene splicing","OR","cat"
# $phrase = "genetic engineering" -dna ->
# "genetic engineering","AND","NOT","dna"
# $phrase = cat or dog -poodle -> "cat","OR","dog","AND","NOT","poodle"
undef(@::Phrases);
my $p = new Parse::RecDescent($grammar);
if (! defined($p->searchphrase($phrase))) {
&Apache::lonnet::logthis('lonsearchcat:unable to process:'.$phrase);
return 'Unable to process phrase '.$phrase;
}
#
# Go through the phrases and make sense of them.
# Apply modifiers NOT OR and AND to the phrases.
my @NewPhrases;
while(@::Phrases) {
my $phrase = shift(@::Phrases);
# &Apache::lonnet::logthis('phrase = '.$phrase);
my $phrasedata;
if ($phrase =~ /^(NOT|OR|AND)$/) {
if ($phrase eq 'OR') {
$phrasedata->{'or'}++;
if (! @::Phrases) { $phrasedata = undef; last; }
$phrase = shift(@::Phrases);
} elsif ($phrase eq 'AND') {
$phrasedata->{'and'}++;
if (! @::Phrases) { $phrasedata = undef; last; }
$phrase = shift(@::Phrases);
}
if ($phrase eq 'NOT') {
$phrasedata->{'negate'}++;
if (! @::Phrases) { $phrasedata = undef; last; }
$phrase = shift(@::Phrases);
}
}
$phrasedata->{'phrase'} = $phrase;
if ($related) {
my @NewWords;
(undef,@NewWords) = &related_version($phrasedata->{'phrase'});
$phrasedata->{'related_words'} = \@NewWords;
}
push(@NewPhrases,$phrasedata);
}
#
# Actually build the sql query from the phrases
my $SQLQuery;
foreach my $phrase (@NewPhrases) {
my $query;
if ($phrase->{'negate'}) {
$query .= $field.' NOT LIKE "%'.$phrase->{'phrase'}.'%"';
} else {
$query .= $field.' LIKE "%'.$phrase->{'phrase'}.'%"';
}
foreach my $related (@{$phrase->{'related_words'}}) {
if ($phrase->{'negate'}) {
$query .= ' AND '.$field.' NOT LIKE "%'.$related.'%"';
} else {
$query .= ' OR '.$field.' LIKE "%'.$related.'%"';
}
}
if ($SQLQuery) {
if ($phrase->{'or'}) {
$SQLQuery .= ' OR ('.$query.')';
} else {
$SQLQuery .= ' AND ('.$query.')';
}
} else {
$SQLQuery = '('.$query.')';
}
}
#
# &Apache::lonnet::logthis("SQLQuery = $SQLQuery");
#
return undef,$SQLQuery;
}
######################################################################
######################################################################
=pod
=item &related_version()
Modifies an input string to include related words. Words in the string
are replaced with parenthesized lists of 'OR'd words. For example
"torque" is replaced with "(torque OR word1 OR word2 OR ...)".
Note: Using this twice on a string is probably silly.
=cut
######################################################################
######################################################################
sub related_version {
my ($word) = @_;
return (undef) if (lc($word) =~ /\b(or|and|not)\b/);
my @Words = &Apache::loncommon::get_related_words($word);
# Only use 4 related words
@Words = ($#Words>4? @Words[0..4] : @Words);
my $result = join " OR ", ($word,@Words);
return $result,sort(@Words);
}
######################################################################
######################################################################
=pod
=item &build_custommetadata_query()
Constructs a custom metadata query using a rather heinous regular
expression.
=cut
######################################################################
######################################################################
sub build_custommetadata_query {
my ($field_name,$logic_statement)=@_;
my $q=new Text::Query('abc',
-parse => 'Text::Query::ParseAdvanced',
-build => 'Text::Query::BuildAdvancedString');
$q->prepare($logic_statement);
my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'};
# quick fix to change literal into xml tag-matching
# will eventually have to write a separate builder module
# wordone=wordtwo becomes\<wordone\>[^\<] *wordtwo[^\<]*\<\/wordone\>
$matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to
/\\<$1\\>?# \<wordone\>
\[\^\\<\]?# [^\<]
\*$2\[\^\\<\]?# *wordtwo[^\<]
\*\\<\\\/$1\\>?# *\<\/wordone\>
/g;
return $matchexp;
}
######################################################################
######################################################################
=pod
=item &build_date_queries()
Builds a SQL logic query to check time/date entries.
Also reports errors (check for /^Incorrect/).
=cut
######################################################################
######################################################################
sub build_date_queries {
my ($cafter,$cbefore,$mafter,$mbefore) = @_;
my ($result,$error,$pretty_string);
#
# Verify the input
if (! defined($cafter) && ! defined($cbefore) &&
! defined($mafter) && ! defined($mbefore)) {
# This is an okay situation, so return undef for the error
return (undef,undef,undef);
}
if ((defined($cafter) && ! defined($cbefore)) ||
(defined($cbefore) && ! defined($cafter))) {
# This is bad, so let them know
$error = &mt('Incorrect entry for the creation date. '.
'You must specify both the beginning and ending dates.');
}
if (! defined($error) &&
((defined($mafter) && ! defined($mbefore)) ||
(defined($mbefore) && ! defined($mafter)))) {
# This is also bad, so let them know
$error = &mt('Incorrect entry for the last revision date. '.
'You must specify both the beginning and ending dates.');
}
if (! defined($error)) {
#
# Build the queries
my @queries;
if (defined($cbefore) && defined($cafter)) {
my (undef,undef,undef,$caday,$camon,$cayear) = localtime($cafter);
my (undef,undef,undef,$cbday,$cbmon,$cbyear) = localtime($cbefore);
# Correct for year being relative to 1900
$cayear+=1900; $cbyear+=1900;
my $cquery=
'(creationdate BETWEEN '.
"'".$cayear.'-'.$camon.'-'.$caday."'".
' AND '.
"'".$cbyear.'-'.$cbmon.'-'.$cbday." 23:59:59')";
$pretty_string .= '<br />' if (defined($pretty_string));
$pretty_string .=
&mt('created between [_1] and [_2]',
&Apache::lonlocal::locallocaltime($cafter),
&Apache::lonlocal::locallocaltime($cbefore+24*60*60-1));
push(@queries,$cquery);
$pretty_string =~ s/ 00:00:00//g;
}
if (defined($mbefore) && defined($mafter)) {
my (undef,undef,undef,$maday,$mamon,$mayear) = localtime($mafter);
my (undef,undef,undef,$mbday,$mbmon,$mbyear) = localtime($mbefore);
# Correct for year being relative to 1900
$mayear+=1900; $mbyear+=1900;
my $mquery=
'(lastrevisiondate BETWEEN '.
"'".$mayear.'-'.$mamon.'-'.$maday."'".
' AND '.
"'".$mbyear.'-'.$mbmon.'-'.$mbday." 23:59:59')";
push(@queries,$mquery);
$pretty_string .= '<br />' if (defined($pretty_string));
$pretty_string .=
&mt('last revised between [_1] and [_2]',
&Apache::lonlocal::locallocaltime($mafter),
&Apache::lonlocal::locallocaltime($mbefore+24*60*60-1));
$pretty_string =~ s/ 00:00:00//g;
}
if (@queries) {
$result .= join(" AND ",@queries);
}
}
return ($result,$error,$pretty_string);
}
######################################################################
######################################################################
=pod
=item ©right_check()
Inputs: $Metadata, a hash pointer of metadata for a resource.
Returns: 1 if the resource is available to the user making the query,
0 otherwise.
=cut
######################################################################
######################################################################
sub copyright_check {
my $Metadata = shift;
# Check copyright tags and skip results the user cannot use
my (undef,undef,$resdom,$resname) = split('/',
$Metadata->{'url'});
# Check for priv
if (($Metadata->{'copyright'} eq 'priv') &&
(($env{'user.name'} ne $resname) &&
($env{'user.domain'} ne $resdom))) {
return 0;
}
# Check for domain
if (($Metadata->{'copyright'} eq 'domain') &&
($env{'user.domain'} ne $resdom)) {
return 0;
}
return 1;
}
######################################################################
######################################################################
=pod
=item &ensure_db_and_table()
Ensure we can get lonmysql to connect to the database and the table we
need exists.
Inputs: $r, table id
Returns: undef on error, 1 if the table exists.
=cut
######################################################################
######################################################################
sub ensure_db_and_table {
my ($r,$table) = @_;
##
## Sanity check the table id.
##
if (! defined($table) || $table eq '' || $table =~ /\D/ ) {
$r->print("Unable to retrieve search results. ".
"Unable to determine the table results were saved in. ".
&Apache::loncommon::end_page());
return undef;
}
##
## Make sure we can connect and the table exists.
##
my $connection_result = &Apache::lonmysql::connect_to_db();
if (!defined($connection_result)) {
$r->print("Unable to connect to the MySQL database where your results".
" are saved.".
&Apache::loncommon::end_page());
&Apache::lonnet::logthis("lonsearchcat: unable to get lonmysql to".
" connect to database.");
&Apache::lonnet::logthis(&Apache::lonmysql::get_error());
return undef;
}
my $table_check = &Apache::lonmysql::check_table($table);
if (! defined($table_check)) {
$r->print("A MySQL error has occurred.</form>".
&Apache::loncommon::end_page());
&Apache::lonnet::logthis("lonmysql was unable to determine the status".
" of table ".$table);
return undef;
} elsif (! $table_check) {
$r->print("The table of results could not be found.");
&Apache::lonnet::logthis("The user requested a table, ".$table.
", that could not be found.");
return undef;
}
return 1;
}
######################################################################
######################################################################
=pod
=item &print_sort_form()
The sort feature is not implemented at this time. This form just prints
a link to change the search query.
=cut
######################################################################
######################################################################
sub print_sort_form {
my ($r,$pretty_query_string,$status) = @_;
##
my %SortableFields=&Apache::lonlocal::texthash(
id => 'Default',
title => 'Title',
author => 'Author',
subject => 'Subject',
url => 'URL',
version => 'Version Number',
mime => 'Mime type',
lang => 'Language',
owner => 'Owner/Publisher',
copyright => 'Copyright',
hostname => 'Host',
creationdate => 'Creation Date',
lastrevisiondate => 'Revision Date'
);
##
my $table = $env{'form.table'};
return if (! &ensure_db_and_table($r,$table));
##
## Get the number of results
##
my $total_results = &Apache::lonmysql::number_of_rows($table);
if (! defined($total_results)) {
$r->print("A MySQL error has occurred.</form>".
&Apache::loncommon::end_page());
&Apache::lonnet::logthis("lonmysql was unable to determine the number".
" of rows in table ".$table);
&Apache::lonnet::logthis(&Apache::lonmysql::get_error());
return;
}
my $js =<<END;
<script type="text/javascript">
function change_sort() {
var newloc = "/adm/searchcat?phase=results";
newloc += "&persistent_db_id=$env{'form.persistent_db_id'}";
newloc += "&sortby=";
newloc += document.forms.statusform.elements.sortby.value;
parent.resultsframe.location= newloc;
}
</script>
END
my $start_page = &Apache::loncommon::start_page('Results',$js,
{'no_title' => 1});
my $breadcrumbs=
&Apache::lonhtmlcommon::breadcrumbs('Searching','Searching',
$env{'form.catalogmode'} ne 'import');
my $result = <<END;
$start_page
$breadcrumbs
<form name="statusform" action="" method="post" target="_top">
<input type="hidden" name="catalogmode" value="import" />
<input type="hidden" name="acts" value="" />
END
#<h2>Sort Results</h2>
#Sort by: <select size="1" name="sortby" onchange="javascript:change_sort();">
# $env{'form.sortby'} = 'id' if (! defined($env{'form.sortby'}));
# foreach (keys(%SortableFields)) {
# $result.="<option name=\"$_\"";
# if ($_ eq $env{'form.sortby'}) {
# $result.=" selected ";
# }
# $result.=" >$SortableFields{$_}</option>\n";
# }
# $result.="</select>\n";
my $revise = &revise_button();
$result.='<p>'.
$status
.&mt('There are [_1] matches to your query.',$total_results)
.' '.$revise.'</p>'
.'<p>'.&mt('Search: ').$pretty_query_string
.'</p></form>';
$r->print($result.&Apache::loncommon::end_page());
return;
}
#####################################################################
#####################################################################
=pod
=item MySQL Table Description
MySQL table creation requires a precise description of the data to be
stored. The use of the correct types to hold data is vital to efficient
storage and quick retrieval of records. The columns must be described in
the following format:
=cut
#####################################################################
#####################################################################
#
# These should probably be scoped but I don't have time right now...
#
my @Datatypes;
my @Fullindicies;
######################################################################
######################################################################
=pod
=item &create_results_table()
Creates the table of search results by calling lonmysql. Stores the
table id in $env{'form.table'}
Inputs: search area - either res or portfolio
Returns: the identifier of the table on success, undef on error.
=cut
######################################################################
######################################################################
sub set_up_table_structure {
my ($tabletype) = @_;
my ($datatypes,$fullindicies) =
&LONCAPA::lonmetadata::describe_metadata_storage($tabletype); # corresponds to table-description.odt
# Copy the table description before modifying it...
@Datatypes = @{$datatypes};
unshift(@Datatypes,{name => 'id',
type => 'MEDIUMINT',
restrictions => 'UNSIGNED NOT NULL',
primary_key => 'yes',
auto_inc => 'yes' });
@Fullindicies = @{$fullindicies};
return;
}
sub create_results_table {
my ($area) = @_;
if ($area eq 'portfolio') {
&set_up_table_structure('portfolio_search');
} else {
&set_up_table_structure('metadata');
}
my $table = &Apache::lonmysql::create_table
( { columns => \@Datatypes,
FULLTEXT => [{'columns' => \@Fullindicies},],
} );
if (defined($table)) {
$env{'form.table'} = $table;
return $table;
}
return undef; # Error...
}
######################################################################
######################################################################
=pod
=item Search Status update functions
Each of the following functions changes the values of one of the
input fields used to display the search status to the user. The names
should be explanatory.
Inputs: Apache request handler ($r), text to display.
Returns: Nothing.
=over 4
=item &update_count_status()
=item &update_status()
=item &update_seconds()
=back
=cut
######################################################################
######################################################################
sub update_count_status {
my ($r,$text) = @_;
$text =~ s/\'/\\\'/g;
$r->print
("<script>document.statusform.count.value = ' $text'</script>\n");
$r->rflush();
}
sub update_status {
my ($r,$text) = @_;
$text =~ s/\'/\\\'/g;
$r->print
("<script>document.statusform.status.value = ' $text'</script>\n");
$r->rflush();
}
{
my $max_time = 300; # seconds for the search to complete
my $start_time = 0;
my $last_time = 0;
sub reset_timing {
$start_time = 0;
$last_time = 0;
}
sub time_left {
if ($start_time == 0) {
$start_time = time;
}
my $time_left = $max_time - (time - $start_time);
$time_left = 0 if ($time_left < 0);
return $time_left;
}
sub update_seconds {
my ($r) = @_;
my $time = &time_left();
if (($last_time-$time) > 0) {
$r->print("<script>".
"document.statusform.seconds.value = '$time'".
"</script>\n");
$r->rflush();
}
$last_time = $time;
}
}
######################################################################
######################################################################
=pod
=item &revise_button()
Inputs: None
Returns: html string for a 'revise search' button.
=cut
######################################################################
######################################################################
sub revise_button {
my $revisetext = &mt('Revise search');
my $revise_phase = 'disp_basic';
$revise_phase = 'disp_adv' if ($env{'form.searchmode'} eq 'advanced');
my $newloc = '/adm/searchcat'.
'?persistent_db_id='.$env{'form.persistent_db_id'}.
'&cleargroupsort=1'.
'&phase='.$revise_phase;
my $result = qq{<input type="button" value="$revisetext" name="revise"} .
qq{ onClick="parent.location='$newloc';" /> };
return $result;
}
######################################################################
######################################################################
=pod
=item &run_search()
Executes a search query by sending it the the other servers and putting the
results into MySQL.
=cut
######################################################################
######################################################################
sub run_search {
# &run_search($r,$query,$customquery,$customshow,
# $libraries,$pretty_string,$env{'form.area'}, $env{'form.algorithm'},
# $env{'form.degree'},$env{'form.connectivitywac'},$env{'form.connectivitysac'},
# $env{'form.instances'},);
my ($r,$query,$customquery,$customshow,$serverlist,
$pretty_string,$area,$algorithm,$degree,$connectivitywac,$connectivitysac,$instances,$proximity) = @_;
# open a log file
my $file = '/home/httpd/perl/logs/test.log'; # Name the file
open(INFO, ">>$file"); # Open the file
print INFO "logfile opened, search started...\n";
INFO->autoflush(1);
print INFO "algorithm run_search: " . $ENV{'form.algorithm'} . "\n";
my $tabletype = 'metadata';
if ($area eq 'portfolio') {
$tabletype = 'portfolio_search';
}
my $connection = $r->connection;
#
# Print run_search header
#
my $start_page = &Apache::loncommon::start_page('Search Status',undef,
{'no_title' => 1});
my $breadcrumbs =
&Apache::lonhtmlcommon::breadcrumbs('Searching','Searching',
$env{'form.catalogmode'} ne 'import');
$r->print(<<END);
$start_page
$breadcrumbs
<form name="statusform" action="" method="post">
<input type="hidden" name="acts" value="" />
END
# Remove leading and trailing <br />
$pretty_string =~ s:^\s*<br />::i;
$pretty_string =~ s:(<br />)*\s*$::im;
my @Lines = split("<br />",$pretty_string);
# I keep getting blank items at the end of the list, hence the following:
while ($Lines[-1] =~ /^\s*$/ && @Lines) {
pop(@Lines);
}
if (@Lines > 2) {
$pretty_string = join '<br />',(@Lines[0..2],'....<br />');
}
$r->print(&mt("Search: [_1]",$pretty_string));
$r->rflush();
#
# Determine the servers we need to contact.
my @Servers_to_contact;
if (defined($serverlist)) {
if (ref($serverlist) eq 'ARRAY') {
@Servers_to_contact = @$serverlist;
} else {
@Servers_to_contact = ($serverlist);
}
} else {
my %all_library_servers = &Apache::lonnet::all_library();
@Servers_to_contact = sort(keys(%all_library_servers));
}
my %Server_status;
#
# Check on the mysql table we will use to store results.
my $table =$env{'form.table'};
if (! defined($table) || $table eq '' || $table =~ /\D/ ) {
$r->print("Unable to determine table id to save search results in.".
"The search has been aborted.".
&Apache::loncommon::end_page());
return;
}
my $table_status = &Apache::lonmysql::check_table($table);
if (! defined($table_status)) {
$r->print("Unable to determine status of table.".
&Apache::loncommon::end_page());
&Apache::lonnet::logthis("Bogus table id of $table for ".
"$env{'user.name'} @ $env{'user.domain'}");
&Apache::lonnet::logthis("lonmysql error = ".
&Apache::lonmysql::get_error());
return;
}
if (! $table_status) {
&Apache::lonnet::logthis("lonmysql error = ".
&Apache::lonmysql::get_error());
&Apache::lonnet::logthis("lonmysql debug = ".
&Apache::lonmysql::get_debug());
&Apache::lonnet::logthis('table status = "'.$table_status.'"');
$r->print("The table id,$table, we tried to use is invalid.".
"The search has been aborted.".
&Apache::loncommon::end_page());
return;
}
##
## Prepare for the big loop.
my $hitcountsum;
my %matches;
my $server;
my $status;
my $revise = &revise_button();
$r->print(<<END);
<br>
<br>
<b>working ... please stand by, this might take a while</b>
</form>
END
$r->rflush();
#print INFO "before getting the row... \n";
#$|++;
# # Parse the result.
# my $Fields = &Apache::lonsearch::createResultRow();#&parse_raw_result($result,$server,$tabletype);
#print INFO "after getting the row... \n";
#print INFO "$Fields $%Fields{'title'}\n";
#while ( my ($key, $value) = each(%$Fields) ) {
# print INFO "$key => $value\n";
#}
# $Fields{'hostname'} = 'tmp9-test'; TODO how do I access the hash here?
#
# Skip if external and we did not want that
#next if ((! $env{'form.inclext'}) && ($Fields{'url'}=~/^\/ext\//));
# Skip based on copyright
#next if (! ©right_check(\%Fields));
print INFO "before store.\n";
$|++;
#$degree,$connectivitywac,$connectivitysac,$instances
my $connectivity;
if ($connectivitywac > 0) {
$connectivity = $connectivitywac;
} else { # catch errors ...TODO
$connectivity = $connectivitysac;
}
my $startuser;
print INFO 'requested user name: '.$env{'form.username'} ."\n";
if ($env{'form.username'} ne '') { # if no explicit start user mentioned, assume the logged in user
$startuser = $env{'form.username'};
} else {
$startuser = $env{'user.name'}.':'.$env{'user.domain'};
}
my $blah = $env{'user.name'}.':'.$env{'user.domain'};
print INFO "creating with $blah \n";
# algorithm: wac sac usedauthors:sortbyreuse relatedcoordinators:sortbysimilarity
my $sort = '';
if ($algorithm eq 'relatedcoordinators') {
$sort = 'sortbysimilarity';
} elsif ($algorithm eq 'usedauthors') {
$sort = 'sortbyreuse';
}
&Apache::lonsearch::createEvaluationRow($startuser, $env{'form.basicexp'}, $algorithm, $degree, $connectivity, $proximity, $instances,'',$blah);
$env{'finished'} = &Apache::lonsearch::search($env{'form.basicexp'}, $startuser,
$algorithm, $sort, $degree,
$connectivity, 'extendurl', $table, $r, $instances, $proximity,$env{'user.name'},$env{'user.domain'});
#
# Store the result in the mysql database
# my $result = &Apache::lonmysql::store_row($table,\%$Fields);
# $r->print("<br>one result stored<br>");
# $r->rflush();
#
# if (! defined($result)) {
#print INFO &Apache::lonmysql::get_error();
# $r->print(&Apache::lonmysql::get_error());
# }
print INFO "finished writing result .\n";
$|++;
close(INFO);
#
# $hitcountsum ++;
# }
# $fh->close();
&update_status($r,&mt('Search Complete [_1]',$server));
&update_seconds($r);
#
&Apache::lonmysql::disconnect_from_db(); # This is unneccessary
#
# We have run out of time or run out of servers to talk to and
# results to get, so let the client know the top frame needs to be
# loaded from /adm/searchcat
$r->print(&Apache::loncommon::end_page());
# if ($env{'form.catalogmode'} ne 'import') {
$r->print("<script>".
"window.location='/adm/searchcat?".
"phase=sort&".
"persistent_db_id=$env{'form.persistent_db_id'}';".
"</script>");
# }
return;
}
######################################################################
######################################################################
=pod
=item &prev_next_buttons()
Returns html for the previous and next buttons on the search results page.
=cut
######################################################################
######################################################################
sub prev_next_buttons {
my ($current_min,$show,$total,$parms) = @_;
return '' if ($show eq 'all'); # No links if you get them all at once.
#
# Create buttons
my $buttons = '<input type="submit" name="prev" value="'.&mt('Prev').'" ';
$buttons .= '/>';
$buttons .= ' 'x3;
$buttons .= '<input type="submit" name="reload" '.
'value="'.&mt('Reload').'" />';
$buttons .= ' 'x3;
$buttons .= '<input type="submit" name="next" value="'.&mt('Next').'" ';
$buttons .= '/>';
return $buttons;
}
######################################################################
######################################################################
=pod
=item &display_results()
Prints the results out for selection and perusal.
=cut
######################################################################
######################################################################
sub display_results {
my ($r,$importbutton,$closebutton,$diropendb,$area, $username,$status) = @_;
my $connection = $r->connection;
$r->print(&search_results_header($importbutton,$closebutton,$status));
##
## Set viewing function
##
my $viewfunction = $Views{$env{'form.viewselect'}};
if (!defined($viewfunction)) {
$r->print("Internal Error - Bad view selected.\n");
$r->rflush();
return;
}
##
## $checkbox_num is a count of the number of checkboxes output on the
## page this is used only during catalogmode=import.
my $checkbox_num = 0;
##
## Get the catalog controls setup
##
my $action = "/adm/searchcat?phase=results";
##
## Deal with import by opening the import db file.
if ($env{'form.catalogmode'} eq 'import') {
if (! tie(%groupsearch_db,'GDBM_File',$diropendb,
&GDBM_WRCREAT(),0640)) {
$r->print('Unable to save import results.</form>'.
&Apache::loncommon::end_page());
$r->rflush();
return;
}
}
##
## Prepare the table for querying
my $table = $env{'form.table'};
return if (! &ensure_db_and_table($r,$table));
##
## Get the number of results
my $total_results = &Apache::lonmysql::number_of_rows($table);
if (! defined($total_results)) {
$r->print("A MySQL error has occurred.</form>".
&Apache::loncommon::end_page());
&Apache::lonnet::logthis("lonmysql was unable to determine the number".
" of rows in table ".$table);
&Apache::lonnet::logthis(&Apache::lonmysql::get_error());
return;
}
##
## Determine how many results we need to get
$env{'form.start'} = 1 if (! exists($env{'form.start'}));
$env{'form.show'} = 20 if (! exists($env{'form.show'}));
if (exists($env{'form.prev'})) {
$env{'form.start'} -= $env{'form.show'};
} elsif (exists($env{'form.next'})) {
$env{'form.start'} += $env{'form.show'};
}
$env{'form.start'} = 1 if ($env{'form.start'}<1);
$env{'form.start'} = $total_results if ($env{'form.start'}>$total_results);
my $min = $env{'form.start'};
my $max;
if ($env{'form.show'} eq 'all') {
$max = $total_results ;
} else {
$max = $min + $env{'form.show'} - 1;
$max = $total_results if ($max > $total_results);
}
##
## Output form elements
$r->print(&hidden_field('table').
&hidden_field('phase').
&hidden_field('persistent_db_id').
&hidden_field('start').
&hidden_field('area').
&hidden_field('username')
);
#
# Build sorting selector
my @fields =
(
{key=>'count'},
{key=>'default'},
{key=>'title' },
{key =>'author' },
{key =>'url',desc=>'URL'},
{key =>'keywords'},
{key =>'stdno',desc=>'relevance (only for Used Authors, Related Coordinators)'},
);
my %fieldnames = &Apache::lonmeta::fieldnames();
my @field_order;
foreach my $field_data (@fields) {
push(@field_order,$field_data->{'key'});
if (! exists($field_data->{'desc'})) {
$field_data->{'desc'}=$fieldnames{$field_data->{'key'}};
} else {
if (! defined($field_data->{'desc'})) {
$field_data->{'desc'} = ucfirst($field_data->{'key'});
}
$field_data->{'desc'} = &mt($field_data->{'desc'});
}
}
my %sort_fields = map {$_->{'key'},$_->{'desc'}} @fields;
$sort_fields{'select_form_order'} = \@field_order;
$env{'form.sortorder'} = 'desc' if (! exists($env{'form.sortorder'}));
if (! exists($env{'form.sortfield'})) {
if ($area eq 'portfolio') {
$env{'form.sortfield'} = 'owner';
} else {
$env{'form.sortfield'} = 'count';
}
}
if (! exists($env{'form.sortorder'})) {
if ($env{'form.sortfield'}=~/^(count|stdno|disc|clear|technical|correct|helpful)$/) {
$env{'form.sortorder'}='desc';
} else {
$env{'form.sortorder'}='asc';
}
}
my $sortform = &mt('Sort by [_1] [_2]',
&Apache::loncommon::select_form($env{'form.sortfield'},
'sortfield',
%sort_fields),
&Apache::loncommon::select_form($env{'form.sortorder'},
'sortorder',
(asc =>&mt('Ascending'),
desc=>&mt('Descending')
))
);
##
## Output links (if necessary) for 'prev' and 'next' pages.
$r->print
('<table width="100%"><tr><td width="25%" align="right">'.
'<nobr>'.$sortform.'</nobr>'.
'<input type="hidden" name="catalogmode" value="import"/>'.
'</td><td width="25%" align="right">'.
&prev_next_buttons($min,$env{'form.show'},$total_results).
'</td><td align="right">'.
&viewoptions().'</td></tr></table>'
);
if ($total_results == 0) { # && ($env{'finished' eq 'false'})
# if ($env{'finished' eq 'false'}) {
$r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2" />'.
'<h3>'.&mt('There are currently no results').'.</h3>'.
"</form>".
&Apache::loncommon::end_page());
# }
return;
} else {
$r->print('<center>'.
mt('Results [_1] to [_2] out of [_3]',
$min,$max,$total_results).
"</center>\n");
}
##
## Get results from MySQL table
my $sort_command = 'id>='.$min.' AND id<='.$max;
my $order;
if (exists($env{'form.sortorder'})) {
if ($env{'form.sortorder'} eq 'asc') {
$order = 'ASC';
} elsif ($env{'form.sortorder'} eq 'desc') {
$order = 'DESC';
} else {
$order = '';
}
} else {
$order = '';
}
if ($env{'form.sortfield'} ne 'default' &&
exists($sort_fields{$env{'form.sortfield'}})) {
$sort_command = $env{'form.sortfield'}.' IS NOT NULL '.
'ORDER BY '.$env{'form.sortfield'}.' '.$order.
' LIMIT '.($min-1).','.($max-$min+1);
}
my @Results = &Apache::lonmysql::get_rows($table,$sort_command);
##
## Loop through the results and output them.
my $tabletype = 'metadata';
if ($area eq 'portfolio') {
$tabletype = 'portfolio_search';
}
foreach my $row (@Results) {
if ($connection->aborted()) {
&cleanup();
return;
}
my %Fields = %{&parse_row($tabletype,@$row)};
my $output="<p>\n";
if (! defined($Fields{'title'}) || $Fields{'title'} eq '') {
$Fields{'title'} = 'Untitled';
}
my $prefix=&catalogmode_output($Fields{'title'},$Fields{'url'},
$Fields{'id'},$checkbox_num++);
# Render the result into html
$output.= &$viewfunction($prefix,%Fields);
# Print them out as they come in.
$r->print($output);
$r->rflush();
}
if (@Results < 1) {
$r->print(&mt("There were no results matching your query"));
} else {
$r->print
('<center>'.
&prev_next_buttons($min,$env{'form.show'},$total_results,
"table=".$env{'form.table'}.
"&phase=results".
"&persistent_db_id=".
$env{'form.persistent_db_id'})
."</center>\n"
);
}
$r->print("</form>".&Apache::loncommon::end_page());
$r->rflush();
untie %groupsearch_db if (tied(%groupsearch_db));
return;
}
######################################################################
######################################################################
=pod
=item &catalogmode_output($title,$url,$fnum,$checkbox_num)
Returns html needed for the various catalog modes. Gets inputs from
$env{'form.catalogmode'}. Stores data in %groupsearch_db.
=cut
######################################################################
######################################################################
sub catalogmode_output {
my $output = '';
my ($title,$url,$fnum,$checkbox_num) = @_;
if ($env{'form.catalogmode'} eq 'interactive') {
$title=~ s/\'/\\\'/g;
if ($env{'form.catalogmode'} eq 'interactive') {
$output.=<<END
<font size='-1'><input type="button" name="returnvalues" value="select"
onClick="javascript:select_data('$title','$url')" />
</font>
END
}
} elsif ($env{'form.catalogmode'} eq 'import') {
$groupsearch_db{"pre_${fnum}_link"}=$url;
$groupsearch_db{"pre_${fnum}_title"}=$title;
$output.=<<END;
<font size='-1'>
<input type="checkbox" name="returnvalues" value="select"
onClick="javascript:queue($checkbox_num,$fnum)" />
</font>
END
}
return $output;
}
######################################################################
######################################################################
=pod
=item &parse_row()
Parse a row returned from the database.
=cut
######################################################################
######################################################################
sub parse_row {
my ($tabletype,@Row) = @_;
my %Fields;
if (! scalar(@Datatypes)) {
&set_up_table_structure($tabletype);
}
for (my $i=0;$i<=$#Row;$i++) {
$Fields{$Datatypes[$i]->{'name'}}=&unescape($Row[$i]);
}
$Fields{'language'} =
&Apache::loncommon::languagedescription($Fields{'language'});
$Fields{'copyrighttag'} =
&Apache::loncommon::copyrightdescription($Fields{'copyright'});
$Fields{'mimetag'} =
&Apache::loncommon::filedescription($Fields{'mime'});
return \%Fields;
}
###########################################################
###########################################################
=pod
=item &parse_raw_result()
Takes a line from the file of results and parse it. Returns a hash
with keys according to column labels
In addition, the following tags are set by calling the appropriate
lonnet function: 'language', 'copyrighttag', 'mimetag'.
The 'title' field is set to "Untitled" if the title field is blank.
'abstract' and 'keywords' are truncated to 200 characters.
=cut
###########################################################
###########################################################
sub parse_raw_result {
my ($result,$hostname,$tabletype) = @_;
# conclude from self to others regarding fields
my %Fields=&LONCAPA::lonmetadata::metadata_col_to_hash
($tabletype,
map {
&unescape($_);
} (split(/\,/,$result)) );
return %Fields;
}
###########################################################
###########################################################
=pod
=item &handle_custom_fields()
=cut
###########################################################
###########################################################
sub handle_custom_fields {
my @results = @{shift()};
my $customshow='';
my $extrashow='';
my @customfields;
if ($env{'form.customshow'}) {
$customshow=$env{'form.customshow'};
$customshow=~s/[^\w\s]//g;
my @fields=map {
"<font color=\"#008000\">$_:</font><!-- $_ -->";
} split(/\s+/,$customshow);
@customfields=split(/\s+/,$customshow);
if ($customshow) {
$extrashow="<ul><li>".join("</li><li>",@fields)."</li></ul>\n";
}
}
my $customdata='';
my %customhash;
foreach my $result (@results) {
if ($result=~/^(custom\=.*)$/) { # grab all custom metadata
my $tmp=$result;
$tmp=~s/^custom\=//;
my ($k,$v)=map {&unescape($_);
} split(/\,/,$tmp);
$customhash{$k}=$v;
}
}
return ($extrashow,\@customfields,\%customhash);
}
######################################################################
######################################################################
=pod
=item &search_results_header()
Output the proper html headers and javascript code to deal with different
calling modes.
Takes most inputs directly from %env, except $mode.
=over 4
=item $mode is either (at this writing) 'Basic' or 'Advanced'
=back
The following environment variables are checked:
=over 4
=item 'form.catalogmode'
Checked for 'interactive' and 'import'.
=item 'form.mode'
Checked for existance & 'edit' mode.
=item 'form.form'
Contains the name of the form that has the input fields to set
=item 'form.element'
the name of the input field to put the URL into
=item 'form.titleelement'
the name of the input field to put the title into
=back
=cut
######################################################################
######################################################################
sub search_results_header {
my ($importbutton,$closebutton,$status) = @_;
$importbutton = <<END;
<input type='button' name='import' value='IMPORT'
onClick='javascript:select_group()'>
END
my $js;
# output beginning of search page
# conditional output of script functions dependent on the mode in
# which the search was invoked
if ($env{'form.catalogmode'} eq 'interactive'){
if (! exists($env{'form.mode'}) || $env{'form.mode'} ne 'edit') {
$js.=<<SCRIPT;
<script type="text/javascript">
function select_data(title,url) {
changeTitle(title);
changeURL(url);
parent.close();
}
function changeTitle(val) {
if (parent.opener.inf.document.forms.resinfo.elements.t) {
parent.opener.inf.document.forms.resinfo.elements.t.value=val;
}
}
function changeURL(val) {
if (parent.opener.inf.document.forms.resinfo.elements.u) {
parent.opener.inf.document.forms.resinfo.elements.u.value=val;
}
}
</script>
SCRIPT
} elsif ($env{'form.mode'} eq 'edit') {
my $form = $env{'form.form'};
my $element = $env{'form.element'};
my $titleelement = $env{'form.titleelement'};
my $changetitle;
if (!$titleelement) {
$changetitle='function changeTitle(val) {}';
} else {
$changetitle=<<END;
function changeTitle(val) {
if (parent.targetwin.document) {
parent.targetwin.document.forms["$form"].elements["$titleelement"].value=val;
} else {
var url = 'forms[\"$form\"].elements[\"$titleelement\"].value';
alert("Unable to transfer data to "+url);
}
}
END
}
$js.=<<SCRIPT;
<script type="text/javascript">
function select_data(title,url) {
changeURL(url);
changeTitle(title);
parent.close();
}
$changetitle
function changeURL(val) {
if (parent.targetwin.document) {
parent.targetwin.document.forms["$form"].elements["$element"].value=val;
} else {
var url = 'forms[\"$form\"].elements[\"$element\"].value';
alert("Unable to transfer data to "+url);
}
}
</script>
SCRIPT
}
}
my $inhibit_menu = "&".&Apache::loncommon::inhibit_menu_check();
$js.= <<SCRIPT if $env{'form.catalogmode'} eq 'import';
<script type="text/javascript">
function queue(checkbox_num,val) {
if (document.forms.results.returnvalues.length != "undefined" &&
typeof(document.forms.results.returnvalues.length) == "number") {
if (document.forms.results.returnvalues[checkbox_num].checked) {
parent.statusframe.document.forms.statusform.elements.acts.value +='1a'+val+'b';
} else {
parent.statusframe.document.forms.statusform.elements.acts.value +='0a'+val+'b';
}
} else {
if (document.forms.results.returnvalues.checked) {
parent.statusframe.document.forms.statusform.elements.acts.value +='1a'+val+'b';
} else {
parent.statusframe.document.forms.statusform.elements.acts.value +='0a'+val+'b';
}
}
}
function select_group() {
parent.window.location=
"/adm/groupsort?mode=$env{'form.mode'}&catalogmode=import$inhibit_menu&acts="+
parent.statusframe.document.forms.statusform.elements.acts.value;
}
</script>
SCRIPT
print INFO "table is here....: " . $env{'form.table'} ."\n";
my $start_page = &Apache::loncommon::start_page(undef,$js,
{'only_body' =>1},$status);
my $result=<<END;
$start_page
<b>How good do the results meet your expectations? </b>
<form> <form name="evaluation" method="post" action="/adm/searchcat">
<input type="hidden" name="phase" value="rate" />
<input type="hidden" name="table" value="$env{'form.table'}" />
<input type="hidden" name="username" value="$env{'form.username'}" />
<input type="hidden" name="catalogmode" value="import" />
<table>
<tr>
<td>
<label> (bad) <input type="radio" name="rating" value="1" checked="1"> 1 </label>
<label> <input type="radio" name="rating" value="2"> 2 </label>
<label> <input type="radio" name="rating" value="3"> 3 </label>
<label> <input type="radio" name="rating" value="4"> 4 </label>
<label> <input type="radio" name="rating" value="5"> 5 (good)</label>
</td>
<td>
<label> your comment: <input type="text" size ="50" maxlength="2000" name="comment" value="" /> (max. 2000 characters)</label>
<INPUT type="submit" value="Send">
</td>
</tr>
</table>
</form>
<hr>
<form name="results" method="post" action="/adm/searchcat">
$importbutton
END
return $result;
}
sub results_link {
my $basic_link = "/adm/searchcat?"."&table=".$env{'form.table'}.
"&persistent_db_id=".$env{'form.persistent_db_id'};
my $results_link = $basic_link."&phase=results".
"&pause=1"."&start=1";
return $results_link;
}
######################################################################
######################################################################
sub print_frames_interface {
my $r = shift;
my $basic_link = "/adm/searchcat?"."&table=".$env{'form.table'}.
"&persistent_db_id=".$env{'form.persistent_db_id'};
my $run_search_link = $basic_link."&phase=run_search";
my $results_link = &results_link();
my $js = <<JS;
<script type="text/javascript">
var targetwin = opener;
var queue = '';
</script>
JS
my $start_page =
&Apache::loncommon::start_page('LON-CAPA Digital Library Search Results',
$js,
{'frameset' => 1,
'add_entries' => {
'rows' => "150,*",},});
my $end_page =
&Apache::loncommon::end_page({'frameset' => 1});
my $result = <<"ENDFRAMES";
$start_page
<frame name="statusframe" src="$run_search_link">
<frame name="resultsframe" src="$results_link">
$end_page
ENDFRAMES
$r->print($result);
return;
}
######################################################################
######################################################################
sub has_stat_data {
my ($values) = @_;
if ( (defined($values->{'count'}) && $values->{'count'} ne '') ||
(defined($values->{'stdno'}) && $values->{'stdno'} ne '') ||
(defined($values->{'disc'}) && $values->{'disc'} ne '') ||
(defined($values->{'avetries'}) && $values->{'avetries'} ne '') ||
(defined($values->{'difficulty'}) && $values->{'difficulty'} ne '')) {
return 1;
}
return 0;
}
sub statfields {
return ('count','stdno','disc','avetries','difficulty');
}
sub has_eval_data {
my ($values) = @_;
if ( (defined($values->{'clear'}) && $values->{'clear'} ne '') ||
(defined($values->{'technical'}) && $values->{'technical'} ne '') ||
(defined($values->{'correct'}) && $values->{'correct'} ne '') ||
(defined($values->{'helpful'}) && $values->{'helpful'} ne '') ||
(defined($values->{'depth'}) && $values->{'depth'} ne '')) {
return 1;
}
return 0;
}
sub evalfields {
return ('clear','technical','correct','helpful','depth');
}
######################################################################
######################################################################
=pod
=item Metadata Viewing Functions
Output is a HTML-ified string.
Input arguments are title, author, subject, url, keywords, version,
notes, short abstract, mime, language, creation date,
last revision date, owner, copyright, hostname, and
extra custom metadata to show.
=over 4
=item &detailed_citation_view()
=cut
######################################################################
######################################################################
sub detailed_citation_view {
my ($prefix,%values) = @_;
my $result;
my $jumpurl=$values{'url'};
$jumpurl=~s|^/ext/|http://|;
$result .= '<b>'.$prefix.
'<img src="'.&Apache::loncommon::icon($values{'url'}).'" />'.' '.
'<a href="'.$jumpurl.'?inhibitmenu=yes" '.
'target="preview">'.$values{'title'}."</a></b>\n";
$result .= "<p>\n";
$result .= '<b>'.$values{'author'}.'</b>,'.
' <i>'.$values{'owner'}.'</i><br />';
foreach my $field
(
{ name=>'url',
translate => '<b>URL:</b> [_1]',
special => 'url link',},
{ name=>'subject',
translate => '<b>Subject:</b> [_1]',},
{ name=>'keywords',
translate => '<b>Keywords:</b> [_1]',},
{ name=>'notes',
translate => '<b>Notes:</b> [_1]',},
{ name=>'mimetag',
translate => '<b>MIME Type:</b> [_1]',},
{ name=>'standards',
translate => '<b>Standards:</b>[_1]',},
{ name=>'copyrighttag',
translate => '<b>Copyright/Distribution:</b> [_1]',},
{ name=>'count',
format => "%d",
translate => '<b>Access Count:</b> [_1]',},
{ name=>'stdno',
format => "%d",
translate => '<b>Number of Students:</b> [_1]',},
{ name=>'avetries',
format => "%.2f",
translate => '<b>Average Tries:</b> [_1]',},
{ name=>'disc',
format => "%.2f",
translate => '<b>Degree of Discrimination:</b> [_1]',},
{ name=>'difficulty',
format => "%.2f",
translate => '<b>Degree of Difficulty:</b> [_1]',},
{ name=>'clear',
format => "%.2f",
translate => '<b>Clear:</b> [_1]',},
{ name=>'depth',
format => "%.2f",
translate => '<b>Depth:</b> [_1]',},
{ name=>'helpful',
format => "%.2f",
translate => '<b>Helpful:</b> [_1]',},
{ name=>'correct',
format => "%.2f",
translate => '<b>Correct:</b> [_1]',},
{ name=>'technical',
format => "%.2f",
translate => '<b>Technical:</b> [_1]',},
{ name=>'comefrom_list',
type => 'list',
translate => 'Resources that lead up to this resource in maps',},
{ name=>'goto_list',
type => 'list',
translate => 'Resources that follow this resource in maps',},
{ name=>'sequsage_list',
type => 'list',
translate => 'Resources using or importing resource',},
) {
next if (! exists($values{$field->{'name'}}) ||
$values{$field->{'name'}} eq '');
if (exists($field->{'type'}) && $field->{'type'} eq 'list') {
$result .= '<b>'.&mt($field->{'translate'}).'</b>';
foreach my $item (split(',',$values{$field->{'name'}})){
$item = &Apache::lonnet::clutter($item);
$result .= &display_url($item,[2,0,1]);
}
} elsif (exists($field->{'format'}) && $field->{'format'} ne ''){
$result.= &mt($field->{'translate'},
sprintf($field->{'format'},
$values{$field->{'name'}}))."<br />\n";
} else {
if ($field->{'special'} eq 'url link') {
$result .= &display_url($jumpurl,[3,0,1]);
} else {
$result.= &mt($field->{'translate'},
$values{$field->{'name'}});
}
$result .= "<br />\n";
}
}
$result .= "</p>";
if (exists($values{'extrashow'}) && $values{'extrashow'} ne '') {
$result .= '<p>'.$values{'extrashow'}.'</p>';
}
if (exists($values{'shortabstract'}) && $values{'shortabstract'} ne '') {
$result .= '<p>'.$values{'shortabstract'}.'</p>';
}
$result .= '<hr align="left" width="200" noshade />'."\n";
return $result;
}
sub detailed_citation_preview {
my ($prefix,%values)=@_;
return '<table><tr><td>'.
&detailed_citation_view($prefix,%values).
'</td><td>'.
&Apache::lonindexer::showpreview($values{'url'}).
'</td></tr></table><hr />';
}
######################################################################
######################################################################
=pod
=item &summary_view()
=cut
######################################################################
######################################################################
sub summary_view {
# print INFO "++++ summary " .$env{'form.username'} . "\n";
my $username = $env{'form.username'};
if ($username eq '') {
$username = $env{'user.name'} . ":" .$env{'user.domain'};
# print INFO "++++ changed username to " .$username . "\n";
}
my ($prefix,%values) = @_;
my $icon=&Apache::loncommon::icon($values{'url'});
my $result=qq{$prefix<img src="$icon" />};
if (exists($env{'form.sortfield'}) &&
$env{'form.sortfield'} !~ /^(default|
author|
url|
title|
owner|
lastrevisiondate|
copyright)$/x) {
my $tmp = $values{$env{'form.sortfield'}};
if (! defined($tmp)) { $tmp = 'undefined'; }
$result .= ' '.$tmp.' ';
}
my $jumpurl=$values{'url'};
$jumpurl=~s|^/ext/|http://|;
my $link = &display_url($jumpurl,[2,0,1]);
$result.=<<END;
<a href="$jumpurl?inhibitmenu=yes"
target='preview'>$values{'title'}</a> <br />
$link
<font size="-1" <a href="/adm/searchcat?&phase=extenddirect&url_id=$values{'goto'}&persistent_db_id=$env{'form.persistent_db_id'}&table=$env{'form.table'}&username=$username" onClick="javascript:document.bgColor='#AAAAAA';document.write('working... please stand by');"> ... Extend by direct relation </a> <br>
<a href="/adm/searchcat?&phase=extendsac&url_id=$values{'goto'}&persistent_db_id=$env{'form.persistent_db_id'}&table=$env{'form.table'}&username=$username" onClick="javascript:document.bgColor='#AAAAAA';document.write('working... please stand by');"> ... Extend by course and SAC </a> <br>
<a href="/adm/searchcat?&phase=extendwac&url_id=$values{'goto'}&persistent_db_id=$env{'form.persistent_db_id'}&table=$env{'form.table'}&username=$username" onClick="javascript:document.bgColor='#AAAAAA';document.write('working... please stand by');"> ... Extend by course and WAC </a> <br>
</font> <br>
<br /> >
$values{'author'}<br />
<font color="red"> $values{'standards'} </font><br>
</p>
<hr align='left' width='200' noshade />
END
return $result;
}
sub summary_preview {
my ($prefix,%values)=@_;
return '<table><tr><td>'.
&summary_view($prefix,%values).
'</td><td>'.
&Apache::lonindexer::showpreview($values{'url'}).
'</td></tr></table><hr />';
}
######################################################################
######################################################################
=pod
=item &compact_view()
=cut
######################################################################
######################################################################
sub compact_view {
my ($prefix,%values) = @_;
my $jumpurl=$values{'url'};
$jumpurl=~s|^/ext/|http://|;
my $link = &display_url($jumpurl,[1,1,1]);
my $result =
$prefix.'<img src="'.&Apache::loncommon::icon($values{'url'}).'"> <br><a href="/adm/searchcat?'.
&Apache::loncommon::inhibit_menu_check().
'&phase=extenddirect'.
'"> Extend by direct relation </a><br>';
if (exists($env{'form.sortfield'}) &&
$env{'form.sortfield'} !~ /^(default|author|url|title)$/) {
my $tmp = $values{$env{'form.sortfield'}};
if (! defined($tmp)) { $tmp = 'undefined'; }
$result .= ' '.$tmp.' ';
}
$jumpurl = &HTML::Entities::encode($jumpurl,'<>&"');
$result.=' <span class="LC_nobreak">'.
'<a href="'.$jumpurl.'?inhibitmenu=yes" target="preview">'.
&HTML::Entities::encode($values{'title'},'<>&"').'</a></span> '.
$link.' <b>'.$values{'author'}.'</b> ('.$values{'domain'}.')<br />';
return $result;
}
sub display_url {
my ($url,$crumb_args) = @_;
my $link;
if ($url=~m|^/ext/|) {
$url=~s|^/ext/|http://|;
$link='<span class="LC_filename">'.$url.'</span>';
} elsif ($url=~m{^(http://|/uploaded/)}) {
$link='<span class="LC_filename">'.$url.'</span>';
} else {
$link=&Apache::lonhtmlcommon::crumbs($url,
'preview',
'',
(($env{'form.catalogmode'} eq 'import')?'parent.statusframe.document.forms.statusform':''),@{$crumb_args}).' ';
}
return $link;
}
######################################################################
######################################################################
=pod
=item &fielded_format_view()
=cut
######################################################################
######################################################################
sub fielded_format_view {
my ($prefix,%values) = @_;
my $icon=&Apache::loncommon::icon($values{'url'});
my %Translated = &Apache::lonmeta::fieldnames();
my $jumpurl=$values{'url'};
$jumpurl=~s|^/ext/|http://|;
my $result=<<END;
$prefix <img src="$icon" />
<dl>
<dt>URL:</dt>
<dd><a href="$jumpurl?inhibitmenu=yes"
target='preview'>$values{'url'}</a></dd>
END
foreach my $field ('title','author','domain','subject','keywords','notes',
'mimetag','language','creationdate','lastrevisiondate',
'owner','copyrighttag','hostname','abstract') {
$result .= (' 'x4).'<dt>'.$Translated{$field}.'</dt>'."\n".
(' 'x8).'<dd>'.$values{$field}.'</dd>'."\n";
}
if (&has_stat_data(\%values)) {
foreach my $field (&statfields()) {
$result .= (' 'x4).'<dt>'.$Translated{$field}.'</dt>'."\n".
(' 'x8).'<dd>'.$values{$field}.'</dd>'."\n";
}
}
if (&has_eval_data(\%values)) {
foreach my $field (&evalfields()) {
$result .= (' 'x4).'<dt>'.$Translated{$field}.'</dt>'."\n".
(' 'x8).'<dd>'.$values{$field}.'</dd>'."\n";
}
}
$result .= "</dl>\n";
$result .= $values{'extrashow'};
$result .= '<hr align="left" width="200" noshade />'."\n";
return $result;
}
######################################################################
######################################################################
=pod
=item &xml_sgml_view()
=back
=cut
######################################################################
######################################################################
sub xml_sgml_view {
my ($prefix,%values) = @_;
my $xml = '<LonCapaResource>'."\n";
# The usual suspects
foreach my $field ('url','title','author','subject','keywords','notes','domain') {
$xml .= qq{<$field>$values{$field}</$field>}."\n";
}
#
$xml .= "<mimeInfo>\n";
foreach my $field ('mime','mimetag') {
$xml .= qq{<$field>$values{$field}</$field>}."\n";
}
$xml .= "</mimeInfo>\n";
#
$xml .= "<languageInfo>\n";
foreach my $field ('language','languagetag') {
$xml .= qq{<$field>$values{$field}</$field>}."\n";
}
$xml .= "</languageInfo>\n";
#
foreach my $field ('creationdate','lastrevisiondate','owner') {
$xml .= qq{<$field>$values{$field}</$field>}."\n";
}
#
$xml .= "<copyrightInfo>\n";
foreach my $field ('copyright','copyrighttag') {
$xml .= qq{<$field>$values{$field}</$field>}."\n";
}
$xml .= "</copyrightInfo>\n";
$xml .= qq{<repositoryLocation>$values{'hostname'}</repositoryLocation>}.
"\n";
$xml .= qq{<shortabstract>$values{'shortabstract'}</shortabstract>}."\n";
#
if (&has_stat_data(\%values)){
$xml .= "<problemstatistics>\n";
foreach my $field (&statfields()) {
$xml .= qq{<$field>$values{$field}</$field>}."\n";
}
$xml .= "</problemstatistics>\n";
}
#
if (&has_eval_data(\%values)) {
$xml .= "<evaluation>\n";
foreach my $field (&evalfields) {
$xml .= qq{<$field>$values{$field}</$field>}."\n";
}
$xml .= "</evaluation>\n";
}
#
$xml .= "</LonCapaResource>\n";
$xml = &HTML::Entities::encode($xml,'<>&');
my $result=<<END;
$prefix
<pre>
$xml
</pre>
$values{'extrashow'}
<hr align='left' width='200' noshade />
END
return $result;
}
######################################################################
######################################################################
=pod
=item &filled() see if field is filled.
=cut
######################################################################
######################################################################
sub filled {
my ($field)=@_;
if ($field=~/\S/ && $field ne 'any') {
return 1;
} else {
return 0;
}
}
######################################################################
######################################################################
=pod
=item &output_unparsed_phrase_error()
=cut
######################################################################
######################################################################
sub output_unparsed_phrase_error {
my ($r,$closebutton,$parms,$hidden_fields,$field)=@_;
my $errorstring;
if ($field eq 'basicexp') {
$errorstring = &mt('Unable to understand the search phrase <i>[_1]</i>. Please modify your search.',$env{'form.basicexp'});
} else {
$errorstring = &mt('Unable to understand the search phrase <b>[_1]</b>:<i>[_2]</i>.',$field,$env{'form.'.$field});
}
my $heading = &mt('Unparsed Field');
my $revise = &mt('Revise search request');
# make query information persistent to allow for subsequent revision
my $start_page = &Apache::loncommon::start_page('Search');
my $end_page = &Apache::loncommon::end_page();
$r->print(<<ENDPAGE);
$start_page
<form method="post" action="/adm/searchcat">
$hidden_fields
$closebutton
<hr />
<h2>$heading</h2>
<p>
$errorstring
</p>
<p>
<a href="/adm/searchcat?$parms&persistent_db_id=$env{'form.persistent_db_id'}">$revise</a>
</p>
$end_page
ENDPAGE
}
######################################################################
######################################################################
=pod
=item &output_blank_field_error()
Output a complete page that indicates the user has not filled in enough
information to do a search.
Inputs: $r (Apache request handle), $closebutton, $parms.
Returns: nothing
$parms is extra information to include in the 'Revise search request' link.
=cut
######################################################################
######################################################################
sub output_blank_field_error {
my ($r,$closebutton,$parms,$hidden_fields)=@_;
my $errormsg = &mt('You did not fill in enough information for the search to be started. You need to fill in relevant fields on the search page in order for a query to be processed.');
my $revise = &mt('Revise Search Request');
my $heading = &mt('Unactionable Search Queary');
my $start_page = &Apache::loncommon::start_page('Search');
my $end_page = &Apache::loncommon::end_page();
$r->print(<<ENDPAGE);
$start_page
<form method="post" action="/adm/searchcat">
$hidden_fields
$closebutton
<hr />
<h2>$heading</h2>
<p>
$errormsg
</p>
<p>
<a href="/adm/searchcat?$parms&persistent_db_id=$env{'form.persistent_db_id'}">$revise</a>
</p>
$end_page
ENDPAGE
return;
}
######################################################################
######################################################################
=pod
=item &output_date_error()
Output a full html page with an error message.
Inputs:
$r, the request pointer.
$message, the error message for the user.
$closebutton, the specialized close button needed for groupsearch.
=cut
######################################################################
######################################################################
sub output_date_error {
my ($r,$message,$closebutton,$hidden_fields)=@_;
# make query information persistent to allow for subsequent revision
my $start_page = &Apache::loncommon::start_page('Search');
my $end_page = &Apache::loncommon::end_page();
$r->print(<<RESULTS);
$start_page
<form method="post" action="/adm/searchcat">
$hidden_fields
<input type='button' value='Revise search request'
onClick='this.form.submit();' />
$closebutton
<hr />
<h3>Error</h3>
<p>
$message
</p>
$end_page
RESULTS
}
######################################################################
######################################################################
=pod
=item &start_fresh_session()
Cleans the global %groupsearch_db by removing all fields which begin with
'pre_' or 'store'.
=cut
######################################################################
######################################################################
sub start_fresh_session {
delete $groupsearch_db{'mode_catalog'};
foreach (keys %groupsearch_db) {
if ($_ =~ /^pre_/) {
delete $groupsearch_db{$_};
}
if ($_ =~ /^store/) {
delete $groupsearch_db{$_};
}
}
}
1;
sub cleanup {
if (tied(%groupsearch_db)) {
unless (untie(%groupsearch_db)) {
&Apache::lonnet::logthis('Failed cleanup searchcat: groupsearch_db');
}
}
&untiehash();
&Apache::lonmysql::disconnect_from_db();
return OK;
}
__END__
=pod
=back
=cut
--hoeppner1214683204--