Commits

Toby Inkster committed 0c4e48e

Release XRD::Parser 0.03, WWW::Finger 0.01.

Comments (0)

Files changed (11)

 Makefile.PL
 MANIFEST
 README
-t/WWW-Finger-Fingerpoint.t
+t/WWW-Finger.t
 lib/WWW/Finger/Fingerpoint.pm
 inc/Module/AutoInstall.pm
 inc/Module/Install/AutoInstall.pm
 requires            'LWP::UserAgent'     => 5.00;
 requires            'RDF::Query'         => 2.200;
 requires            'RDF::Query::Client' => 0.02;
-requires            'RDF::Trine'         => 0.111;
+requires            'RDF::Trine'         => 0.112;
 requires            'XML::LibXML'        => 1.60;
-requires            'XRD::Parser'        => 0.02;
+requires            'XRD::Parser'        => 0.03;
 requires            'URI'                => 1.30;
 
 auto_install;
 
 SYNOPSIS
       use WWW::Finger;
-  
       my $finger = WWW::Finger->new("joe@example.com");
-  
       if (defined $finger)
       {
         print $finger->name . "\n";
 
     *       cpan.org scraper (for user@cpan.org)
 
+    The cpan.org scraper implementation is disabled by default. See
+    "IMPLEMENTATIONS" for more details.
+
   Constructor
     *       "new"
 
             return undef if no implemetation is able to handle the identifier
 
   Object Methods
-    Some or all of these methods may return undef. The "name", "mbox",
-    "homepage", "weblog", "image" and "key" methods work in both scalar and
-    list context. Depending on which implementation was used by
-    "WWW::Finger::new", the object may also have additional methods. Consult
-    the documentation for the various implementations for details.
+    Any of these methods can return undef if the appropriate information is
+    not available. The "name", "mbox", "homepage", "weblog", "image" and "key"
+    methods work in both scalar and list context. Depending on which
+    implementation was used by "WWW::Finger::new", the object may also have
+    additional methods. Consult the documentation of the various
+    implementations for details.
 
     "name"  The person's name (or handle/nickname).
 
     "graph" An RDF::Trine::Model object holding data about the person. (See
             RDF::Trine.)
 
+IMPLEMENTATIONS
+  Loading Additional Implementations
+    When importing this package ("use WWW::Finger") you can pass it a list of
+    additional finger implementations to load. For example:
+
+      use WWW::Finger qw(WWW::Finger::CPAN MyCorp::Finger);
+
+    For packages which start with "WWW::Finger::" there is a special
+    abbreviation:
+
+      use WWW::Finger qw(+CPAN MyCorp::Finger);
+
+    Assuming the finger implementations are written correctly,
+    WWW::Finger->new should just notice they exist and use them when
+    appropriate.
+
+    The WebFinger and Fingerpoint implementations are loaded by default.
+
+    To load additional implementations later on (after you've already "used"
+    WWW::Finger) you can call the import method:
+
+      WWW::Finger->import(qw(+Foo +Bar MyCorp::Baz));
+
+    There's no official method of removing an already-imported implementation,
+    but if you really need to, try playing around with the
+    @WWW::Finger::Modules array.
+
+  Calling an Implementation Specifically
+    If you need to call a particular implementation specifically, that should
+    be fairly simple:
+
+      use WWW::Finger::WebFinger;
+      my $finger = WWW::Finger::WebFinger->new("joe@example.com");
+      if (defined $finger)
+      {
+        print $finger->name . "\n";
+      }
+
+  Writing Your Own Implementation
+    Use this stub:
+
+      package WWW::Finger::Example;
+  
+      use strict;
+      use WWW::Finger;
+      use URI;
+  
+      our @ISA = qw(WWW::Finger);
+      our $VERSION = '0.01';
+  
+      BEGIN { push @WWW::Finger::Modules, __PACKAGE__; }
+  
+      sub new
+      {
+        my ($class, $identifier) = @_;
+        my $self = {};
+    
+        # Canonicalise the identifier. You don't have to use
+        # "mailto:"; other URI schemes are allowable.
+        $identifier = "mailto:$identifier"
+          unless $identifier =~ /^[a-z0-9\.\-\+]+:/i;
+
+        # Check whether this package can get useful info
+        # from $identifier. If not, then return undef.
+        if ('check things here')
+        {
+          return undef;
+        }
+    
+        $self->{'ident'} = URI->new($identifier);
+        bless $self, $class;
+      }
+  
+      # Override WWW::Finger methods like 'name', 'mbox', etc.
+      # Feel free to provide additional methods too.
+  
+      1;
+
 SEE ALSO
     Net::Finger.
 

WWW-Finger-0.01.tar.gz

Binary file added.
 #!/usr/bin/perl
 
 use lib "lib";
-use WWW::Finger;
+use lib "../XRD-Parser/lib";
 
-my $finger = WWW::Finger->new('mailto:tobyink@cpan.org');
+use Data::Dumper;
+use XRD::Parser 0.03;
+
+use WWW::Finger qw(+CPAN);
+
+my $finger = WWW::Finger->new('foo_bar@examples.tobyinkster.co.uk');
 
 print $finger->name . "\n";
 print $finger->homepage . "\n";
 print $finger->image . "\n";
 print $finger->mbox . "\n";
+print Dumper($finger->graph->as_hashref) . "\n";

lib/WWW/Finger.pm

 use strict;
 use 5.008001;
 
-use WWW::Finger::CPAN;
-use WWW::Finger::Fingerpoint;
-use WWW::Finger::Webfinger;
+use Carp;
+our @Modules;
+
+our $VERSION = '0.01';
 
 BEGIN
 {
-	my @Modules = ();
+	@Modules = ();
+	eval "use WWW::Finger::Fingerpoint;";
+	carp "Could not load Fingerpoint implementation ($@)" if $@;
+	!eval "use WWW::Finger::Webfinger;";
+	carp "Could not load Webfinger implementation ($@)" if $@;
 }
 
-
 sub new
 {
 	my $class      = shift;
 	return undef;
 }
 
+sub import
+{
+	my $class = shift;
+	foreach my $implementation (@_)
+	{
+		my $module = $implementation;
+		$module =~ s/^\+/WWW::Finger::/;
+		eval "use $module;";
+		carp $@ if $@;
+	}
+}
+
 sub name     { return undef; }
 sub mbox     { return undef; }
 sub key      { return undef; }
 sub graph    { return undef; }
 
 1;
-
 __END__
-# Below is stub documentation for your module. You'd better edit it!
 
 =head1 NAME
 
 =head1 SYNOPSIS
 
   use WWW::Finger;
-  
   my $finger = WWW::Finger->new("joe@example.com");
-  
   if (defined $finger)
   {
     print $finger->name . "\n";
 
 =back
 
+The cpan.org scraper implementation is disabled by default. See
+"IMPLEMENTATIONS" for more details.
+
 =head2 Constructor
 
 =over 8
 
 =head2 Object Methods
 
-Some or all of these methods may return undef. The C<name>, C<mbox>,
-C<homepage>, C<weblog>, C<image> and C<key> methods work in both scalar
-and list context. Depending on which implementation was used by
-C<WWW::Finger::new>, the object may also have additional methods. Consult
-the documentation for the various implementations for details.
+Any of these methods can return undef if the appropriate information
+is not available. The C<name>, C<mbox>, C<homepage>, C<weblog>,
+C<image> and C<key> methods work in both scalar and list context.
+Depending on which implementation was used by C<WWW::Finger::new>,
+the object may also have additional methods. Consult the
+documentation of the various implementations for details.
 
 =over 8
 
 
 =back
 
+=head1 IMPLEMENTATIONS
+
+=head2 Loading Additional Implementations
+
+When importing this package ("use WWW::Finger") you can pass it
+a list of additional finger implementations to load. For example:
+
+  use WWW::Finger qw(WWW::Finger::CPAN MyCorp::Finger);
+
+For packages which start with "WWW::Finger::" there is a special
+abbreviation:
+
+  use WWW::Finger qw(+CPAN MyCorp::Finger);
+
+Assuming the finger implementations are written correctly,
+WWW::Finger->new should just notice they exist and use them
+when appropriate.
+
+The WebFinger and Fingerpoint implementations are loaded by
+default.
+
+To load additional implementations later on (after you've
+already "used" WWW::Finger) you can call the import method:
+
+  WWW::Finger->import(qw(+Foo +Bar MyCorp::Baz));
+
+There's no official method of removing an already-imported
+implementation, but if you really need to, try playing around
+with the C<@WWW::Finger::Modules> array.
+
+=head2 Calling an Implementation Specifically
+
+If you need to call a particular implementation specifically,
+that should be fairly simple:
+
+  use WWW::Finger::WebFinger;
+  my $finger = WWW::Finger::WebFinger->new("joe@example.com");
+  if (defined $finger)
+  {
+    print $finger->name . "\n";
+  }
+
+=head2 Writing Your Own Implementation
+
+Use this stub:
+
+  package WWW::Finger::Example;
+  
+  use strict;
+  use WWW::Finger;
+  use URI;
+  
+  our @ISA = qw(WWW::Finger);
+  our $VERSION = '0.01';
+  
+  BEGIN { push @WWW::Finger::Modules, __PACKAGE__; }
+  
+  sub new
+  {
+    my ($class, $identifier) = @_;
+    my $self = {};
+    
+    # Canonicalise the identifier. You don't have to use
+    # "mailto:"; other URI schemes are allowable.
+    $identifier = "mailto:$identifier"
+      unless $identifier =~ /^[a-z0-9\.\-\+]+:/i;
+
+    # Check whether this package can get useful info
+    # from $identifier. If not, then return undef.
+    if ('check things here')
+    {
+      return undef;
+    }
+    
+    $self->{'ident'} = URI->new($identifier);
+    bless $self, $class;
+  }
+  
+  # Override WWW::Finger methods like 'name', 'mbox', etc.
+  # Feel free to provide additional methods too.
+  
+  1;
+
 =head1 SEE ALSO
 
 L<Net::Finger>.

lib/WWW/Finger/CPAN.pm

 
 1;
 __END__
-# Below is stub documentation for your module. You'd better edit it!
 
 =head1 NAME
 
-WWW::Finger::CPAN - WWW::Finger implementation for CPAN authors
+WWW::Finger::CPAN - WWW::Finger implementation which scrapes cpan.org.
+
+=head1 SEE ALSO
+
+L<WWW::Finger>.
 
 =head1 AUTHOR
 

lib/WWW/Finger/Fingerpoint.pm

 
 1;
 __END__
-# Below is stub documentation for your module. You'd better edit it!
 
 =head1 NAME
 
 
 =head1 SYNOPSIS
 
+  ## Using WWW::Finger
+  
+  use WWW::Finger;
+  
+  my $finger = WWW::Finger->new("joe@example.com");
+  
+  if ($finger)
+  {
+    if ($finger->isa('WWW::Finger::Fingerpoint'))
+    {
+      print "WWW::Finger used WWW::Fingerpoint\n";
+    }
+    print $finger->name . "\n";  # print person's name.
+ }
+
+  ## Using WWW::Finger::Fingerpoint directly
+  
   use RDF::Query::Client;
   use WWW::Finger::Fingerpoint;
   
     }
   }
 
