fu: Close-up of Fu, bringing a scoop of water to her mouth (Default)
fu ([personal profile] fu) wrote in [site community profile] changelog2011-08-22 09:56 am

[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] 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)" );
--------------------------------------------------------------------------------
kareila: (Default)

[personal profile] kareila 2011-08-22 03:11 pm (UTC)(link)
Psst, don't forget to make bin/worker/resolve-extacct executable.
yvi: Kaylee half-smiling, looking very pretty (Default)

[personal profile] yvi 2011-08-22 04:09 pm (UTC)(link)
\o/
turlough: The Girl (Grace Jeanette) yay!ing from car window, Art is the Weapon video, Sept 2010 ((mcr) yay!)

[personal profile] turlough 2011-08-25 08:37 pm (UTC)(link)
SO COOL!!!!!