r34557 - in /branches/upstream/libgravatar-url-perl: ./ current/ current/lib/ current/lib/Gravatar/ current/t/
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Fri May 1 05:15:42 UTC 2009
Author: ryan52-guest
Date: Fri May 1 05:15:08 2009
New Revision: 34557
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=34557
Log:
[svn-inject] Installing original source of libgravatar-url-perl
Added:
branches/upstream/libgravatar-url-perl/
branches/upstream/libgravatar-url-perl/current/
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/SIGNATURE
branches/upstream/libgravatar-url-perl/current/lib/
branches/upstream/libgravatar-url-perl/current/lib/Gravatar/
branches/upstream/libgravatar-url-perl/current/lib/Gravatar/URL.pm
branches/upstream/libgravatar-url-perl/current/t/
branches/upstream/libgravatar-url-perl/current/t/deprecated.t
branches/upstream/libgravatar-url-perl/current/t/error.t
branches/upstream/libgravatar-url-perl/current/t/id.t
branches/upstream/libgravatar-url-perl/current/t/url.t
Added: 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=34557&op=file
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/Build.PL (added)
+++ branches/upstream/libgravatar-url-perl/current/Build.PL Fri May 1 05:15:08 2009
@@ -1,0 +1,40 @@
+#!/usr/bin/perl -w
+
+use 5.006;
+
+use strict;
+use Module::Build;
+
+my $builder = Module::Build->new(
+ module_name => 'Gravatar::URL',
+ license => 'perl',
+
+ meta_merge => {
+ resources => {
+ bugtracker =>
+ 'http://rt.cpan.org/Public/Dist/Display.html?Name=Gravatar-URL',
+ repository =>
+ 'http://github.com/schwern/gravatar-url/tree/master',
+ },
+
+ keywords => [ 'Gravatar' ],
+
+ configure_requires => {
+ 'Module::Build' => 0.2808
+ },
+ },
+
+ build_requires => {
+ 'Test::More' => 0.40,
+ 'Test::Warn' => 0.11,
+ },
+
+ requires => {
+ 'URI::Escape' => 0,
+ 'Digest::MD5' => 0,
+ 'Carp' => 0,
+ perl => '5.6.0',
+ },
+);
+
+$builder->create_build_script();
Added: branches/upstream/libgravatar-url-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/Changes?rev=34557&op=file
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/Changes (added)
+++ branches/upstream/libgravatar-url-perl/current/Changes Fri May 1 05:15:08 2009
@@ -1,0 +1,30 @@
+1.01 Thu Apr 9 13:11:32 PDT 2009
+ Protocol Updates
+ (The Gravatar protocol changed, so we're changing with it)
+ * Gravatar expanded the max size to 512.
+ [rt.cpan.org 41244] (CHISEL)
+ * Base URL changed to http://www.gravatar.com/avatar/
+ * Ratings are now lower cased. Upper cased ratings still
+ accepted, but will be lower cased.
+ * Using new http://base/id?key=value style.
+ * The border key has been removed from the protocol,
+ so its use throws a deprecation warning.
+
+ New Features
+ * The short_keys flag uses short keys in the URL
+ ("s" instead of "size", for example).
+
+
+1.00 Sun Apr 27 14:12:24 PDT 2008
+ Bug Fixes
+ * Gravatar IDs are insensitive to the case of the email address.
+
+ Doc Fixes
+ * Clarified how relative default URLs will be handled
+
+ Dist Fixes
+ * Added a configure_requires on Module::Build and a requires on perl 5.6.
+
+
+0.01 Sat Sep 8 00:59:04 PDT 2007
+First release, stealing liberally from Template::Plugin::Gravatar
Added: branches/upstream/libgravatar-url-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/MANIFEST?rev=34557&op=file
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/MANIFEST (added)
+++ branches/upstream/libgravatar-url-perl/current/MANIFEST Fri May 1 05:15:08 2009
@@ -1,0 +1,10 @@
+Build.PL
+Changes
+lib/Gravatar/URL.pm
+MANIFEST
+META.yml
+t/deprecated.t
+t/error.t
+t/id.t
+t/url.t
+SIGNATURE Added here by Module::Build
Added: 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=34557&op=file
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/META.yml (added)
+++ branches/upstream/libgravatar-url-perl/current/META.yml Fri May 1 05:15:08 2009
@@ -1,0 +1,30 @@
+---
+name: Gravatar-URL
+version: 1.01
+author: []
+abstract: Make URLs for Gravatars from an email address
+license: perl
+resources:
+ bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=Gravatar-URL
+ license: http://dev.perl.org/licenses/
+ repository: http://github.com/schwern/gravatar-url/tree/master
+requires:
+ Carp: 0
+ Digest::MD5: 0
+ URI::Escape: 0
+ perl: 5.6.0
+build_requires:
+ Test::More: 0.4
+ Test::Warn: 0.11
+provides:
+ Gravatar::URL:
+ file: lib/Gravatar/URL.pm
+ version: 1.01
+generated_by: Module::Build version 0.32
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
+keywords:
+ - Gravatar
+configure_requires:
+ Module::Build: 0.2808
Added: branches/upstream/libgravatar-url-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/SIGNATURE?rev=34557&op=file
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/SIGNATURE (added)
+++ branches/upstream/libgravatar-url-perl/current/SIGNATURE Fri May 1 05:15:08 2009
@@ -1,0 +1,32 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.55.
+
+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: SHA1
+
+SHA1 da6f215441f5f4c2ef0f1ac5347aad253ff6c50f Build.PL
+SHA1 b3682d5f2e0318d0d3d23aac866f997c8ed37410 Changes
+SHA1 7758b0be320c022c1ce8ca12ac464354d371b1d3 MANIFEST
+SHA1 4299310ce303d6be6ffc9ab65ed04728f744e3ec META.yml
+SHA1 15653f61d2fa90771833e0c8b6a24dd45863c588 lib/Gravatar/URL.pm
+SHA1 218d731c6d9ccf14c33a3b3db3faff3f4c6a24b4 t/deprecated.t
+SHA1 0250d25f32bcfe6dafab0b3892f4575959ef6890 t/error.t
+SHA1 3b4f3259bb95a336b73ecd2c06bf96dd30637a0a t/id.t
+SHA1 a1daffcb9416394c540b324b21a022b2b61c8a3d t/url.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.9 (Darwin)
+
+iEYEARECAAYFAkneV5QACgkQWMohlhD1QydtfQCfcze4m56PfxlfLG+oTJQIZDXO
+pGIAnjb1uA8ETnr/EWGXnUWGanXjOOC/
+=9cBO
+-----END PGP SIGNATURE-----
Added: 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=34557&op=file
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/lib/Gravatar/URL.pm (added)
+++ branches/upstream/libgravatar-url-perl/current/lib/Gravatar/URL.pm Fri May 1 05:15:08 2009
@@ -1,0 +1,213 @@
+package Gravatar::URL;
+
+use strict;
+use warnings;
+
+use URI::Escape qw(uri_escape);
+use Digest::MD5 qw(md5_hex);
+use Carp;
+
+our $VERSION = '1.01';
+
+use base 'Exporter';
+our @EXPORT = qw(
+ gravatar_id
+ gravatar_url
+);
+
+my $Gravatar_Base = "http://www.gravatar.com/avatar/";
+
+
+=head1 NAME
+
+Gravatar::URL - Make URLs for Gravatars from an email address
+
+=head1 SYNOPSIS
+
+ use Gravatar::URL;
+
+ my $gravatar_id = gravatar_id($email);
+
+ my $gravatar_url = gravatar_url(email => $email);
+
+=head1 DESCRIPTION
+
+A Gravatar is a Globally Recognized Avatar for a given email address.
+This allows you to have a global picture associated with your email
+address. You can look up the Gravatar for any email address by
+constructing a URL to get the image from L<gravatar.com>. This module
+does that.
+
+Examples of use include the author faces on L<http://search.cpan.org>.
+
+See L<http://gravatar.com> for more info.
+
+=head1 Functions
+
+=head3 B<gravatar_url>
+
+ # By email
+ my $url = gravatar_url( email => $email, %options );
+
+ # By gravatar ID
+ my $url = gravatar_url( id => $id, %options );
+
+Constructs a URL to fetch the gravatar for a given C<$email> or C<$id>.
+
+C<$id> is a gravatar ID. See L</gravatar_id> for more information.
+
+C<%options> are optional and are...
+
+=head4 rating
+
+A user can rate how offensive the content of their gravatar is, like a
+movie. The ratings are g, pg, r and x. If you specify a rating it is
+the highest rating that will be given.
+
+ rating => "r" # includes g, pg and r
+
+=head4 size
+
+Specifies the desired width and height of the gravatar (gravatars are square).
+
+Valid values are from 1 to 512 inclusive. Any size other than 80 may
+cause the original gravatar image to be downsampled using bicubic
+resampling before output.
+
+ size => 40, # 40 x 40 image
+
+=head4 default
+
+The url to use if the user has no gravatar or has none that fits your rating requirements.
+
+ default => "http://upload.wikimedia.org/wikipedia/en/8/89/Alfred.jpg"
+
+Relative URLs will be relative to the base (ie. gravatar.com), not your web site.
+
+Gravatar defines special values that you may use as a default to
+produce dynamic default images. These are "identicon", "monsterid" and
+"wavatar". See L<http://en.gravatar.com/site/implement/url> for more
+info.
+
+If omitted, Gravatar will serve up their default image, the blue G.
+
+=head4 border
+
+B<DEPRECATED!> This key has been removed from the Gravatar protocol.
+It will be removed from future versions of Gravatar::URL.
+
+Gravatars can be requested to have a 1 pixel colored border. If you'd
+like that, pass in the color to border as a 3 or 6 digit hex string.
+
+ border => "000000", # a black border, like my soul
+ border => "000", # black, but in 3 digits
+
+=head4 base
+
+This is the URL of the location of the Gravatar server you wish to
+grab Gravatars from. Defaults to
+L<http://www.gravatar.com/avatar/">.
+
+=head4 short_keys
+
+If true, use short key names when constructing the URL. "s" instead
+of "size", "r" instead of "ratings" and so on.
+
+short_keys defaults to false, but may default to true in the future.
+
+=cut
+
+sub gravatar_url {
+ my %args = @_;
+
+ exists $args{id} or exists $args{email} or
+ croak "Cannot generate a Gravatar URI without an email address or gravatar id";
+
+ exists $args{id} xor exists $args{email} or
+ croak "Both an id and an email were given. gravatar_url() only takes one";
+
+ my $base = $args{base} || $Gravatar_Base;
+
+ if ( exists $args{size} ) {
+ $args{size} >= 1 and $args{size} <= 512
+ or croak "Gravatar size must be 1 .. 512";
+ }
+
+ if ( exists $args{rating} ) {
+ $args{rating} =~ /\A(?:g|pg|r|x)\Z/i
+ or croak "Gravatar rating can only be g, pg, r, or x";
+ $args{rating} = lc $args{rating};
+ }
+
+ if ( exists $args{border} ) {
+ carp "The border key is deprecated";
+ $args{border} =~ /\A[0-9A-F]{3}(?:[0-9A-F]{3})?\Z/
+ or croak "Border must be a 3 or 6 digit hex number in caps";
+ }
+
+ $args{gravatar_id} = $args{id} || gravatar_id($args{email});
+
+ $args{default} = uri_escape($args{default})
+ if $args{default};
+
+ my @pairs;
+ for my $arg ( qw( rating size default border ) ) {
+ next unless exists $args{$arg};
+
+ my $key = $arg;
+ $key = substr($key, 0, 1) if $args{short_keys};
+ push @pairs, join("=", $key, $args{$arg});
+ }
+
+ my $uri = $base;
+ $uri .= "/" unless $uri =~ m{/$};
+ $uri .= $args{gravatar_id};
+ $uri .= "?".join("&", at pairs) if @pairs;
+
+ return $uri;
+}
+
+
+=head3 B<gravatar_id>
+
+ my $id = gravatar_id($email);
+
+Converts an C<$email> address into its Gravatar C<$id>.
+
+=cut
+
+sub gravatar_id {
+ my $email = shift;
+ return md5_hex(lc $email);
+}
+
+
+=head1 THANKS
+
+Thanks to L<gravatar.com> for coming up with the whole idea and Ashley
+Pond V from whose L<Template::Plugin::Gravatar> I took most of the
+original code.
+
+
+=head1 LICENSE
+
+Copyright 2007 - 2009, Michael G Schwern <schwern at pobox.com>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+
+=head1 SEE ALSO
+
+L<Template::Plugin::Gravatar> - a Gravatar plugin for Template Toolkit
+
+L<http://www.gravatar.com> - The Gravatar web site
+
+L<http://en.gravatar.com/site/implement/url> - The Gravatar URL implementor's guide
+
+=cut
+
+
+1;
Added: branches/upstream/libgravatar-url-perl/current/t/deprecated.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/t/deprecated.t?rev=34557&op=file
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/t/deprecated.t (added)
+++ branches/upstream/libgravatar-url-perl/current/t/deprecated.t Fri May 1 05:15:08 2009
@@ -1,0 +1,21 @@
+#!/usr/bin/perl -w
+
+# Test that deprecated keys warn.
+
+use strict;
+use Test::More 'no_plan';
+use Test::Warn;
+
+use Gravatar::URL;
+
+my $id = 'a60fc0828e808b9a6a9d50f1792240c8';
+my $email = 'whatever at wherever.whichever';
+my $base = 'http://www.gravatar.com/avatar';
+
+warning_is {
+ is gravatar_url(
+ id => '12345',
+ base => 'http://www.example.com/gravatar',
+ border => "FFF"
+ ), "http://www.example.com/gravatar/12345?border=FFF";
+} {carped => "The border key is deprecated"};
Added: branches/upstream/libgravatar-url-perl/current/t/error.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/t/error.t?rev=34557&op=file
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/t/error.t (added)
+++ branches/upstream/libgravatar-url-perl/current/t/error.t Fri May 1 05:15:08 2009
@@ -1,0 +1,47 @@
+#!/usr/bin/perl -w
+
+# Test argument error handling.
+
+use strict;
+
+use Test::More 'no_plan';
+
+BEGIN { use_ok 'Gravatar::URL' }
+
+my @tests = (
+ [ {},
+ "Cannot generate a Gravatar URI without an email address or gravatar id"
+ ],
+
+ [ { email => 'foo at bar.com', id => '12345' },
+ "Both an id and an email were given. gravatar_url() only takes one"
+ ],
+
+ [ { email => 'foo at bar.com', rating => 'Q' },
+ "Gravatar rating can only be g, pg, r, or x"
+ ],
+
+ [ { email => 'foo at bar.com', size => 0 },
+ "Gravatar size must be 1 .. 512"
+ ],
+
+ [ { email => 'foo at bar.com', size => 1 } ],
+ [ { email => 'foo at bar.com', size => 512 } ],
+
+ [ { email => 'foo at bar.com', size => 513 },
+ "Gravatar size must be 1 .. 512"
+ ],
+);
+
+for my $test (@tests) {
+ my($args, $want) = @$test;
+
+ eval { gravatar_url( %$args ) };
+
+ my $error = $@;
+ $want = !$want ? ""
+ : sprintf "%s at %s line %d\n", $want, $0, __LINE__ - 4;
+
+ my $name = join ", ", map { "$_ => '$args->{$_}'" } keys %$args;
+ is $error, $want, "gravatar_url($name)";
+}
Added: branches/upstream/libgravatar-url-perl/current/t/id.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/t/id.t?rev=34557&op=file
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/t/id.t (added)
+++ branches/upstream/libgravatar-url-perl/current/t/id.t Fri May 1 05:15:08 2009
@@ -1,0 +1,23 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More 'no_plan';
+
+BEGIN { use_ok "Gravatar::URL" }
+
+my %email2id = (
+ 'alfred at example.com' => '6ffc501bf3b215384ea3abd3b6026735',
+ 'whatever at wherever.whichever' => 'a60fc0828e808b9a6a9d50f1792240c8',
+ 'PHRED at cpan.org' => 'c18b1af66a7f62015ecc26707a1321b9',
+ 'iHaveAn at email.com', => '3b3be63a4c2a439b013787725dfce802',
+);
+
+for my $email (keys %email2id) {
+ my $id = $email2id{$email};
+
+ is gravatar_id( $email ) => $id, "$email";
+ is gravatar_id( lc $email ) => $id, "lc $email";
+ is gravatar_id( uc $email ) => $id, "uc $email";
+ is gravatar_id( ucfirst $email ) => $id, "ucfirst $email";
+}
Added: branches/upstream/libgravatar-url-perl/current/t/url.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgravatar-url-perl/current/t/url.t?rev=34557&op=file
==============================================================================
--- branches/upstream/libgravatar-url-perl/current/t/url.t (added)
+++ branches/upstream/libgravatar-url-perl/current/t/url.t Fri May 1 05:15:08 2009
@@ -1,0 +1,96 @@
+#!/usr/bin/perl -w
+
+use Test::More 'no_plan';
+
+BEGIN { use_ok 'Gravatar::URL'; }
+
+{
+ my $id = 'a60fc0828e808b9a6a9d50f1792240c8';
+ my $email = 'whatever at wherever.whichever';
+ my $base = 'http://www.gravatar.com/avatar';
+
+ my @tests = (
+ [{ email => $email },
+ "$base/$id",
+ ],
+
+ [{ id => $id },
+ "$base/$id",
+ ],
+
+ [{ email => $email,
+ base => 'http://example.com/gravatar'
+ },
+ "http://example.com/gravatar/$id",
+ ],
+
+ # Make sure we don't get a double slash after the base.
+ [{ email => $email,
+ base => 'http://example.com/gravatar/'
+ },
+ "http://example.com/gravatar/$id",
+ ],
+
+ [{ default => "/local.png",
+ email => $email
+ },
+ "$base/$id?default=%2Flocal.png",
+ ],
+
+ [{ default => "/local.png",
+ rating => 'X',
+ email => $email,
+ },
+ "$base/$id?rating=x&default=%2Flocal.png",
+ ],
+
+ [{ default => "/local.png",
+ email => $email,
+ rating => 'R',
+ size => 80
+ },
+ "$base/$id?rating=r&size=80&default=%2Flocal.png"
+ ],
+
+ [{ default => "/local.png",
+ rating => 'PG',
+ size => 45,
+ email => $email,
+ },
+ "$base/$id?rating=pg&size=45&default=%2Flocal.png"
+ ],
+
+ [{ default => "/local.png",
+ rating => 'PG',
+ size => 45,
+ email => $email,
+ },
+ "$base/$id?rating=pg&size=45&default=%2Flocal.png"
+ ],
+
+ [{ default => "/local.png",
+ rating => 'PG',
+ size => 45,
+ email => $email,
+ short_keys => 1,
+ },
+ "$base/$id?r=pg&s=45&d=%2Flocal.png"
+ ],
+ );
+
+ # Add tests for the special defaults.
+ for my $special ("identicon", "monsterid", "wavatar") {
+ my $test = [{ default => $special,
+ email => $email,
+ },
+ "$base/$id?default=$special",
+ ];
+ push @tests, $test;
+ }
+
+ for my $test (@tests) {
+ my($args, $url ) = @$test;
+ is gravatar_url( %$args ), $url, join ", ", keys %$args;
+ }
+}
+
More information about the Pkg-perl-cvs-commits
mailing list