From 524a5cbb21b0c4cba03210a4113f16799713f082 Mon Sep 17 00:00:00 2001 From: Joe Atzberger Date: Mon, 21 Apr 2008 16:22:34 -0500 Subject: [PATCH] Tags - module, script and template support for user tagging in OPAC. Signed-off-by: Joshua Ferraro --- C4/Tags.pm | 427 ++++++++++++++++++ .../opac-tmpl/prog/en/modules/opac-tags.tmpl | 76 ++++ opac/opac-tags.pl | 154 +++++++ 3 files changed, 657 insertions(+) create mode 100644 C4/Tags.pm create mode 100644 koha-tmpl/opac-tmpl/prog/en/modules/opac-tags.tmpl create mode 100755 opac/opac-tags.pl diff --git a/C4/Tags.pm b/C4/Tags.pm new file mode 100644 index 0000000000..0eebb0c9f4 --- /dev/null +++ b/C4/Tags.pm @@ -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 + diff --git a/koha-tmpl/opac-tmpl/prog/en/modules/opac-tags.tmpl b/koha-tmpl/opac-tmpl/prog/en/modules/opac-tags.tmpl new file mode 100644 index 0000000000..0637aa4588 --- /dev/null +++ b/koha-tmpl/opac-tmpl/prog/en/modules/opac-tags.tmpl @@ -0,0 +1,76 @@ +Koha Online Catalog › Tags + + + + + +
+
+
+
+ + + +
There was a problem with this operation: + Sorry, tags are not enabled on this system. + ERROR: illegal paramter +
+ + + + +

tags successfully added.

+ + +

tags successfully deleted.

+ + + +
+

My Tags

+ + + + + + + + + + +
TermTitleDate/Time AddedDelete
&q="> + + "> + + " value="Delete" />
+
+ +
To see any of your own saved tags, first log in.
+ + +

All Tags

+
+
+

Show up to + tags from other users. + +

+
+
+ Results: + + +
+
+
+
+ + +
+
+ diff --git a/opac/opac-tags.pl b/opac/opac-tags.pl new file mode 100755 index 0000000000..0a613d9178 --- /dev/null +++ b/opac/opac-tags.pl @@ -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; + -- 2.39.5