C4/Tags.pm

   1 package C4::Tags;
   2 # This file is part of Koha.
   3 #
   4 # Koha is free software; you can redistribute it and/or modify it under the
   5 # terms of the GNU General Public License as published by the Free Software
   6 # Foundation; either version 2 of the License, or (at your option) any later
   7 # version.
   8 #
   9 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  10 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  11 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along with
  14 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  15 # Suite 330, Boston, MA  02111-1307 USA
  16
  17 use strict;
  18 use warnings;
  19 use Carp;
  20 use Exporter;
  21
  22 use C4::Context;
  23 use C4::Debug;
  24
  25 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  26 use vars qw($ext_dict $select_all @fields);
  27
  28 BEGIN {
  29         $VERSION = 0.01;
  30         @ISA = qw(Exporter);
  31         @EXPORT_OK = qw(
  32                 &get_tag &get_tags &get_tag_rows
  33                 &add_tags &add_tag
  34                 &delete_tag_row_by_id
  35                 &remove_tag
  36                 &delete_tag_rows_by_ids
  37                 &rectify_weights
  38         );
  39         # %EXPORT_TAGS = ();
  40         $ext_dict = C4::Context->preference('TagsExternalDictionary');
  41         if ($debug) {
  42                 require Data::Dumper;
  43                 import Data::Dumper qw(:DEFAULT);
  44                 print STDERR __PACKAGE__ . " external dictionary = " . ($ext_dict||'none') . "\n";
  45         }
  46         if ($ext_dict) {
  47                 require Lingua::Ispell;
  48                 import Lingua::Ispell qw(spellcheck);
  49         }
  50 }
  51
  52 INIT {
  53     $ext_dict and $Lingua::Ispell::path = $ext_dict;
  54     $debug and print STDERR "\$Lingua::Ispell::path = $Lingua::Ispell::path\n";
  55         @fields = qw(tag_id borrowernumber biblionumber term language date_created);
  56         $select_all = "SELECT " . join(',',@fields) . "\n FROM   tags_all\n";
  57 }
  58
  59 sub remove_tag ($) {
  60         my $tag_id = shift;
  61         my $rows = get_tag_rows({tag_id=>$tag_id}) or return 0;
  62         (scalar(@$rows) == 1) or return undef;
  63         my $row = shift(@$rows);
  64         ($tag_id == $row->{tag_id}) or return 0;
  65         my $tags = get_tags({term=>$row->{term}, biblionumber=>$row->{biblionumber}});
  66         my $index = shift(@$tags);
  67         $debug and print STDERR
  68                 sprintf "remove_tag: tag_id=>%s, biblionumber=>%s, weight=>%s, weight_total=>%s\n",
  69                         $row->{tag_id}, $row->{biblionumber}, $index->{weight}, $index->{weight_total};
  70         if ($index->{weight} <= 1) {
  71                 delete_tag_index($row->{term},$row->{biblionumber});
  72         } else {
  73                 decrement_weight($row->{term},$row->{biblionumber});
  74         }
  75         if ($index->{weight_total} <= 1) {
  76                 delete_tag_approval($row->{term});
  77         } else {
  78                 decrement_weight_total($row->{term});
  79         }
  80         delete_tag_row_by_id($tag_id);
  81 }
  82
  83 sub delete_tag_index ($$) {
  84         (@_) or return undef;
  85         my $sth = C4::Context->dbh->prepare("DELETE FROM tags_index WHERE term = ? AND biblionumber = ? LIMIT 1");
  86         $sth->execute(@_);
  87         return $sth->rows || 0;
  88 }
  89 sub delete_tag_approval ($) {
  90         (@_) or return undef;
  91         my $sth = C4::Context->dbh->prepare("DELETE FROM tags_approval WHERE term = ? LIMIT 1");
  92         $sth->execute(shift);
  93         return $sth->rows || 0;
  94 }
  95 sub delete_tag_row_by_id ($) {
  96         (@_) or return undef;
  97         my $sth = C4::Context->dbh->prepare("DELETE FROM tags_all WHERE tag_id = ? LIMIT 1");
  98         $sth->execute(shift);
  99         return $sth->rows || 0;
 100 }
 101 sub delete_tag_rows_by_ids (@) {
 102         (@_) or return undef;
 103         my $i=0;
 104         foreach(@_) {
 105                 $i += delete_tag_row_by_id($_);
 106         }
 107         ($i == scalar(@_)) or
 108                 warn sprintf "delete_tag_rows_by_ids tried %s tag_ids, only succeeded on $i", scalar(@_);
 109         return $i;
 110 }
 111
 112 sub get_tag_rows ($) {
 113         my $hash = shift || {};
 114         my @ok_fields = @fields;
 115         push @ok_fields, 'limit';       # push the limit! :)
 116         my $wheres;
 117         my $limit  = "";
 118         my @exe_args = ();
 119         foreach my $key (keys %$hash) {
 120                 $debug and print STDERR "get_tag_rows arg. '$key' = ", $hash->{$key}, "\n";
 121                 unless (length $key) {
 122                         carp "Empty argument key to get_tag_rows: ignoring!";
 123                         next;
 124                 }
 125                 unless (1 == scalar grep {/^ $key $/xi} @ok_fields) {
 126                         carp "get_tag_rows received unreconized argument key '$key'.";
 127                         next;
 128                 }
 129                 if ($key =~ /^limit$/i) {
 130                         my $val = $hash->{$key};
 131                         unless ($val =~ /^\d+$/) {
 132                                 carp "Non-nuerical limit value '$val' ignored!";
 133                                 next;
 134                         }
 135                         $limit = " LIMIT $val\n";
 136                 } else {
 137                         $wheres .= ($wheres) ? " AND    $key = ?\n" : " WHERE  $key = ?\n";
 138                         push @exe_args, $hash->{$key};
 139                 }
 140         }
 141         my $query = $select_all . ($wheres||'') . $limit;
 142         $debug and print STDERR "get_tag_rows query:\n $query\n",
 143                                                         "get_tag_rows query args: ", join(',', @exe_args), "\n";
 144         my $sth = C4::Context->dbh->prepare($query);
 145         if (@exe_args) {
 146                 $sth->execute(@exe_args);
 147         } else {
 148                 $sth->execute;
 149         }
 150         return $sth->fetchall_arrayref({});
 151 }
 152
 153 sub get_tags (;$) {             # i.e., from tags_index
 154         # my $self = shift;
 155         my $hash = shift || {};
 156         my @ok_fields = qw(term biblionumber weight limit sort);
 157         my $wheres;
 158         my $limit  = "";
 159         my $order  = "";
 160         my @exe_args = ();
 161         foreach my $key (keys %$hash) {
 162                 $debug and print STDERR "get_tags arg. '$key' = ", $hash->{$key}, "\n";
 163                 unless (length $key) {
 164                         carp "Empty argument key to get_tags: ignoring!";
 165                         next;
 166                 }
 167                 unless (1 == scalar grep {/^ $key $/xi} @ok_fields) {
 168                         carp "get_tags received unreconized argument key '$key'.";
 169                         next;
 170                 }
 171                 if ($key =~ /^limit$/i) {
 172                         my $val = $hash->{$key};
 173                         unless ($val =~ /^\d+$/) {
 174                                 carp "Non-nuerical limit value '$val' ignored!";
 175                                 next;
 176                         }
 177                         $limit = " LIMIT $val\n";
 178                 } elsif ($key =~ /^sort$/i) {
 179                         foreach my $by (split /\,/, $hash->{$key}) {
 180                                 unless (
 181                                         $by =~ /^([-+])?(term)/ or
 182                                         $by =~ /^([-+])?(biblionumber)/ or
 183                                         $by =~ /^([-+])?(weight)/
 184                                 ) {
 185                                         carp "get_tags received illegal sort order '$by'";
 186                                         next;
 187                                 }
 188                                 $order .= " ORDER BY $2 " . ($1 eq '-' ? 'DESC' : $1 eq '+' ? 'ASC' : '') . "\n";
 189                         }
 190
 191                 } else {
 192                         my $whereval = $key;
 193                         ($key =~ /^term$/i) and $whereval = 'tags_index.term';
 194                         $wheres .= ($wheres) ? " AND    $whereval = ?\n" : " WHERE  $whereval = ?\n";
 195                         push @exe_args, $hash->{$key};
 196                 }
 197         }
 198         my $query = "
 199         SELECT    tags_index.term as term,biblionumber,weight,weight_total
 200         FROM      tags_index
 201         LEFT JOIN tags_approval
 202         ON        tags_index.term = tags_approval.term
 203         " . ($wheres||'') . $order . $limit;
 204         $debug and print STDERR "get_tags query:\n $query\n",
 205                                                         "get_tags query args: ", join(',', @exe_args), "\n";
 206         my $sth = C4::Context->dbh->prepare($query);
 207         if (@exe_args) {
 208                 $sth->execute(@exe_args);
 209         } else {
 210                 $sth->execute;
 211         }
 212         return $sth->fetchall_arrayref({});
 213 }
 214
 215 sub is_approved ($) {
 216         my $term = shift or return undef;
 217         if ($ext_dict) {
 218                 return (spellcheck($term) ? 0 : 1);
 219         }
 220         my $sth = C4::Context->dbh->prepare("SELECT approved FROM tags_approval WHERE term = ?");
 221         $sth->execute($term);
 222         $sth->rows or return undef;
 223         return $sth->fetch;
 224 }
 225
 226 sub get_tag_index ($;$) {
 227         my $term = shift or return undef;
 228         my $sth;
 229         if (@_) {
 230                 $sth = C4::Context->dbh->prepare("SELECT * FROM tags_index WHERE term = ? AND biblionumber = ?");
 231                 $sth->execute($term,shift);
 232         } else {
 233                 $sth = C4::Context->dbh->prepare("SELECT * FROM tags_index WHERE term = ?");
 234                 $sth->execute($term);
 235         }
 236         return $sth->fetchrow_hashref;
 237 }
 238
 239 sub add_tag_approval ($;$) {
 240         my $term = shift or return undef;
 241         my $query = "SELECT * FROM tags_approval WHERE term = ?";
 242         my $sth = C4::Context->dbh->prepare($query);
 243         $sth->execute($term);
 244         ($sth->rows) and return increment_weight_total($term);
 245         my $ok = (@_ ? shift : 0);
 246         if ($ok) {
 247                 $query = "INSERT INTO tags_approval (term,approved_by,approved,date_approved) VALUES (?,?,1,NOW())";
 248                 $debug and print STDERR "add_tag_approval query:\n$query\nadd_tag_approval args: ($term,$ok)\n";
 249                 $sth = C4::Context->dbh->prepare($query);
 250                 $sth->execute($term,$ok);
 251         } else {
 252                 $query = "INSERT INTO tags_approval (term,date_approved) VALUES (?,NOW())";
 253                 $debug and print STDERR "add_tag_approval query:\n$query\nadd_tag_approval args: ($term)\n";
 254                 $sth = C4::Context->dbh->prepare($query);
 255                 $sth->execute($term);
 256         }
 257         return $sth->rows;
 258 }
 259
 260 sub add_tag_index ($$;$) {
 261         my $term         = shift or return undef;
 262         my $biblionumber = shift or return undef;
 263         my $query = "SELECT * FROM tags_index WHERE term = ? AND biblionumber = ?";
 264         my $sth = C4::Context->dbh->prepare($query);
 265         $sth->execute($term,$biblionumber);
 266         ($sth->rows) and return increment_weight($term,$biblionumber);
 267         $query = "INSERT INTO tags_index (term,biblionumber) VALUES (?,?)";
 268         $debug and print "add_tag_index query:\n$query\nadd_tag_index args: ($term,$biblionumber)\n";
 269         $sth = C4::Context->dbh->prepare($query);
 270         $sth->execute($term,$biblionumber);
 271         return $sth->rows;
 272 }
 273
 274 sub get_tag ($) {               # by tag_id
 275         (@_) or return undef;
 276         my $sth = C4::Context->dbh->prepare("$select_all WHERE tag_id = ?");
 277         $sth->execute(shift);
 278         return $sth->fetchrow_hashref;
 279 }
 280
 281 sub rectify_weights (;$) {
 282         my $dbh = C4::Context->dbh;
 283         my $sth;
 284         my $query = "
 285         SELECT term,biblionumber,count(*) as count
 286         FROM   tags_all
 287         ";
 288         (@_) and $query .= " WHERE term =? ";
 289         $query .= " GROUP BY term,biblionumber ";
 290         $sth = $dbh->prepare($query);
 291         if (@_) {
 292                 $sth->execute(shift);
 293         } else {
 294                 $sth->execute();
 295         }
 296         my $results = $sth->fetchall_arrayref({}) or return undef;
 297         my %tally = ();
 298         foreach (@$results) {
 299                 _set_weight($_->{count},$_->{term},$_->{biblionumber});
 300                 $tally{$_->{term}} += $_->{count};
 301         }
 302         foreach (keys %tally) {
 303                 _set_weight_total($tally{$_},$_);
 304         }
 305         return ($results,\%tally);
 306 }
 307
 308 sub increment_weights ($$) {
 309         increment_weight(@_);
 310         increment_weight_total(shift);
 311 }
 312 sub decrement_weights ($$) {
 313         decrement_weight(@_);
 314         derement_weight_total(shift);
 315 }
 316 sub increment_weight_total ($) {
 317         _set_weight_total('weight_total+1',shift);
 318 }
 319 sub increment_weight ($$) {
 320         _set_weight('weight+1',shift,shift);
 321 }
 322 sub decrement_weight_total ($) {
 323         _set_weight_total('weight_total-1',shift);
 324 }
 325 sub decrement_weight ($$) {
 326         _set_weight('weight-1',shift,shift);
 327 }
 328 sub _set_weight_total ($$) {
 329         my $sth = C4::Context->dbh->prepare("
 330         UPDATE tags_approval
 331         SET    weight_total=" . (shift) . "
 332         WHERE  term=?
 333         ");
 334         $sth->execute(shift);   # just the term
 335 }
 336 sub _set_weight ($$$) {
 337         my $dbh = C4::Context->dbh;
 338         my $sth = $dbh->prepare("
 339         UPDATE tags_index
 340         SET    weight=" . (shift) . "
 341         WHERE  term=?
 342         AND    biblionumber=?
 343         ");
 344         $sth->execute(@_);
 345 }
 346
 347 sub add_tag ($$;$$) {   # biblionumber,term,[borrowernumber,approvernumber]
 348         my $biblionumber = shift or return undef;
 349         my $term         = shift or return undef;
 350         my $borrowernumber = (@_) ? shift : 0;          # the user, default to kohaadmin
 351
 352         # first, add to tags regardless of approaval
 353         my $query = "INSERT INTO tags_all
 354         (borrowernumber,biblionumber,term,date_created)
 355         VALUES (?,?,?,NOW())";
 356         $debug and print STDERR "add_tag query:\n $query\n",
 357                                                         "add_tag query args: ($borrowernumber,$biblionumber,$term)\n";
 358         my $sth = C4::Context->dbh->prepare($query);
 359         $sth->execute($borrowernumber,$biblionumber,$term);
 360
 361         # then
 362         if (@_) {       # if an arg remains, it is the borrowernumber of the approver: tag is pre-approved.
 363                 my $approver = shift;
 364                 add_tag_approval($term,$approver);
 365                 add_tag_index($term,$biblionumber,$approver);
 366         } elsif (is_approved($term)) {
 367                 add_tag_approval($term,1);
 368                 add_tag_index($term,$biblionumber,1);
 369         } else {
 370                 add_tag_approval($term);
 371                 add_tag_index($term,$biblionumber);
 372         }
 373 }
 374
 375 1;
 376 __END__
 377
 378 =head1 C4::Tags.pm - Support for user tagging of biblios.
 379
 380 More verose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
 381
 382 =head2 add_tag(biblionumber,term[,borrowernumber])
 383
 384 =head3 TO DO: Add real perldoc
 385
 386 =head2 Tricks
 387
 388 If you want to auto-populate some tags for debugging, do something like this:
 389
 390 mysql> select biblionumber from biblio where title LIKE "%Health%";
 391 +--------------+
 392 | biblionumber |
 393 +--------------+
 394 |           18 |
 395 |           22 |
 396 |           24 |
 397 |           30 |
 398 |           44 |
 399 |           45 |
 400 |           46 |
 401 |           49 |
 402 |          111 |
 403 |          113 |
 404 |          128 |
 405 |          146 |
 406 |          155 |
 407 |          518 |
 408 |          522 |
 409 |          524 |
 410 |          530 |
 411 |          544 |
 412 |          545 |
 413 |          546 |
 414 |          549 |
 415 |          611 |
 416 |          613 |
 417 |          628 |
 418 |          646 |
 419 |          655 |
 420 +--------------+
 421 26 rows in set (0.00 sec)
 422
 423 Then, take those numbers and type them into this perl command line:
 424 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",});'
 425
 426 =cut
 427