Remove unused, broken code.
Patch by kareila.
diffs (923 lines):
diff -r 95226a1cdf3a -r 23d5a5fac9ce bin/worker/ljtalk-gm
--- a/bin/worker/ljtalk-gm Thu Jul 22 09:47:11 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,610 +0,0 @@
-#!/usr/bin/perl
-# This code was forked from the LiveJournal project owned and operated
-# by Live Journal, Inc. The code has been modified and expanded by
-# Dreamwidth Studios, LLC. These files were originally licensed under
-# the terms of the license supplied by Live Journal, Inc, which can
-# currently be found at:
-#
-#
http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt
-#
-# In accordance with the original license, this code and all its
-# modifications are provided under the GNU General Public License.
-# A copy of that license can be found in the LICENSE file included as
-# part of this distribution.
-
-use strict;
-use lib "$ENV{LJHOME}/cgi-bin";
-require 'ljprotocol.pl';
-use LJ::Worker::Gearman;
-use LJ::Jabber::Presence;
-use LJ::Jabber::LastSeen;
-use MIME::Base64;
-use Storable;
-gearman_decl("ljtalk_auth_check" => \&ljtalk_auth_check);
-gearman_decl("ljtalk_get_roster" => \&ljtalk_get_roster);
-gearman_decl("ljtalk_avatar_data" => \&ljtalk_avatar_data);
-gearman_decl("ljtalk_avatar_sha1" => \&ljtalk_avatar_sha1);
-gearman_decl("ljtalk_bot_talk" => \&ljtalk_bot_talk);
-gearman_decl("ljtalk_load_roster_item" => \&ljtalk_load_roster_item);
-gearman_decl("ljtalk_delete_roster_item" => \&ljtalk_delete_roster_item);
-gearman_decl("ljtalk_addupdateset_roster" => \&ljtalk_addupdateset_roster);
-gearman_decl("ljtalk_initial_presence" => \&ljtalk_initial_presence);
-gearman_decl("ljtalk_alter_presence" => \&ljtalk_alter_presence);
-gearman_decl("ljtalk_connection_closing" => \&ljtalk_connection_closing);
-gearman_decl("ljtalk_init" => \&ljtalk_init);
-gearman_decl("ljtalk_user_motd" => \&ljtalk_user_motd);
-gearman_work();
-
-# ----------------------------------------------------------------------------
-
-use Image::Magick;
-use Digest::SHA1 qw(sha1_hex);
-use Storable;
-
-use constant REL_TO => 1;
-use constant REL_FROM => 2;
-use constant REL_PENDIN => 4;
-use constant REL_PENDOUT => 8;
-
-# Plugin::LiveJournal
-sub ljtalk_init {
- my $job = shift;
- LJ::Jabber::Presence->clear_cluster(1);
- return "OK";
-}
-
-# Plugin::LiveJournal
-sub ljtalk_connection_closing {
- my $job = shift;
-
-
- my $args = Storable::thaw($job->arg);
- my ($user, $resource, $priority, $xml) = (@$args);
-
- my $u = LJ::load_user($user)
- or return "ERR:nouser";
- my $rv = eval {
- LJ::Jabber::Presence->delete($u, $resource);
- };
- if ($@) {
- warn "EVAL failure deleting resource $user/$resource: $@" if ($@);
- } else {
- warn "Delete of resource $user/$resource = $rv\n" if
$LJ::IS_DEV_SERVER;
- }
-
- return "OK";
-}
-
-# Plugin::LiveJournal
-sub ljtalk_alter_presence {
- my $job = shift;
- my $args = Storable::thaw($job->arg);
- my ($user, $resource, $priority, $xml) = (@$args);
- my $u = LJ::load_user($user)
- or return "ERR:nouser";
-
- # ignore unavailable ones, or map them into deletes...? ignoring for
- # now. all this presence code needs to be cleaned way up.
- if ($xml =~ /\btype=[\'\"]unavailable[\'\"]/) {
- return "OK";
- }
-
- eval {
- if (my $presence = LJ::Jabber::Presence->new($u, $resource)) {
- $presence->set_presence($xml);
- $presence->set_priority($priority) if($priority);
- } else {
- LJ::Jabber::Presence->create(
- u => $u,
- resource => $resource,
- cluster => 1,
- presence => $xml,
- priority => $priority,
- );
- }
- };
- warn "EVAL failure: $@" if ($@);
-
- if (my $ls = LJ::Jabber::LastSeen->new($u)) {
- $ls->set_presence($xml);
- } else {
- LJ::Jabber::LastSeen->create( u => $u,
- presence => $xml,
- );
- }
-
- return "OK";
-}
-
-# Plugin::LiveJournal
-sub ljtalk_initial_presence {
- my $job = shift;
- my $args = Storable::thaw($job->arg);
- my ($user, $resource, $ip) = (@$args);
- my $u = LJ::load_user($user)
- or return "ERR:nouser";
-
- my $count = LJ::Jabber::Presence->delete($u, $resource);
- if ($count) {
- # Should we disconnect the users from the other clusters when this
happens?
- warn "Deleted $count matching presence entries." if $LJ::IS_DEV_SERVER;
- }
-
- LJ::Jabber::Presence->create(resource => $resource,
- u => $u,
- presence => '',
- cluster => 1,
- client => '',
- remoteip => $ip,
- );
- return 1;
-}
-
-#
-sub ljtalk_user_motd {
- my $job = shift;
- my $args = Storable::thaw($job->arg);
- my $user = shift @$args;
- my $u = LJ::load_user($user)
- or return;
-
- my $latest_motd = 1; # Current revision of the motd
-
- my $motd_ver = 0;
-
- return '';
- if (my $ls = LJ::Jabber::LastSeen->new($u)) {
- $motd_ver = $ls->motd_ver;
- $ls->set_motd_ver($latest_motd);
- } else {
- LJ::Jabber::LastSeen->create( u => $u,
- motd_ver => $latest_motd,
- );
- }
-
- if ($motd_ver < $latest_motd) {
- my $how_much = $user =~
/^whitaker|revmischa|brad|crucially|supersat|mart|scsi|evan|hachi$/ ?
- "more than Whitaker's mom" :
- "a lot";
-
- return "<body>LJ Talk is currently a pre-alpha service lacking tons of
features and probably with a bunch of bugs. We're actively developing it,
constantly restarting it with new stuff. So just don't be surprised if the
service goes up and down ${how_much}.</body>";
- }
- return '';
-}
-
-# Authen::LiveJournal
-sub ljtalk_auth_check {
- my $job = shift;
- my $args = Storable::thaw($job->arg);
- my ($user, $streamid, $digest, $resource, $ip, $cluster) = (@$args);
- my $u = LJ::load_user($user)
- or return "ERR:nouser";
- return "ERR:notperson" unless $u->is_person;
- return "ERR:nopassword" unless $u->password;
-
- return "ERR:banned" if LJ::login_ip_banned($u, $ip);
- my $correct = sha1_hex($streamid . $u->password);
- unless ($digest eq $correct) {
- LJ::handle_bad_login($u, $ip);
- return "ERR:badpass";
- }
-
- if (my $ls = LJ::Jabber::LastSeen->new($u)) {
- $ls->set_presence('');
- } else {
- LJ::Jabber::LastSeen->create(u => $u,
- presence => '',
- );
- }
-
- return "OK";
-}
-
-# RosterStorage::LiveJournal
-sub ljtalk_get_roster {
- my $job = shift;
- my $user = $job->arg;
- my $u = LJ::load_user($user) or die "No user";
-
- my %user; # uid -> [$barejid, $substate_bitmask, $name, $groups]
- my $dbr = LJ::get_db_reader();
- my $sth;
-
- # get outgoing friends
- $sth = $dbr->prepare("SELECT u.userid, u.user FROM user u, friends f ".
- "WHERE f.userid=? AND f.friendid=u.userid AND
u.journaltype='P'");
- die "db error" if $dbr->errstr;
- $sth->execute($u->{userid});
- while (my ($uid, $user) = $sth->fetchrow_array) {
- next if $uid == $u->{userid};
- $user{$uid} = ["$us...@$lj::DOMAIN", REL_PENDOUT];
- }
-
- # get edges back
- my $uids = join(',', keys %user);
- if ($uids) {
- $sth = $dbr->prepare("SELECT userid FROM friends WHERE friendid=? AND
userid IN ($uids)");
- $sth->execute($u->{userid});
- while (my ($uid) = $sth->fetchrow_array) {
- my $erec = $user{$uid} or next; # unless it was REL_PENDOUT
(the only thing it could be up to this point)
- $erec->[1] = REL_TO | REL_FROM;
- }
- }
-
- # go through and complement it with jabroster table, respecting the
ljflags, to remove state
- $sth = $u->prepare("SELECT contactid, name, substate, groups, ljflags ".
- "FROM jabroster WHERE userid=?");
- $sth->execute($u->{userid});
- while (my $rostrow = $sth->fetchrow_hashref) {
- my $uid = $rostrow->{contactid};
- my $cu = LJ::load_userid($uid)
- or next;
- my $barejid = $cu->is_identity ?
- $cu->identity->value :
- "$cu->{use...@$lj::DOMAIN";
-
- my $rec = $user{$uid} ||= [];
- $rec->[0] = $barejid;
- $rec->[1] = defined $rec->[1] ? (($rec->[1]+0) |
($rostrow->{substate}+0)) : $rostrow->{substate}+0;
- $rec->[2] = $rostrow->{name};
- $rec->[3] = $rostrow->{groups};
-
- # remove 'to' bit if ljflags bit0 says so
- if ($rostrow->{ljflags}+0 & 1) {
- $rec->[1]-- if ($rec->[1]+0) & REL_TO;
- }
- }
-
- # list of [jid, nick, $substate, [...@groups]]
- my @list;
- foreach my $uid (keys %user) {
- my $urec = $user{$uid};
- my ($barejid, $substate, $name, $groups) = @$urec;
- next unless $substate; # substate went from to -> no longer mutual
(still to) -> none (hide flag on), so skip
-
- $groups ||= $LJ::SITENAMESHORT;
- my @grp = split(/\0/, $groups);
- unless ($name) {
- $barejid =~ /^(.+?)\@/;
- $name = $1;
- }
- push @list, [$urec->[0], $name, $substate, \...@grp];
- }
-
- return Storable::nfreeze(\...@list);
-}
-
-sub ljtalk_avatar_data {
- return _avatar_want(shift, "data");
-}
-
-sub ljtalk_avatar_sha1 {
- return _avatar_want(shift, "sha1");
-}
-
-sub _avatar_want {
- my ($job, $want) = @_;
-
- my $args = Storable::thaw($job->arg);
- my $keyword = $args->[1];
-
- my $u = LJ::load_user($args->[0]) or die "invalid user: '" . $args->[0] .
"'";
-
- my $upic = LJ::Userpic->new_from_keyword($u, $keyword);
- my $upic_id = $upic ? $upic->id : $u->{defaultpicid};
-
- return "" unless $u && $upic_id;
-
- my $memkey = [$u->{userid}, "avatar2:$u->{userid}:$upic_id"]; # 2 = v2,
for cache busting
-
- my $res = sub {
- my $val = shift; # [ [blobref, mime, w, h], sha1 ]
- return $val->[1] if $want eq "sha1";
- my $img = $val->[0];
- my $blobref = $img->[0];
- my $mime = $img->[1];
-
-
- my $b64 = encode_base64($$blobref);
- my $mimetype;
- if ($$blobref =~ /^GIF/) {
- $mimetype = "image/gif";
- } elsif ($$blobref =~ /^\x89PNG/) {
- $mimetype = "image/png";
- } else {
- $mimetype = 'image/jpeg';
- }
-
- my $vcard_data;
- $u->preload_props(qw(city state zip country url ));
-
- $vcard_data = '<NICKNAME>' . LJ::exml($u->{user}) . '</NICKNAME>';
- $vcard_data .= '<N><GIVEN>' . LJ::exml($u->{name}) . '</GIVEN></N>'
if($u->{name});
- $vcard_data .= ("<URL>" . ( $u->prop('url') ?
LJ::exml($u->prop('url')) : ( $u->journal_base . '/') ) . "</URL>");
-
- if (my $bday = $u->bday_string) {
- $bday = "0000-$bday" unless $bday =~ /\d\d\d\d/;
- $vcard_data .= qq{<BDAY>$bday</BDAY>};
- }
-
- if ($u->can_show_location &&
- ($u->prop('city') || $u->prop('state') || $u->prop('country') ||
$u->prop('zip') )) {
- $vcard_data .= '<ADR>';
- $vcard_data .= '<CTRY>' . LJ::exml($u->prop('country')) .
'</CTRY>' if $u->prop('country');
- $vcard_data .= '<PCODE>' . LJ::exml($u->prop('zip')) .
'</PCODE>' if $u->prop('zip');
- $vcard_data .= '<REGION>' . LJ::exml($u->prop('state')) .
'</REGION>' if $u->prop('state');
- $vcard_data .= '<LOCALITY>' . LJ::exml($u->prop('city')) .
'</LOCALITY>' if $u->prop('city');
- $vcard_data .= '</ADR>';
-
- }
-
- my $vcard = qq{<vCard xmlns='vcard-temp'>
- $vcard_data
- <PHOTO>
- <TYPE>$mimetype</TYPE>
- <BINVAL>$b64</BINVAL>
- </PHOTO>
- </vCard>};
- return $vcard;
- };
-
- my $val = LJ::MemCache::get($memkey);
- return $res->($val) if $val;
-
- # get image parameters ($imp) of [blobref, mime, w, h]
- my $imp = LJ::_get_upf_scaled(size => 96,
- downsize_only => 1, # don't enlarge
64x64, for instance, to 96x96
- mogkey =>
$u->mogfs_userpic_key($upic_id),
- maxfilesize => 200,
- );
- die "ERROR: could not resize image down\n" unless $imp;
-
- my $blobref = $imp->[0];
- my $sha1 = sha1_hex($$blobref);
- $val = [$imp, $sha1];
-
- LJ::MemCache::set($memkey, $val, 86400);
- return $res->($val);
-}
-
-# Bot::LiveJournal
-sub ljtalk_bot_talk {
- my $job = shift;
- my $req = Storable::thaw($job->arg);
- my $text = $req->{text} || "";
- $text = LJ::no_utf8_flag($text);
- $text =~ s/^\s+//;
-
- my $ret = sub {
- return Storable::nfreeze({ text => $_[0], html => $_[1] });
- };
-
- my $rand = sub {
- return $ret->($_[int rand @_]);
- };
-
- if ($text =~ m!^post:\s*(.+)!si) {
- return $ret->(_bot_post($req, $1));
- }
-
- if ($text =~ /help/i) {
- return $ret->(_bot_help($req));
- }
-
- if ($text =~ /^(yo|hey|hello|hi|sup|lo)\b/) {
- return $rand->("yo", "hey", "hello", "hi");
- }
-
- if ($text =~ /^(asl|a\/s\/l)(\?|$)/) {
- return $rand->("6/male/san francisco/goat. i guess that's
a/s/l/species.");
- }
-
- return $ret->("I don't know what that means. I'm actually pretty stupid.
Type 'help' for help.");
-}
-
-sub _bot_help {
- return ("To post to your journal, message me with \"post: \" and some
text. To use a subject, do: \"post: [Your Subject] Your post....\"");
-}
-
-sub _bot_get_remote {
- my $req = shift;
-
- if ($req->{jid} =~ /^([\w\-]{1,25})\...@$lj::DOMAIN$/) {
- return LJ::load_user($1);
- }
-
- return undef;
-}
-
-sub _bot_post {
- my $req = shift;
- my $body = shift;
- my $subject = "Posted using <a
href=\"http://www.livejournal.com/chat/\";>LJ Talk</a>...";
- if ($body =~ s/^\s*\[(.*?)\]\s*//) {
- $subject = $1;
- }
-
- my $u = _bot_get_remote($req)
- or return "Can't post from non-LiveJournal Jabber addresses yet.";
-
- # build lj entry
- my $props = {};
- my $req = {
- #'usejournal' => $journal,
- 'ver' => 1,
- 'username' => $u->user,
- 'event' => $body,
- 'subject' => $subject,
- #'security' => $lj_headers{security},
- #'allowmask' => $amask,
- 'props' => $props,
- 'tz' => 'guess',
- };
-
- # post!
- my $post_error;
- my $res = LJ::Protocol::do_request("postevent", $req, \$post_error, {
noauth => 1 });
- if ($post_error) {
- return ("Error: $post_error");
- }
-
- my $url = $res->{url};
- return ("Posted: $url", "<i>Posted:</i> <a href='$url'>$url</a>");
-}
-
-sub ljtalk_addupdateset_roster {
- my $job = shift;
- my $req = Storable::thaw($job->arg);
-
- my $u = LJ::load_user($req->{user})
- or die "Failed to load user object";
-
- # FIXME: bogus canonicalization, xmpp supports unicode/stringprep/etc:
- my $contact = lc $req->{contact};
- my $is_lj;
- my $cu; # contact's $u object
- if ($contact =~ /^([\w-]{1,25})\...@\q$lj::DOMAIN\E/i) {
- $is_lj = $1;
- $cu = LJ::load_user($is_lj)
- or die "Contact doesn't exist";
- } else {
- $cu = LJ::User::load_identity_user("J", "$contact")
- or die "Failed to load identity user J:$contact";
- }
-
- my $rv;
- my $substate = $req->{substate} || 0;
-
- my $glist = join("\0", @{$req->{groups} || []});
- $rv = $u->do("INSERT IGNORE INTO jabroster SET userid=?, contactid=?,
name=?, groups=?, substate=? ",
- undef, $u->{userid}, $cu->{userid}, $req->{name}, $glist,
$substate);
- unless ($rv > 0) {
- my $newstate = defined $req->{substate} ? $req->{substate} :
"substate";
- $u->do("UPDATE jabroster SET name=?, groups=?, substate=$newstate
WHERE userid=? AND contactid=?",
- undef, $req->{name}, $glist, $u->{userid}, $cu->{userid});
- $substate = $u->selectrow_array("SELECT substate FROM jabroster WHERE
userid=? AND contactid=?",
- undef, $u->{userid}, $cu->{userid});
- }
- return Storable::nfreeze({substate => $substate});
-}
-
-sub _contact_u_if_exists {
- my $contact = shift;
-
- # FIXME: bogus canonicalization, xmpp supports unicode/stringprep/etc:
- my $contact = lc $contact;
- my $is_lj;
- my $cu; # contact's $u object
- if ($contact =~ /^([\w-]{1,25})\...@\q$lj::DOMAIN\E/i) {
- $is_lj = $1;
- $cu = LJ::load_user($is_lj);
- } else {
- $cu = _load_identity_user_no_vivify("J", $contact);
- }
- return wantarray ? ($cu, $is_lj) : $cu;
-}
-
-sub ljtalk_delete_roster_item {
- my $job = shift;
- my $req = Storable::thaw($job->arg);
-
- my $u = LJ::load_user($req->{user})
- or die "Failed to load user object";
-
- my ($cu, $is_lj) = _contact_u_if_exists($req->{contact});
- return 1 unless $cu;
-
- # non-LJ case is easy, just delete them:
- if (!$is_lj) {
- $u->do("DELETE FROM jabroster WHERE userid=? AND contactid=?",
- undef, $u->{userid}, $cu->{userid});
- return 1;
- }
-
- # in LJ case, we can't just delete them, since their roster is composed
- # of explicit + implicit (mutual friends). so if they're mututal friends,
- # we need to set the 'hide_to bit' on in ljflags.
- my $rv = $u->do("UPDATE jabroster SET substate=0, ljflags=1 ".
- "WHERE userid=? AND contactid=?", undef,
- $u->{userid}, $cu->{userid});
- return 1 if $rv > 0;
- $u->do("INSERT IGNORE INTO jabroster SET userid=?, contactid=?, substate=0,
ljflags=1 ",
- undef, $u->{userid}, $cu->{userid})
- or die;
- return 1;
-}
-
-sub ljtalk_load_roster_item {
- my $job = shift;
- my $req = Storable::thaw($job->arg);
-
- my $u = LJ::load_user($req->{user})
- or die "Failed to load user object";
-
- my ($cu, $is_lj) = _contact_u_if_exists($req->{contact});
- return Storable::nfreeze({}) unless $cu;
-
- my $rostrow = $u->selectrow_hashref("SELECT name, substate, groups,
ljflags ".
- "FROM jabroster WHERE userid=? AND
contactid=?",
- undef, $u->{userid}, $cu->{userid});
-
- # non-LJ JIDs don't need to consult friends tables, so just do it now
- unless (defined $is_lj) {
- return Storable::nfreeze({}) unless $rostrow;
- return Storable::nfreeze({
- substate => $rostrow->{substate},
- name => $rostrow->{name},
- groups => $rostrow->{groups},
- });
- }
-
- # otherwise, we have to augment the jabber-only relationship with the
- # LJ/friends/database relationship. so figure out the LJ relationship...
- my $to = LJ::is_friend($u, $cu);
- my $from = LJ::is_friend($cu, $u);
-
- # start with the jabber-only relationship,
- my $substate = $rostrow ? ($rostrow->{substate}+0) : 0;
-
- # if you're both, ignore the substate in this table... the only value
- # is both (to+from).
- if ($to && $from) {
- $substate = REL_TO | REL_FROM;
- }
-
- elsif ($to) {
- $substate = REL_PENDOUT;
- }
-
- elsif ($from) {
- # we don't pre-populate REL_PENDIN stuff from the LJ database,
- # because then people would get flooded by "HEY ACK THIS PERSON?"
- # from DJabberd which uses the REL_PENDIN as a bit to mean
- # an ack is pending. and we don't want those floods.
- }
-
- # bit0 of ljflags says "they're a friend, but I don't want them in my
roster"
- # FIXME: ljflags never gets turned off when user is added back. need a
place to do that.
- if ($rostrow && ($rostrow->{ljflags}+0) & 1) {
- $substate-- if $substate & 1; # lame bitmath. :)
- }
-
- my $groups = $rostrow ? $rostrow->{groups} : "";
- $groups ||= $is_lj ? $LJ::SITENAMESHORT : "Contacts";
-
- return Storable::nfreeze({
- substate => $substate,
- groups => $groups,
- name => ($rostrow ? $rostrow->{name} : $cu->{user}) || $cu->{user},
- });
-}
-
-# TODO: move this into LJ::User and add no-vivify flag
-sub _load_identity_user_no_vivify {
- my ($type, $ident) = @_;
- my $dbh = LJ::get_db_writer();
- my $uid = $dbh->selectrow_array("SELECT userid FROM identitymap WHERE
idtype=? AND identity=?",
- undef, $type, $ident);
- return LJ::load_userid($uid) if $uid;
- return undef;
-}
diff -r 95226a1cdf3a -r 23d5a5fac9ce cgi-bin/LJ/Jabber/LastSeen.pm
--- a/cgi-bin/LJ/Jabber/LastSeen.pm Thu Jul 22 09:47:11 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,231 +0,0 @@
-# This code was forked from the LiveJournal project owned and operated
-# by Live Journal, Inc. The code has been modified and expanded by
-# Dreamwidth Studios, LLC. These files were originally licensed under
-# the terms of the license supplied by Live Journal, Inc, which can
-# currently be found at:
-#
-#
http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt
-#
-# In accordance with the original license, this code and all its
-# modifications are provided under the GNU General Public License.
-# A copy of that license can be found in the LICENSE file included as
-# part of this distribution.
-
-package LJ::Jabber::LastSeen;
-
-use strict;
-use warnings;
-no warnings 'redefine';
-
-use Carp qw(croak);
-
-use LJ::MemCache;
-
-=head1 PACKAGE METHODS
-
-=head2 $obj = LJ::Jabber::LastSeen->new( $u )
-
-Loads a Jabber last seen object from Memcache, or failing that from the
database.
-
-Requires one arguments, a LJ::User object (or something that's similar)
-
-=cut
-
-sub new {
- my $class = shift;
- return undef;
- my ($u, $resource) = @_;
-
- croak "No user" unless $u;
-
- my $self = {
- u => $u,
- };
-
- bless $self, $class;
-
- my $userid = $u->id;
-
- my $memcached = LJ::MemCache::get( [$userid, "jablastseen:$userid"] );
-
- if ($memcached) {
- %$self = (%$self, %$memcached);
- return $self;
- }
-
- my $dbh = $u->writer() or die "No db";
-
- my $row = $dbh->selectrow_hashref("SELECT presence, time, motd_ver FROM
jablastseen WHERE userid=?",
- undef, $self->u->id);
-
- die $dbh->errstr if $dbh->errstr;
-
- return unless $row;
-
- %$self = (%$self, %$row);
-
- LJ::MemCache::set( [$userid, "jablastseen:$userid"],
- {
- presence => $self->presence,
- time => $self->time,
- motd_ver => $self->motd_ver,
- } );
-
- return $self;
-}
-
-=head2 $obj = LJ::Jabber::Presence->create( %opts );
-
-Creates a Jabber::Presence object from %opts and saves it to the database.
-
-Options are as follows:
-
-=over
-
-=item u
-
-LJ::User object (or similar) representing the user this presence applies to
-
-=item presence
-
-Raw XML string of presence data for this user's presence.
-
-=item motd_ver
-
-Integer field for holding motd version number, so we only show a user the motd
if they haven't seen it before.
-
-=back
-
-=cut
-
-sub create {
- my $class = shift;
- my %opts = @_;
- return undef;
- my $u = delete( $opts{u} ) or croak "No user";
- my $presence = delete( $opts{presence} );
- my $motd_ver = delete( $opts{motd_ver} );
-
- my $time = CORE::time;
-
- croak( "Unknown options: " . join( ',', keys %opts ) )
- if (keys %opts);
-
- my $userid = $u->id;
-
- my $self = bless {
- u => $u,
- presence => $presence,
- time => $time,
- motd_ver => $motd_ver,
- }, $class;
-
- my $dbh = $u->writer() or die "No db";
-
- my $sth = $dbh->prepare( "INSERT INTO jablastseen (userid, presence, time,
motd_ver) VALUES (?, ?, ?, ?)" );
- $sth->execute( $u->id, $presence, $time, $motd_ver );
-
- if ($sth->errstr) {
- die "Insertion error: " . $sth->errstr;
- return;
- }
-
- LJ::MemCache::set( [$userid, "jablastseen:$userid"],
- {
- presence => $presence,
- time => $time,
- motd_ver => $motd_ver,
- } );
-
- return $self;
-}
-
-=head1 OBJECT METHODS
-
-=head2 $obj->u
-
-=head2 $obj->presence
-
-=head2 $obj->time
-
-=head2 $obj->motd_ver
-
-General purpose accessors for attributes on these objects.
-
-=cut
-
-sub u { $_[0]->{u} }
-sub presence { $_[0]->{presence} }
-sub time { $_[0]->{time} }
-sub motd_ver { $_[0]->{motd_ver} }
-
-=head2 $obj->set_presence( $val )
-
-=head2 $obj->set_motd_ver( $val )
-
-Setters for values on these objects.
-
-=cut
-
-sub set_presence {
- my $self = shift;
- my $val = shift;
-
- croak( "Didn't pass in a defined value to set" )
- unless defined $val;
-
- $self->{presence} = $val;
- $self->{time} = CORE::time;
-
- $self->_save( 'presence', 'time' );
-
- return $val;
-}
-
-sub set_motd_ver {
- my $self = shift;
- my $val = shift;
-
- croak "Didn't pass in a defined value to set"
- unless defined $val;
-
- $self->{motd_ver} = $val;
- $self->{time} = CORE::time;
-
- $self->_save( 'motd_ver', 'time' );
-
- return $val;
-}
-
-# Internal functions
-
-my %savable_cols = map { ($_, 1) } qw(presence motd_ver time);
-
-sub _save {
- my $self = shift;
-
- return unless @_;
-
- my @bad_cols = grep {!$savable_cols{$_}} @_;
- die "Cannot save cols " . join( ',', @bad_cols ) . "."
- if @bad_cols;
-
- my $userid = $self->u->id;
-
- my $dbh = $self->u->writer() or die "No db";
-
- my $sql = "UPDATE jablastseen SET " .
- join( ', ', map { "$_ = " . (defined($self->{$_}) ? "?" :
"NULL") } @_ ) .
- " WHERE userid=?";
-
- my @placeholders = map { defined($self->{$_}) ? $self->{$_} : () } @_;
-
- $dbh->do( $sql, undef, @placeholders, $userid );
-
- die "Database update failed: " . $dbh->errstr
- if $dbh->errstr;
-
- LJ::MemCache::delete( [$userid, "jablastseen:$userid"], 0 );
-}
-
-1;
diff -r 95226a1cdf3a -r 23d5a5fac9ce t/jabber-lastseen.t
--- a/t/jabber-lastseen.t Thu Jul 22 09:47:11 2010 -0700
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,70 +0,0 @@
-#!/usr/bin/perl
-use strict;
-use Test::More;
-use lib "$ENV{LJHOME}/cgi-bin";
-require 'ljlib.pl';
-
-use Carp;
-
-$SIG{__DIE__} = sub { Carp::croak( @_ ) };
-
-use LJ::Jabber::LastSeen;
-use LJ::Test qw(temp_user memcache_stress);
-
-unless ($ENV{TEST_TODO}) {
- plan skip_all => "This test is disabled until Jabber::LastSeen is
rewritten";
- exit;
-}
-
-plan 'no_plan';
-
-memcache_stress( sub {
-
-my $one = {
- u => temp_user(),
- presence => "<xml><data>",
- motd_ver => 3,
-};
-
-my $two = {
- u => temp_user(),
- presence => "<more><xml>",
- motd_ver => 5,
-};
-
-add( $one );
-load( $one );
-
-add( $two );
-load( $two );
-load( $one );
-
-} );
-
-sub add {
- my $args = shift;
- my $obj = LJ::Jabber::LastSeen->create( %$args );
-
- ok( $obj, "Object create" );
- checkattrs( $obj, $args );
-
- return $obj;
-}
-
-sub load {
- my $args = shift;
- my $obj = LJ::Jabber::LastSeen->new( $args->{u} );
-
- ok( $obj, "Object load" );
- checkattrs( $obj, $args );
-
- return $obj;
-}
-
-sub checkattrs {
- my $obj = shift;
- my $check = shift;
- is( $obj->u, $check->{u}, "User matches" );
- is( $obj->presence, $check->{presence}, "presence data matches" );
- is( $obj->motd_ver, $check->{motd_ver}, "motd_ver matches" );
-}
_______________________________________________
dw-changelog mailing list
[email protected]
http://lists.dwscoalition.org/mailman/listinfo/dw-changelog
