Koha-community
/
Koha
13
5
Fork 0
Code Issues Releases Wiki Activity
Browse Source

Tags - module, script and template support for user tagging in OPAC. 

Signed-off-by: Joshua Ferraro <jmf@liblime.com>
3.0.x
Joe Atzberger 16 years ago
committed by Joshua Ferraro
parent
31da55ea2d
commit
524a5cbb21
3 changed files with 657 additions and 0 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 427
      C4/Tags.pm
  2. 76
      koha-tmpl/opac-tmpl/prog/en/modules/opac-tags.tmpl
  3. 154
      opac/opac-tags.pl

427
C4/Tags.pm
View File

@ -0,0 +1,427 @@
package C4::Tags;
# This file is part of Koha.
#
# Koha 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.
#
# Koha 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
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
use strict;
use warnings;
use Carp;
use Exporter;
use C4::Context;
use C4::Debug;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use vars qw($ext_dict $select_all @fields);
BEGIN {
$VERSION = 0.01;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
&get_tag &get_tags &get_tag_rows
&add_tags &add_tag
&delete_tag_row_by_id
&remove_tag
&delete_tag_rows_by_ids
&rectify_weights
);
# %EXPORT_TAGS = ();
$ext_dict = C4::Context->preference('TagsExternalDictionary');
if ($debug) {
require Data::Dumper;
import Data::Dumper qw(:DEFAULT);
print STDERR __PACKAGE__ . " external dictionary = " . ($ext_dict||'none') . "\n";
}
if ($ext_dict) {
require Lingua::Ispell;
import Lingua::Ispell qw(spellcheck);
}
}
INIT {
$ext_dict and $Lingua::Ispell::path = $ext_dict;
$debug and print STDERR "\$Lingua::Ispell::path = $Lingua::Ispell::path\n";
@fields = qw(tag_id borrowernumber biblionumber term language date_created);
$select_all = "SELECT " . join(',',@fields) . "\n FROM tags_all\n";
}
sub remove_tag ($) {
my $tag_id = shift;
my $rows = get_tag_rows({tag_id=>$tag_id}) or return 0;
(scalar(@$rows) == 1) or return undef;
my $row = shift(@$rows);
($tag_id == $row->{tag_id}) or return 0;
my $tags = get_tags({term=>$row->{term}, biblionumber=>$row->{biblionumber}});
my $index = shift(@$tags);
$debug and print STDERR
sprintf "remove_tag: tag_id=>%s, biblionumber=>%s, weight=>%s, weight_total=>%s\n",
$row->{tag_id}, $row->{biblionumber}, $index->{weight}, $index->{weight_total};
if ($index->{weight} <= 1) {
delete_tag_index($row->{term},$row->{biblionumber});
} else {
decrement_weight($row->{term},$row->{biblionumber});
}
if ($index->{weight_total} <= 1) {
delete_tag_approval($row->{term});
} else {
decrement_weight_total($row->{term});
}
delete_tag_row_by_id($tag_id);
}
sub delete_tag_index ($$) {
(@_) or return undef;
my $sth = C4::Context->dbh->prepare("DELETE FROM tags_index WHERE term = ? AND biblionumber = ? LIMIT 1");
$sth->execute(@_);
return $sth->rows || 0;
}
sub delete_tag_approval ($) {
(@_) or return undef;
my $sth = C4::Context->dbh->prepare("DELETE FROM tags_approval WHERE term = ? LIMIT 1");
$sth->execute(shift);
return $sth->rows || 0;
}
sub delete_tag_row_by_id ($) {
(@_) or return undef;
my $sth = C4::Context->dbh->prepare("DELETE FROM tags_all WHERE tag_id = ? LIMIT 1");
$sth->execute(shift);
return $sth->rows || 0;
}
sub delete_tag_rows_by_ids (@) {
(@_) or return undef;
my $i=0;
foreach(@_) {
$i += delete_tag_row_by_id($_);
}
($i == scalar(@_)) or
warn sprintf "delete_tag_rows_by_ids tried %s tag_ids, only succeeded on $i", scalar(@_);
return $i;
}
sub get_tag_rows ($) {
my $hash = shift || {};
my @ok_fields = @fields;
push @ok_fields, 'limit'; # push the limit! :)
my $wheres;
my $limit = "";
my @exe_args = ();
foreach my $key (keys %$hash) {
$debug and print STDERR "get_tag_rows arg. '$key' = ", $hash->{$key}, "\n";
unless (length $key) {
carp "Empty argument key to get_tag_rows: ignoring!";
next;
}
unless (1 == scalar grep {/^ $key $/xi} @ok_fields) {
carp "get_tag_rows received unreconized argument key '$key'.";
next;
}
if ($key =~ /^limit$/i) {
my $val = $hash->{$key};
unless ($val =~ /^\d+$/) {
carp "Non-nuerical limit value '$val' ignored!";
next;
}
$limit = " LIMIT $val\n";
} else {
$wheres .= ($wheres) ? " AND $key = ?\n" : " WHERE $key = ?\n";
push @exe_args, $hash->{$key};
}
}
my $query = $select_all . ($wheres||'') . $limit;
$debug and print STDERR "get_tag_rows query:\n $query\n",
"get_tag_rows query args: ", join(',', @exe_args), "\n";
my $sth = C4::Context->dbh->prepare($query);
if (@exe_args) {
$sth->execute(@exe_args);
} else {
$sth->execute;
}
return $sth->fetchall_arrayref({});
}
sub get_tags (;$) { # i.e., from tags_index
# my $self = shift;
my $hash = shift || {};
my @ok_fields = qw(term biblionumber weight limit sort);
my $wheres;
my $limit = "";
my $order = "";
my @exe_args = ();
foreach my $key (keys %$hash) {
$debug and print STDERR "get_tags arg. '$key' = ", $hash->{$key}, "\n";
unless (length $key) {
carp "Empty argument key to get_tags: ignoring!";
next;
}
unless (1 == scalar grep {/^ $key $/xi} @ok_fields) {
carp "get_tags received unreconized argument key '$key'.";
next;
}
if ($key =~ /^limit$/i) {
my $val = $hash->{$key};
unless ($val =~ /^\d+$/) {
carp "Non-nuerical limit value '$val' ignored!";
next;
}
$limit = " LIMIT $val\n";
} elsif ($key =~ /^sort$/i) {
foreach my $by (split /\,/, $hash->{$key}) {
unless (
$by =~ /^([-+])?(term)/ or
$by =~ /^([-+])?(biblionumber)/ or
$by =~ /^([-+])?(weight)/
) {
carp "get_tags received illegal sort order '$by'";
next;
}
$order .= " ORDER BY $2 " . ($1 eq '-' ? 'DESC' : $1 eq '+' ? 'ASC' : '') . "\n";
}
} else {
my $whereval = $key;
($key =~ /^term$/i) and $whereval = 'tags_index.term';
$wheres .= ($wheres) ? " AND $whereval = ?\n" : " WHERE $whereval = ?\n";
push @exe_args, $hash->{$key};
}
}
my $query = "
SELECT tags_index.term as term,biblionumber,weight,weight_total
FROM tags_index
LEFT JOIN tags_approval
ON tags_index.term = tags_approval.term
" . ($wheres||'') . $order . $limit;
$debug and print STDERR "get_tags query:\n $query\n",
"get_tags query args: ", join(',', @exe_args), "\n";
my $sth = C4::Context->dbh->prepare($query);
if (@exe_args) {
$sth->execute(@exe_args);
} else {
$sth->execute;
}
return $sth->fetchall_arrayref({});
}
sub is_approved ($) {
my $term = shift or return undef;
if ($ext_dict) {
return (spellcheck($term) ? 0 : 1);
}
my $sth = C4::Context->dbh->prepare("SELECT approved FROM tags_approval WHERE term = ?");
$sth->execute($term);
$sth->rows or return undef;
return $sth->fetch;
}
sub get_tag_index ($;$) {
my $term = shift or return undef;
my $sth;
if (@_) {
$sth = C4::Context->dbh->prepare("SELECT * FROM tags_index WHERE term = ? AND biblionumber = ?");
$sth->execute($term,shift);
} else {
$sth = C4::Context->dbh->prepare("SELECT * FROM tags_index WHERE term = ?");
$sth->execute($term);
}
return $sth->fetchrow_hashref;
}
sub add_tag_approval ($;$) {
my $term = shift or return undef;
my $query = "SELECT * FROM tags_approval WHERE term = ?";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute($term);
($sth->rows) and return increment_weight_total($term);
my $ok = (@_ ? shift : 0);
if ($ok) {
$query = "INSERT INTO tags_approval (term,approved_by,approved,date_approved) VALUES (?,?,1,NOW())";
$debug and print STDERR "add_tag_approval query:\n$query\nadd_tag_approval args: ($term,$ok)\n";
$sth = C4::Context->dbh->prepare($query);
$sth->execute($term,$ok);
} else {
$query = "INSERT INTO tags_approval (term,date_approved) VALUES (?,NOW())";
$debug and print STDERR "add_tag_approval query:\n$query\nadd_tag_approval args: ($term)\n";
$sth = C4::Context->dbh->prepare($query);
$sth->execute($term);
}
return $sth->rows;
}
sub add_tag_index ($$;$) {
my $term = shift or return undef;
my $biblionumber = shift or return undef;
my $query = "SELECT * FROM tags_index WHERE term = ? AND biblionumber = ?";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute($term,$biblionumber);
($sth->rows) and return increment_weight($term,$biblionumber);
$query = "INSERT INTO tags_index (term,biblionumber) VALUES (?,?)";
$debug and print "add_tag_index query:\n$query\nadd_tag_index args: ($term,$biblionumber)\n";
$sth = C4::Context->dbh->prepare($query);
$sth->execute($term,$biblionumber);
return $sth->rows;
}
sub get_tag ($) { # by tag_id
(@_) or return undef;
my $sth = C4::Context->dbh->prepare("$select_all WHERE tag_id = ?");
$sth->execute(shift);
return $sth->fetchrow_hashref;
}
sub rectify_weights (;$) {
my $dbh = C4::Context->dbh;
my $sth;
my $query = "
SELECT term,biblionumber,count(*) as count
FROM tags_all
";
(@_) and $query .= " WHERE term =? ";
$query .= " GROUP BY term,biblionumber ";
$sth = $dbh->prepare($query);
if (@_) {
$sth->execute(shift);
} else {
$sth->execute();
}
my $results = $sth->fetchall_arrayref({}) or return undef;
my %tally = ();
foreach (@$results) {
_set_weight($_->{count},$_->{term},$_->{biblionumber});
$tally{$_->{term}} += $_->{count};
}
foreach (keys %tally) {
_set_weight_total($tally{$_},$_);
}
return ($results,\%tally);
}
sub increment_weights ($$) {
increment_weight(@_);
increment_weight_total(shift);
}
sub decrement_weights ($$) {
decrement_weight(@_);
derement_weight_total(shift);
}
sub increment_weight_total ($) {
_set_weight_total('weight_total+1',shift);
}
sub increment_weight ($$) {
_set_weight('weight+1',shift,shift);
}
sub decrement_weight_total ($) {
_set_weight_total('weight_total-1',shift);
}
sub decrement_weight ($$) {
_set_weight('weight-1',shift,shift);
}
sub _set_weight_total ($$) {
my $sth = C4::Context->dbh->prepare("
UPDATE tags_approval
SET weight_total=" . (shift) . "
WHERE term=?
");
$sth->execute(shift); # just the term
}
sub _set_weight ($$$) {
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("
UPDATE tags_index
SET weight=" . (shift) . "
WHERE term=?
AND biblionumber=?
");
$sth->execute(@_);
}
sub add_tag ($$;$$) { # biblionumber,term,[borrowernumber,approvernumber]
my $biblionumber = shift or return undef;
my $term = shift or return undef;
my $borrowernumber = (@_) ? shift : 0; # the user, default to kohaadmin
# first, add to tags regardless of approaval
my $query = "INSERT INTO tags_all
(borrowernumber,biblionumber,term,date_created)
VALUES (?,?,?,NOW())";
$debug and print STDERR "add_tag query:\n $query\n",
"add_tag query args: ($borrowernumber,$biblionumber,$term)\n";
my $sth = C4::Context->dbh->prepare($query);
$sth->execute($borrowernumber,$biblionumber,$term);
# then
if (@_) { # if an arg remains, it is the borrowernumber of the approver: tag is pre-approved.
my $approver = shift;
add_tag_approval($term,$approver);
add_tag_index($term,$biblionumber,$approver);
} elsif (is_approved($term)) {
add_tag_approval($term,1);
add_tag_index($term,$biblionumber,1);
} else {
add_tag_approval($term);
add_tag_index($term,$biblionumber);
}
}
1;
__END__
=head1 C4::Tags.pm - Support for user tagging of biblios.
More verose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
=head2 add_tag(biblionumber,term[,borrowernumber])
=head3 TO DO: Add real perldoc
=head2 Tricks
If you want to auto-populate some tags for debugging, do something like this:
mysql> select biblionumber from biblio where title LIKE "%Health%";
+--------------+
| biblionumber |
+--------------+
| 18 |
| 22 |
| 24 |
| 30 |
| 44 |
| 45 |
| 46 |
| 49 |
| 111 |
| 113 |
| 128 |
| 146 |
| 155 |
| 518 |
| 522 |
| 524 |
| 530 |
| 544 |
| 545 |
| 546 |
| 549 |
| 611 |
| 613 |
| 628 |
| 646 |
| 655 |
+--------------+
26 rows in set (0.00 sec)
Then, take those numbers and type them into this perl command line:
perl -ne 'use C4::Tags qw(get_tags add_tag); use Data::Dumper;chomp; add_tag($_,"health",51,1); print Dumper get_tags({limit=>5,term=>"health",});'
=cut

76
koha-tmpl/opac-tmpl/prog/en/modules/opac-tags.tmpl
View File

@ -0,0 +1,76 @@
<!-- TMPL_INCLUDE NAME="doc-head-open.inc" --><!-- TMPL_IF NAME="LibraryNameTitle" --><!-- TMPL_VAR NAME="LibraryNameTitle" --><!-- TMPL_ELSE -->Koha Online<!-- /TMPL_IF --> Catalog &rsaquo; Tags
<!-- TMPL_INCLUDE NAME="doc-head-close.inc" -->
</head>
<body>
<!-- TMPL_INCLUDE NAME="masthead.inc" -->
<div id="doc3" class="yui-t1">
<div id="bd">
<div id="yui-main">
<div class="yui-b"><div class="yui-g">
<!-- TMPL_IF NAME="ERRORS" -->
<!-- TMPL_LOOP NAME="ERRORS" -->
<div class="error">There was a problem with this operation:
<!-- TMPL_IF NAME="tagsdisabled" -->Sorry, tags are not enabled on this system.<!-- /TMPL_IF -->
<!-- TMPL_IF NAME="badparam" -->ERROR: illegal paramter <!-- TMPL_VAR NAME="badparam" --><!-- /TMPL_IF -->
</div>
<!-- /TMPL_LOOP -->
<!-- /TMPL_IF -->
<!-- TMPL_IF NAME="add_op" -->
<h3><!-- TMPL_VAR NAME="added_count" --> tags successfully added.</h3>
<!-- /TMPL_IF -->
<!-- TMPL_IF NAME="deleted_count" -->
<h3><!-- TMPL_VAR NAME="deleted_count" --> tags successfully deleted.</h3>
<!-- /TMPL_IF -->
<!-- TMPL_IF NAME="MY_TAGS" -->
<form method="post" action="opac-tags.pl">
<h2>My Tags</h2>
<table>
<tr><th>Term</th><th>Title</th><th>Date/Time Added</th><th>Delete</th>
</tr>
<!-- TMPL_LOOP NAME="MY_TAGS" -->
<tr><td><a href="/cgi-bin/koha/opac-search.pl?tag=<!-- TMPL_VAR NAME="term" ESCAPE="URL" -->&amp;q=<!-- TMPL_VAR NAME="term" ESCAPE="URL" -->">
<!-- TMPL_VAR NAME="term" ESCAPE="HTML" --></a>
</td>
<td><a href="/cgi-bin/koha/opac-detail.pl?biblionumber=<!-- TMPL_VAR NAME="biblionumber" -->">
<!-- TMPL_VAR NAME="bib_summary" ESCAPE="HTML" --></a></td>
<td><!-- TMPL_VAR NAME="date_created_display" -->
<span class="time" style="background-color:lightgray;"><!-- TMPL_VAR NAME="time_created_display" --></span></td>
<td><input type="submit" name="del<!-- TMPL_VAR NAME="tag_id" -->" value="Delete" /></td>
</tr>
<!-- /TMPL_LOOP -->
</table>
</form>
<!-- TMPL_ELSE -->
<div class="msg">To see any of your own saved tags, first log in.</div>
<!-- /TMPL_IF -->
<h1>All Tags</h1>
<div id="action">
<form method="post" action="opac-tags.pl">
<p>Show up to <input name="limit" maxlength="4" size="4" value="100" />
tags from other users.
<input type="submit" value="OK" />
</p>
</form>
</div>
<!-- TMPL_IF NAME="TAGLOOP" --> Results:<ul>
<!-- TMPL_LOOP NAME="TAGLOOP" -->
<li><a href="/cgi-bin/koha/opac-search.pl?tag=<!-- TMPL_VAR NAME="term" ESCAPE="URL" -->&amp;q=<!-- TMPL_VAR NAME="term" ESCAPE="URL" -->">
<!-- TMPL_VAR NAME="term" ESCAPE="HTML" --></a> (<!-- TMPL_VAR NAME="weight_total" -->)</li>
<!-- /TMPL_LOOP -->
</ul>
<!-- /TMPL_IF -->
</div>
</div>
</div>
<div class="yui-b">
<!-- TMPL_INCLUDE NAME="navigation.inc" -->
<!-- TMPL_INCLUDE NAME="usermenu.inc" -->
</div>
</div>
<!-- TMPL_INCLUDE NAME="opac-bottom.inc" -->

154
opac/opac-tags.pl
View File

@ -0,0 +1,154 @@
#!/usr/bin/perl
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
#
# Koha 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.
#
# Koha 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
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
=head1
TODO :: Description here
=cut
use strict;
use warnings;
use C4::Auth;
use C4::Context;
use C4::Debug;
use C4::Output;
use C4::Dates qw(format_date);
use CGI;
use C4::Biblio;
use C4::Tags qw(add_tag get_tags get_tag_rows remove_tag);
my $query = new CGI;
my %newtags = ();
my @deltags = ();
my %counts = ();
my @errors = ();
# The trick here is to support multiple tags added to multiple bilbios in one POST.
# So the name of param has to have biblionumber built in.
# For lack of anything more compelling, we just use "newtag[biblionumber]"
# We split the value into tags at comma and semicolon
my $openadds = C4::Context->preference('TagsModeration') ? 0 : 1;
unless (C4::Context->preference('TagsEnabled')) {
push @errors, {+ tagsdisabled=>1 };
} else {
foreach ($query->param) {
if (/^newtag(.*)/) {
my $biblionumber = $1;
unless ($biblionumber =~ /^\d+$/) {
$debug and warn "$_ references non numerical biblionumber '$biblionumber'";
push @errors, {+'badparam' => $_ };
next;
}
$newtags{$biblionumber} = $query->param($_);
} elsif (/^del(\d+)$/) {
push @deltags, $1;
}
}
}
my $add_op = (scalar(keys %newtags) + scalar(@deltags)) ? 1 : 0;
my ($template, $loggedinuser, $cookie) = get_template_and_user({
template_name => "opac-tags.tmpl",
query => $query,
type => "opac",
authnotrequired => ($add_op ? 0 : 1), # auth required to add tags
debug => 1,
});
if ($add_op) {
unless ($loggedinuser) {
push @errors, {+'login' => $_ };
%newtags=(); # zero out any attempted additions
@deltags=(); # zero out any attempted deletions
}
}
foreach my $biblionumber (keys %newtags) {
my @values = split /[;,]/, $newtags{$biblionumber};
foreach (@values) {
s/^\s*(.+)\s*$/$1/;
my $result;
if ($openadds) {
$result = add_tag($biblionumber,$_,$loggedinuser,0); # pre-approved
} else {
$result = add_tag($biblionumber,$_,$loggedinuser);
}
if ($result) {
$counts{$biblionumber}++;
} else {
warn "add_tag($biblionumber,$_,$loggedinuser...) returned $result";
}
}
}
my $dels = 0;
foreach (@deltags) {
remove_tag($_) and $dels++;
}
my $results = [];
my $my_tags = [];
if ($loggedinuser) {
$my_tags = get_tag_rows({borrowernumber=>$loggedinuser});
foreach (@$my_tags) {
my $biblio = GetBiblioData($_->{biblionumber});
$_->{bib_summary} = $biblio->{title};
($biblio->{author}) and $_->{bib_summary} .= " by " . $biblio->{author};
my $date = $_->{date_created} || '';
$date =~ /\s+(\d{2}\:\d{2}\:\d{2})/;
$_->{time_created_display} = $1;
$_->{date_created_display} = format_date($_->{date_created});
}
}
if ($add_op) {
my $adds = 0;
for (values %counts) {$adds += $_;}
$template->param(
add_op => 1,
added_count => $adds,
deleted_count => $dels,
);
} else {
my ($arg,$limit,$tmpresults);
my $hardmax = 100; # you might disagree what this value should be, but there definitely should be a max
$limit = $query->param('limit') || $hardmax;
($limit =~ /^\d+$/ and $limit <= $hardmax) or $limit = $hardmax;
if ($arg = $query->param('tag')) {
$tmpresults = get_tags({term => $arg, limit=>$limit, 'sort'=>'-weight'});
} elsif ($arg = $query->param('biblionumber')) {
$tmpresults = get_tags({biblionumber => $arg, limit=>$limit, 'sort'=>'-weight'});
} else {
$tmpresults = get_tags({limit=>$limit, 'sort'=>'-weight'});
}
my %uniq;
foreach (@$tmpresults) {
$uniq{$_->{term}}++ and next;
push @$results, $_;
}
}
(scalar @errors ) and $template->param(ERRORS => \@errors);
(scalar @$results) and $template->param(TAGLOOP => $results);
(scalar @$my_tags) and $template->param(MY_TAGS => $my_tags);
output_html_with_http_headers $query, $cookie, $template->output;
Write Preview
Loading…
Cancel
Save