![[site community profile]](https://www.dreamwidth.org/img/comm_staff.png){kind=small}
[dw-free] Extend DW::External::User to discover account type and save it
[commit: http://hg.dwscoalition.org/dw-free/rev/432d42b6a6bb]
http://bugs.dwscoalition.org/show_bug.cgi?id=733
Auto-discovery account types of journals from LJ/LJ-based sites, in user
tags that are made using: <user name="exampleusername"
site="livejournal.com">, etc.
Patch by![[personal profile]](https://www.dreamwidth.org/img/silk/identity/user.png)
kareila.
Files modified:
http://bugs.dwscoalition.org/show_bug.cgi?id=733
Auto-discovery account types of journals from LJ/LJ-based sites, in user
tags that are made using: <user name="exampleusername"
site="livejournal.com">, etc.
Patch by
kareila.Files modified:
- bin/upgrading/update-db-general.pl
- bin/worker/resolve-extacct
- cgi-bin/DW/External/Site.pm
- cgi-bin/DW/External/Site/ArchiveofOurOwn.pm
- cgi-bin/DW/External/Site/DeadJournal.pm
- cgi-bin/DW/External/Site/Dreamwidth.pm
- cgi-bin/DW/External/Site/Inksome.pm
- cgi-bin/DW/External/Site/InsaneJournal.pm
- cgi-bin/DW/External/Site/JournalFen.pm
- cgi-bin/DW/External/Site/LiveJournal.pm
- cgi-bin/DW/External/Site/Tumblr.pm
- cgi-bin/DW/External/Site/Twitter.pm
- cgi-bin/DW/External/Site/Unknown.pm
- cgi-bin/DW/External/Userinfo.pm
- etc/config.pl
- htdocs/img/external/dj-community.gif
- htdocs/img/external/dj-syndicated.gif
- htdocs/img/external/dj-userinfo.gif
- htdocs/img/external/ij-community.gif
- htdocs/img/external/ij-userinfo.gif
- htdocs/img/external/ink-community.gif
- htdocs/img/external/ink-userinfo.gif
- htdocs/img/external/lj-community.gif
- htdocs/img/external/lj-syndicated.gif
- t/external-user.t
--------------------------------------------------------------------------------
diff -r 3d2583b4dc77 -r 432d42b6a6bb bin/upgrading/update-db-general.pl
--- a/bin/upgrading/update-db-general.pl Mon Aug 22 17:34:35 2011 +0800
+++ b/bin/upgrading/update-db-general.pl Mon Aug 22 17:55:28 2011 +0800
@@ -3083,6 +3083,17 @@
)
EOC
+register_tablecreate('externaluserinfo', <<'EOC');
+CREATE TABLE externaluserinfo (
+ site INT UNSIGNED NOT NULL,
+ user VARCHAR(50) NOT NULL,
+ last INT UNSIGNED,
+ type CHAR(1),
+
+ PRIMARY KEY (site, user)
+)
+EOC
+
register_tablecreate('renames', <<'EOC');
CREATE TABLE renames (
diff -r 3d2583b4dc77 -r 432d42b6a6bb bin/worker/resolve-extacct
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/worker/resolve-extacct Mon Aug 22 17:55:28 2011 +0800
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+#
+# bin/worker/resolve-extacct
+#
+# Gearman worker for resolving journal type of external accounts.
+#
+# Authors:
+# Jen Griffin <kareila@livejournal.com>
+#
+# Copyright (c) 2010-2011 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself. For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+use strict;
+use warnings;
+use lib "$ENV{LJHOME}/cgi-bin";
+require "ljlib.pl";
+
+use LJ::Worker::Gearman;
+use Storable qw/ thaw /;
+
+use DW::External::Userinfo;
+use DW::External::User;
+
+gearman_decl( 'resolve-extacct' => \&worker );
+gearman_work();
+
+sub worker {
+ my $job = $_[0];
+ my %in = %{ thaw( $job->arg ) || {} };
+
+ # reconstruct DW::External::User object
+ my $u = DW::External::User->new( user => $in{user}, site => $in{site} );
+ return unless $u;
+
+ # the processor is defined in DW::External::Userinfo
+ return DW::External::Userinfo->check_remote( $u, $in{url} );
+}
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Site.pm
--- a/cgi-bin/DW/External/Site.pm Mon Aug 22 17:34:35 2011 +0800
+++ b/cgi-bin/DW/External/Site.pm Mon Aug 22 17:55:28 2011 +0800
@@ -20,6 +20,7 @@
use strict;
use Carp qw/ croak /;
+use DW::External::Userinfo;
use DW::External::XPostProtocol;
use LJ::ModuleLoader;
@@ -110,36 +111,77 @@
return $self;
}
+# returns the account type for this user on this site.
+sub journaltype {
+ my $self = shift;
+ return DW::External::Userinfo->lj_journaltype( @_ )
+ if $self->{servicetype} eq 'lj';
+ return 'P'; # default
+}
+
# returns the journal_url for this user on this site.
sub journal_url {
my ( $self, $u ) = @_;
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: this should do something like $u->is_person to determine what kind
-# of thing to setup...
- return 'http://' . $self->{hostname} . '/users/' . $u->user . '/';
+ # IF YOU OVERRIDE THIS WITH CODE THAT CHECKS JOURNALTYPE,
+ # YOU MUST PASS THE BASE URL TO CHECK EXPLICITLY.
+ # OTHERWISE IT WILL CALL BACK HERE FOR THE URL,
+ # AND YOU WILL SEE WHAT INFINITE RECURSION LOOKS LIKE.
+
+ # override this on a site-by-site basis if needed
+ return "http://$self->{hostname}/users/" . $u->user . '/';
}
-
# returns the profile_url for this user on this site.
sub profile_url {
my ( $self, $u ) = @_;
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: same as above
- return 'http://' . $self->{hostname} . '/users/' . $u->user . '/profile';
+ # IF YOU OVERRIDE THIS WITH CODE THAT CHECKS JOURNALTYPE,
+ # YOU MUST PASS THE BASE URL TO CHECK EXPLICITLY.
+ # OTHERWISE IT WILL CALL BACK HERE FOR THE URL,
+ # AND YOU WILL SEE WHAT INFINITE RECURSION LOOKS LIKE.
+
+ # override this on a site-by-site basis if needed
+ return $self->journal_url( $u ) . 'profile';
}
+
+# returns the feed_url for this user on this site.
+sub feed_url {
+ my ( $self, $u ) = @_;
+ croak 'need a DW::External::User'
+ unless $u && ref $u eq 'DW::External::User';
+
+ # IF YOU OVERRIDE THIS WITH CODE THAT CHECKS JOURNALTYPE,
+ # YOU MUST PASS THE BASE URL TO CHECK EXPLICITLY.
+ # OTHERWISE IT WILL CALL BACK HERE FOR THE URL,
+ # AND YOU WILL SEE WHAT INFINITE RECURSION LOOKS LIKE.
+
+ # override this on a site-by-site basis if needed
+ return $self->journal_url( $u ) . 'data/atom';
+}
+
# returns the badge_image_url for this user on this site.
sub badge_image_url {
my ( $self, $u ) = @_;
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: same as above
- return 'http://' . $self->{hostname} . '/img/userinfo.gif';
+ # override this on a site-by-site basis if needed
+ my $type = $self->journaltype( $u ) || 'P';
+ my $gif = {
+ P => '/img/userinfo.gif',
+ C => '/img/community.gif',
+ Y => '/img/syndicated.gif',
+ };
+ # this will do the right thing for an lj-based site,
+ # but it's better to override this with cached images
+ # to avoid hammering the remote site with image requests.
+ return "http://$self->{hostname}$gif->{$type}";
}
# adjust the request for any per-site limitations
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Site/ArchiveofOurOwn.pm
--- a/cgi-bin/DW/External/Site/ArchiveofOurOwn.pm Mon Aug 22 17:34:35 2011 +0800
+++ b/cgi-bin/DW/External/Site/ArchiveofOurOwn.pm Mon Aug 22 17:55:28 2011 +0800
@@ -39,26 +39,6 @@
# argument: DW::External::User
-# returns URL to this user's account
-sub journal_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
- return 'http://www.archiveofourown.org/users/' . $u->user . '/';
-}
-
-
-# argument: DW::External::User
-# returns URL to this user's profile
-sub profile_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
- return 'http://www.archiveofourown.org/users/' . $u->user . '/profile';
-}
-
-
-# argument: DW::External::User
# returns URL to the badge image (head icon) for this user
sub badge_image_url {
my ( $self, $u ) = @_;
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Site/DeadJournal.pm
--- a/cgi-bin/DW/External/Site/DeadJournal.pm Mon Aug 22 17:34:35 2011 +0800
+++ b/cgi-bin/DW/External/Site/DeadJournal.pm Mon Aug 22 17:55:28 2011 +0800
@@ -38,41 +38,22 @@
# argument: DW::External::User
-# returns URL to this account's journal
-sub journal_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
-
-# FIXME: this should do something like $u->is_person to determine what kind
-# of thing to setup...
- return 'http://www.deadjournal.com/users/' . $u->user . '/';
-}
-
-
-# argument: DW::External::User
-# returns URL to this account's journal
-sub profile_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
-
-# FIXME: same as above
- return 'http://www.deadjournal.com/users/' . $u->user . '/profile';
-}
-
-
-# argument: DW::External::User
# returns URL to the badge image (head icon) for this user
sub badge_image_url {
my ( $self, $u ) = @_;
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: same as above
- return 'http://www.deadjournal.com/img/userinfo.gif';
+ my $type = $self->journaltype( $u ) || 'P';
+ my $gif = {
+ P => '/external/dj-userinfo.gif',
+ C => '/external/dj-community.gif',
+ Y => '/external/dj-syndicated.gif',
+ };
+ return $LJ::IMGPREFIX . $gif->{$type};
}
+
# argument: request hash
# returns: modified request hash
sub pre_crosspost_hook {
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Site/Dreamwidth.pm
--- a/cgi-bin/DW/External/Site/Dreamwidth.pm Mon Aug 22 17:34:35 2011 +0800
+++ b/cgi-bin/DW/External/Site/Dreamwidth.pm Mon Aug 22 17:55:28 2011 +0800
@@ -44,21 +44,9 @@
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: this should do something like $u->is_person to determine what kind
-# of thing to setup...
- return 'http://www.dreamwidth.org/users/' . $u->user . '/';
-}
-
-
-# argument: DW::External::User
-# returns URL to this account's journal
-sub profile_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
-
-# FIXME: same as above
- return 'http://www.dreamwidth.org/users/' . $u->user . '/profile';
+ my $user = $u->user;
+ $user =~ tr/_/-/;
+ return "http://$user.$self->{domain}/";
}
@@ -69,8 +57,13 @@
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: same as above
- return "$LJ::IMGPREFIX/silk/identity/user.png";
+ my $type = $self->journaltype( $u ) || 'P';
+ my $img = {
+ P => '/silk/identity/user.png',
+ C => '/silk/identity/community.png',
+ Y => '/silk/identity/feed.png',
+ };
+ return $LJ::IMGPREFIX . $img->{$type};
}
sub canonical_username {
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Site/Inksome.pm
--- a/cgi-bin/DW/External/Site/Inksome.pm Mon Aug 22 17:34:35 2011 +0800
+++ b/cgi-bin/DW/External/Site/Inksome.pm Mon Aug 22 17:55:28 2011 +0800
@@ -44,21 +44,10 @@
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: this should do something like $u->is_person to determine what kind
-# of thing to setup...
- return 'http://www.inksome.com/users/' . $u->user . '/';
-}
-
-
-# argument: DW::External::User
-# returns URL to this account's journal
-sub profile_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
-
-# FIXME: same as above
- return 'http://www.inksome.com/users/' . $u->user . '/profile';
+ # normal default is broken for Inksome community redirect
+ my $user = $u->user;
+ $user =~ tr/_/-/;
+ return "http://$user.$self->{domain}/";
}
@@ -69,8 +58,8 @@
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: same as above
- return 'http://www.inksome.com/img/userinfo.gif';
+ # Inksome went away, so just assume every account is personal
+ return "$LJ::IMGPREFIX/external/ink-userinfo.gif";
}
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Site/InsaneJournal.pm
--- a/cgi-bin/DW/External/Site/InsaneJournal.pm Mon Aug 22 17:34:35 2011 +0800
+++ b/cgi-bin/DW/External/Site/InsaneJournal.pm Mon Aug 22 17:55:28 2011 +0800
@@ -38,41 +38,22 @@
# argument: DW::External::User
-# returns URL to this account's journal
-sub journal_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
-
-# FIXME: this should do something like $u->is_person to determine what kind
-# of thing to setup...
- return 'http://www.insanejournal.com/users/' . $u->user . '/';
-}
-
-
-# argument: DW::External::User
-# returns URL to this account's journal
-sub profile_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
-
-# FIXME: same as above
- return 'http://www.insanejournal.com/users/' . $u->user . '/profile';
-}
-
-
-# argument: DW::External::User
# returns URL to the badge image (head icon) for this user
sub badge_image_url {
my ( $self, $u ) = @_;
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: same as above
- return 'http://www.insanejournal.com/img/userinfo.gif';
+ my $type = $self->journaltype( $u ) || 'P';
+ my $gif = {
+ P => '/external/ij-userinfo.gif',
+ C => '/external/ij-community.gif',
+ Y => '/external/lj-syndicated.gif',
+ };
+ return $LJ::IMGPREFIX . $gif->{$type};
}
+
# argument: request hash
# returns: modified request hash
sub pre_crosspost_hook {
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Site/JournalFen.pm
--- a/cgi-bin/DW/External/Site/JournalFen.pm Mon Aug 22 17:34:35 2011 +0800
+++ b/cgi-bin/DW/External/Site/JournalFen.pm Mon Aug 22 17:55:28 2011 +0800
@@ -38,39 +38,19 @@
# argument: DW::External::User
-# returns URL to this account's journal
-sub journal_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
-
-# FIXME: this should do something like $u->is_person to determine what kind
-# of thing to setup...
- return 'http://www.journalfen.net/users/' . $u->user . '/';
-}
-
-
-# argument: DW::External::User
-# returns URL to this account's journal
-sub profile_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
-
-# FIXME: same as above
- return 'http://www.journalfen.net/users/' . $u->user . '/profile';
-}
-
-
-# argument: DW::External::User
# returns URL to the badge image (head icon) for this user
sub badge_image_url {
my ( $self, $u ) = @_;
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: same as above
- return 'http://www.journalfen.net/img/userinfo.gif';
+ my $type = $self->journaltype( $u ) || 'P';
+ my $gif = {
+ P => '/external/lj-userinfo.gif',
+ C => '/external/lj-community.gif',
+ Y => '/external/lj-syndicated.gif',
+ };
+ return $LJ::IMGPREFIX . $gif->{$type};
}
sub canonical_username {
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Site/LiveJournal.pm
--- a/cgi-bin/DW/External/Site/LiveJournal.pm Mon Aug 22 17:34:35 2011 +0800
+++ b/cgi-bin/DW/External/Site/LiveJournal.pm Mon Aug 22 17:55:28 2011 +0800
@@ -44,21 +44,9 @@
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: this should do something like $u->is_person to determine what kind
-# of thing to setup...
- return 'http://www.livejournal.com/users/' . $u->user . '/';
-}
-
-
-# argument: DW::External::User
-# returns URL to this account's journal
-sub profile_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
-
-# FIXME: same as above
- return 'http://www.livejournal.com/users/' . $u->user . '/profile';
+ my $user = $u->user;
+ $user =~ tr/_/-/;
+ return "http://$user.$self->{domain}/";
}
@@ -69,8 +57,13 @@
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
-# FIXME: same as above
- return "$LJ::IMGPREFIX/external/lj-userinfo.gif";
+ my $type = $self->journaltype( $u ) || 'P';
+ my $gif = {
+ P => '/external/lj-userinfo.gif',
+ C => '/external/lj-community.gif',
+ Y => '/external/lj-syndicated.gif',
+ };
+ return $LJ::IMGPREFIX . $gif->{$type};
}
sub canonical_username {
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Site/Tumblr.pm
--- a/cgi-bin/DW/External/Site/Tumblr.pm Mon Aug 22 17:34:35 2011 +0800
+++ b/cgi-bin/DW/External/Site/Tumblr.pm Mon Aug 22 17:55:28 2011 +0800
@@ -55,7 +55,7 @@
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
- return 'http://' . $u->user . '.' . $self->{hostname};
+ return $self->journal_url( $u );
}
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Site/Twitter.pm
--- a/cgi-bin/DW/External/Site/Twitter.pm Mon Aug 22 17:34:35 2011 +0800
+++ b/cgi-bin/DW/External/Site/Twitter.pm Mon Aug 22 17:55:28 2011 +0800
@@ -54,7 +54,7 @@
croak 'need a DW::External::User'
unless $u && ref $u eq 'DW::External::User';
- return 'http://' . $self->{hostname} . '/' . $u->user;
+ return $self->journal_url( $u );
}
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Site/Unknown.pm
--- a/cgi-bin/DW/External/Site/Unknown.pm Mon Aug 22 17:34:35 2011 +0800
+++ b/cgi-bin/DW/External/Site/Unknown.pm Mon Aug 22 17:55:28 2011 +0800
@@ -48,17 +48,6 @@
# argument: DW::External::User
-# returns URL to this account's journal
-sub profile_url {
- my ( $self, $u ) = @_;
- croak 'need a DW::External::User'
- unless $u && ref $u eq 'DW::External::User';
-
- return 'http://www.' . $self->{hostname} . '/users/' . $u->user . '/profile';
-}
-
-
-# argument: DW::External::User
# returns URL to the badge image (head icon) for this user
sub badge_image_url {
my ( $self, $u ) = @_;
diff -r 3d2583b4dc77 -r 432d42b6a6bb cgi-bin/DW/External/Userinfo.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/External/Userinfo.pm Mon Aug 22 17:55:28 2011 +0800
@@ -0,0 +1,288 @@
+#!/usr/bin/perl
+#
+# DW::External::Userinfo - Methods for discovery of journal type
+# for DW::External::User accounts.
+#
+# Authors:
+# Jen Griffin <kareila@livejournal.com>
+#
+# Copyright (c) 2010-2011 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself. For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+
+package DW::External::Userinfo;
+use strict;
+
+use Carp qw/ croak /;
+use Storable qw/ nfreeze /;
+use LWPx::ParanoidAgent;
+
+# timeout interval - to avoid hammering the remote site,
+# wait 30 minutes before trying again for this user
+sub wait { return 1800; }
+
+sub agent {
+ return LWPx::ParanoidAgent->new( agent => "$LJ::SITENAME Userinfo; $LJ::ADMIN_EMAIL",
+ max_size => 10240 );
+}
+
+
+# CACHE METHODS
+
+sub load {
+ my ( $class, $u ) = @_;
+ croak 'need a DW::External::User'
+ unless $u && ref $u eq 'DW::External::User';
+ my $user = $u->user;
+ my $site = $u->site->{siteid};
+
+ # check memcache
+ my $memkey = "ext_userinfo:$site:$user";
+ my $data = LJ::MemCache::get( $memkey );
+ return $data if defined $data;
+
+ # check the database
+ my $dbr = LJ::get_db_reader() or return undef;
+ $data = $dbr->selectrow_array(
+ "SELECT type FROM externaluserinfo WHERE user=?" .
+ " AND site=?", undef, $user, $site );
+ die $dbr->errstr if $dbr->err;
+
+ if ( defined $data ) {
+ LJ::MemCache::set( $memkey, $data );
+ } else { # rate limiting
+ LJ::MemCache::set( $memkey, '', $class->wait );
+ }
+
+ # possible return values:
+ # - the journaltype PYC (best case scenario)
+ # - undef (not cached anywhere, go look for it)
+ # - null string (timeout in memcache, need to wait)
+ return $data;
+}
+
+sub timeout {
+ # there are two layers of timeout protection.
+ # we set a timeout in memcache for ext_userinfo
+ # when we try to load the data for the user,
+ # but we also set one in the database for persistence.
+ # this function checks to see if the timeout
+ # is in effect, returning true if we need to wait more,
+ # or false if it's OK to try to try loading again.
+
+ my ( $class, $u ) = @_;
+ croak 'need a DW::External::User'
+ unless $u && ref $u eq 'DW::External::User';
+ my $user = $u->user;
+ my $site = $u->site->{siteid};
+
+ # check memcache
+ my $memkey = "ext_userinfo:$site:$user";
+ my $timeout = LJ::MemCache::get( $memkey );
+ return 1 if defined $timeout && $timeout eq '';
+
+ # check the database
+ my $dbr = LJ::get_db_reader() or return undef;
+ $timeout = $dbr->selectrow_array(
+ "SELECT last FROM externaluserinfo WHERE user=?" .
+ " AND site=?", undef, $user, $site );
+ die $dbr->errstr if $dbr->err;
+ return 0 unless $timeout;
+
+ # at this point, we've determined that there is a
+ # timeout in the database but not in memcache.
+ # we need to check and see if it's expired.
+
+ my $time_remaining = $timeout + $class->wait - time;
+ if ( $time_remaining > 0 ) {
+ # timeout hasn't expired yet
+ LJ::MemCache::set( $memkey, '', $time_remaining + 60 );
+ return 1;
+ } else {
+ return 0; # timeout expired
+ }
+}
+
+sub save {
+ my ( $class, $u, %opts ) = @_;
+ croak 'need a DW::External::User'
+ unless $u && ref $u eq 'DW::External::User';
+ return undef unless %opts;
+ my $user = $u->user;
+ my $site = $u->site->{siteid};
+
+ my $memkey = "ext_userinfo:$site:$user";
+ my $dbh = LJ::get_db_writer() or return undef;
+
+ if ( $opts{timeout} ) {
+ $dbh->do( "REPLACE INTO externaluserinfo (user, site, last)" .
+ " VALUES (?,?,?)", undef, $user, $site, $opts{timeout} );
+ die $dbh->errstr if $dbh->err;
+ LJ::MemCache::set( $memkey, '', $class->wait );
+
+ } elsif ( $opts{type} && $opts{type} =~ /^[PYC]$/ ) {
+ # save as journaltype and clear any timeout
+ $dbh->do( "REPLACE INTO externaluserinfo (user, site, type, last)" .
+ " VALUES (?,?,?,?)", undef, $user, $site, $opts{type}, undef );
+ die $dbh->errstr if $dbh->err;
+ LJ::MemCache::set( $memkey, $opts{type} );
+
+ } else {
+ my $opterr = join ', ', map { "$_ => $opts{$_}" } keys %opts;
+ croak "Bad values passed to DW::External::Userinfo->save: $opterr";
+ }
+
+ return 1;
+}
+
+
+# PARSE METHODS
+
+sub parse_domain {
+ my ( $class, $url ) = @_;
+ return '' unless $url;
+ my ( $host ) = $url =~ m@^https?://([^/]+)@;
+ my @parts = split /\./, $host;
+ return join '.', $parts[-2], $parts[-1];
+}
+
+sub is_offsite_redirect {
+ my ( $class, $res, $url ) = @_;
+ return 0 unless $res->previous;
+ my $resurl = $res->previous->header( 'Location' );
+ if ( my $resdom = $class->parse_domain( $resurl ) ) {
+ my $urldom = $class->parse_domain( $url );
+ return 1 if $resdom ne $urldom;
+ }
+}
+
+sub atomtype {
+ my ( $class, $atomurl ) = @_;
+ return undef unless $atomurl;
+ my $ua = $class->agent;
+ my $res = $ua->get( $atomurl );
+ return undef unless $res && $res->is_success;
+
+ # check for redirects to a different domain
+ # (this will catch offsite syndicated accounts)
+ return 'feed' if $class->is_offsite_redirect( $res, $atomurl );
+
+ # this is simple enough not to bother with an XML parser
+ my $text = $res->content || '';
+ my ( $str ) = $text =~ m@<(?:lj|dw):journal ([^/]*)/>@i;
+ return undef unless $str;
+
+ my @attrs = split / /, $str;
+ foreach ( @attrs ) {
+ # look for type="journaltype"
+ my ( $key, $val ) = split /=/;
+ return substr( $val, 1, -1 ) if $key eq 'type';
+ } # community / personal / news
+}
+
+sub title {
+ my ( $class, $url ) = @_;
+ return undef unless $url;
+ my $ua = $class->agent;
+ my $res = $ua->get( $url );
+ return 'error' if $res && $res->code == 404; # non-exist
+ return undef unless $res && $res->is_success; # non-response
+
+ my $text = $res->content || '';
+ my ( $title ) = $text =~ m@<title>([^<]*)</title>@i;
+ return lc $title; # e.g. username - community profile
+}
+
+
+# REMOTE METHODS
+# to be called from gearman worker (background processing)
+
+sub check_remote {
+ my ( $class, $u, $urlbase ) = @_;
+ croak 'need a DW::External::User'
+ unless $u && ref $u eq 'DW::External::User';
+ my $site = $u->site;
+ my $type;
+
+ # translate to one-character journaltype codes
+ my %type = (
+ asylum => 'C', # InsaneJournal
+ community => 'C',
+ feed => 'Y',
+ news => 'C',
+ personal => 'P',
+ syndicated => 'Y',
+ user => 'P',
+ );
+
+ # invalid users don't always 404, so we also detect from title
+ my %invalid = ( 'error' => 1, 'unknown journal' => 1 );
+
+ my ( $profile, $feed );
+ if ( $urlbase ) {
+ $profile = $urlbase . 'profile';
+ $feed = $urlbase . 'data/atom';
+ } else { # beware recursion
+ $profile = $site->profile_url( $u );
+ $feed = $site->feed_url( $u );
+ }
+
+ # Remote attempt 1/2: Check atom feed.
+ unless ( $type ) {
+ my $a = $class->atomtype( $feed );
+ $type = $type{$a} if $a && $type{$a};
+ }
+
+ # Remote attempt 2/2: Check the profile page title,
+ # in case the site has nonstandard or nonexistent feeds.
+ unless ( $type ) {
+ if ( my $t = $class->title( $profile ) ) {
+ return $class->save( $u, timeout => time + 3*86400 ) # 3 days
+ if $invalid{$t};
+ my $keys = join '|', sort keys %type;
+ my ( $w ) = ( $t =~ /\b($keys)\b/ );
+ $type = $type{$w} if $w && $type{$w};
+ }
+ }
+
+ # If everything has failed, set a timeout.
+ my %opts = $type ? ( type => $type ) : ( timeout => time );
+ return $class->save( $u, %opts );
+}
+
+
+# JOURNALTYPE METHODS
+# to be called from DW::External::Site
+
+# determines the account type for this user on an lj-based site.
+sub lj_journaltype {
+ my ( $class, $u, $urlbase ) = @_;
+ croak 'need a DW::External::User'
+ unless $u && ref $u eq 'DW::External::User';
+
+ # try to load the journaltype from cache
+ if ( my $type = $class->load( $u ) ) {
+ return $type;
+ }
+
+ # if it's not cached, check remote if allowed
+ if ( LJ::is_enabled( 'extacct_info', $u->site ) &&
+ ! $class->timeout( $u ) ) {
+
+ # ask gearman worker to do a lookup (calls check_remote)
+ if ( my $gc = LJ::gearman_client() ) {
+ my ( $user, $site ) = ( $u->user, $u->site->{domain} );
+ my $args = { user => $user, site => $site, url => $urlbase };
+ $gc->dispatch_background( 'resolve-extacct', nfreeze( $args ),
+ { uniq => "$user\@$site" } );
+ }
+ }
+
+ # default is to assume personal account
+ return 'P';
+}
+
+
+1;
diff -r 3d2583b4dc77 -r 432d42b6a6bb etc/config.pl
--- a/etc/config.pl Mon Aug 22 17:34:35 2011 +0800
+++ b/etc/config.pl Mon Aug 22 17:55:28 2011 +0800
@@ -159,6 +159,11 @@
tellafriend => 0,
);
+ # allow extacct_info for all sites except LiveJournal
+ #$DISABLED{extacct_info} = sub {
+ # ref $_[0] && defined $_[0]->{sitename} &&
+ # $_[0]->{sitename} eq 'LiveJournal' ? 1 : 0 };
+
# turn $SERVER_DOWN on while you do any maintenance
$SERVER_TOTALLY_DOWN = 0;
$SERVER_DOWN = 0;
diff -r 3d2583b4dc77 -r 432d42b6a6bb htdocs/img/external/dj-community.gif
Binary file htdocs/img/external/dj-community.gif has changed
diff -r 3d2583b4dc77 -r 432d42b6a6bb htdocs/img/external/dj-syndicated.gif
Binary file htdocs/img/external/dj-syndicated.gif has changed
diff -r 3d2583b4dc77 -r 432d42b6a6bb htdocs/img/external/dj-userinfo.gif
Binary file htdocs/img/external/dj-userinfo.gif has changed
diff -r 3d2583b4dc77 -r 432d42b6a6bb htdocs/img/external/ij-community.gif
Binary file htdocs/img/external/ij-community.gif has changed
diff -r 3d2583b4dc77 -r 432d42b6a6bb htdocs/img/external/ij-userinfo.gif
Binary file htdocs/img/external/ij-userinfo.gif has changed
diff -r 3d2583b4dc77 -r 432d42b6a6bb htdocs/img/external/ink-community.gif
Binary file htdocs/img/external/ink-community.gif has changed
diff -r 3d2583b4dc77 -r 432d42b6a6bb htdocs/img/external/ink-userinfo.gif
Binary file htdocs/img/external/ink-userinfo.gif has changed
diff -r 3d2583b4dc77 -r 432d42b6a6bb htdocs/img/external/lj-community.gif
Binary file htdocs/img/external/lj-community.gif has changed
diff -r 3d2583b4dc77 -r 432d42b6a6bb htdocs/img/external/lj-syndicated.gif
Binary file htdocs/img/external/lj-syndicated.gif has changed
diff -r 3d2583b4dc77 -r 432d42b6a6bb t/external-user.t
--- a/t/external-user.t Mon Aug 22 17:34:35 2011 +0800
+++ b/t/external-user.t Mon Aug 22 17:55:28 2011 +0800
@@ -96,7 +96,7 @@
is( $u->user, "example_username", "Canonicalize usernames from LJ-based sites" );
is( $u->site->{hostname}, "www.livejournal.com", "Site is livejournal.com" );
- is( $u->site->journal_url( $u ), "http://www.livejournal.com/users/example_username/", "hyphen is an underscore when not a subdomain" );
+ is( $u->site->journal_url( $u ), "http://example-username.livejournal.com/", "use hyphen in subdomain" );
}
note( "Username with hyphen (subdomain)" );
--------------------------------------------------------------------------------