-=head1 DESCRIPTION
-
-Methods:
-
-  * new      - create new object from e-mail address
-  * name     - get person's name
-  * mbox     - get person's e-mail address
-  * homepage - get person's homepage URL
-  * weblog   - get person's blog URL
-  * image    - get person's photo or avatar URL
-  * key      - get a person's PGP/GPG key URL
-  * webid    - get person's identifying URI
-  * endpoint - get person's SPARQL endpoint for querying data
-  * graph    - get the results of a SPARQL DESCRIBE on the person
-
-I'll document this better one day!
-
 =head1 SEE ALSO
 
 L<WWW::Finger>.

lib/WWW/Finger/Webfinger.pm

 use strict;
 
 use Carp;
-use LWP::Simple;
+use LWP::UserAgent;
 use RDF::Query;
-use RDF::Trine;
+use RDF::Trine 0.112;
 use WWW::Finger;
 use URI;
 use URI::Escape;
-use XRD::Parser 0.02;
+use XRD::Parser 0.03;
 
 our @ISA = qw(WWW::Finger);
 our $VERSION = '0.01';
 
+BEGIN
+{
+	push @WWW::Finger::Modules, __PACKAGE__;
+}
+
 sub new
 {
 	my $class = shift;
-	my $ident = shift or croak "Need to supply an e-mail address\n";
+	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);
 		unless $ident->scheme =~ /^(mailto|acct|xmpp)$/;
 
 	$self->{'ident'} = $ident;
