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