File Coverage

blib/lib/WWW/Shorten/IsGd.pm
Criterion Covered Total %
statement 15 32 46.8
branch 0 18 0.0
condition n/a
subroutine 5 7 71.4
pod 2 2 100.0
total 22 59 37.2


line stmt bran cond sub pod time code
1             package WWW::Shorten::IsGd;
2              
3 2     2   59864 use strict;
  2         4  
  2         48  
4 2     2   7 use warnings;
  2         2  
  2         50  
5              
6 2     2   5 use base qw( WWW::Shorten::generic Exporter );
  2         2  
  2         543  
7             our @EXPORT = qw( makeashorterlink makealongerlink );
8              
9 2     2   33241 use Carp ();
  2         3  
  2         26  
10 2     2   859 use HTML::Entities qw(decode_entities);
  2         7261  
  2         562  
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://is.gd/create.php', {
19             url => $url,
20             format => 'simple',
21             });
22              
23 0 0         return undef 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 is.gd key/URL passed to makealongerlink');
32 0           my $ua = __PACKAGE__->ua();
33              
34 0 0         $url = "https://is.gd/$url" unless $url =~ m{^https?://}i;
35 0           my $res = $ua->post('https://is.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__