X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FTags.pm;h=1db7accc06bed815795019c63357883edec423ee;hb=00cf699c82aeea46ef5a72bf344fd306430c5aba;hp=5f2ff6988a1f51e98012dec8b5b6089f95a87637;hpb=7c174930ac1618a53dbda4bc785b335f21113238;p=koha.git diff --git a/C4/Tags.pm b/C4/Tags.pm index 5f2ff6988a..1db7accc06 100644 --- a/C4/Tags.pm +++ b/C4/Tags.pm @@ -1,18 +1,22 @@ package C4::Tags; + +# Copyright Liblime 2008 +# Parts Copyright ACPL 2011 +# # 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 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 3 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. +# 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 +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . use strict; use warnings; @@ -21,29 +25,36 @@ use Exporter; use C4::Context; use C4::Debug; +use Module::Load::Conditional qw/check_install/; +#use Data::Dumper; +use constant TAG_FIELDS => qw(tag_id borrowernumber biblionumber term language date_created); +use constant TAG_SELECT => "SELECT " . join(',', TAG_FIELDS) . "\n FROM tags_all\n"; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); -use vars qw($ext_dict $select_all @fields); +use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); BEGIN { - $VERSION = 0.03; @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 - &get_approval_rows - &blacklist - &whitelist - &is_approved - &approval_counts - &get_filters - ); + @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 + &get_approval_rows + &blacklist + &whitelist + &is_approved + &approval_counts + &get_count_by_tag_status + &get_filters + stratify_tags + ); # %EXPORT_TAGS = (); - $ext_dict = C4::Context->preference('TagsExternalDictionary'); + my $ext_dict = C4::Context->preference('TagsExternalDictionary'); + if ( $ext_dict && ! check_install( module => 'Lingua::Ispell' ) ) { + warn "Ignoring TagsExternalDictionary, because Lingua::Ispell is not installed."; + $ext_dict = q{}; + } if ($debug) { require Data::Dumper; import Data::Dumper qw(:DEFAULT); @@ -51,18 +62,19 @@ BEGIN { } if ($ext_dict) { require Lingua::Ispell; - import Lingua::Ispell qw(spellcheck add_word_lc save_dictionary); + import Lingua::Ispell qw(spellcheck add_word_lc); + $Lingua::Ispell::path = $ext_dict; + $debug and print STDERR "\$Lingua::Ispell::path = $Lingua::Ispell::path\n"; } } -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"; -} +=head1 C4::Tags.pm - Support for user tagging of biblios. + +More verose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}. + +=cut -sub get_filters (;$) { +sub get_filters { my $query = "SELECT * FROM tags_filters "; my ($sth); if (@_) { @@ -78,7 +90,7 @@ sub get_filters (;$) { # (SELECT count(*) FROM tags_all ) as tags_all, # (SELECT count(*) FROM tags_index ) as tags_index, -sub approval_counts () { +sub approval_counts { my $query = "SELECT (SELECT count(*) FROM tags_approval WHERE approved= 1) as approved_count, (SELECT count(*) FROM tags_approval WHERE approved=-1) as rejected_count, @@ -92,14 +104,32 @@ sub approval_counts () { return $result; } -sub remove_tag ($;$) { - my $tag_id = shift or return undef; +=head2 get_count_by_tag_status + + get_count_by_tag_status($status); + +Takes a status and gets a count of tags with that status + +=cut + +sub get_count_by_tag_status { + my ($status) = @_; + my $dbh = C4::Context->dbh; + my $query = + "SELECT count(*) FROM tags_approval WHERE approved=?"; + my $sth = $dbh->prepare($query); + $sth->execute( $status ); + return $sth->fetchrow; +} + +sub remove_tag { + my $tag_id = shift or return; my $user_id = (@_) ? shift : undef; my $rows = (defined $user_id) ? get_tag_rows({tag_id=>$tag_id, borrowernumber=>$user_id}) : get_tag_rows({tag_id=>$tag_id}) ; $rows or return 0; - (scalar(@$rows) == 1) or return undef; # should never happen (duplicate ids) + (scalar(@$rows) == 1) or return; # should never happen (duplicate ids) my $row = shift(@$rows); ($tag_id == $row->{tag_id}) or return 0; my $tags = get_tags({term=>$row->{term}, biblionumber=>$row->{biblionumber}}); @@ -120,26 +150,26 @@ sub remove_tag ($;$) { delete_tag_row_by_id($tag_id); } -sub delete_tag_index ($$) { - (@_) or return undef; +sub delete_tag_index { + (@_) or return; 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; +sub delete_tag_approval { + (@_) or return; 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; +sub delete_tag_row_by_id { + (@_) or return; 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; +sub delete_tag_rows_by_ids { + (@_) or return; my $i=0; foreach(@_) { $i += delete_tag_row_by_id($_); @@ -149,9 +179,9 @@ sub delete_tag_rows_by_ids (@) { return $i; } -sub get_tag_rows ($) { +sub get_tag_rows { my $hash = shift || {}; - my @ok_fields = @fields; + my @ok_fields = TAG_FIELDS; push @ok_fields, 'limit'; # push the limit! :) my $wheres; my $limit = ""; @@ -178,7 +208,7 @@ sub get_tag_rows ($) { push @exe_args, $hash->{$key}; } } - my $query = $select_all . ($wheres||'') . $limit; + my $query = TAG_SELECT . ($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); @@ -190,7 +220,7 @@ sub get_tag_rows ($) { return $sth->fetchall_arrayref({}); } -sub get_tags (;$) { # i.e., from tags_index +sub get_tags { # i.e., from tags_index my $hash = shift || {}; my @ok_fields = qw(term biblionumber weight limit sort approved); my $wheres; @@ -259,9 +289,9 @@ sub get_tags (;$) { # i.e., from tags_index return $sth->fetchall_arrayref({}); } -sub get_approval_rows (;$) { # i.e., from tags_approval +sub get_approval_rows { # i.e., from tags_approval my $hash = shift || {}; - my @ok_fields = qw(term approved date_approved approved_by weight_total limit sort); + my @ok_fields = qw(term approved date_approved approved_by weight_total limit sort borrowernumber); my $wheres; my $limit = ""; my $order = ""; @@ -279,7 +309,7 @@ sub get_approval_rows (;$) { # i.e., from tags_approval if ($key eq 'limit') { my $val = $hash->{$key}; unless ($val =~ /^(\d+,)?\d+$/) { - carp "Non-nuerical limit value '$val' ignored!"; + carp "Non-numerical limit value '$val' ignored!"; next; } $limit = " LIMIT $val\n"; @@ -288,6 +318,7 @@ sub get_approval_rows (;$) { # i.e., from tags_approval unless ( $by =~ /^([-+])?(term)/ or $by =~ /^([-+])?(biblionumber)/ or + $by =~ /^([-+])?(borrowernumber)/ or $by =~ /^([-+])?(weight_total)/ or $by =~ /^([-+])?(approved(_by)?)/ or $by =~ /^([-+])?(date_approved)/ @@ -333,10 +364,11 @@ sub get_approval_rows (;$) { # i.e., from tags_approval return $sth->fetchall_arrayref({}); } -sub is_approved ($) { - my $term = shift or return undef; +sub is_approved { + my $term = shift or return; my $sth = C4::Context->dbh->prepare("SELECT approved FROM tags_approval WHERE term = ?"); $sth->execute($term); + my $ext_dict = C4::Context->preference('TagsExternalDictionary'); unless ($sth->rows) { $ext_dict and return (spellcheck($term) ? 0 : 1); # spellcheck returns empty on OK word return 0; @@ -344,8 +376,8 @@ sub is_approved ($) { return $sth->fetchrow; } -sub get_tag_index ($;$) { - my $term = shift or return undef; +sub get_tag_index { + my $term = shift or return; my $sth; if (@_) { $sth = C4::Context->dbh->prepare("SELECT * FROM tags_index WHERE term = ? AND biblionumber = ?"); @@ -359,7 +391,8 @@ sub get_tag_index ($;$) { sub whitelist { my $operator = shift; - defined $operator or return undef; # have to test defined to allow =0 (kohaadmin) + defined $operator or return; # have to test defined to allow =0 (kohaadmin) + my $ext_dict = C4::Context->preference('TagsExternalDictionary'); if ($ext_dict) { foreach (@_) { spellcheck($_) or next; @@ -381,7 +414,7 @@ sub whitelist { # a term mistakenly, you can still reverse it. But there is no going back to "neutral". sub blacklist { my $operator = shift; - defined $operator or return undef; # have to test defined to allow =0 (kohaadmin) + defined $operator or return; # have to test defined to allow =0 (kohaadmin) foreach (@_) { my $aref = get_approval_rows({term=>$_}); if ($aref and scalar @$aref) { @@ -394,23 +427,23 @@ sub blacklist { } sub add_filter { my $operator = shift; - defined $operator or return undef; # have to test defined to allow =0 (kohaadmin) + defined $operator or return; # have to test defined to allow =0 (kohaadmin) my $query = "INSERT INTO tags_blacklist (regexp,y,z) VALUES (?,?,?)"; # my $sth = C4::Context->dbh->prepare($query); return scalar @_; } sub remove_filter { my $operator = shift; - defined $operator or return undef; # have to test defined to allow =0 (kohaadmin) + defined $operator or return; # have to test defined to allow =0 (kohaadmin) my $query = "REMOVE FROM tags_blacklist WHERE blacklist_id = ?"; # my $sth = C4::Context->dbh->prepare($query); # $sth->execute($term); return scalar @_; } -sub add_tag_approval ($;$$) { # or disapproval +sub add_tag_approval { # or disapproval $debug and warn "add_tag_approval(" . join(", ",map {defined($_) ? $_ : 'UNDEF'} @_) . ")"; - my $term = shift or return undef; + my $term = shift or return; my $query = "SELECT * FROM tags_approval WHERE term = ?"; my $sth = C4::Context->dbh->prepare($query); $sth->execute($term); @@ -433,10 +466,10 @@ sub add_tag_approval ($;$$) { # or disapproval return $sth->rows; } -sub mod_tag_approval ($$$) { +sub mod_tag_approval { my $operator = shift; - defined $operator or return undef; # have to test defined to allow =0 (kohaadmin) - my $term = shift or return undef; + defined $operator or return; # have to test defined to allow =0 (kohaadmin) + my $term = shift or return; my $approval = (scalar @_ ? shift : 1); # default is to approve my $query = "UPDATE tags_approval SET approved_by=?, approved=?, date_approved=NOW() WHERE term = ?"; $debug and print STDERR "mod_tag_approval query: $query\nmod_tag_approval args: ($operator,$approval,$term)\n"; @@ -444,9 +477,9 @@ sub mod_tag_approval ($$$) { $sth->execute($operator,$approval,$term); } -sub add_tag_index ($$;$) { - my $term = shift or return undef; - my $biblionumber = shift or return undef; +sub add_tag_index { + my $term = shift or return; + my $biblionumber = shift or return; my $query = "SELECT * FROM tags_index WHERE term = ? AND biblionumber = ?"; my $sth = C4::Context->dbh->prepare($query); $sth->execute($term,$biblionumber); @@ -458,61 +491,34 @@ sub add_tag_index ($$;$) { return $sth->rows; } -sub get_tag ($) { # by tag_id - (@_) or return undef; - my $sth = C4::Context->dbh->prepare("$select_all WHERE tag_id = ?"); +sub get_tag { # by tag_id + (@_) or return; + my $sth = C4::Context->dbh->prepare(TAG_SELECT . "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 ($$) { +sub increment_weights { increment_weight(@_); increment_weight_total(shift); } -sub decrement_weights ($$) { +sub decrement_weights { decrement_weight(@_); decrement_weight_total(shift); } -sub increment_weight_total ($) { +sub increment_weight_total { _set_weight_total('weight_total+1',shift); } -sub increment_weight ($$) { +sub increment_weight { _set_weight('weight+1',shift,shift); } -sub decrement_weight_total ($) { +sub decrement_weight_total { _set_weight_total('weight_total-1',shift); } -sub decrement_weight ($$) { +sub decrement_weight { _set_weight('weight-1',shift,shift); } -sub _set_weight_total ($$) { +sub _set_weight_total { my $sth = C4::Context->dbh->prepare(" UPDATE tags_approval SET weight_total=" . (shift) . " @@ -520,7 +526,7 @@ sub _set_weight_total ($$) { "); # note: CANNOT use "?" for weight_total (see the args above). $sth->execute(shift); # just the term } -sub _set_weight ($$$) { +sub _set_weight { my $dbh = C4::Context->dbh; my $sth = $dbh->prepare(" UPDATE tags_index @@ -531,13 +537,13 @@ sub _set_weight ($$$) { $sth->execute(@_); } -sub add_tag ($$;$$) { # biblionumber,term,[borrowernumber,approvernumber] - my $biblionumber = shift or return undef; - my $term = shift or return undef; +sub add_tag { # biblionumber,term,[borrowernumber,approvernumber] + my $biblionumber = shift or return; + my $term = shift or return; my $borrowernumber = (@_) ? shift : 0; # the user, default to kohaadmin $term =~ s/^\s+//; $term =~ s/\s+$//; - ($term) or return undef; # must be more than whitespace + ($term) or return; # must be more than whitespace my $rows = get_tag_rows({biblionumber=>$biblionumber, borrowernumber=>$borrowernumber, term=>$term, limit=>1}); my $query = "INSERT INTO tags_all (borrowernumber,biblionumber,term,date_created) @@ -546,7 +552,7 @@ sub add_tag ($$;$$) { # biblionumber,term,[borrowernumber,approvernumber] "add_tag query args: ($borrowernumber,$biblionumber,$term)\n"; if (scalar @$rows) { $debug and carp "Duplicate tag detected. Tag not added."; - return undef; + return; } # add to tags_all regardless of approaval my $sth = C4::Context->dbh->prepare($query); @@ -569,17 +575,52 @@ sub add_tag ($$;$$) { # biblionumber,term,[borrowernumber,approvernumber] } } +# This takes a set of tags, as returned by C and divides +# them up into a number of "strata" based on their weight. This is useful +# to display them in a number of different sizes. +# +# Usage: +# ($min, $max) = stratify_tags($strata, $tags); +# $stratum: the number of divisions you want +# $tags: the tags, as provided by get_approval_rows +# $min: the minimum stratum value +# $max: the maximum stratum value. This may be the same as $min if there +# is only one weight. Beware of divide by zeros. +# This will add a field to the tag called "stratum" containing the calculated +# value. +sub stratify_tags { + my ( $strata, $tags ) = @_; + return (0,0) if !@$tags; + my ( $min, $max ); + foreach (@$tags) { + my $w = $_->{weight_total}; + $min = $w if ( !defined($min) || $min > $w ); + $max = $w if ( !defined($max) || $max < $w ); + } + + # normalise min to zero + $max = $max - $min; + my $orig_min = $min; + $min = 0; + + # if min and max are the same, just make it 1 + my $span = ( $strata - 1 ) / ( $max || 1 ); + foreach (@$tags) { + my $w = $_->{weight_total}; + $_->{stratum} = int( ( $w - $orig_min ) * $span ); + } + return ( $min, $max ); +} + 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 +=cut + =head2 External Dictionary (Ispell) [Recommended] An external dictionary can be used as a means of "pre-populating" and tracking @@ -627,7 +668,7 @@ This could be called an "approved terms" table. See above regarding the Externa approved - Negative, 0 or positive if tag is rejected, pending or approved. date_approved - date of last action approved_by - staffer performing the last action - weight_total - total occurance of term in any biblio by any users + weight_total - total occurrence of term in any biblio by any users tags_index - This table is for performance, because by far the most common operation will be fetching tags for a list of search results. We will have a set of biblios, and we will