[#2105] external user tag for Facebook

Had to override canonical_url because FB usernames have
a different allowed character set.

cgi-bin/DW/External/Site.pm

@@ -62,6 +62,7 @@ $domaintosite{"lj.rossia.org"} = DW::External::Site->new("25", "lj.rossia.org",
 # more two-part sites
 $domaintosite{"medium.com"} = DW::External::Site->new("26", "medium.com", "medium.com", "Medium", "medium");
 $domaintosite{"imzy.com"} = DW::External::Site->new("27", "www.imzy.com", "imzy.com", "Imzy", "imzy");
+$domaintosite{"facebook.com"} = DW::External::Site->new("28", "www.facebook.com", "facebook.com", "Facebook", "FB");
 
 
 @all_sites_without_alias = values %domaintosite;
@@ -104,6 +105,9 @@ $domaintosite{"lj.rossia"} = $domaintosite{"lj.rossia.org"};
 $domaintosite{"ljr"} = $domaintosite{"lj.rossia.org"};
 $domaintosite{"medium"} = $domaintosite{"medium.com"};
 $domaintosite{"imzy"} = $domaintosite{"imzy.com"};
+$domaintosite{"facebook"} = $domaintosite{"facebook.com"};
+$domaintosite{"fb"} = $domaintosite{"facebook.com"};
+
 foreach my $value (@all_sites_without_alias) {
     $idtosite{$value->{siteid}} = $value;
 }

cgi-bin/DW/External/Site/Facebook.pm

@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+#
+# DW::External::Site::Facebook
+#
+# Class to support linking to user accounts on Facebook.
+#
+# Authors:
+#      Jen Griffin <kareila@livejournal.com>
+#
+# Copyright (c) 2017 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::Site::Facebook;
+
+use strict;
+use base 'DW::External::Site';
+use Carp qw/ croak /;
+
+
+# new does nothing for these classes
+sub new { croak 'cannot build with new'; }
+
+
+# returns an object if we allow this domain; else undef
+sub accepts {
+    my ( $class, $parts ) = @_;
+
+    # let's just assume the last two parts are good if we have them
+    return undef unless scalar( @$parts ) >= 2;
+
+    return bless { hostname => "$parts->[-2].$parts->[-1]" }, $class;
+}
+
+
+# argument: DW::External::User
+# returns URL to this account's page
+sub journal_url {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+    return 'https://' . $self->{hostname} . "/" . $u->user;
+}
+
+
+# argument: DW::External::User
+# returns URL to this account's profile
+sub profile_url {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+    return 'https://' . $self->{hostname} . "/" . $u->user;
+}
+
+
+# argument: DW::External::User
+# returns info for the badge image (userhead icon) for this user
+sub badge_image {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+    # for lack of anything better, let's use the favicon
+    return {
+        url => "https://www.facebook.com/favicon.ico",
+        width => 16,
+        height => 16,
+    }
+}
+
+
+# returns a cleaned version of the username
+sub canonical_username {
+    my $input = $_[1];
+    my $user = "";
+
+    if ( $input =~ /^\s*([a-zA-Z0-9.]+)\s*$/ ) {  # good username
+        $user = $1;
+    }
+    return $user;
+}
+
+
+1;