/usr/share/perl5/WWW/Finger/Webfinger.pm is in libwww-finger-perl 0.105-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 | package WWW::Finger::Webfinger;
use 5.010;
use common::sense;
use utf8;
use Carp 0;
use HTTP::LRDD 0.104;
use LWP::UserAgent 0;
use RDF::Query 2.900;
use RDF::Trine 0.135 qw[iri];
use URI 0;
use URI::Escape 0;
use XRD::Parser 0.102;
use parent qw(WWW::Finger::_GenericRDF);
BEGIN {
$WWW::Finger::Webfinger::AUTHORITY = 'cpan:TOBYINK';
$WWW::Finger::Webfinger::VERSION = '0.105';
}
sub speed { 100 }
sub new
{
my $class = shift;
my $ident = shift or croak "Need to supply an account address\n";
my $self = bless {}, $class;
$ident = "acct:$ident"
unless $ident =~ /^[a-z0-9\.\-\+]+:/i;
$ident = URI->new($ident);
return undef
unless $ident->scheme =~ /^(mailto|acct|xmpp)$/;
$self->{'ident'} = $ident;
my $lrdd = HTTP::LRDD->new('http://lrdd.net/rel/descriptor', 'describedby', 'lrdd', 'webfinger');
my @d = $lrdd->discover($ident);
$self->{'graph'} = $lrdd->process_all($ident);
$self->follow_seeAlso(0);
return undef
unless $self->{'graph'}->count_statements(iri($ident),undef,undef)
|| $self->{'graph'}->count_statements(undef,undef,iri($ident));
return $self;
}
sub _simple_sparql
{
my $self = shift;
my $where = '';
foreach my $p (@_)
{
$where .= " UNION " if length $where;
$where .= sprintf('{ <%s> <%s> ?x . } '
. 'UNION { ?z xrd:alias <%s> ; <%s> ?x . } '
. 'UNION { ?z <http://xmlns.com/foaf/0.1/account> <%s> ; <%s> ?x . } '
. 'UNION { ?z <http://xmlns.com/foaf/0.1/holdsAccount> <%s> ; <%s> ?x . }',
(''.$self->{'ident'}), $p,
(''.$self->{'ident'}), $p,
(''.$self->{'ident'}), $p,
(''.$self->{'ident'}), $p,
);
}
my $sparql = "PREFIX xrd: <http://ontologi.es/xrd#> SELECT DISTINCT ?x WHERE { $where }";
my $query = RDF::Query->new($sparql);
my $iter = $query->execute( $self->{'graph'} );
my @results;
while (my $row = $iter->next)
{
push @results, $row->{'x'}->literal_value
if $row->{'x'}->is_literal;
push @results, $row->{'x'}->uri
if $row->{'x'}->is_resource;
}
if (wantarray)
{
return @results;
}
if (@results)
{
return $results[0];
}
return;
}
sub webid
{
return (shift)->SUPER::webid(@_);
}
1;
__END__
=head1 NAME
WWW::Finger::Webfinger - WWW::Finger module for Webfinger
=head1 DESCRIPTION
Webfinger is currently a very unstable specification, with implementation details
changing all the time. Given this instability, it seems prudent to describe the
protocol, as implemented by this package.
Given an e-mail-like identifier, the package will prepend "acct:" to it, assuming that
the identifier doesn't already have a URI scheme. This identifier will now be called
[ident].
The package looks up the host-meta file associated with the host for [ident].
It is assumed to be formatted according to the draft-hammer-hostmeta-05
Internet Draft L<http://tools.ietf.org/html/draft-hammer-hostmeta-05> and
XRD Working Draft 10 <http://www.oasis-open.org/committees/download.php/35274/xrd-1.0-wd10.html>.
Both these drafts are dated 19 November 2009.
A link template will be extracted from the host-meta for the host using either
of the following two relationships: L<http://lrdd.net/rel/descriptor>,
L<http://www.iana.org/assignments/relation/lrdd>. (Neither is prioritised, so
if both exist and have different templates, hilarity will ensue.)
The token "{uri}" in the link template will be replaced with the URL-encoded
version of [ident] to create an account descriptor URI.
The account descriptor URI is fetched via HTTP GET with an Accept header
asking for RDF/XML, Turtle, RDF/JSON or XRD. The result is parsed for account
description data if it has status code 200 (OK).
The following relationships/properties are understood in the account
description:
=over
=item * http://xmlns.com/foaf/0.1/name
=item * http://xmlns.com/foaf/0.1/homepage
=item * http://webfinger.net/rel/profile-page
=item * http://xmlns.com/foaf/0.1/weblog
=item * http://xmlns.com/foaf/0.1/mbox
=item * http://webfinger.net/rel/avatar
=item * http://xmlns.com/foaf/0.1/img
=item * http://xmlns.com/foaf/0.1/depiction
=item * http://ontologi.es/sparql#endpoint
=back
As well as the standard WWW::Finger methods, WWW::Finger::Webfinger provides this
additional method:
=over
=item C<< get($p1, $p2, ...) >>
$p1, $p2 and are RDF predicate URIs, XRD Link@rel values, or XRD Property@type values
# Returns phone numbers...
$finger->get('http://xmlns.com/foaf/0.1/phone',
'http://rdf.data-vocabulary.org/#tel');
# Salmon-style magic keys
$finger->get('magic-public-key');
=back
=head1 SEE ALSO
L<WWW::Finger>, L<XRD::Parser>, L<HTTP::LRDD>.
L<http://code.google.com/p/webfinger/>.
=head1 AUTHOR
Toby Inkster, E<lt>tobyink@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENCE
Copyright (C) 2009-2012 by Toby Inkster
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 DISCLAIMER OF WARRANTIES
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
=cut
|