File Coverage

blib/lib/WWW/Shorten/VGd.pm
Criterion Covered Total %
statement 15 32 46.8
branch 0 16 0.0
condition n/a
subroutine 5 7 71.4
pod 2 2 100.0
total 22 57 38.6


line stmt bran cond sub pod time code
1             package WWW::Shorten::VGd;
2              
3 2     2   59238 use strict;
  2         2  
  2         46  
4 2     2   6 use warnings;
  2         2  
  2         44  
5              
6 2     2   6 use base qw( WWW::Shorten::generic Exporter );
  2         2  
  2         497  
7             our @EXPORT = qw( makeashorterlink makealongerlink );
8              
9 2     2   32367 use Carp ();
  2         2  
  2         27  
10 2     2   835 use HTML::Entities qw(decode_entities);
  2         7171  
  2         515  
11              
12             our $VERSION = '0.005';
13             $VERSION = eval $VERSION;
14              
15             sub makeashorterlink {
16 0 0   0 1   my $url = shift or Carp::croak('No URL passed to makeashorterlink');
17 0           my $ua = __PACKAGE__->ua();
18 0           my $response = $ua->post('https://v.gd/create.php', {
19             url => $url,
20             format => 'simple',
21             });
22              
23 0 0         return unless $response->is_success;
24 0           my $shorturl = $response->decoded_content();
25 0 0         return undef unless $shorturl;
26 0 0         return undef if $shorturl =~ m/^\s*Error/;
27 0           return $shorturl;
28             }
29              
30             sub makealongerlink {
31 0 0   0 1   my $url = shift or Carp::croak('No v.gd key/URL passed to makealongerlink');
32 0           my $ua = __PACKAGE__->ua();
33              
34 0           $url =~ s{\Qhttps?://v.gd/\E}{}i;
35 0           my $res = $ua->post('https://v.gd/forward.php', {
36             shorturl => $url,
37             format => 'simple',
38             });
39              
40 0 0         return undef unless $res->is_success;
41 0           my $longurl = $res->decoded_content;
42 0 0         return undef unless $longurl;
43 0 0         return undef if $longurl =~ m/^\s*Error/;
44 0           return decode_entities($longurl);
45             }
46              
47             1;
48              
49             __END__