-	my ($user, $host) = split /\@/, $ident->to;
+	my ($user, $host) = split /\@/, $ident->authority;
 	
-	my $ua = LWP::UserAgent->new;
-	$ua->timeout(10);
-	$ua->env_proxy;
-
-	my $xrd_parser = XRD::Parser->new(undef,
-		sprintf("http://%s/.well-known/host-meta", $host));
-	$xrd_parser->consume;
-	$self->{'hostmeta'} = $xrd_parser->graph;
+	eval {
+		my $xrd_parser = XRD::Parser->hostmeta($host);
+		$xrd_parser->consume;
+		$self->{'hostmeta'} = $xrd_parser->graph;
+	};
+	return undef unless defined $self->{'hostmeta'};
 	
 	my @descriptors;
-	my $sparql  = sprintf("SELECT ?template WHERE { <%s> <%s> ?template . }",
+	my $sparql  = sprintf("SELECT DISTINCT ?template WHERE { { <%s> <%s> ?template . } UNION { <%s> <%s> ?template . } }",
 		('http://ontologi.es/xrd#host:' . lc $host),
-		'x-xrd+template+for:http://lrdd.net/rel/descriptor');
+		'x-xrd+template+for:http://lrdd.net/rel/descriptor',
+		('http://ontologi.es/xrd#host:' . lc $host),
+		'x-xrd+template+for:http://www.iana.org/assignments/relation/lrdd',
+		);
 	my $query   = RDF::Query->new($sparql);
 	my $results = $query->execute( $self->{'hostmeta'} );
 	while (my $row = $results->next)
 			
 		my $template = $row->{'template'}->literal_value;
 		my $escaped  = uri_escape("$ident");
