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