File Coverage

blib/lib/Template/Plugin/Gravatar.pm
Criterion Covered Total %
statement 47 47 100.0
branch 12 12 100.0
condition 22 27 81.4
subroutine 8 8 100.0
pod 1 1 100.0
total 90 95 94.7


line stmt bran cond sub pod time code
1             package Template::Plugin::Gravatar;
2 4     4   158259 use warnings;
  4         8  
  4         158  
3 4     4   18 use strict;
  4         6  
  4         123  
4 4     4   17 use base "Template::Plugin";
  4         7  
  4         2056  
5 4     4   5684 use Carp qw( carp croak );
  4         6  
  4         265  
6 4     4   2143 use URI ();
  4         15950  
  4         73  
7 4     4   24 use Digest::MD5 ();
  4         4  
  4         1513  
8              
9             our $VERSION = "0.09";
10             our $AUTHORITY = "cpan:ASHLEY";
11             our $Gravatar_Base = "http://www.gravatar.com/avatar/";
12              
13             sub new {
14 18     18 1 45403 my ( $class, $context, $instance_args ) = @_;
15 18   100     65 $instance_args ||= {}; # the USE'd object.
16 18   100     67 my $config = $context->{CONFIG}{GRAVATAR} || {}; # from TT config.
17 18         21 my %args;
18              
19 18   100     63 $args{default} = $instance_args->{default} || $config->{default};
20 18   100     62 $args{rating} = $instance_args->{rating} || $config->{rating};
21 18   66     56 $args{border} = $instance_args->{border} || $config->{border};
22 18   100     57 $args{size} = $instance_args->{size} || $config->{size};
23              
24             # Overriding the base might be nice for some developers.
25 18   66     81 $args{base} = $instance_args->{base} || $config->{base} ||
26             $Gravatar_Base;
27              
28             return sub {
29 15   100 15   529 my $args = shift || {};
30 15         52 $args = {
31             %args,
32 15         34 %{$args}
33             };
34 15 100       202 $args->{email} || croak "Cannot generate a Gravatar URI without an email address";
35 14 100       31 if ( $args->{size} ) {
36 9 100 66     194 $args->{size} >= 1 and $args->{size} <= 2048
37             or croak "Gravatar size must be 1 .. 2048";
38             }
39 13 100       23 if ( $args->{rating} ) {
40 10 100       175 $args->{rating} =~ /\A(?:G|PG|R|X)\z/
41             or croak "Gravatar rating can only be G, PG, R, or X";
42             }
43 12 100       24 if ( $args->{border} ) {
44 2         459 carp "Border is deprecated! Dropping it.";
45             }
46              
47 12         344 my $email = $args->{email};
48 12         63 s/\A\s+//, s/\s+\z// for $email;
49 12         30 $email = lc $email; # Might need to consider charset here or document consideration...
50 12         61 $args->{gravatar_id} = Digest::MD5::md5_hex($email);
51              
52 12   33     65 my $uri = URI->new( $args->{base} || $Gravatar_Base );
53 12         16505 my @ordered = map { $_, $args->{$_} }
  40         90  
54             grep $args->{$_},
55             qw( gravatar_id rating size default );
56 12         58 $uri->query_form(@ordered);
57 12         1613 $uri;
58             }
59 18         102 }
60              
61             1;
62              
63             __END__