-		$template = s/\{uri\}/$escaped/;
+		$template =~ s/\{uri\}/$escaped/g;
 		
 		push @descriptors, $template;
 	}
 	
-	use Data::Dumper;
-	warn Dumper(\@descriptors);
+	my $ua = LWP::UserAgent->new;
+	$ua->timeout(10);
+	$ua->env_proxy;
+	$ua->default_header('Accept' => 'application/rdf+xml, text/turtle, application/x-rdf+json, application/xrd+xml;q=0.5, */*;q=0.01');
+
+	foreach my $d (@descriptors)
+	{
+		eval
+		{
+			my $response = $ua->get($d);
+			die unless $response->is_success;
+			
+			if ($response->content_type =~ /xrd/i)
+			{
+				my $profile_parser = XRD::Parser->new($response->decoded_content, $d);
+				$profile_parser->consume;
+				
+				$self->{'graph'} = $profile_parser->graph;
+			}
+			else
+			{
+				my $parser;
+				$parser = RDF::Trine::Parser::Turtle->new  if $response->content_type =~ m`(n3|turtle|text/plain)`;
+				$parser = RDF::Trine::Parser::RDFJSON->new if $response->content_type =~ m`(json)`;
+				$parser = RDF::Trine::Parser::RDFXML->new  unless defined $parser;
+				
+				my $model  = RDF::Trine::Model->new( RDF::Trine::Store->temporary_store );
+				$parser->parse_into_model($d, $response->decoded_content, $model);
+				
+				$self->{'graph'} = $model;
+			}
+		};
+		last
+			if defined $self->{'graph'} && $self->{'graph'}->count_statements;
+	}
+	
+	return undef
+		unless defined $self->{'graph'} && $self->{'graph'}->count_statements;
+	
+	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 . }',
+			(''.$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 undef;
+}
+
+sub name
+{
+	my $self = shift;
+	return $self->_simple_sparql(
+		'http://xmlns.com/foaf/0.1/name');
+}
+
+sub homepage
+{
+	my $self = shift;
+	return $self->_simple_sparql(
+		'http://xmlns.com/foaf/0.1/homepage',
+		'http://webfinger.net/rel/profile-page');
+}
+
+sub weblog
+{
+	my $self = shift;
+	return $self->_simple_sparql(
+		'http://xmlns.com/foaf/0.1/weblog');
+}
+
+sub mbox
+{
+	my $self = shift;
+	return $self->_simple_sparql(
+		'http://xmlns.com/foaf/0.1/mbox');
+}
+
+sub image
+{
+	my $self = shift;
+	return $self->_simple_sparql(
+		'http://webfinger.net/rel/avatar',
+		'http://xmlns.com/foaf/0.1/img',
+		'http://xmlns.com/foaf/0.1/depiction');
+}
+
+sub webid
+{
+	my $self = shift;
+	return ''.$self->{'ident'};
+}
+
+sub graph
+{
+	my $self = shift;
+	return $self->{'graph'};
 }
 
 1;
 
 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 8
+
+=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
+
+=back
+
+=head1 SEE ALSO
+
+L<WWW::Finger>, L<XRD::Parser>.
+
+L<http://code.google.com/p/webfinger/>.
+
 =head1 AUTHOR
 
 Toby Inkster, E<lt>tobyink@cpan.orgE<gt>

t/WWW-Finger-Fingerpoint.t

-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl WWW-Finger-Fingerpoint.t'
-
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
-
-use Test::More tests => 1;
-BEGIN { use_ok('WWW::Finger::Fingerpoint') };
-
-#########################
-
-# Insert your test code below, the Test::More module is use()ed here so read
-# its man page ( perldoc Test::More ) for help writing this test script.
-
+use Test::More tests => 3;
+BEGIN { use_ok('WWW::Finger') };
+
+WWW::Finger->import('+CPAN');
+
+my $finger = WWW::Finger->new('tobyink@cpan.org');
+ok(defined $finger, "CPAN finger worked");
+is($finger->name, "Toby Inkster", "CPAN finger returned correct name");