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         $debug and warn "add_tag_approval(" . join(", ",map {defined($_) ? $_ : 'UNDEF'} @_) . ")";
 413         my $term = shift or return undef;
 414         my $query = "SELECT * FROM tags_approval WHERE term = ?";
 415         my $sth = C4::Context->dbh->prepare($query);
 416         $sth->execute($term);
 417         ($sth->rows) and return increment_weight_total($term);
 418         my $operator = shift || 0;
 419         my $approval = (@_ ? shift : 0);        # default is unapproved
 420         my @exe_args = ($term);         # all 3 queries will use this argument
 421         if ($operator) {
 422                 $query = "INSERT INTO tags_approval (term,approved_by,approved,date_approved) VALUES (?,?,?,NOW())";
 423                 push @exe_args, $operator, $approval;
 424         } elsif ($approval) {
 425                 $query = "INSERT INTO tags_approval (term,approved,date_approved) VALUES (?,?,NOW())";
 426                 push @exe_args, $approval;
 427         } else {
 428                 $query = "INSERT INTO tags_approval (term,date_approved) VALUES (?,NOW())";
 429         }
 430         $debug and print STDERR "add_tag_approval query: $query\nadd_tag_approval args: (" . join(", ", @exe_args) . ")\n";
 431         $sth = C4::Context->dbh->prepare($query);
 432         $sth->execute(@exe_args);
 433         return $sth->rows;
 434 }
 435
 436 sub mod_tag_approval ($$$) {
 437         my $operator = shift;
 438         defined $operator or return undef; # have to test defined to allow =0 (kohaadmin)
 439         my $term     = shift or return undef;
 440         my $approval = (scalar @_ ? shift : 1); # default is to approve
 441         my $query = "UPDATE tags_approval SET approved_by=?, approved=?, date_approved=NOW() WHERE term = ?";
 442         $debug and print STDERR "mod_tag_approval query: $query\nmod_tag_approval args: ($operator,$approval,$term)\n";
 443         my $sth = C4::Context->dbh->prepare($query);
 444         $sth->execute($operator,$approval,$term);
 445 }
 446
 447 sub add_tag_index ($$;$) {
 448         my $term         = shift or return undef;
 449         my $biblionumber = shift or return undef;
 450         my $query = "SELECT * FROM tags_index WHERE term = ? AND biblionumber = ?";
 451         my $sth = C4::Context->dbh->prepare($query);
 452         $sth->execute($term,$biblionumber);
 453         ($sth->rows) and return increment_weight($term,$biblionumber);
 454         $query = "INSERT INTO tags_index (term,biblionumber) VALUES (?,?)";
 455         $debug and print STDERR "add_tag_index query: $query\nadd_tag_index args: ($term,$biblionumber)\n";
 456         $sth = C4::Context->dbh->prepare($query);
 457         $sth->execute($term,$biblionumber);
 458         return $sth->rows;
 459 }
 460
 461 sub get_tag ($) {               # by tag_id
 462         (@_) or return undef;
 463         my $sth = C4::Context->dbh->prepare("$select_all WHERE tag_id = ?");
 464         $sth->execute(shift);
 465         return $sth->fetchrow_hashref;
 466 }
 467
 468 sub rectify_weights (;$) {
 469         my $dbh = C4::Context->dbh;
 470         my $sth;
 471         my $query = "
 472         SELECT term,biblionumber,count(*) as count
 473         FROM   tags_all
 474         ";
 475         (@_) and $query .= " WHERE term =? ";
 476         $query .= " GROUP BY term,biblionumber ";
 477         $sth = $dbh->prepare($query);
 478         if (@_) {
 479                 $sth->execute(shift);
 480         } else {
 481                 $sth->execute();
 482         }
 483         my $results = $sth->fetchall_arrayref({}) or return undef;
 484         my %tally = ();
 485         foreach (@$results) {
 486                 _set_weight($_->{count},$_->{term},$_->{biblionumber});
 487                 $tally{$_->{term}} += $_->{count};
 488         }
 489         foreach (keys %tally) {
 490                 _set_weight_total($tally{$_},$_);
 491         }
 492         return ($results,\%tally);
 493 }
 494
 495 sub increment_weights ($$) {
 496         increment_weight(@_);
 497         increment_weight_total(shift);
 498 }
 499 sub decrement_weights ($$) {
 500         decrement_weight(@_);
 501         decrement_weight_total(shift);
 502 }
 503 sub increment_weight_total ($) {
 504         _set_weight_total('weight_total+1',shift);
 505 }
 506 sub increment_weight ($$) {
 507         _set_weight('weight+1',shift,shift);
 508 }
 509 sub decrement_weight_total ($) {
 510         _set_weight_total('weight_total-1',shift);
 511 }
 512 sub decrement_weight ($$) {
 513         _set_weight('weight-1',shift,shift);
 514 }
 515 sub _set_weight_total ($$) {
 516         my $sth = C4::Context->dbh->prepare("
 517         UPDATE tags_approval
 518         SET    weight_total=" . (shift) . "
 519         WHERE  term=?
 520         ");                                             # note: CANNOT use "?" for weight_total (see the args above).
 521         $sth->execute(shift);   # just the term
 522 }
 523 sub _set_weight ($$$) {
 524         my $dbh = C4::Context->dbh;
 525         my $sth = $dbh->prepare("
 526         UPDATE tags_index
 527         SET    weight=" . (shift) . "
 528         WHERE  term=?
 529         AND    biblionumber=?
 530         ");
 531         $sth->execute(@_);
 532 }
 533
 534 sub add_tag ($$;$$) {   # biblionumber,term,[borrowernumber,approvernumber]
 535         my $biblionumber = shift or return undef;
 536         my $term         = shift or return undef;
 537         my $borrowernumber = (@_) ? shift : 0;          # the user, default to kohaadmin
 538         $term =~ s/^\s+//;
 539         $term =~ s/\s+$//;
 540         ($term) or return undef;        # must be more than whitespace
 541         my $rows = get_tag_rows({biblionumber=>$biblionumber, borrowernumber=>$borrowernumber, term=>$term, limit=>1});
 542         my $query = "INSERT INTO tags_all
 543         (borrowernumber,biblionumber,term,date_created)
 544         VALUES (?,?,?,NOW())";
 545         $debug and print STDERR "add_tag query: $query\n",
 546                                                         "add_tag query args: ($borrowernumber,$biblionumber,$term)\n";
 547         if (scalar @$rows) {
 548                 $debug and carp "Duplicate tag detected.  Tag not added.";
 549                 return undef;
 550         }
 551         # add to tags_all regardless of approaval
 552         my $sth = C4::Context->dbh->prepare($query);
 553         $sth->execute($borrowernumber,$biblionumber,$term);
 554
 555         # then
 556         if (scalar @_) {        # if arg remains, it is the borrowernumber of the approver: tag is pre-approved.
 557                 my $approver = shift;
 558                 $debug and print STDERR "term '$term' pre-approved by borrower #$approver\n";
 559                 add_tag_approval($term,$approver,1);
 560                 add_tag_index($term,$biblionumber,$approver);
 561         } elsif (is_approved($term) >= 1) {
 562                 $debug and print STDERR "term '$term' approved by whitelist\n";
 563                 add_tag_approval($term,0,1);
 564                 add_tag_index($term,$biblionumber,1);
 565         } else {
 566                 $debug and print STDERR "term '$term' NOT approved (yet)\n";
 567                 add_tag_approval($term);
 568                 add_tag_index($term,$biblionumber);
 569         }
 570 }
 571
 572 1;
 573 __END__
 574
 575 =head1 C4::Tags.pm - Support for user tagging of biblios.
 576
 577 More verose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
 578
 579 =head2 add_tag(biblionumber,term[,borrowernumber])
 580
 581 =head3 TO DO: Add real perldoc
 582
 583 =head2 External Dictionary (Ispell) [Recommended]
 584
 585 An external dictionary can be used as a means of "pre-populating" and tracking
 586 allowed terms based on the widely available Ispell dictionary.  This can be the system
 587 dictionary or a personal version, but in order to support whitelisting, it must be
 588 editable to the process running Koha.
 589
 590 To enable, enter the absolute path to the ispell dictionary in the system
 591 preference "TagsExternalDictionary".
 592
 593 Using external Ispell is recommended for both ease of use and performance.  Note that any
 594 language version of Ispell can be installed.  It is also possible to modify the dictionary
 595 at the command line to affect the desired content.
 596
 597 WARNING: The default Ispell dictionary includes (properly spelled) obscenities!  Users
 598 should build their own wordlist and recompile Ispell based on it.  See man ispell for
 599 instructions.
 600
 601 =head2 Table Structure
 602
 603 The tables used by tags are:
 604         tags_all
 605         tags_index
 606         tags_approval
 607         tags_blacklist
 608
 609 Your first thought may be that this looks a little complicated.  It is, but only because
 610 it has to be.  I'll try to explain.
 611
 612 tags_all - This table would be all we really need if we didn't care about moderation or
 613 performance or tags disappearing when borrowers are removed.  Too bad, we do.  Otherwise
 614 though, it contains all the relevant info about a given tag:
 615         tag_id         - unique id number for it
 616         borrowernumber - user that entered it
 617         biblionumber   - book record it is attached to
 618         term           - tag "term" itself
 619         language       - perhaps used later to influence weighting
 620         date_created   - date and time it was created
 621
 622 tags_approval - Since we need to provide moderation, this table is used to track it.  If no
 623 external dictionary is used, this table is the sole reference for approval and rejection.
 624 With an external dictionary, it tracks pending terms and past whitelist/blacklist actions.
 625 This could be called an "approved terms" table.  See above regarding the External Dictionary.
 626         term           - tag "term" itself
 627         approved       - Negative, 0 or positive if tag is rejected, pending or approved.
 628         date_approved  - date of last action
 629         approved_by    - staffer performing the last action
 630         weight_total   - total occurance of term in any biblio by any users
 631
 632 tags_index - This table is for performance, because by far the most common operation will
 633 be fetching tags for a list of search results.  We will have a set of biblios, and we will
 634 want ONLY their approved tags and overall weighting.  While we could implement a query that
 635 would traverse tags_all filtered against tags_approval, the performance implications of
 636 trying to calculate that and the "weight" (number of times a tag appears) on the fly are drastic.
 637         term           - approved term as it appears in tags_approval
 638         biblionumber   - book record it is attached to
 639         weight         - number of times tag applied by any user
 640
 641 tags_blacklist - A set of regular expression filters.  Unsurprisingly, these should be perl-
 642 compatible (PCRE) for your version of perl.  Since this is a blacklist, a term will be
 643 blocked if it matches any of the given patterns.  WARNING: do not add blacklist regexps
 644 if you do not understand their operation and interaction.  It is quite easy to define too
 645 simple or too complex a regexp and effectively block all terms.  The blacklist operation is
 646 fairly resource intensive, since every line of tags_blacklist will need to be read and compared.
 647 It is recommended that tags_blacklist be used minimally, and only by an administrator with an
 648 understanding of regular expression syntax and performance.
 649
 650 So the best way to think about the different tables is that they are each tailored to a certain
 651 use.  Note that tags_approval and tags_index do not rely on the user's borrower mapping, so
 652 the tag population can continue to grow even if a user (along with their corresponding
 653 rows in tags_all) is removed.
 654
 655 =head2 Tricks
 656
 657 If you want to auto-populate some tags for debugging, do something like this:
 658
 659 mysql> select biblionumber from biblio where title LIKE "%Health%";
 660 +--------------+
 661 | biblionumber |
 662 +--------------+
 663 |           18 |
 664 |           22 |
 665 |           24 |
 666 |           30 |
 667 |           44 |
 668 |           45 |
 669 |           46 |
 670 |           49 |
 671 |          111 |
 672 |          113 |
 673 |          128 |
 674 |          146 |
 675 |          155 |
 676 |          518 |
 677 |          522 |
 678 |          524 |
 679 |          530 |
 680 |          544 |
 681 |          545 |
 682 |          546 |
 683 |          549 |
 684 |          611 |
 685 |          613 |
 686 |          628 |
 687 |          646 |
 688 |          655 |
 689 +--------------+
 690 26 rows in set (0.00 sec)
 691
 692 Then, take those numbers and type/pipe them into this perl command line:
 693 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",});'
 694
 695 Note, the borrowernumber in this example is 51.  Use your own or any arbitrary valid borrowernumber.
 696
 697 =cut
 698