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