C4/Tags.pm

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