C4/Tags.pm

   1 package C4::Tags;
   2
   3 # Copyright Liblime 2008
   4 # Parts Copyright ACPL 2011
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along
  18 # with Koha; if not, write to the Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  20
  21 use strict;
  22 use warnings;
  23 use Carp;
  24 use Exporter;
  25
  26 use C4::Context;
  27 use C4::Debug;
  28 #use Data::Dumper;
  29
  30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  31 use vars qw($ext_dict $select_all @fields);
  32
  33 BEGIN {
  34     $VERSION = 3.07.00.049;
  35         @ISA = qw(Exporter);
  36         @EXPORT_OK = qw(
  37                 &get_tag &get_tags &get_tag_rows
  38                 &add_tags &add_tag
  39                 &delete_tag_row_by_id
  40                 &remove_tag
  41                 &delete_tag_rows_by_ids
  42                 &rectify_weights
  43                 &get_approval_rows
  44                 &blacklist
  45                 &whitelist
  46                 &is_approved
  47                 &approval_counts
  48                 &get_count_by_tag_status
  49                 &get_filters
  50         );
  51         # %EXPORT_TAGS = ();
  52         $ext_dict = C4::Context->preference('TagsExternalDictionary');
  53         if ($debug) {
  54                 require Data::Dumper;
  55                 import Data::Dumper qw(:DEFAULT);
  56                 print STDERR __PACKAGE__ . " external dictionary = " . ($ext_dict||'none') . "\n";
  57         }
  58         if ($ext_dict) {
  59                 require Lingua::Ispell;
  60                 import Lingua::Ispell qw(spellcheck add_word_lc save_dictionary);
  61         }
  62 }
  63
  64 INIT {
  65     $ext_dict and $Lingua::Ispell::path = $ext_dict;
  66     $debug and print STDERR "\$Lingua::Ispell::path = $Lingua::Ispell::path\n";
  67         @fields = qw(tag_id borrowernumber biblionumber term language date_created);
  68         $select_all = "SELECT " . join(',',@fields) . "\n FROM   tags_all\n";
  69 }
  70
  71 sub get_filters {
  72         my $query = "SELECT * FROM tags_filters ";
  73         my ($sth);
  74         if (@_) {
  75                 $sth = C4::Context->dbh->prepare($query . " WHERE filter_id = ? ");
  76                 $sth->execute(shift);
  77         } else {
  78                 $sth = C4::Context->dbh->prepare($query);
  79                 $sth->execute;
  80         }
  81         return $sth->fetchall_arrayref({});
  82 }
  83
  84 #       (SELECT count(*) FROM tags_all     ) as tags_all,
  85 #       (SELECT count(*) FROM tags_index   ) as tags_index,
  86
  87 sub approval_counts {
  88         my $query = "SELECT
  89                 (SELECT count(*) FROM tags_approval WHERE approved= 1) as approved_count,
  90                 (SELECT count(*) FROM tags_approval WHERE approved=-1) as rejected_count,
  91                 (SELECT count(*) FROM tags_approval WHERE approved= 0) as unapproved_count
  92         ";
  93         my $sth = C4::Context->dbh->prepare($query);
  94         $sth->execute;
  95         my $result = $sth->fetchrow_hashref();
  96         $result->{approved_total} = $result->{approved_count} + $result->{rejected_count} + $result->{unapproved_count};
  97         $debug and warn "counts returned: " . Dumper $result;
  98         return $result;
  99 }
 100
 101 =head2 get_count_by_tag_status
 102
 103   get_count_by_tag_status($status);
 104
 105 Takes a status and gets a count of tags with that status
 106
 107 =cut
 108
 109 sub get_count_by_tag_status  {
 110     my ($status) = @_;
 111     my $dbh            = C4::Context->dbh;
 112     my $query          =
 113       "SELECT count(*) FROM tags_approval WHERE approved=?";
 114     my $sth = $dbh->prepare($query);
 115     $sth->execute( $status );
 116   return $sth->fetchrow;
 117 }
 118
 119 sub remove_tag {
 120         my $tag_id  = shift or return undef;
 121         my $user_id = (@_) ? shift : undef;
 122         my $rows = (defined $user_id) ?
 123                         get_tag_rows({tag_id=>$tag_id, borrowernumber=>$user_id}) :
 124                         get_tag_rows({tag_id=>$tag_id}) ;
 125         $rows or return 0;
 126         (scalar(@$rows) == 1) or return undef;  # should never happen (duplicate ids)
 127         my $row = shift(@$rows);
 128         ($tag_id == $row->{tag_id}) or return 0;
 129         my $tags = get_tags({term=>$row->{term}, biblionumber=>$row->{biblionumber}});
 130         my $index = shift(@$tags);
 131         $debug and print STDERR
 132                 sprintf "remove_tag: tag_id=>%s, biblionumber=>%s, weight=>%s, weight_total=>%s\n",
 133                         $row->{tag_id}, $row->{biblionumber}, $index->{weight}, $index->{weight_total};
 134         if ($index->{weight} <= 1) {
 135                 delete_tag_index($row->{term},$row->{biblionumber});
 136         } else {
 137                 decrement_weight($row->{term},$row->{biblionumber});
 138         }
 139         if ($index->{weight_total} <= 1) {
 140                 delete_tag_approval($row->{term});
 141         } else {
 142                 decrement_weight_total($row->{term});
 143         }
 144         delete_tag_row_by_id($tag_id);
 145 }
 146
 147 sub delete_tag_index {
 148         (@_) or return undef;
 149         my $sth = C4::Context->dbh->prepare("DELETE FROM tags_index WHERE term = ? AND biblionumber = ? LIMIT 1");
 150         $sth->execute(@_);
 151         return $sth->rows || 0;
 152 }
 153 sub delete_tag_approval {
 154         (@_) or return undef;
 155         my $sth = C4::Context->dbh->prepare("DELETE FROM tags_approval WHERE term = ? LIMIT 1");
 156         $sth->execute(shift);
 157         return $sth->rows || 0;
 158 }
 159 sub delete_tag_row_by_id {
 160         (@_) or return undef;
 161         my $sth = C4::Context->dbh->prepare("DELETE FROM tags_all WHERE tag_id = ? LIMIT 1");
 162         $sth->execute(shift);
 163         return $sth->rows || 0;
 164 }
 165 sub delete_tag_rows_by_ids {
 166         (@_) or return undef;
 167         my $i=0;
 168         foreach(@_) {
 169                 $i += delete_tag_row_by_id($_);
 170         }
 171         ($i == scalar(@_)) or
 172                 warn sprintf "delete_tag_rows_by_ids tried %s tag_ids, only succeeded on $i", scalar(@_);
 173         return $i;
 174 }
 175
 176 sub get_tag_rows {
 177         my $hash = shift || {};
 178         my @ok_fields = @fields;
 179         push @ok_fields, 'limit';       # push the limit! :)
 180         my $wheres;
 181         my $limit  = "";
 182         my @exe_args = ();
 183         foreach my $key (keys %$hash) {
 184                 $debug and print STDERR "get_tag_rows arg. '$key' = ", $hash->{$key}, "\n";
 185                 unless (length $key) {
 186                         carp "Empty argument key to get_tag_rows: ignoring!";
 187                         next;
 188                 }
 189                 unless (1 == scalar grep {/^ $key $/x} @ok_fields) {
 190                         carp "get_tag_rows received unreconized argument key '$key'.";
 191                         next;
 192                 }
 193                 if ($key eq 'limit') {
 194                         my $val = $hash->{$key};
 195                         unless ($val =~ /^(\d+,)?\d+$/) {
 196                                 carp "Non-nuerical limit value '$val' ignored!";
 197                                 next;
 198                         }
 199                         $limit = " LIMIT $val\n";
 200                 } else {
 201                         $wheres .= ($wheres) ? " AND    $key = ?\n" : " WHERE  $key = ?\n";
 202                         push @exe_args, $hash->{$key};
 203                 }
 204         }
 205         my $query = $select_all . ($wheres||'') . $limit;
 206         $debug and print STDERR "get_tag_rows query:\n $query\n",
 207                                                         "get_tag_rows query args: ", join(',', @exe_args), "\n";
 208         my $sth = C4::Context->dbh->prepare($query);
 209         if (@exe_args) {
 210                 $sth->execute(@exe_args);
 211         } else {
 212                 $sth->execute;
 213         }
 214         return $sth->fetchall_arrayref({});
 215 }
 216
 217 sub get_tags {          # i.e., from tags_index
 218         my $hash = shift || {};
 219         my @ok_fields = qw(term biblionumber weight limit sort approved);
 220         my $wheres;
 221         my $limit  = "";
 222         my $order  = "";
 223         my @exe_args = ();
 224         foreach my $key (keys %$hash) {
 225                 $debug and print STDERR "get_tags arg. '$key' = ", $hash->{$key}, "\n";
 226                 unless (length $key) {
 227                         carp "Empty argument key to get_tags: ignoring!";
 228                         next;
 229                 }
 230                 unless (1 == scalar grep {/^ $key $/x} @ok_fields) {
 231                         carp "get_tags received unreconized argument key '$key'.";
 232                         next;
 233                 }
 234                 if ($key eq 'limit') {
 235                         my $val = $hash->{$key};
 236                         unless ($val =~ /^(\d+,)?\d+$/) {
 237                                 carp "Non-nuerical limit value '$val' ignored!";
 238                                 next;
 239                         }
 240                         $limit = " LIMIT $val\n";
 241                 } elsif ($key eq 'sort') {
 242                         foreach my $by (split /\,/, $hash->{$key}) {
 243                                 unless (
 244                                         $by =~ /^([-+])?(term)/ or
 245                                         $by =~ /^([-+])?(biblionumber)/ or
 246                                         $by =~ /^([-+])?(weight)/
 247                                 ) {
 248                                         carp "get_tags received illegal sort order '$by'";
 249                                         next;
 250                                 }
 251                                 if ($order) {
 252                                         $order .= ", ";
 253                                 } else {
 254                                         $order = " ORDER BY ";
 255                                 }
 256                                 $order .= $2 . " " . ((!$1) ? '' : $1 eq '-' ? 'DESC' : $1 eq '+' ? 'ASC' : '') . "\n";
 257                         }
 258
 259                 } else {
 260                         my $whereval = $hash->{$key};
 261                         my $longkey = ($key eq 'term'    ) ? 'tags_index.term'        :
 262                                                   ($key eq 'approved') ? 'tags_approval.approved' : $key;
 263                         my $op = ($whereval =~ s/^(>=|<=)// or
 264                                           $whereval =~ s/^(>|=|<)//   ) ? $1 : '=';
 265                         $wheres .= ($wheres) ? " AND    $longkey $op ?\n" : " WHERE  $longkey $op ?\n";
 266                         push @exe_args, $whereval;
 267                 }
 268         }
 269         my $query = "
 270         SELECT    tags_index.term as term,biblionumber,weight,weight_total
 271         FROM      tags_index
 272         LEFT JOIN tags_approval
 273         ON        tags_index.term = tags_approval.term
 274         " . ($wheres||'') . $order . $limit;
 275         $debug and print STDERR "get_tags query:\n $query\n",
 276                                                         "get_tags query args: ", join(',', @exe_args), "\n";
 277         my $sth = C4::Context->dbh->prepare($query);
 278         if (@exe_args) {
 279                 $sth->execute(@exe_args);
 280         } else {
 281                 $sth->execute;
 282         }
 283         return $sth->fetchall_arrayref({});
 284 }
 285
 286 sub get_approval_rows {         # i.e., from tags_approval
 287         my $hash = shift || {};
 288         my @ok_fields = qw(term approved date_approved approved_by weight_total limit sort borrowernumber);
 289         my $wheres;
 290         my $limit  = "";
 291         my $order  = "";
 292         my @exe_args = ();
 293         foreach my $key (keys %$hash) {
 294                 $debug and print STDERR "get_approval_rows arg. '$key' = ", $hash->{$key}, "\n";
 295                 unless (length $key) {
 296                         carp "Empty argument key to get_approval_rows: ignoring!";
 297                         next;
 298                 }
 299                 unless (1 == scalar grep {/^ $key $/x} @ok_fields) {
 300                         carp "get_approval_rows received unreconized argument key '$key'.";
 301                         next;
 302                 }
 303                 if ($key eq 'limit') {
 304                         my $val = $hash->{$key};
 305                         unless ($val =~ /^(\d+,)?\d+$/) {
 306                                 carp "Non-numerical limit value '$val' ignored!";
 307                                 next;
 308                         }
 309                         $limit = " LIMIT $val\n";
 310                 } elsif ($key eq 'sort') {
 311                         foreach my $by (split /\,/, $hash->{$key}) {
 312                                 unless (
 313                                         $by =~ /^([-+])?(term)/            or
 314                                         $by =~ /^([-+])?(biblionumber)/    or
 315                     $by =~ /^([-+])?(borrowernumber)/  or
 316                                         $by =~ /^([-+])?(weight_total)/    or
 317                                         $by =~ /^([-+])?(approved(_by)?)/  or
 318                                         $by =~ /^([-+])?(date_approved)/
 319                                 ) {
 320                                         carp "get_approval_rows received illegal sort order '$by'";
 321                                         next;
 322                                 }
 323                                 if ($order) {
 324                                         $order .= ", ";
 325                                 } else {
 326                                         $order = " ORDER BY " unless $order;
 327                                 }
 328                                 $order .= $2 . " " . ((!$1) ? '' : $1 eq '-' ? 'DESC' : $1 eq '+' ? 'ASC' : '') . "\n";
 329                         }
 330
 331                 } else {
 332                         my $whereval = $hash->{$key};
 333                         my $op = ($whereval =~ s/^(>=|<=)// or
 334                                           $whereval =~ s/^(>|=|<)//   ) ? $1 : '=';
 335                         $wheres .= ($wheres) ? " AND    $key $op ?\n" : " WHERE  $key $op ?\n";
 336                         push @exe_args, $whereval;
 337                 }
 338         }
 339         my $query = "
 340         SELECT  tags_approval.term          AS term,
 341                         tags_approval.approved      AS approved,
 342                         tags_approval.date_approved AS date_approved,
 343                         tags_approval.approved_by   AS approved_by,
 344                         tags_approval.weight_total  AS weight_total,
 345                         CONCAT(borrowers.surname, ', ', borrowers.firstname) AS approved_by_name
 346         FROM    tags_approval
 347         LEFT JOIN borrowers
 348         ON      tags_approval.approved_by = borrowers.borrowernumber ";
 349         $query .= ($wheres||'') . $order . $limit;
 350         $debug and print STDERR "get_approval_rows query:\n $query\n",
 351                                                         "get_approval_rows query args: ", join(',', @exe_args), "\n";
 352         my $sth = C4::Context->dbh->prepare($query);
 353         if (@exe_args) {
 354                 $sth->execute(@exe_args);
 355         } else {
 356                 $sth->execute;
 357         }
 358         return $sth->fetchall_arrayref({});
 359 }
 360
 361 sub is_approved {
 362         my $term = shift or return undef;
 363         my $sth = C4::Context->dbh->prepare("SELECT approved FROM tags_approval WHERE term = ?");
 364         $sth->execute($term);
 365         unless ($sth->rows) {
 366                 $ext_dict and return (spellcheck($term) ? 0 : 1);       # spellcheck returns empty on OK word
 367                 return 0;
 368         }
 369         return $sth->fetchrow;
 370 }
 371
 372 sub get_tag_index {
 373         my $term = shift or return undef;
 374         my $sth;
 375         if (@_) {
 376                 $sth = C4::Context->dbh->prepare("SELECT * FROM tags_index WHERE term = ? AND biblionumber = ?");
 377                 $sth->execute($term,shift);
 378         } else {
 379                 $sth = C4::Context->dbh->prepare("SELECT * FROM tags_index WHERE term = ?");
 380                 $sth->execute($term);
 381         }
 382         return $sth->fetchrow_hashref;
 383 }
 384
 385 sub whitelist {
 386         my $operator = shift;
 387         defined $operator or return undef; # have to test defined to allow =0 (kohaadmin)
 388         if ($ext_dict) {
 389                 foreach (@_) {
 390                         spellcheck($_) or next;
 391                         add_word_lc($_);
 392                 }
 393         }
 394         foreach (@_) {
 395                 my $aref = get_approval_rows({term=>$_});
 396                 if ($aref and scalar @$aref) {
 397                         mod_tag_approval($operator,$_,1);
 398                 } else {
 399                         add_tag_approval($_,$operator);
 400                 }
 401         }
 402         return scalar @_;
 403 }
 404 # note: there is no "unwhitelist" operation because there is no remove for Ispell.
 405 # The blacklist regexps should operate "in front of" the whitelist, so if you approve
 406 # a term mistakenly, you can still reverse it. But there is no going back to "neutral".
 407 sub blacklist {
 408         my $operator = shift;
 409         defined $operator or return undef; # have to test defined to allow =0 (kohaadmin)
 410         foreach (@_) {
 411                 my $aref = get_approval_rows({term=>$_});
 412                 if ($aref and scalar @$aref) {
 413                         mod_tag_approval($operator,$_,-1);
 414                 } else {
 415                         add_tag_approval($_,$operator,-1);
 416                 }
 417         }
 418         return scalar @_;
 419 }
 420 sub add_filter {
 421         my $operator = shift;
 422         defined $operator or return undef; # have to test defined to allow =0 (kohaadmin)
 423         my $query = "INSERT INTO tags_blacklist (regexp,y,z) VALUES (?,?,?)";
 424         # my $sth = C4::Context->dbh->prepare($query);
 425         return scalar @_;
 426 }
 427 sub remove_filter {
 428         my $operator = shift;
 429         defined $operator or return undef; # have to test defined to allow =0 (kohaadmin)
 430         my $query = "REMOVE FROM tags_blacklist WHERE blacklist_id = ?";
 431         # my $sth = C4::Context->dbh->prepare($query);
 432         # $sth->execute($term);
 433         return scalar @_;
 434 }
 435
 436 sub add_tag_approval {  # or disapproval
 437         $debug and warn "add_tag_approval(" . join(", ",map {defined($_) ? $_ : 'UNDEF'} @_) . ")";
 438         my $term = shift or return undef;
 439         my $query = "SELECT * FROM tags_approval WHERE term = ?";
 440         my $sth = C4::Context->dbh->prepare($query);
 441         $sth->execute($term);
 442         ($sth->rows) and return increment_weight_total($term);
 443         my $operator = shift || 0;
 444         my $approval = (@_ ? shift : 0);        # default is unapproved
 445         my @exe_args = ($term);         # all 3 queries will use this argument
 446         if ($operator) {
 447                 $query = "INSERT INTO tags_approval (term,approved_by,approved,date_approved) VALUES (?,?,?,NOW())";
 448                 push @exe_args, $operator, $approval;
 449         } elsif ($approval) {
 450                 $query = "INSERT INTO tags_approval (term,approved,date_approved) VALUES (?,?,NOW())";
 451                 push @exe_args, $approval;
 452         } else {
 453                 $query = "INSERT INTO tags_approval (term,date_approved) VALUES (?,NOW())";
 454         }
 455         $debug and print STDERR "add_tag_approval query: $query\nadd_tag_approval args: (" . join(", ", @exe_args) . ")\n";
 456         $sth = C4::Context->dbh->prepare($query);
 457         $sth->execute(@exe_args);
 458         return $sth->rows;
 459 }
 460
 461 sub mod_tag_approval {
 462         my $operator = shift;
 463         defined $operator or return undef; # have to test defined to allow =0 (kohaadmin)
 464         my $term     = shift or return undef;
 465         my $approval = (scalar @_ ? shift : 1); # default is to approve
 466         my $query = "UPDATE tags_approval SET approved_by=?, approved=?, date_approved=NOW() WHERE term = ?";
 467         $debug and print STDERR "mod_tag_approval query: $query\nmod_tag_approval args: ($operator,$approval,$term)\n";
 468         my $sth = C4::Context->dbh->prepare($query);
 469         $sth->execute($operator,$approval,$term);
 470 }
 471
 472 sub add_tag_index {
 473         my $term         = shift or return undef;
 474         my $biblionumber = shift or return undef;
 475         my $query = "SELECT * FROM tags_index WHERE term = ? AND biblionumber = ?";
 476         my $sth = C4::Context->dbh->prepare($query);
 477         $sth->execute($term,$biblionumber);
 478         ($sth->rows) and return increment_weight($term,$biblionumber);
 479         $query = "INSERT INTO tags_index (term,biblionumber) VALUES (?,?)";
 480         $debug and print STDERR "add_tag_index query: $query\nadd_tag_index args: ($term,$biblionumber)\n";
 481         $sth = C4::Context->dbh->prepare($query);
 482         $sth->execute($term,$biblionumber);
 483         return $sth->rows;
 484 }
 485
 486 sub get_tag {           # by tag_id
 487         (@_) or return undef;
 488         my $sth = C4::Context->dbh->prepare("$select_all WHERE tag_id = ?");
 489         $sth->execute(shift);
 490         return $sth->fetchrow_hashref;
 491 }
 492
 493 sub rectify_weights {
 494         my $dbh = C4::Context->dbh;
 495         my $sth;
 496         my $query = "
 497         SELECT term,biblionumber,count(*) as count
 498         FROM   tags_all
 499         ";
 500         (@_) and $query .= " WHERE term =? ";
 501         $query .= " GROUP BY term,biblionumber ";
 502         $sth = $dbh->prepare($query);
 503         if (@_) {
 504                 $sth->execute(shift);
 505         } else {
 506                 $sth->execute();
 507         }
 508         my $results = $sth->fetchall_arrayref({}) or return undef;
 509         my %tally = ();
 510         foreach (@$results) {
 511                 _set_weight($_->{count},$_->{term},$_->{biblionumber});
 512                 $tally{$_->{term}} += $_->{count};
 513         }
 514         foreach (keys %tally) {
 515                 _set_weight_total($tally{$_},$_);
 516         }
 517         return ($results,\%tally);
 518 }
 519
 520 sub increment_weights {
 521         increment_weight(@_);
 522         increment_weight_total(shift);
 523 }
 524 sub decrement_weights {
 525         decrement_weight(@_);
 526         decrement_weight_total(shift);
 527 }
 528 sub increment_weight_total {
 529         _set_weight_total('weight_total+1',shift);
 530 }
 531 sub increment_weight {
 532         _set_weight('weight+1',shift,shift);
 533 }
 534 sub decrement_weight_total {
 535         _set_weight_total('weight_total-1',shift);
 536 }
 537 sub decrement_weight {
 538         _set_weight('weight-1',shift,shift);
 539 }
 540 sub _set_weight_total {
 541         my $sth = C4::Context->dbh->prepare("
 542         UPDATE tags_approval
 543         SET    weight_total=" . (shift) . "
 544         WHERE  term=?
 545         ");                                             # note: CANNOT use "?" for weight_total (see the args above).
 546         $sth->execute(shift);   # just the term
 547 }
 548 sub _set_weight {
 549         my $dbh = C4::Context->dbh;
 550         my $sth = $dbh->prepare("
 551         UPDATE tags_index
 552         SET    weight=" . (shift) . "
 553         WHERE  term=?
 554         AND    biblionumber=?
 555         ");
 556         $sth->execute(@_);
 557 }
 558
 559 sub add_tag {   # biblionumber,term,[borrowernumber,approvernumber]
 560         my $biblionumber = shift or return undef;
 561         my $term         = shift or return undef;
 562         my $borrowernumber = (@_) ? shift : 0;          # the user, default to kohaadmin
 563         $term =~ s/^\s+//;
 564         $term =~ s/\s+$//;
 565         ($term) or return undef;        # must be more than whitespace
 566         my $rows = get_tag_rows({biblionumber=>$biblionumber, borrowernumber=>$borrowernumber, term=>$term, limit=>1});
 567         my $query = "INSERT INTO tags_all
 568         (borrowernumber,biblionumber,term,date_created)
 569         VALUES (?,?,?,NOW())";
 570         $debug and print STDERR "add_tag query: $query\n",
 571                                                         "add_tag query args: ($borrowernumber,$biblionumber,$term)\n";
 572         if (scalar @$rows) {
 573                 $debug and carp "Duplicate tag detected.  Tag not added.";
 574                 return undef;
 575         }
 576         # add to tags_all regardless of approaval
 577         my $sth = C4::Context->dbh->prepare($query);
 578         $sth->execute($borrowernumber,$biblionumber,$term);
 579
 580         # then
 581         if (scalar @_) {        # if arg remains, it is the borrowernumber of the approver: tag is pre-approved.
 582                 my $approver = shift;
 583                 $debug and print STDERR "term '$term' pre-approved by borrower #$approver\n";
 584                 add_tag_approval($term,$approver,1);
 585                 add_tag_index($term,$biblionumber,$approver);
 586         } elsif (is_approved($term) >= 1) {
 587                 $debug and print STDERR "term '$term' approved by whitelist\n";
 588                 add_tag_approval($term,0,1);
 589                 add_tag_index($term,$biblionumber,1);
 590         } else {
 591                 $debug and print STDERR "term '$term' NOT approved (yet)\n";
 592                 add_tag_approval($term);
 593                 add_tag_index($term,$biblionumber);
 594         }
 595 }
 596
 597 1;
 598 __END__
 599
 600 =head1 C4::Tags.pm - Support for user tagging of biblios.
 601
 602 More verose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
 603
 604 =head2 add_tag(biblionumber,term[,borrowernumber])
 605
 606 =head3 TO DO: Add real perldoc
 607
 608 =cut
 609
 610 =head2 External Dictionary (Ispell) [Recommended]
 611
 612 An external dictionary can be used as a means of "pre-populating" and tracking
 613 allowed terms based on the widely available Ispell dictionary.  This can be the system
 614 dictionary or a personal version, but in order to support whitelisting, it must be
 615 editable to the process running Koha.
 616
 617 To enable, enter the absolute path to the ispell dictionary in the system
 618 preference "TagsExternalDictionary".
 619
 620 Using external Ispell is recommended for both ease of use and performance.  Note that any
 621 language version of Ispell can be installed.  It is also possible to modify the dictionary
 622 at the command line to affect the desired content.
 623
 624 WARNING: The default Ispell dictionary includes (properly spelled) obscenities!  Users
 625 should build their own wordlist and recompile Ispell based on it.  See man ispell for
 626 instructions.
 627
 628 =head2 Table Structure
 629
 630 The tables used by tags are:
 631         tags_all
 632         tags_index
 633         tags_approval
 634         tags_blacklist
 635
 636 Your first thought may be that this looks a little complicated.  It is, but only because
 637 it has to be.  I'll try to explain.
 638
 639 tags_all - This table would be all we really need if we didn't care about moderation or
 640 performance or tags disappearing when borrowers are removed.  Too bad, we do.  Otherwise
 641 though, it contains all the relevant info about a given tag:
 642         tag_id         - unique id number for it
 643         borrowernumber - user that entered it
 644         biblionumber   - book record it is attached to
 645         term           - tag "term" itself
 646         language       - perhaps used later to influence weighting
 647         date_created   - date and time it was created
 648
 649 tags_approval - Since we need to provide moderation, this table is used to track it.  If no
 650 external dictionary is used, this table is the sole reference for approval and rejection.
 651 With an external dictionary, it tracks pending terms and past whitelist/blacklist actions.
 652 This could be called an "approved terms" table.  See above regarding the External Dictionary.
 653         term           - tag "term" itself
 654         approved       - Negative, 0 or positive if tag is rejected, pending or approved.
 655         date_approved  - date of last action
 656         approved_by    - staffer performing the last action
 657         weight_total   - total occurance of term in any biblio by any users
 658
 659 tags_index - This table is for performance, because by far the most common operation will
 660 be fetching tags for a list of search results.  We will have a set of biblios, and we will
 661 want ONLY their approved tags and overall weighting.  While we could implement a query that
 662 would traverse tags_all filtered against tags_approval, the performance implications of
 663 trying to calculate that and the "weight" (number of times a tag appears) on the fly are drastic.
 664         term           - approved term as it appears in tags_approval
 665         biblionumber   - book record it is attached to
 666         weight         - number of times tag applied by any user
 667
 668 tags_blacklist - A set of regular expression filters.  Unsurprisingly, these should be perl-
 669 compatible (PCRE) for your version of perl.  Since this is a blacklist, a term will be
 670 blocked if it matches any of the given patterns.  WARNING: do not add blacklist regexps
 671 if you do not understand their operation and interaction.  It is quite easy to define too
 672 simple or too complex a regexp and effectively block all terms.  The blacklist operation is
 673 fairly resource intensive, since every line of tags_blacklist will need to be read and compared.
 674 It is recommended that tags_blacklist be used minimally, and only by an administrator with an
 675 understanding of regular expression syntax and performance.
 676
 677 So the best way to think about the different tables is that they are each tailored to a certain
 678 use.  Note that tags_approval and tags_index do not rely on the user's borrower mapping, so
 679 the tag population can continue to grow even if a user (along with their corresponding
 680 rows in tags_all) is removed.
 681
 682 =head2 Tricks
 683
 684 If you want to auto-populate some tags for debugging, do something like this:
 685
 686 mysql> select biblionumber from biblio where title LIKE "%Health%";
 687 +--------------+
 688 | biblionumber |
 689 +--------------+
 690 |           18 |
 691 |           22 |
 692 |           24 |
 693 |           30 |
 694 |           44 |
 695 |           45 |
 696 |           46 |
 697 |           49 |
 698 |          111 |
 699 |          113 |
 700 |          128 |
 701 |          146 |
 702 |          155 |
 703 |          518 |
 704 |          522 |
 705 |          524 |
 706 |          530 |
 707 |          544 |
 708 |          545 |
 709 |          546 |
 710 |          549 |
 711 |          611 |
 712 |          613 |
 713 |          628 |
 714 |          646 |
 715 |          655 |
 716 +--------------+
 717 26 rows in set (0.00 sec)
 718
 719 Then, take those numbers and type/pipe them into this perl command line:
 720 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",});'
 721
 722 Note, the borrowernumber in this example is 51.  Use your own or any arbitrary valid borrowernumber.
 723
 724 =cut
 725