src/newslash_web/lib/Newslash/Model/Tags.pm

   1 package Newslash::Model::Tags;
   2 #use Newslash::Model::Base -base;
   3 use base Newslash::Model::LegacyDB;
   4
   5
   6 sub get_topics {
   7     my ($self, ) = @_;
   8     my $sql = <<"EOSQL";
   9 SELECT * FROM topics;
  10 EOSQL
  11     my $dbh = $self->connect_db;
  12     my $sth = $dbh->prepare($sql);
  13     $sth->execute;
  14     my $rs = $sth->fetchall_arrayref({});
  15     if (!$rs) {
  16         $self->disconnect_db;
  17         return;
  18     }
  19     $self->disconnect_db;
  20     return $rs;
  21 }
  22
  23 sub set_tag {
  24     my $self = shift;
  25     return if $self->check_readonly;
  26     my $params = {@_};
  27
  28     my $globj_id = $params->{globj_id};
  29     my $uid = $params->{uid} || 1;
  30     my $name = $params->{name};
  31     my $private = $params->{private} ? "yes" : "no";
  32     my $active = defined $params->{active} ? $params->{active} : 1;
  33     my $tagname_id = $params->{tagname_id};
  34
  35     if (!$globj_id) {
  36         $self->set_error("no globj_id", 1);
  37         return;
  38     }
  39
  40     if ($name) {
  41         my $tagname = $self->select_tagnames(tagname => $name);
  42         if ($tagname) {
  43             $tagname_id = $tagname->{tagnameid};
  44         }
  45         else {
  46             $tagname_id = $self->create(tagname => $name);
  47         }
  48     }
  49
  50     if (!$tagname_id) {
  51         return;
  52     }
  53
  54     my $inactivated = $active ? "NULL" : "NOW()";
  55     my $sql = <<"EOSQL";
  56 INSERT IGNORE INTO tags
  57     (tagnameid, globjid, uid, created_at, inactivated, private, is_active)
  58   VALUES
  59     (?,         ?,       ?,   NOW(),     $inactivated, ?,       ?)
  60 EOSQL
  61
  62     my $dbh = $params->{dbh} || $self->connect_db;
  63     my $rs = $dbh->do($sql, undef, $tagname_id, $globj_id, $uid, $private, $active);
  64     if (!$rs) {
  65         $self->set_errorno($dbh->{mysql_errorno});
  66         $self->disconnect_db if !$params->{dbh};
  67         return;
  68     }
  69     my $id = $dbh->last_insert_id(undef, undef, undef, undef);
  70     $self->disconnect_db if !$params->{dbh};
  71     return $id;
  72 }
  73
  74 sub create {
  75     my $self = shift;
  76     my $params = {@_};
  77
  78     if ($params->{tagname}) {
  79         my $sql = "INSERT INTO tagnames (tagname) VALUES (?)";
  80         my $dbh = $self->connect_db;
  81         my $rs = $dbh->do($sql, undef, $params->{tagname});
  82         if (!$rs) {
  83             $self->disconnect_db;
  84             return;
  85         }
  86         my $id = $dbh->last_insert_id(undef, undef, undef, undef);
  87         $self->disconnect_db;
  88         return $id;
  89     }
  90     return;
  91 }
  92
  93 sub select {
  94     my $self = shift;
  95     return $self->generic_select('tags',
  96                                  uniques => [qw(tagid)],
  97                                  keys => [qw(tagnameid globjid uid private is_active)],
  98                                  params => {@_});
  99 }
 100
 101 sub select_tagnames {
 102     my $self = shift;
 103     my $params = {@_};
 104
 105     if ($params->{tagname}) {
 106         my $sql = "SELECT * FROM tagnames WHERE tagname = ?";
 107         my $dbh = $self->connect_db;
 108         my $sth = $dbh->prepare($sql);
 109         $sth->execute($params->{tagname});
 110         my $rs = $sth->fetchall_arrayref({});
 111         $self->disconnect_db;
 112         if (@$rs) {
 113             return $rs->[0];
 114         }
 115         return;
 116     }
 117 }
 118
 119
 120 # =================== Legacy API ====================
 121
 122 {
 123 my $nodid = 0;
 124 my $nixid = 0;
 125 sub createTag {
 126         my($self, $hr, $options) = @_;
 127     return if $self->check_readonly;
 128
 129         my $tag = $self->_setuptag($hr);
 130         return 0 if !$tag;
 131
 132         # Anonymous users can now tag in limited circumstances where they're shown
 133         # a functional tag widget on previewed items, and on transferTags calls that
 134         # pass their tags along behind the scenes
 135
 136         # I'm not sure why a duplicate or opposite tag would ever be "OK"
 137         # in the tags table, but for now let's keep our options open in
 138         # case there's some reason we'd want "raw" tag inserting ability.
 139         # Maybe in the future we can eliminate these options.
 140 # dupes no longer allowed, unique key rejects them
 141 #       my $check_dupe = (!$options || !$options->{dupe_ok});
 142         my $check_opp = (!$options || !$options->{opposite_ok});
 143         my $check_aclog = (!$options || !$options->{no_adminlog_check});
 144         my $opp_tagnameids = [ ];
 145         if ($check_opp) {
 146                 $opp_tagnameids = $self->getOppositeTagnameids($tag->{tagnameid});
 147                 # getOppositeTagnameids demands a clid to identify the
 148                 # non-natural opposite of nod and nix.  To ensure those
 149                 # two are never allowed to exist at the same time,
 150                 # hardcode them as opposites here.
 151                 # XXX should fix this by rethinking what "opposite" means for "all clout types"
 152                 # XXX this closure will break for multiple Slash sites that have different tagnameids for nod/nix
 153                 my $constants = $self->getCurrentStatic();
 154                 $nodid ||= $self->getTagnameidFromNameIfExists($constants->{tags_upvote_tagname}   || 'nod');
 155                 $nixid ||= $self->getTagnameidFromNameIfExists($constants->{tags_downvote_tagname} || 'nix');
 156                 if ($tag->{tagnameid} == $nodid) {
 157                         push @$opp_tagnameids, $nixid unless grep { $_ == $nixid } @$opp_tagnameids;
 158                 } elsif ($tag->{tagnameid} == $nixid) {
 159                         push @$opp_tagnameids, $nodid unless grep { $_ == $nodid } @$opp_tagnameids;
 160                 }
 161         }
 162
 163         $self->sqlDo('SET AUTOCOMMIT=0');
 164
 165         #if (isAdmin($options->{uid} || getCurrentUser('uid'))) {
 166         if (0) {
 167                 my $domain_tag = $self->getCurrentStatic('domain_tag_name');
 168                 if ($hr->{name} ne $domain_tag) {
 169                         my $domain_tagnameid = $self->getTagnameidFromNameIfExists($domain_tag);
 170                         if ($domain_tagnameid && $tag->{tagnameid} != $domain_tagnameid) {
 171                                 my $count = $self->sqlCount('tags', "globjid = $tag->{globjid} AND tagnameid != $domain_tagnameid");
 172                                 # first tag?  give it extra emphasis.
 173                                 $hr->{emphasis} = 1 unless $count;
 174                         }
 175                 }
 176         }
 177
 178         my $rows = $self->sqlInsert('tags', $tag);
 179         my $tagid = $rows ? $self->getLastInsertId() : 0;
 180
 181 #       if ($rows && $check_dupe) {
 182 #               # Check to make sure this user hasn't already tagged
 183 #               # this object with this tagname.  We do this by, in
 184 #               # a transaction, doing the insert and checking to see
 185 #               # whether there are 1 or more rows in the table
 186 #               # preceding the one just inserted with matching the
 187 #               # criteria.  If so, the insert is rolled back and
 188 #               # 0 is returned.
 189 #               # Because of the uid_tagnameid_globjid_inactivated index,
 190 #               # this should, I believe, not even touch table data,
 191 #               # so it should be very fast.
 192 #               # XXX Might want to make it faster by doing this
 193 #               # select before the insert above, esp. with tagViewed().
 194 #               my $count = $self->sqlCount('tags',
 195 #                       "uid            = $tag->{uid}
 196 #                        AND globjid    = $tag->{globjid}
 197 #                        AND tagnameid  = $tag->{tagnameid}
 198 #                        AND is_active  = 1
 199 #                        AND tagid < $tagid");
 200 #                        #inactivated IS NULL
 201 #               if ($count == 0) {
 202 #                       # This is the only tag, it's allowed.
 203 #                       # Continue processing.
 204 #               } else {
 205 #                       # Duplicate tag, not allowed.
 206 #                       $self->sqlDo('ROLLBACK');
 207 #                       $rows = 0;
 208 #               }
 209 #       }
 210
 211         # If that has succeeded so far, then eliminate any opposites
 212         # of this tag which may have already been created.
 213         if ($rows && $check_opp && @$opp_tagnameids) {
 214                 for my $opp_tagnameid (@$opp_tagnameids) {
 215                         my $opp_tag = {
 216                                 uid =>          $tag->{uid},
 217                                 globjid =>      $tag->{globjid},
 218                                 tagnameid =>    $opp_tagnameid
 219                         };
 220                         my $count = $self->deactivateTag($opp_tag, { tagid_prior_to => $tagid });
 221                         $rows = 0 if $count > 1; # values > 1 indicate a logic error
 222                 }
 223         }
 224
 225         # If all that was successful, add a tag_clout param if
 226         # necessary.
 227         if ($rows) {
 228                 # Find any admin commands that set clout for this tagnameid.
 229                 # We look for this globjid specifically, because any
 230                 # commands for the tagnameid generally will already have
 231                 # a tag_clout in tagname_params.
 232                 my $admincmds_ar = $self->getTagnameAdmincmds(
 233                         $tag->{tagnameid}, $tag->{globjid});
 234                 for my $opp_tagnameid (@$opp_tagnameids) {
 235                         my $opp_ar = $self->getTagnameAdmincmds(
 236                                 $opp_tagnameid, $tag->{globjid});
 237                         push @$admincmds_ar, @$opp_ar;
 238                 }
 239                 # XXX Also, if the tag is on a project, check
 240                 # getTagnameSfnetadmincmds().
 241                 # Any negative admin command, to either this tagname or
 242                 # its opposite, means clout must be set to 0.
 243                 if (grep { $_->{cmdtype} =~ /^[_#]/ } @$admincmds_ar) {
 244                         my $count = $self->sqlInsert('tag_params', {
 245                                 tagid =>        $tagid,
 246                                 name =>         'tag_clout',
 247                                 value =>        0,
 248                         });
 249                         $rows = 0 if $count < 1;
 250                 }
 251         }
 252
 253         # If it was requested to add this tag with 'emphasis', do so.
 254         if ($hr->{emphasis}) {
 255                 my $count = $self->sqlInsert('tag_params', {
 256                         tagid =>        $tagid,
 257                         name =>         'emphasis',
 258                         value =>        1,
 259                 });
 260                 $rows = 0 if $count < 1;
 261         }
 262
 263         # If it passed all the tests, commit it.  Otherwise rollback.
 264         if ($rows) {
 265                 $self->sqlDo('COMMIT');
 266         } else {
 267                 $self->sqlDo('ROLLBACK');
 268         }
 269
 270         # Return AUTOCOMMIT to its original state in any case.
 271         $self->sqlDo('SET AUTOCOMMIT=1');
 272
 273         # Dynamic blocks and Tagger/Contradictor achievement.
 274         if ($rows) {
 275                 my $dynamic_blocks = $self->getObject('Slash::DynamicBlocks');
 276                 if ($dynamic_blocks) {
 277                         $dynamic_blocks->setUserBlock('tags', $tag->{uid});
 278                 }
 279
 280                 if ($hr->{table} && $hr->{table} eq 'stories') {
 281                         my $achievements = $self->getObject('Slash::Achievements');
 282                         if ($achievements) {
 283                                 $achievements->setUserAchievement('the_tagger', $tag->{uid}, { ignore_lookup => 1, exponent => 0 });
 284                                 my $tagname = $self->getTagnameDataFromId($tag->{tagnameid});
 285                                 if ($tagname->{tagname} =~ /^\!/) {
 286                                         $achievements->setUserAchievement('the_contradictor', $tag->{uid}, { ignore_lookup => 1, exponent => 0 });
 287                                 }
 288                         }
 289                 }
 290         }
 291
 292         return $rows ? $tagid : 0;
 293 }
 294 }
 295
 296 # This returns just the single tagname that is the opposite of
 297 # another tagname, formed by prepending a "!" or removing an
 298 # existing "!".  This is not guaranteed to be the only opposite
 299 # of the given tagname.
 300
 301 sub getBangOppositeTagname {
 302         my($self, $tagname) = @_;
 303         return substr($tagname, 0, 1) eq '!' ? substr($tagname, 1) : '!' . $tagname;
 304 }
 305
 306 sub getTagnameAdmincmds {
 307         my($self, $tagnameid, $globjid) = @_;
 308         return [ ] if !$tagnameid;
 309         my $where_clause = "tagnameid=$tagnameid";
 310         $where_clause .= " AND globjid=$globjid" if $globjid;
 311         return $self->sqlSelectAllHashrefArray(
 312                 "tagnameid, IF(globjid IS NULL, 'all', globjid) AS globjid,
 313                  cmdtype, created_at,
 314                  UNIX_TIMESTAMP(created_at) AS created_at_ut",
 315                 'tagcommand_adminlog',
 316                 $where_clause);
 317 }
 318
 319 sub getTagnameDataFromId {
 320         my($self, $id) = @_;
 321         my $hr = $self->getTagnameDataFromIds([ $id ]);
 322         return $hr->{$id};
 323 }
 324
 325 sub getTagnameDataFromIds {
 326         my($self, $id_ar) = @_;
 327         $id_ar ||= [ ];
 328         $id_ar = [ grep { $_ && /^\d+$/ } @$id_ar ];
 329         my $constants = $self->getCurrentStatic();
 330         my @remaining_ids = @$id_ar;
 331
 332         # # First, grab from local cache any ids it has.  We do cache locally
 333         # # (in addition to memcached) because some tagnames are very frequently
 334         # # accessed (e.g. nod, nix).
 335         # my $local_hr = { };
 336         # my $table_cache         = "_tagname_cache";
 337         # my $table_cache_time    = "_tagname_cache_time";
 338         # $self->_genericCacheRefresh('tagname', $constants->{tags_cache_expire});
 339         # if ($self->{$table_cache_time}) {
 340         #       for my $id (@$id_ar) {
 341         #               $local_hr->{$id} = $self->{$table_cache}{$id} if $self->{$table_cache}{$id};
 342         #       }
 343         # }
 344         # my @remaining_ids = grep { !$local_hr->{$_} } @$id_ar;
 345
 346         # # Next, check memcached.
 347
 348         # my $mcd_hr = { };
 349         # my $mcd = $self->getMCD();
 350         # my $mcdkey;
 351         # $mcdkey = "$self->{_mcd_keyprefix}:tagdata" if $mcd;
 352         # if ($mcd && @remaining_ids) {
 353         #       my $mcdkey_qr = qr/^\Q$mcdkey:\E(\d+)$/;
 354         #       my @keylist = ( map { "$mcdkey:$_" } @remaining_ids );
 355         #       my $mcdkey_hr = $mcd->get_multi(@keylist);
 356         #       for my $k (keys %$mcdkey_hr) {
 357         #               my($id) = $k =~ $mcdkey_qr;
 358         #               next unless $id;
 359         #               $mcd_hr->{$id} = $mcdkey_hr->{$k};
 360         #               # Locally store any hits found.
 361         #               $self->{$table_cache}{$id} = $mcd_hr->{$id};
 362         #       }
 363         # }
 364         # @remaining_ids = grep { !$mcd_hr->{$_} } @remaining_ids;
 365
 366         # Finally, check MySQL.
 367
 368         my $mysql_hr = { };
 369         my $splice_count = 2000;
 370         while (@remaining_ids) {
 371                 my @id_chunk = splice @remaining_ids, 0, $splice_count;
 372                 my $id_in_str = join(',', @id_chunk);
 373                 my $ar_ar = $self->sqlSelectAll('tagnameid, tagname',
 374                         'tagnames',
 375                         "tagnameid IN ($id_in_str)");
 376                 for my $ar (@$ar_ar) {
 377                         $mysql_hr->{ $ar->[0] }{tagname} = $ar->[1];
 378                 }
 379                 $ar_ar = $self->sqlSelectAll('tagnameid, name, value',
 380                         'tagname_params',
 381                         "tagnameid IN ($id_in_str)");
 382                 for my $ar (@$ar_ar) {
 383                         next if $ar->[1] =~ /^tagname(id)?$/; # don't get to override these
 384                         $mysql_hr->{ $ar->[0] }{ $ar->[1] } = $ar->[2];
 385                 }
 386         }
 387         # # Locally store this data.
 388         # for my $id (keys %$mysql_hr) {
 389         #       $self->{$table_cache}{$id} = $mysql_hr->{$id};
 390         # }
 391         # $self->{$table_cache_time} ||= time;
 392         # # Store this data in memcached.
 393         # if ($mcd) {
 394         #       for my $id (keys %$mysql_hr) {
 395         #               $mcd->set("$mcdkey:$id", $mysql_hr->{$id}, $constants->{memcached_exptime_tags});
 396         #       }
 397         # }
 398
 399         #return {(
 400         #       %$local_hr, %$mcd_hr, %$mysql_hr
 401         #)};
 402         return {(
 403                 {}, {}, %$mysql_hr
 404         )};
 405 }
 406
 407 # This returns an arrayref of tagnameids that are all the
 408 # opposite of a given tagname or tagnameid (either works as
 409 # input).  Or, an arrayref of tagname/tagnameids can be given
 410 # as input and the returned arrayref will be tagnameids that
 411 # are all the opposites of at least one of the inputs.
 412
 413 sub getOppositeTagnameids {
 414         my($self, $data, $create, $clid) = @_;
 415         $clid ||= 0;
 416         $data = [ $data ] if !ref($data);
 417
 418         my %tagnameid = ( );
 419         for my $d (@$data) {
 420                 next unless $d;
 421                 if ($d =~ /^\d+$/) {
 422                         $tagnameid{$d} = 1;
 423                 } else {
 424                         my $id = $self->getTagnameidFromNameIfExists($d);
 425                         $tagnameid{$id} = 1 if $id;
 426                 }
 427         }
 428
 429         my $orig_to_opp_hr = $self->consolidateTagnameidValues(\%tagnameid, $clid,
 430                 { invert => 1, posonly => 1 });
 431
 432         my @opp_tagnameids = sort { $a <=> $b } keys %$orig_to_opp_hr;
 433         return \@opp_tagnameids;
 434 }
 435
 436 # This takes a hashref with keys tagnameids and numeric values, a
 437 # similarity value of either 1 or -1, and optionally a clout type id.
 438 # It returns a hashref with keys the consolidated-preferred of the
 439 # original, and values the sum of the source original values.
 440 # If $abs is set, the values are the sum of the absolute values of
 441 # the source original values.
 442 #
 443 # For example, for a clout type with synonyms:
 444 #       obvious <- duh, !insightful
 445 #       insightful <- !obvious, !duh
 446 #       cool <- neat
 447 # and a source hashref:
 448 #       obvious => 1.2, duh => 3.4, !duh => 5.6, foo => 7.8, neat => 9.1
 449 # would return, for similarity = 1, the consolidated-preferred:
 450 # XXX this is wrong, includes positives only not negatives
 451 #       insightful => 1.8 (i.e. 5.6-(1.2+3.4)), foo => 7.8, cool => 9.1
 452 # For similarity = -1 would return the consolidated-opposite:
 453 #       obvious => -1.8, !foo => -7.8, !cool => -9.1
 454 # For similarity = 1 and abs set, would return:
 455 #       insightful => 10.3 (i.e. 5.6+1.2+3.4), foo => 7.8, cool => 9.1
 456 # For similarity = -1 and abs set, would return:
 457 #       obvious => 10.3, !foo => 7.8, !cool => 9.1
 458 #
 459 # I haven't spelled out anywhere a transitive or reflexive law of
 460 # tagnames, but if I did, corollaries of those laws would be
 461 # A) cTV(cTV(X, -1), -1) = cTV(X,  1)
 462 # B) cTV(cTV(X,  1), -1) = cTV(X, -1) = cTV(cTV(X, -1),  1)
 463 # C) cTV(cTV(X,  1),  1) = cTV(X,  1)
 464
 465 # abs: when calculating values for antonyms, add instead of subtracting
 466 # invert: subtract for synonyms and add for antonyms
 467 #       (has no effect if abs is also specified)
 468 # synonly: only calculate values for synonyms, ignore antonyms
 469 # posonly: when all values are calculated, throw out all values <= 0
 470 #       (has no effect if abs is also specified)
 471 #       (has no effect if synonly is also specified and all input values are > 0)
 472
 473 sub consolidateTagnameidValues {
 474         my($self, $tagnameid_hr, $clid, $options) = @_;
 475         $clid ||= 0;
 476         my $abs = $options->{abs} || 0;
 477         my $invert = $options->{invert} || 0;
 478         my $synonly = $options->{synonly} || 0;
 479         my $posonly = $options->{posonly} || 0;
 480
 481         # Two ways to have an opposite of a tagname.  The first only
 482         # applied for a given clout type:  have an entry in the
 483         # tagnames_similarity_rendered table.  If no clout ID is
 484         # specified, this way does not apply.  We try this first, and
 485         # -- for tagnames that do have such entries -- we know we
 486         # don't need to try the second way because the first includes
 487         # the second.
 488
 489         # The second way is a "bang" opposite:  prepare a "!" or
 490         # remove an existing prepended "!".  This is slower than the
 491         # first way because we have to convert IDs to names and back,
 492         # but it's the only way that applies if no clout ID is
 493         # specified.
 494
 495         # First we consolidate using the rendered similarity table.
 496
 497         my @tagnameids = keys %$tagnameid_hr;
 498
 499         my $origid_sim_pref = { };
 500         if ($clid) {
 501                 my $src_tnids_str = join(',', @tagnameids);
 502                 my $where_clause =
 503                 my $origid_sim_pref_ar = $self->sqlSelectAllHashrefArray(
 504                         'syn_tnid, similarity, pref_tnid',
 505                         'tagnames_similarity_rendered',
 506                         "clid=$clid AND syn_tnid IN ($src_tnids_str)");
 507                 for my $hr (@$origid_sim_pref_ar) {
 508                         my $syn_tnid = $hr->{syn_tnid};
 509                         my $similarity = $hr->{similarity};
 510                         my $pref_tnid = $hr->{pref_tnid};
 511                         $origid_sim_pref->{$syn_tnid}{$similarity} = $pref_tnid;
 512                 }
 513                 @tagnameids = grep { !exists $origid_sim_pref->{$_} } @tagnameids;
 514         }
 515
 516         # Second, we consolidate using bang-type opposites.
 517
 518         my $tndata_hr = $self->getTagnameDataFromIds([ @tagnameids ]);
 519         for my $id (@tagnameids) {
 520                 next if $origid_sim_pref->{$id}{1};
 521                 $origid_sim_pref->{$id}{1} = $id;
 522                 next if $synonly;
 523                 my $tagname = $tndata_hr->{$id}{tagname};
 524                 my $oppname = $self->getBangOppositeTagname($tagname);
 525                 my $oppid = $self->getTagnameidCreate($oppname);
 526                 $origid_sim_pref->{$id}{-1} = $oppid;
 527                 $origid_sim_pref->{$oppid}{-1} = $id;
 528                 $origid_sim_pref->{$oppid}{1} = $oppid;
 529         }
 530
 531         # Add up the consolidated values.
 532
 533         my $retval = { };
 534         for my $id (keys %$tagnameid_hr) {
 535                 my $pref = $origid_sim_pref->{$id}{1};
 536                 my $opp  = $origid_sim_pref->{$id}{-1};
 537                 $retval->{$pref} ||= 0;
 538                 $retval->{$pref}  += $tagnameid_hr->{$id};
 539                 next if $synonly;
 540                 $retval->{$opp}  ||= 0;
 541                 $retval->{$opp}   += $tagnameid_hr->{$id} * ($abs ? 1 : -1);
 542         }
 543         if ($invert) {
 544                 for my $id (keys %$retval) {
 545                         $retval->{$id} = -$retval->{$id};
 546                 }
 547         }
 548         if ($posonly) {
 549                 my @nonpos = grep { $retval->{$_} <= 0 } keys %$retval;
 550                 delete @{$retval}{@nonpos};
 551         }
 552         $retval;
 553 }
 554
 555
 556 my $tags_tagname_regex = "^!?[a-z一-龠ぁ-んァ-ヴー][a-z0-9一-龠ぁ-んァ-ヴー/・]{0,63}\$";
 557
 558 sub tagnameSyntaxOK {
 559     my($self, $tagname) = @_;
 560     return 0 unless defined($tagname) && length($tagname) > 0;
 561     #my $constants = getCurrentStatic();
 562     #my $regex = $constants->{tags_tagname_regex};
 563     my $regex = $tags_tagname_regex;
 564     return($tagname =~ /$regex/);
 565 }
 566
 567 sub getTagnameidFromNameIfExists {
 568     my($self, $name) = @_;
 569     #my $constants = getCurrentStatic();
 570     return 0 if !$self->tagnameSyntaxOK($name);
 571
 572     #my $table_cache         = "_tagid_cache";
 573     #my $table_cache_time    = "_tagid_cache_time";
 574     #$self->_genericCacheRefresh('tagid', $constants->{tags_cache_expire});
 575     #if ($self->{$table_cache_time} && $self->{$table_cache}{$name}) {
 576     #    return $self->{$table_cache}{$name};
 577     #}
 578
 579     #my $mcd = $self->getMCD();
 580     #my $mcdkey = "$self->{_mcd_keyprefix}:tagid:" if $mcd;
 581     #if ($mcd) {
 582     #    my $id = $mcd->get("$mcdkey$name");
 583     #    if ($id) {
 584     #        if ($self->{$table_cache_time}) {
 585     #            $self->{$table_cache}{$name} = $id;
 586     #        }
 587     #        return $id;
 588     #    }
 589     #}
 590
 591     my $db = $self->new_instance_of('Newslash::Model::LegacyDB');
 592     my $name_q = $db->sqlQuote($name);
 593     my $id = $db->sqlSelect('tagnameid', 'tagnames',
 594                               "tagname=$name_q");
 595     return 0 if !$id;
 596     #if ($self->{$table_cache_time}) {
 597     #    $self->{$table_cache}{$name} = $id;
 598     #}
 599     #$mcd->set("$mcdkey$name", $id, $constants->{memcached_exptime_tags}) if $mcd;
 600     return $id;
 601 }
 602
 603 sub createTagname {
 604     my($self, $name) = @_;
 605     return if $self->check_readonly;
 606     return 0 if !$self->tagnameSyntaxOK($name);
 607
 608     my $db = $self->new_instance_of('Newslash::Model::LegacyDB');
 609     my $rows = $db->sqlInsert('tagnames', {
 610                                            tagnameid =>    undef,
 611                                            tagname =>      $name,
 612                                           }, { ignore => 1 });
 613     if (!$rows) {
 614         # Insert failed, presumably because this tag already
 615         # exists.  The caller should have checked for this
 616         # before attempting to create the tag, but maybe the
 617         # reader that was checked didn't have this tag
 618         # replicated yet.  Pull the information directly
 619         # from this writer DB.
 620         return $self->getTagnameidFromNameIfExists($name);
 621     }
 622     # The insert succeeded.  Return the ID that was just added.
 623     return $self->getLastInsertId();
 624 }
 625
 626 sub getTagnameidCreate {
 627     my($self, $name) = @_;
 628     return 0 if !$self->tagnameSyntaxOK($name);
 629     #my $reader = getObject('Slash::Tags', { db_type => 'reader' });
 630     #my $id = $reader->getTagnameidFromNameIfExists($name);
 631     my $id = $self->getTagnameidFromNameIfExists($name);
 632     return $id if $id;
 633     return $self->createTagname($name);
 634 }
 635
 636 sub _setuptag {
 637     my ($self, $hr, $options) = @_;
 638     my $tag = { -created_at => 'NOW()' };
 639
 640     #$tag->{uid} = $hr->{uid} || getCurrentUser('uid');
 641     $tag->{uid} = $hr->{uid};
 642
 643     if ($hr->{tagnameid}) {
 644         $tag->{tagnameid} = $hr->{tagnameid};
 645     } else {
 646         # Need to determine tagnameid from name.  We
 647         # create the new tag name if necessary.
 648         $tag->{tagnameid} = $self->getTagnameidCreate($hr->{name});
 649     }
 650     return 0 if !$options->{tagname_not_required} && !$tag->{tagnameid};
 651
 652     if ($hr->{globjid}) {
 653         $tag->{globjid} = $hr->{globjid};
 654     } else {
 655         my $globjs = $self->new_instance_of('Globjids');
 656         $tag->{globjid} = $globjs->getGlobjidCreate($hr->{table}, $hr->{id});
 657     }
 658     return 0 if !$tag->{globjid};
 659
 660     $tag->{private} = $hr->{private} ? 'yes' : 'no';
 661
 662     return $tag;
 663 }
 664
 665 sub logDeactivatedTags {
 666     my($self, $deactivated_tagids) = @_;
 667     return if $self->check_readonly;
 668     return 0 if !$deactivated_tagids;
 669     my $logged = 0;
 670     my $db = $self->new_instance_of('Newslash::Model::LegacyDB');
 671     for my $tagid (@$deactivated_tagids) {
 672         $logged += $db->sqlInsert('tags_deactivated',
 673                                   { tagid => $tagid });
 674     }
 675     return $logged;
 676 }
 677
 678 sub deactivateTag {
 679     my ($self, $hr, $options) = @_;
 680     return if $self->check_readonly;
 681     my $tag = $self->_setuptag($hr, { tagname_not_required => !$options->{tagname_required} });
 682     return 0 if !$tag;
 683
 684     my $prior_clause = '';
 685     $prior_clause = " AND tagid < $options->{tagid_prior_to}" if $options->{tagid_prior_to};
 686             my $where_clause = "uid         = $tag->{uid}
 687                          AND globjid    = $tag->{globjid}
 688                          AND inactivated IS NULL
 689                          $prior_clause";
 690     $where_clause .= " AND tagnameid = $tag->{tagnameid}" if $tag->{tagnameid};
 691     my $db = $self->new_instance_of('Newslash::Model::LegacyDB');
 692     my $previously_active_tagids = $db->sqlSelectColArrayref('tagid', 'tags', $where_clause);
 693     my $count = $db->sqlUpdate('tags', { -inactivated => 'NOW()', -is_active => 'NULL' }, $where_clause);
 694
 695     if ($count > 1) {
 696         # Logic error, there should never be more than one
 697         # tag meeting those criteria.
 698         warn scalar(gmtime) . " $count deactivated tags id '$tag->{tagnameid}' for uid=$tag->{uid} on $tag->{globjid}";
 699     }
 700
 701     if ($count && $previously_active_tagids && @$previously_active_tagids) {
 702         #my $tagboxdb = getObject('Slash::Tagbox');
 703         #$tagboxdb->logDeactivatedTags($previously_active_tagids);
 704         $self->logDeactivatedTags($previously_active_tagids);
 705     }
 706
 707     return $count;
 708 }
 709
 710 1;