r72090 - in /branches/upstream/libgravatar-url-perl/current: Build.PL Changes MANIFEST META.yml SIGNATURE lib/Gravatar/URL.pm lib/Libravatar/URL.pm lib/Unicornify/URL.pm t/libravatar.t
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Thu Mar 31 11:12:42 UTC 2011
Author: angelabad-guest
Date: Thu Mar 31 11:11:32 2011
New Revision: 72090
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=72090
Log:
[svn-upgrade] new version libgravatar-url-perl (1.04)
Added:
branches/upstream/libgravatar-url-perl/current/SIGNATURE
Modified:
branches/upstream/libgravatar-url-perl/current/Build.PL
branches/upstream/libgravatar-url-perl/current/Changes
branches/upstream/libgravatar-url-perl/current/MANIFEST
branches/upstream/libgravatar-url-perl/current/META.yml
branches/upstream/libgravatar-url-perl/current/lib/Gravatar/URL.pm
branches/upstream/libgravatar-url-perl/current/lib/Libravatar/URL.pm
branches/upstream/libgravatar-url-perl/current/lib/Unicornify/URL.pm
branches/upstream/libgravatar-url-perl/current/t/libravatar.t
Modified: branches/upstream/libgravatar-url-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/Build.PL?rev=72090&op=diff
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/Build.PL (original)
+++ branches/upstream/libgravatar-url-perl/current/Build.PL Thu Mar 31 11:11:32 2011
@@ -33,6 +33,7 @@
'Net::DNS::Resolver' => 0,
'URI::Escape' => 0,
'Digest::MD5' => 0,
+ 'Digest::SHA' => 0,
'Carp' => 0,
perl => '5.6.0',
'parent' => 0,
Modified: branches/upstream/libgravatar-url-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/Changes?rev=72090&op=diff
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/Changes (original)
+++ branches/upstream/libgravatar-url-perl/current/Changes Thu Mar 31 11:11:32 2011
@@ -1,3 +1,7 @@
+1.04 Tue Mar 29 17:47:34 NZDT 2011
+ New features
+ * Added OpenID support in Libravatar::URL
+
1.03 Sat Mar 12 18:17:03 NZDT 2011
New Features
* Added Libravatar::URL for federated avatar hosting with a Gravatar
Modified: branches/upstream/libgravatar-url-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/MANIFEST?rev=72090&op=diff
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/MANIFEST (original)
+++ branches/upstream/libgravatar-url-perl/current/MANIFEST Thu Mar 31 11:11:32 2011
@@ -12,3 +12,4 @@
t/libravatar.t
t/unicornify.t
t/url.t
+SIGNATURE Added here by Module::Build
Modified: branches/upstream/libgravatar-url-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/META.yml?rev=72090&op=diff
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/META.yml (original)
+++ branches/upstream/libgravatar-url-perl/current/META.yml Thu Mar 31 11:11:32 2011
@@ -1,6 +1,6 @@
---
name: Gravatar-URL
-version: 1.03
+version: 1.04
author: []
abstract: Make URLs for Gravatars from an email address
license: perl
@@ -14,6 +14,7 @@
requires:
Carp: 0
Digest::MD5: 0
+ Digest::SHA: 0
Net::DNS::Resolver: 0
URI::Escape: 0
parent: 0
@@ -23,13 +24,13 @@
provides:
Gravatar::URL:
file: lib/Gravatar/URL.pm
- version: 1.03
+ version: 1.04
Libravatar::URL:
file: lib/Libravatar/URL.pm
- version: 1.03
+ version: 1.04
Unicornify::URL:
file: lib/Unicornify/URL.pm
- version: 1.03
+ version: 1.04
generated_by: Module::Build version 0.340201
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
Added: branches/upstream/libgravatar-url-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/SIGNATURE?rev=72090&op=file
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/SIGNATURE (added)
+++ branches/upstream/libgravatar-url-perl/current/SIGNATURE Thu Mar 31 11:11:32 2011
@@ -1,0 +1,47 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.66.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+ % cpansign -v
+
+It will check each file's integrity, as well as the signature's
+validity. If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA256
+
+SHA1 7167d0e20bd720b44dd6537748b258de132d4931 Build.PL
+SHA1 6a25663ad17eae0e367ec4679d64ca9a15a68190 Changes
+SHA1 18bb6448d08c7658c6991171dbee9b761cf72e8d MANIFEST
+SHA1 8ca6e2e38708e91e4bd249dc854520a142c3cafe MANIFEST.SKIP
+SHA1 3f588ec2c21f33603265575474a91643b7454750 META.yml
+SHA1 ea9ce95f0027d1356cfecc9ade1f899f5d05b5a4 lib/Gravatar/URL.pm
+SHA1 f2f931bf78a6b63ed2646f80d68477944a7f93c3 lib/Libravatar/URL.pm
+SHA1 c61a9a12a298c2b9300fb5af99a3b38b2abe5b98 lib/Unicornify/URL.pm
+SHA1 02f21c26f52380259046ea05ae9d560b8a5c5072 t/deprecated.t
+SHA1 0250d25f32bcfe6dafab0b3892f4575959ef6890 t/error.t
+SHA1 3b4f3259bb95a336b73ecd2c06bf96dd30637a0a t/id.t
+SHA1 33e83ab4d46c39e69472167a55ed5bc920a5d2c7 t/libravatar.t
+SHA1 7bdb7b0b2b440eaade3bb2a968c4919c7c2d4666 t/unicornify.t
+SHA1 1b8f6257f03be54ba3e0d39973b3ff0113785afa t/url.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.11 (GNU/Linux)
+
+iQIcBAEBCAAGBQJNkWXjAAoJEBYoHy4AfJjRsjoQALAMi12O5P4XYM89vs89bK7r
+lBvaPPZgWqdPN//BaHrycdJyCyutH427NUhO/pgK2mWcdlRv81gcPmnaUrzxxRNr
+2GYPpbf5L90U2C8O3kaggU3Si1R+y1mQutlFgDCtOZrc+9IHD4c8SCT8n/6PqEVr
+2iKgKIPajY9QT3orjlo/DfrJn2gVj46p0HCphuduF+GHf1YEsCkFTwBkON+Je/Lc
+I4m/YMwuV1CZCN68F1Iu0+E2HbJrfqDU24ouj9sQzf7ZwffQX46ufjXpPFNU+tIE
+HM2xKvd2BNx4EQOXQoGsKb/L/gKuHAr+sokJ1xEQzSMvdf6gvEB2Wzo9DBYZQVDC
+HoJDLHvcdy6lZyss7QQVv9va6c3T0AxUP7FAYnt+Cy5QiGPEwy7PkvLAsIimxyZW
+XGfkzeT/Nl9Zz7cWmJxmFltYgsIsFbrUMlpe8wjTq0FNszwELJQcUm1eGtUQKqVp
+xpRSTa28uvx5liwQwHGdGaraYgo8+aynF0TxUKgd0cNrunlHonaNmvrFq9gelSAX
+Nzds2gUywit/luKCOuWg0IS8quofMYBvGByHQwo+geqHSNzanWi3lApyqgi9bgIt
+CAzZPjRb6OLZJvvIpWLZ5LB+ib5VNBcdAI1mbMfjIxIAG7QEE8iJCSqrhCl3v2An
+vFOVcb3OpUjkpMi1AvF7
+=YMWU
+-----END PGP SIGNATURE-----
Modified: branches/upstream/libgravatar-url-perl/current/lib/Gravatar/URL.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/lib/Gravatar/URL.pm?rev=72090&op=diff
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/lib/Gravatar/URL.pm (original)
+++ branches/upstream/libgravatar-url-perl/current/lib/Gravatar/URL.pm Thu Mar 31 11:11:32 2011
@@ -7,7 +7,7 @@
use Digest::MD5 qw(md5_hex);
use Carp;
-our $VERSION = '1.03';
+our $VERSION = '1.04';
use parent 'Exporter';
our @EXPORT = qw(
Modified: branches/upstream/libgravatar-url-perl/current/lib/Libravatar/URL.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/lib/Libravatar/URL.pm?rev=72090&op=diff
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/lib/Libravatar/URL.pm (original)
+++ branches/upstream/libgravatar-url-perl/current/lib/Libravatar/URL.pm Thu Mar 31 11:11:32 2011
@@ -3,9 +3,11 @@
use strict;
use warnings;
-our $VERSION = '1.03';
-
use Gravatar::URL qw(gravatar_url);
+use Digest::SHA qw(sha256_hex);
+use Carp;
+
+our $VERSION = '1.04';
use parent 'Exporter';
our @EXPORT = qw(
@@ -33,9 +35,13 @@
=head3 B<libravatar_url>
+ # By email
my $url = libravatar_url( email => $email, %options );
-Constructs a URL to fetch the Libravatar for the given $email address.
+ # By OpenID
+ my $url = libravatar_url( openid => $openid, %options );
+
+Constructs a URL to fetch the Libravatar for the given $email address or $openid URL.
C<%options> are optional. C<libravatar_url> will accept all the
options of L<Gravatar::URL/gravatar_url> except for C<rating> and C<border>.
@@ -97,13 +103,24 @@
short_keys => 1,
);
-# Extra the domain component of an email address
+# Extract the domain component of an email address
sub email_domain {
my ( $email ) = @_;
return undef unless $email;
if ( $email =~ m/@([^@]+)$/ ) {
return $1;
+ }
+ return undef;
+}
+
+# Extract the domain component of an OpenID URI
+sub openid_domain {
+ my ( $openid ) = @_;
+ return undef unless $openid;
+
+ if ( $openid =~ m@^(http|https)://([^/]+)@i ) {
+ return $2;
}
return undef;
}
@@ -181,37 +198,66 @@
}
sub federated_url {
- my ( $email, $https ) = @_;
- my $domain = email_domain($email);
+ my %args = @_;
+
+ my $domain;
+ if ( exists $args{email} ) {
+ $domain = email_domain($args{email});
+ }
+ elsif ( exists $args{openid} ) {
+ $domain = openid_domain($args{openid});
+ }
return undef unless $domain;
require Net::DNS::Resolver;
my $fast_resolver = Net::DNS::Resolver->new(retry => 1, tcp_timeout => 1, udp_timeout => 1, dnssec => 1);
- my $srv_prefix = $https ? '_avatars-sec' : '_avatars';
+ my $srv_prefix = $args{https} ? '_avatars-sec' : '_avatars';
my $packet = $fast_resolver->query($srv_prefix . '._tcp.' . $domain, 'SRV');
if ( $packet and $packet->answer ) {
my ( $target, $port ) = srv_hostname($packet->answer);
- return build_url($target, $port, $https);
+ return build_url($target, $port, $args{https});
}
return undef;
+}
+
+sub lowercase_openid {
+ my $openid = shift;
+
+ if ( $openid =~ m@^([^:]+://[^/]+)(.*)@ ) {
+ $openid = (lc $1) . $2;
+ }
+ return $openid;
}
sub libravatar_url {
my %args = @_;
my $custom_base = defined $args{base};
+ exists $args{email} or exists $args{openid} or exists $args{id} or
+ croak "Cannot generate a Libravatar URI without an email address, an OpenID or a gravatar id";
+
+ if ( exists $args{email} and (exists $args{openid} or exists $args{id}) or
+ exists $args{openid} and (exists $args{email} or exists $args{id}) or
+ exists $args{id} and (exists $args{email} or exists $args{openid}) ) {
+ croak "Two or more identifiers (email, OpenID or gravatar id) were given. libravatar_url() only takes one";
+ }
+
$defaults{base_http} = $Libravatar_Http_Base;
$defaults{base_https} = $Libravatar_Https_Base;
Gravatar::URL::_apply_defaults(\%args, \%defaults);
if ( !$custom_base ) {
- my $federated_url = federated_url($args{email}, $args{https});
+ my $federated_url = federated_url(%args);
if ( $federated_url ) {
$args{base} = $federated_url;
}
}
+ if ( exists $args{openid} ) {
+ $args{id} = sha256_hex(lowercase_openid($args{openid}));
+ undef $args{openid};
+ }
return gravatar_url(%args);
}
Modified: branches/upstream/libgravatar-url-perl/current/lib/Unicornify/URL.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/lib/Unicornify/URL.pm?rev=72090&op=diff
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/lib/Unicornify/URL.pm (original)
+++ branches/upstream/libgravatar-url-perl/current/lib/Unicornify/URL.pm Thu Mar 31 11:11:32 2011
@@ -3,7 +3,7 @@
use strict;
use warnings;
-our $VERSION = '1.03';
+our $VERSION = '1.04';
use Gravatar::URL qw(gravatar_url);
Modified: branches/upstream/libgravatar-url-perl/current/t/libravatar.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/t/libravatar.t?rev=72090&op=diff
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/t/libravatar.t (original)
+++ branches/upstream/libgravatar-url-perl/current/t/libravatar.t Thu Mar 31 11:11:32 2011
@@ -6,7 +6,7 @@
use_ok 'Libravatar::URL'; }
{
- my @domain_tests = (
+ my @email_domain_tests = (
['',
undef,
],
@@ -32,9 +32,79 @@
],
);
- for my $test (@domain_tests) {
+ for my $test (@email_domain_tests) {
my ($email, $domain) = @$test;
is Libravatar::URL::email_domain($email), $domain;
+ }
+
+ my @openid_domain_tests = (
+ ['',
+ undef,
+ ],
+
+ ['notanopenid',
+ undef,
+ ],
+
+ ['http://example.com',
+ 'example.com',
+ ],
+
+ ['https://a.example.com',
+ 'a.example.com',
+ ],
+
+ ['http://b.example.com/',
+ 'b.example.com',
+ ],
+
+ ['http://example.org/id/larry',
+ 'example.org',
+ ],
+
+ ['https://a.example.org/~larry/openid.html',
+ 'a.example.org',
+ ],
+ );
+
+ for my $test (@openid_domain_tests) {
+ my ($openid, $domain) = @$test;
+ is Libravatar::URL::openid_domain($openid), $domain;
+ }
+
+ my @lowercase_openid = (
+ ['',
+ '',
+ ],
+
+ ['notanopenid',
+ 'notanopenid',
+ ],
+
+ ['http://Example.Com',
+ 'http://example.com',
+ ],
+
+ ['HTTPS://a.example.com',
+ 'https://a.example.com',
+ ],
+
+ ['http://b.eXample.com/',
+ 'http://b.example.com/',
+ ],
+
+ ['http://example.ORG/ID/Larry',
+ 'http://example.org/ID/Larry',
+ ],
+
+ ['Https://A.example.org/~Larry/OpenID.html',
+ 'https://a.example.org/~Larry/OpenID.html',
+ ],
+ );
+
+ for my $test (@lowercase_openid) {
+ my ($openid, $lc_openid) = @$test;
+ is Libravatar::URL::lowercase_openid($openid), $lc_openid;
}
my @url_tests = (
@@ -143,6 +213,6 @@
is_deeply \@result, $pair;
}
- $test_count = @domain_tests + @url_tests + @srv_tests + 2;
+ $test_count = @email_domain_tests + @openid_domain_tests + @lowercase_openid + @url_tests + @srv_tests + 2;
done_testing($test_count);
}
More information about the Pkg-perl-cvs-commits
mailing list