package Newslash::Model::Tags;
-use Newslash::Model::Base -base;
+#use Newslash::Model::Base -base;
+use base Newslash::Model::LegacyDB;
+use Data::Dumper;
+use List::Util qw(any all);
+
+use constant RESERVED_TAG_NAMES => [qw(metanix
+ metanod
+ nix
+ nod
+ poll
+ おもしろおかしい
+ すばらしい洞察
+ オフトピック
+ フレームのもと
+ 不当プラスモデ
+ 不当マイナスモデ
+ 余計なもの
+ 参考になる
+ 既出
+ 興味深い
+ 荒し
+ 荒らし
+ story
+ journal
+ comment
+ submission
+ )];
+
+sub is_reserved_name {
+ my ($self, $tag_name) = @_;
+ return any { $tag_name eq $_ } @{RESERVED_TAG_NAMES()};
+}
+sub select_for_items {
+ my ($self, $type, $primary_key, $items) = @_;
+ return if !$items;
-sub set_tag {
+ if (ref($items) ne "ARRAY") {
+ $items = [$items];
+ }
+ return if !@$items;
+
+ my $globjs = $self->new_instance_of("Globjs");
+ my $gtid = $globjs->get_gtid($type);
+ return if !$gtid;
+
+ my @target_ids = map { $_->{$primary_key} } @$items;
+
+ # convert primary_key to globjid
+ #my @target_globj_ids;
+ #for my $id (@target_ids) {
+ # my $globj_id = $globjs->get_globjid_from_item($type, $id);
+ # push @target_globj_ids, $globj_id;
+ #}
+
+ my @placeholders = map { "?" } @target_ids;
+ my $placeholder = join(", ", @placeholders);
+
+
+ my $sql = <<"EOSQL";
+SELECT * FROM globjs
+ JOIN tags ON globjs.globjid = tags.globjid
+ JOIN tagnames ON tags.tagnameid = tagnames.tagnameid
+ WHERE globjs.gtid = ? AND globjs.target_id IN ($placeholder)
+EOSQL
+
+ my $dbh = $self->connect_db;
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($gtid, @target_ids);
+ my $rs = $sth->fetchall_arrayref({});
+ $self->disconnect_db;
+
+ return if !$rs;
+
+ my $tags_of = {};
+ for my $tag (@$rs) {
+ my $id = $tag->{target_id};
+ $tags_of->{$id} = [] if !$tags_of->{$id};
+ push @{$tags_of->{$id}}, $tag;
+ }
+ return $tags_of;
+}
+
+sub get_topics {
+ my ($self, ) = @_;
+ my $sql = <<"EOSQL";
+SELECT * FROM topics;
+EOSQL
+ my $dbh = $self->connect_db;
+ my $sth = $dbh->prepare($sql);
+ $sth->execute;
+ my $rs = $sth->fetchall_arrayref({});
+ if (!$rs) {
+ $self->disconnect_db;
+ return;
+ }
+ $self->disconnect_db;
+ return $rs;
+}
+
+sub add {
my $self = shift;
+ return if $self->check_readonly;
my $params = {@_};
-
my $globj_id = $params->{globj_id};
+
my $uid = $params->{uid} || 1;
my $name = $params->{name};
my $private = $params->{private} ? "yes" : "no";
my $tagname_id = $params->{tagname_id};
if (!$globj_id) {
+ $self->last_error("no globj_id");
return;
}
if ($name) {
- my $tagname = $self->select(tagname => $name);
+ my $tagname = $self->select_tagnames(tagname => $name);
if ($tagname) {
$tagname_id = $tagname->{tagnameid};
}
}
if (!$tagname_id) {
+ $self->last_error("no tagname id");
return;
}
my $inactivated = $active ? "NULL" : "NOW()";
my $sql = <<"EOSQL";
-INSERT INTO tags
+INSERT IGNORE INTO tags
(tagnameid, globjid, uid, created_at, inactivated, private, is_active)
VALUES
(?, ?, ?, NOW(), $inactivated, ?, ?)
my $dbh = $self->connect_db;
my $rs = $dbh->do($sql, undef, $tagname_id, $globj_id, $uid, $private, $active);
if (!$rs) {
- $dbh->disconnect;
+ $self->set_errorno($dbh->err);
+ $self->disconnect_db;
return;
}
my $id = $dbh->last_insert_id(undef, undef, undef, undef);
- $dbh->disconnect;
+ $self->disconnect_db;
return $id;
}
+sub del {
+ my $self = shift;
+ return if $self->check_readonly;
+ my $params = {@_};
+
+ my $globj_id = $params->{globj_id};
+ my $uid = $params->{uid} || 1;
+ my $name = $params->{name};
+ my $tagname_id = $params->{tagname_id};
+
+ if (!$globj_id) {
+ $self->set_error("no globj_id", 1);
+ return;
+ }
+
+ if ($name) {
+ my $tagname = $self->select_tagnames(tagname => $name);
+ if ($tagname) {
+ $tagname_id = $tagname->{tagnameid};
+ }
+ else {
+ $self->set_error("tagname not found", 2);
+ return;
+ }
+ }
+
+ if (!$tagname_id) {
+ $self->set_error("no tagname_id found", 3);
+ return;
+ }
+
+ my $sql = <<"EOSQL";
+DELETE FROM tags
+ WHERE tagnameid = ?
+ AND globjid = ?
+ AND uid = ?
+EOSQL
+
+ my $dbh = $self->connect_db;
+ my $rs = $dbh->do($sql, undef, $tagname_id, $globj_id, $uid);
+ if (!defined $rs) {
+ $self->set_errorno($dbh->err);
+ $self->disconnect_db;
+ return;
+ }
+ $self->disconnect_db;
+ return $rs;
+}
+
+sub set {
+ my $self = shift;
+ return if $self->check_readonly;
+ my $params = {@_};
+ my $globj_id = $params->{globj_id} || $params->{globjid};
+
+ if (!$globj_id) {
+ $self->set_error("no globj_id", 1);
+ return;
+ }
+ my $tag_names = $params->{names} || $params->{tagnames} || $params->{tag_names};
+
+
+ if (!$tag_names) {
+ if (!$params->{name} && !$params->{tagname} && !$params->{tag_name}) {
+ $self->set_error("no names given", 1);
+ return;
+ }
+ $tag_names = [$params->{name} || $params->{tagname} || $params->{tag_name}];
+ }
+
+ my $uid = $params->{uid} || 1;
+ my $private = $params->{private} ? "yes" : "no";
+ my $active = defined $params->{active} ? $params->{active} : 1;
+ my $tagname_value_of = $self->select_tagnames(tagnames => $tag_names);
+
+ # get tags for globj_id
+ my $existing_tags = $self->select(globjid => $globj_id,
+ uid => $uid);
+ return if !$existing_tags;
+
+ # create tagname
+ my @ids_to_add;
+ my @ids;
+ for my $name (@$tag_names) {
+ my $tagname_id;
+ if (!$tagname_value_of->{$name}) {
+ $tagname_id = $self->create(tagname => $name);
+ $tagname_value_of->{$name} = { tagname => $name,
+ tagnameid => $tagname_id };
+ }
+ else {
+ $tagname_id = $tagname_value_of->{$name}->{tagnameid};
+ }
+
+ push @ids, $tagname_id;
+ if (all { $tagname_id != $_ } @$existing_tags) {
+ push @ids_to_add, $tagname_id;
+ }
+ }
+
+ # add tags
+ my $sql = <<"EOSQL";
+INSERT IGNORE INTO tags
+ (tagnameid, globjid, uid, created_at, inactivated, private, is_active)
+ VALUES
+ (?, ?, ?, NOW(), NULL, ?, ?)
+EOSQL
+
+ my $dbh = $self->start_transaction;
+
+ # add tags
+ for my $tnid (@ids_to_add) {
+ my $rs = $dbh->do($sql, undef, $tnid, $globj_id, $uid, $private, $active);
+ if (!defined $rs) {
+ $self->set_error($dbh->err);
+ $self->rollback;
+ return;
+ }
+ }
+
+ # remove tags
+ my @placeholders = map { "?" } @ids;
+ my $placeholder_str = join(", ", @placeholders);
+ $sql = <<"EOSQL";
+DELETE FROM tags
+ WHERE globjid = ?
+ AND uid = ?
+ AND tagnameid NOT IN ($placeholder_str)
+EOSQL
+ my $rs = $dbh->do($sql, undef, $globj_id, $uid, @ids);
+ if (!defined $rs) {
+ $self->set_error($dbh->err);
+ $self->rollback;
+ return;
+ }
+ $self->commit;
+ return 1;
+}
+
+sub set_tag {
+ return shift->add(@_);
+}
+
sub create {
my $self = shift;
my $params = {@_};
my $dbh = $self->connect_db;
my $rs = $dbh->do($sql, undef, $params->{tagname});
if (!$rs) {
- $dbh->disconnect;
+ $self->disconnect_db;
return;
}
my $id = $dbh->last_insert_id(undef, undef, undef, undef);
- $dbh->disconnect;
+ $self->disconnect_db;
return $id;
}
return;
sub select {
my $self = shift;
my $params = {@_};
+ my $unique_keys = { id => "tags.tagid",
+ tagid => "tags.tagid",
+ };
+ my $keys = { tagnameid => "tags.tagnameid",
+ globjid => "tags.globjid",
+ globj_id => "tags.globjid",
+ uid => "tags.uid",
+ private => "tags.private",
+ is_active => "tags.is_active",
+ tagname => "tagnames.tagname",
+ tag_name => "tagnames.tagname",
+ };
+ my $datetime_keys = { created_at => "tags.created_at",
+ inactivated => "tags.inactivated",
+ };
+ my $timestamp = "tags.created_at";
+
+ my ($where_clause, $where_values, $unique) = $self->build_where_clause(unique_keys => $unique_keys,
+ keys => $keys,
+ datetime_keys => $datetime_keys,
+ timestamp => $timestamp,
+ params => $params);
+ my ($limit_clause, $limit_values) = $self->build_limit_clause(params => $params);
+ my ($orderby_clause, $orderby_values) = $self->build_order_by_clause(keys => $keys,
+ params => $params);
+
+ my @attrs;
+ push @attrs, @$where_values, @$limit_values, @$orderby_values;
+
+ my $dbh = $self->connect_db;
+ my $sql = <<"EOSQL";
+SELECT tags.*, tagnames.*
+ FROM tags
+ LEFT JOIN tagnames ON tags.tagnameid = tagnames.tagnameid
+ $where_clause
+ $orderby_clause
+ $limit_clause
+EOSQL
+
+ my $sth = $dbh->prepare($sql);
+ $sth->execute(@attrs);
+ my $items = $sth->fetchall_arrayref({});
+
+ if (!$items) {
+ $self->disconnect_db();
+ return;
+ }
+ if (@$items == 0) {
+ $self->disconnect_db();
+ return $unique ? undef : [];
+ }
+ return $items;
+
+}
+
+sub select_tagnames {
+ my $self = shift;
+ my $params = {@_};
+
+ $params->{tagname} ||= $params->{tag_name};
+ $params->{tagnames} ||= $params->{tag_names};
if ($params->{tagname}) {
my $sql = "SELECT * FROM tagnames WHERE tagname = ?";
my $sth = $dbh->prepare($sql);
$sth->execute($params->{tagname});
my $rs = $sth->fetchall_arrayref({});
- $dbh->disconnect;
+ $self->disconnect_db;
if (@$rs) {
return $rs->[0];
}
return;
}
+
+ if ($params->{tagnames}) {
+ my @placeholders = map { "?" } @{$params->{tagnames}};
+ my $placeholder_str = join(", ", @placeholders);
+
+ my $sql = "SELECT * FROM tagnames WHERE tagname IN ($placeholder_str)";
+ my $dbh = $self->connect_db;
+ my $sth = $dbh->prepare($sql);
+ $sth->execute(@{$params->{tagnames}});
+ my $rs = $sth->fetchall_hashref("tagname");
+ $self->disconnect_db;
+ if ($rs) {
+ return $rs;
+ }
+ return;
+ }
}
# =================== Legacy API ====================
+{
+my $nodid = 0;
+my $nixid = 0;
+sub createTag {
+ my($self, $hr, $options) = @_;
+ return if $self->check_readonly;
+
+ my $tag = $self->_setuptag($hr);
+ return 0 if !$tag;
+
+ # Anonymous users can now tag in limited circumstances where they're shown
+ # a functional tag widget on previewed items, and on transferTags calls that
+ # pass their tags along behind the scenes
+
+ # I'm not sure why a duplicate or opposite tag would ever be "OK"
+ # in the tags table, but for now let's keep our options open in
+ # case there's some reason we'd want "raw" tag inserting ability.
+ # Maybe in the future we can eliminate these options.
+# dupes no longer allowed, unique key rejects them
+# my $check_dupe = (!$options || !$options->{dupe_ok});
+ my $check_opp = (!$options || !$options->{opposite_ok});
+ my $check_aclog = (!$options || !$options->{no_adminlog_check});
+ my $opp_tagnameids = [ ];
+ if ($check_opp) {
+ $opp_tagnameids = $self->getOppositeTagnameids($tag->{tagnameid});
+ # getOppositeTagnameids demands a clid to identify the
+ # non-natural opposite of nod and nix. To ensure those
+ # two are never allowed to exist at the same time,
+ # hardcode them as opposites here.
+ # XXX should fix this by rethinking what "opposite" means for "all clout types"
+ # XXX this closure will break for multiple Slash sites that have different tagnameids for nod/nix
+ my $constants = $self->getCurrentStatic();
+ $nodid ||= $self->getTagnameidFromNameIfExists($constants->{tags_upvote_tagname} || 'nod');
+ $nixid ||= $self->getTagnameidFromNameIfExists($constants->{tags_downvote_tagname} || 'nix');
+ if ($tag->{tagnameid} == $nodid) {
+ push @$opp_tagnameids, $nixid unless grep { $_ == $nixid } @$opp_tagnameids;
+ } elsif ($tag->{tagnameid} == $nixid) {
+ push @$opp_tagnameids, $nodid unless grep { $_ == $nodid } @$opp_tagnameids;
+ }
+ }
+
+ $self->sqlDo('SET AUTOCOMMIT=0');
+
+ #if (isAdmin($options->{uid} || getCurrentUser('uid'))) {
+ if (0) {
+ my $domain_tag = $self->getCurrentStatic('domain_tag_name');
+ if ($hr->{name} ne $domain_tag) {
+ my $domain_tagnameid = $self->getTagnameidFromNameIfExists($domain_tag);
+ if ($domain_tagnameid && $tag->{tagnameid} != $domain_tagnameid) {
+ my $count = $self->sqlCount('tags', "globjid = $tag->{globjid} AND tagnameid != $domain_tagnameid");
+ # first tag? give it extra emphasis.
+ $hr->{emphasis} = 1 unless $count;
+ }
+ }
+ }
+
+ my $rows = $self->sqlInsert('tags', $tag);
+ my $tagid = $rows ? $self->getLastInsertId() : 0;
+
+# if ($rows && $check_dupe) {
+# # Check to make sure this user hasn't already tagged
+# # this object with this tagname. We do this by, in
+# # a transaction, doing the insert and checking to see
+# # whether there are 1 or more rows in the table
+# # preceding the one just inserted with matching the
+# # criteria. If so, the insert is rolled back and
+# # 0 is returned.
+# # Because of the uid_tagnameid_globjid_inactivated index,
+# # this should, I believe, not even touch table data,
+# # so it should be very fast.
+# # XXX Might want to make it faster by doing this
+# # select before the insert above, esp. with tagViewed().
+# my $count = $self->sqlCount('tags',
+# "uid = $tag->{uid}
+# AND globjid = $tag->{globjid}
+# AND tagnameid = $tag->{tagnameid}
+# AND is_active = 1
+# AND tagid < $tagid");
+# #inactivated IS NULL
+# if ($count == 0) {
+# # This is the only tag, it's allowed.
+# # Continue processing.
+# } else {
+# # Duplicate tag, not allowed.
+# $self->sqlDo('ROLLBACK');
+# $rows = 0;
+# }
+# }
+
+ # If that has succeeded so far, then eliminate any opposites
+ # of this tag which may have already been created.
+ if ($rows && $check_opp && @$opp_tagnameids) {
+ for my $opp_tagnameid (@$opp_tagnameids) {
+ my $opp_tag = {
+ uid => $tag->{uid},
+ globjid => $tag->{globjid},
+ tagnameid => $opp_tagnameid
+ };
+ my $count = $self->deactivateTag($opp_tag, { tagid_prior_to => $tagid });
+ $rows = 0 if $count > 1; # values > 1 indicate a logic error
+ }
+ }
+
+ # If all that was successful, add a tag_clout param if
+ # necessary.
+ if ($rows) {
+ # Find any admin commands that set clout for this tagnameid.
+ # We look for this globjid specifically, because any
+ # commands for the tagnameid generally will already have
+ # a tag_clout in tagname_params.
+ my $admincmds_ar = $self->getTagnameAdmincmds(
+ $tag->{tagnameid}, $tag->{globjid});
+ for my $opp_tagnameid (@$opp_tagnameids) {
+ my $opp_ar = $self->getTagnameAdmincmds(
+ $opp_tagnameid, $tag->{globjid});
+ push @$admincmds_ar, @$opp_ar;
+ }
+ # XXX Also, if the tag is on a project, check
+ # getTagnameSfnetadmincmds().
+ # Any negative admin command, to either this tagname or
+ # its opposite, means clout must be set to 0.
+ if (grep { $_->{cmdtype} =~ /^[_#]/ } @$admincmds_ar) {
+ my $count = $self->sqlInsert('tag_params', {
+ tagid => $tagid,
+ name => 'tag_clout',
+ value => 0,
+ });
+ $rows = 0 if $count < 1;
+ }
+ }
+
+ # If it was requested to add this tag with 'emphasis', do so.
+ if ($hr->{emphasis}) {
+ my $count = $self->sqlInsert('tag_params', {
+ tagid => $tagid,
+ name => 'emphasis',
+ value => 1,
+ });
+ $rows = 0 if $count < 1;
+ }
+
+ # If it passed all the tests, commit it. Otherwise rollback.
+ if ($rows) {
+ $self->sqlDo('COMMIT');
+ } else {
+ $self->sqlDo('ROLLBACK');
+ }
+
+ # Return AUTOCOMMIT to its original state in any case.
+ $self->sqlDo('SET AUTOCOMMIT=1');
+
+ # Dynamic blocks and Tagger/Contradictor achievement.
+ if ($rows) {
+ my $dynamic_blocks = $self->getObject('Slash::DynamicBlocks');
+ if ($dynamic_blocks) {
+ $dynamic_blocks->setUserBlock('tags', $tag->{uid});
+ }
+
+ if ($hr->{table} && $hr->{table} eq 'stories') {
+ my $achievements = $self->getObject('Slash::Achievements');
+ if ($achievements) {
+ $achievements->setUserAchievement('the_tagger', $tag->{uid}, { ignore_lookup => 1, exponent => 0 });
+ my $tagname = $self->getTagnameDataFromId($tag->{tagnameid});
+ if ($tagname->{tagname} =~ /^\!/) {
+ $achievements->setUserAchievement('the_contradictor', $tag->{uid}, { ignore_lookup => 1, exponent => 0 });
+ }
+ }
+ }
+ }
+
+ return $rows ? $tagid : 0;
+}
+}
+
+# This returns just the single tagname that is the opposite of
+# another tagname, formed by prepending a "!" or removing an
+# existing "!". This is not guaranteed to be the only opposite
+# of the given tagname.
+
+sub getBangOppositeTagname {
+ my($self, $tagname) = @_;
+ return substr($tagname, 0, 1) eq '!' ? substr($tagname, 1) : '!' . $tagname;
+}
+
+sub getTagnameAdmincmds {
+ my($self, $tagnameid, $globjid) = @_;
+ return [ ] if !$tagnameid;
+ my $where_clause = "tagnameid=$tagnameid";
+ $where_clause .= " AND globjid=$globjid" if $globjid;
+ return $self->sqlSelectAllHashrefArray(
+ "tagnameid, IF(globjid IS NULL, 'all', globjid) AS globjid,
+ cmdtype, created_at,
+ UNIX_TIMESTAMP(created_at) AS created_at_ut",
+ 'tagcommand_adminlog',
+ $where_clause);
+}
+
+sub getTagnameDataFromId {
+ my($self, $id) = @_;
+ my $hr = $self->getTagnameDataFromIds([ $id ]);
+ return $hr->{$id};
+}
+
+sub getTagnameDataFromIds {
+ my($self, $id_ar) = @_;
+ $id_ar ||= [ ];
+ $id_ar = [ grep { $_ && /^\d+$/ } @$id_ar ];
+ my $constants = $self->getCurrentStatic();
+ my @remaining_ids = @$id_ar;
+
+ # # First, grab from local cache any ids it has. We do cache locally
+ # # (in addition to memcached) because some tagnames are very frequently
+ # # accessed (e.g. nod, nix).
+ # my $local_hr = { };
+ # my $table_cache = "_tagname_cache";
+ # my $table_cache_time = "_tagname_cache_time";
+ # $self->_genericCacheRefresh('tagname', $constants->{tags_cache_expire});
+ # if ($self->{$table_cache_time}) {
+ # for my $id (@$id_ar) {
+ # $local_hr->{$id} = $self->{$table_cache}{$id} if $self->{$table_cache}{$id};
+ # }
+ # }
+ # my @remaining_ids = grep { !$local_hr->{$_} } @$id_ar;
+
+ # # Next, check memcached.
+
+ # my $mcd_hr = { };
+ # my $mcd = $self->getMCD();
+ # my $mcdkey;
+ # $mcdkey = "$self->{_mcd_keyprefix}:tagdata" if $mcd;
+ # if ($mcd && @remaining_ids) {
+ # my $mcdkey_qr = qr/^\Q$mcdkey:\E(\d+)$/;
+ # my @keylist = ( map { "$mcdkey:$_" } @remaining_ids );
+ # my $mcdkey_hr = $mcd->get_multi(@keylist);
+ # for my $k (keys %$mcdkey_hr) {
+ # my($id) = $k =~ $mcdkey_qr;
+ # next unless $id;
+ # $mcd_hr->{$id} = $mcdkey_hr->{$k};
+ # # Locally store any hits found.
+ # $self->{$table_cache}{$id} = $mcd_hr->{$id};
+ # }
+ # }
+ # @remaining_ids = grep { !$mcd_hr->{$_} } @remaining_ids;
+
+ # Finally, check MySQL.
+
+ my $mysql_hr = { };
+ my $splice_count = 2000;
+ while (@remaining_ids) {
+ my @id_chunk = splice @remaining_ids, 0, $splice_count;
+ my $id_in_str = join(',', @id_chunk);
+ my $ar_ar = $self->sqlSelectAll('tagnameid, tagname',
+ 'tagnames',
+ "tagnameid IN ($id_in_str)");
+ for my $ar (@$ar_ar) {
+ $mysql_hr->{ $ar->[0] }{tagname} = $ar->[1];
+ }
+ $ar_ar = $self->sqlSelectAll('tagnameid, name, value',
+ 'tagname_params',
+ "tagnameid IN ($id_in_str)");
+ for my $ar (@$ar_ar) {
+ next if $ar->[1] =~ /^tagname(id)?$/; # don't get to override these
+ $mysql_hr->{ $ar->[0] }{ $ar->[1] } = $ar->[2];
+ }
+ }
+ # # Locally store this data.
+ # for my $id (keys %$mysql_hr) {
+ # $self->{$table_cache}{$id} = $mysql_hr->{$id};
+ # }
+ # $self->{$table_cache_time} ||= time;
+ # # Store this data in memcached.
+ # if ($mcd) {
+ # for my $id (keys %$mysql_hr) {
+ # $mcd->set("$mcdkey:$id", $mysql_hr->{$id}, $constants->{memcached_exptime_tags});
+ # }
+ # }
+
+ #return {(
+ # %$local_hr, %$mcd_hr, %$mysql_hr
+ #)};
+ return {(
+ {}, {}, %$mysql_hr
+ )};
+}
+
+# This returns an arrayref of tagnameids that are all the
+# opposite of a given tagname or tagnameid (either works as
+# input). Or, an arrayref of tagname/tagnameids can be given
+# as input and the returned arrayref will be tagnameids that
+# are all the opposites of at least one of the inputs.
+
+sub getOppositeTagnameids {
+ my($self, $data, $create, $clid) = @_;
+ $clid ||= 0;
+ $data = [ $data ] if !ref($data);
+
+ my %tagnameid = ( );
+ for my $d (@$data) {
+ next unless $d;
+ if ($d =~ /^\d+$/) {
+ $tagnameid{$d} = 1;
+ } else {
+ my $id = $self->getTagnameidFromNameIfExists($d);
+ $tagnameid{$id} = 1 if $id;
+ }
+ }
+
+ my $orig_to_opp_hr = $self->consolidateTagnameidValues(\%tagnameid, $clid,
+ { invert => 1, posonly => 1 });
+
+ my @opp_tagnameids = sort { $a <=> $b } keys %$orig_to_opp_hr;
+ return \@opp_tagnameids;
+}
+
+# This takes a hashref with keys tagnameids and numeric values, a
+# similarity value of either 1 or -1, and optionally a clout type id.
+# It returns a hashref with keys the consolidated-preferred of the
+# original, and values the sum of the source original values.
+# If $abs is set, the values are the sum of the absolute values of
+# the source original values.
+#
+# For example, for a clout type with synonyms:
+# obvious <- duh, !insightful
+# insightful <- !obvious, !duh
+# cool <- neat
+# and a source hashref:
+# obvious => 1.2, duh => 3.4, !duh => 5.6, foo => 7.8, neat => 9.1
+# would return, for similarity = 1, the consolidated-preferred:
+# XXX this is wrong, includes positives only not negatives
+# insightful => 1.8 (i.e. 5.6-(1.2+3.4)), foo => 7.8, cool => 9.1
+# For similarity = -1 would return the consolidated-opposite:
+# obvious => -1.8, !foo => -7.8, !cool => -9.1
+# For similarity = 1 and abs set, would return:
+# insightful => 10.3 (i.e. 5.6+1.2+3.4), foo => 7.8, cool => 9.1
+# For similarity = -1 and abs set, would return:
+# obvious => 10.3, !foo => 7.8, !cool => 9.1
+#
+# I haven't spelled out anywhere a transitive or reflexive law of
+# tagnames, but if I did, corollaries of those laws would be
+# A) cTV(cTV(X, -1), -1) = cTV(X, 1)
+# B) cTV(cTV(X, 1), -1) = cTV(X, -1) = cTV(cTV(X, -1), 1)
+# C) cTV(cTV(X, 1), 1) = cTV(X, 1)
+
+# abs: when calculating values for antonyms, add instead of subtracting
+# invert: subtract for synonyms and add for antonyms
+# (has no effect if abs is also specified)
+# synonly: only calculate values for synonyms, ignore antonyms
+# posonly: when all values are calculated, throw out all values <= 0
+# (has no effect if abs is also specified)
+# (has no effect if synonly is also specified and all input values are > 0)
+
+sub consolidateTagnameidValues {
+ my($self, $tagnameid_hr, $clid, $options) = @_;
+ $clid ||= 0;
+ my $abs = $options->{abs} || 0;
+ my $invert = $options->{invert} || 0;
+ my $synonly = $options->{synonly} || 0;
+ my $posonly = $options->{posonly} || 0;
+
+ # Two ways to have an opposite of a tagname. The first only
+ # applied for a given clout type: have an entry in the
+ # tagnames_similarity_rendered table. If no clout ID is
+ # specified, this way does not apply. We try this first, and
+ # -- for tagnames that do have such entries -- we know we
+ # don't need to try the second way because the first includes
+ # the second.
+
+ # The second way is a "bang" opposite: prepare a "!" or
+ # remove an existing prepended "!". This is slower than the
+ # first way because we have to convert IDs to names and back,
+ # but it's the only way that applies if no clout ID is
+ # specified.
+
+ # First we consolidate using the rendered similarity table.
+
+ my @tagnameids = keys %$tagnameid_hr;
+
+ my $origid_sim_pref = { };
+ if ($clid) {
+ my $src_tnids_str = join(',', @tagnameids);
+ my $where_clause =
+ my $origid_sim_pref_ar = $self->sqlSelectAllHashrefArray(
+ 'syn_tnid, similarity, pref_tnid',
+ 'tagnames_similarity_rendered',
+ "clid=$clid AND syn_tnid IN ($src_tnids_str)");
+ for my $hr (@$origid_sim_pref_ar) {
+ my $syn_tnid = $hr->{syn_tnid};
+ my $similarity = $hr->{similarity};
+ my $pref_tnid = $hr->{pref_tnid};
+ $origid_sim_pref->{$syn_tnid}{$similarity} = $pref_tnid;
+ }
+ @tagnameids = grep { !exists $origid_sim_pref->{$_} } @tagnameids;
+ }
+
+ # Second, we consolidate using bang-type opposites.
+
+ my $tndata_hr = $self->getTagnameDataFromIds([ @tagnameids ]);
+ for my $id (@tagnameids) {
+ next if $origid_sim_pref->{$id}{1};
+ $origid_sim_pref->{$id}{1} = $id;
+ next if $synonly;
+ my $tagname = $tndata_hr->{$id}{tagname};
+ my $oppname = $self->getBangOppositeTagname($tagname);
+ my $oppid = $self->getTagnameidCreate($oppname);
+ $origid_sim_pref->{$id}{-1} = $oppid;
+ $origid_sim_pref->{$oppid}{-1} = $id;
+ $origid_sim_pref->{$oppid}{1} = $oppid;
+ }
+
+ # Add up the consolidated values.
+
+ my $retval = { };
+ for my $id (keys %$tagnameid_hr) {
+ my $pref = $origid_sim_pref->{$id}{1};
+ my $opp = $origid_sim_pref->{$id}{-1};
+ $retval->{$pref} ||= 0;
+ $retval->{$pref} += $tagnameid_hr->{$id};
+ next if $synonly;
+ $retval->{$opp} ||= 0;
+ $retval->{$opp} += $tagnameid_hr->{$id} * ($abs ? 1 : -1);
+ }
+ if ($invert) {
+ for my $id (keys %$retval) {
+ $retval->{$id} = -$retval->{$id};
+ }
+ }
+ if ($posonly) {
+ my @nonpos = grep { $retval->{$_} <= 0 } keys %$retval;
+ delete @{$retval}{@nonpos};
+ }
+ $retval;
+}
my $tags_tagname_regex = "^!?[a-z一-龠ぁ-んァ-ヴー][a-z0-9一-龠ぁ-んァ-ヴー/・]{0,63}\$";
# }
#}
- my $db = $self->new_instance_of('LegacyDB');
+ my $db = $self->new_instance_of('Newslash::Model::LegacyDB');
my $name_q = $db->sqlQuote($name);
my $id = $db->sqlSelect('tagnameid', 'tagnames',
"tagname=$name_q");
sub createTagname {
my($self, $name) = @_;
+ return if $self->check_readonly;
return 0 if !$self->tagnameSyntaxOK($name);
- my $db = $self->new_instance_of('LegacyDB');
+ my $db = $self->new_instance_of('Newslash::Model::LegacyDB');
my $rows = $db->sqlInsert('tagnames', {
tagnameid => undef,
tagname => $name,
sub logDeactivatedTags {
my($self, $deactivated_tagids) = @_;
+ return if $self->check_readonly;
return 0 if !$deactivated_tagids;
my $logged = 0;
- my $db = $self->new_instance_of('LegacyDB');
+ my $db = $self->new_instance_of('Newslash::Model::LegacyDB');
for my $tagid (@$deactivated_tagids) {
$logged += $db->sqlInsert('tags_deactivated',
{ tagid => $tagid });
sub deactivateTag {
my ($self, $hr, $options) = @_;
+ return if $self->check_readonly;
my $tag = $self->_setuptag($hr, { tagname_not_required => !$options->{tagname_required} });
return 0 if !$tag;
AND inactivated IS NULL
$prior_clause";
$where_clause .= " AND tagnameid = $tag->{tagnameid}" if $tag->{tagnameid};
- my $db = $self->new_instance_of('LegacyDB');
+ my $db = $self->new_instance_of('Newslash::Model::LegacyDB');
my $previously_active_tagids = $db->sqlSelectColArrayref('tagid', 'tags', $where_clause);
my $count = $db->sqlUpdate('tags', { -inactivated => 'NOW()', -is_active => 'NULL' }, $where_clause);
return $count;
}
+
+1;