File Coverage

blib/lib/Template/Plugin/Gravatar.pm
Criterion Covered Total %
statement 47 47 100.0
branch 12 12 100.0
condition 18 27 66.6
subroutine 8 8 100.0
pod 1 1 100.0
total 86 95 90.5


line stmt bran cond sub pod time code
1             package Template::Plugin::Gravatar;
2 4     4   133054 use warnings;
  4         6  
  4         134  
3 4     4   14 use strict;
  4         4  
  4         76  
4 4     4   12 use base "Template::Plugin";
  4         6  
  4         1873  
5 4     4   5075 use Carp qw( carp croak );
  4         5  
  4         224  
6 4     4   2293 use URI ();
  4         15712  
  4         76  
7 4     4   24 use Digest::MD5 ();
  4         4  
  4         1454  
8              
9             our $VERSION = "0.10";
10             our $AUTHORITY = "cpan:ASHLEY";
11             our $Gravatar_Base = "https://gravatar.com/avatar/";
12              
13             sub new {
14 18     18 1 44152 my ( $class, $context, $instance_args ) = @_;
15 18   100     73 $instance_args ||= {}; # the USE'd object.
16 18   100     78 my $config = $context->{CONFIG}{GRAVATAR} || {}; # from TT config.
17 18         20 my %args;
18              
19 18   66     64 $args{default} = $instance_args->{default} || $config->{default};
20 18   66     61 $args{rating} = $instance_args->{rating} || $config->{rating};
21 18   66     49 $args{border} = $instance_args->{border} || $config->{border};
22 18   66     49 $args{size} = $instance_args->{size} || $config->{size};
23              
24             # Overriding the base might be nice for some developers.
25             $args{base} = $instance_args->{base} || $config->{base} ||
26 18   33     75 $Gravatar_Base;
27              
28             return sub {
29 15   100 15   596 my $args = shift || {};
30             $args = {
31             %args,
32 15         43 %{$args}
  15         56  
33             };
34 15 100       212 $args->{email} || croak "Cannot generate a Gravatar URI without an email address";
35 14 100       33 if ( $args->{size} ) {
36 9 100 66     191 $args->{size} >= 1 and $args->{size} <= 2048
37             or croak "Gravatar size must be 1 .. 2048";
38             }
39 13 100       25 if ( $args->{rating} ) {
40 10 100       203 $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       25 if ( $args->{border} ) {
44 2         437 carp "Border is deprecated! Dropping it.";
45             }
46              
47 12         195 my $email = $args->{email};
48 12         64 s/\A\s+//, s/\s+\z// for $email;
49 12         22 $email = lc $email; # Might need to consider charset here or document consideration...
50 12         63 $args->{gravatar_id} = Digest::MD5::md5_hex($email);
51              
52 12   33     56 my $uri = URI->new( $args->{base} || $Gravatar_Base );
53 40         80 my @ordered = map { $_, $args->{$_} }
54 12         19015 grep $args->{$_},
55             qw( gravatar_id rating size default );
56 12         56 $uri->query_form(@ordered);
57 12         1288 $uri;
58             }
59 18         108 }
60              
61             1;
62              
63             __END__