File Coverage

blib/lib/WWW/Shorten/VGd.pm
Criterion Covered Total %
statement 33 34 97.0
branch 10 16 62.5
condition n/a
subroutine 8 8 100.0
pod 2 2 100.0
total 53 60 88.3


line stmt bran cond sub pod time code
1             package WWW::Shorten::VGd;
2             # ABSTRACT: shorten (or lengthen) URLs with http://v.gd
3 1     1   31502 use strict;
  1         2  
  1         49  
4 1     1   7 use warnings;
  1         2  
  1         30  
5 1     1   37 use 5.006;
  1         3  
  1         72  
6             our $VERSION = '0.003'; # VERSION
7              
8              
9 1     1   10 use base qw( WWW::Shorten::generic Exporter );
  1         2  
  1         972  
10             our @EXPORT = qw( makeashorterlink makealongerlink );
11 1     1   126951 use Carp;
  1         6  
  1         477  
12 1     1   5194 use HTML::Entities;
  1         33124  
  1         570  
13              
14              
15             sub makeashorterlink {
16 3 100   3 1 1504 my $url = shift or croak 'No URL passed to makeashorterlink';
17 2         26 my $ua = __PACKAGE__->ua();
18 2 50       40113 my $response = $ua->post('http://v.gd/create.php', [
19             url => $url,
20             source => 'PerlAPI-' . (defined __PACKAGE__->VERSION ? __PACKAGE__->VERSION : 'dev'),
21             format => 'simple',
22             ]);
23 2 50       213890 return unless $response->is_success;
24 2         26 my $shorturl = $response->{_content};
25 2 50       12 return if $shorturl =~ m/Error/;
26 2 50       14 if ($response->content =~ m{(\Qhttp://v.gd/\E[\w_]+)}) {
27 2         77 return $1;
28             }
29 0         0 return;
30             }
31              
32              
33             sub makealongerlink {
34 3 100   3 1 933 my $url = shift or croak 'No v.gd key/URL passed to makealongerlink';
35 2         535 my $ua = __PACKAGE__->ua();
36            
37 2         28 $url =~ s{\Qhttp://v.gd/\E}{}i;
38 2 50       205 my $response = $ua->post('http://v.gd/forward.php', [
39             shorturl => $url,
40             source => 'PerlAPI-' . (defined __PACKAGE__->VERSION ? __PACKAGE__->VERSION : 'dev'),
41             format => 'simple',
42             ]);
43             # use Data::Dumper;
44             # print STDERR Dumper $response;
45 2 50       84303 return unless $response->is_success;
46              
47 2         90 my $longurl = $response->{_content};
48 2         64 return decode_entities($longurl);
49             }
50              
51             1;
52              
53              
54              
55             =pod
56              
57             =encoding utf-8
58              
59             =head1 NAME
60              
61             WWW::Shorten::VGd - shorten (or lengthen) URLs with http://v.gd
62              
63             =head1 VERSION
64              
65             version 0.003
66              
67             =head1 SYNOPSIS
68              
69             use WWW::Shorten::VGd;
70             use WWW::Shorten 'VGd';
71              
72             my $url = q{http://averylong.link/wow?thats=really&really=long};
73             my $short_url = makeashorterlink($url);
74             my $long_url = makealongerlink($short_url); # eq $url
75              
76             =head1 DESCRIPTION
77              
78             A Perl interface to the web site L. v.gd simply maintains
79             a database of long URLs, each of which has a unique identifier. By default,
80             this URL shortening service will show you a preview page before redirecting
81             you. This can be turned off by setting a cookie at L.
82              
83             =head1 FUNCTIONS
84              
85             =head2 makeashorterlink
86              
87             The function C will call the v.gd web site passing
88             it your long URL and will return the shortened link.
89              
90             =head2 makealongerlink
91              
92             The function C does the reverse. C
93             will accept as an argument either the full TinyURL URL or just the
94             TinyURL identifier.
95              
96             If anything goes wrong, then either function will return C.
97              
98             =head1 AVAILABILITY
99              
100             The project homepage is L.
101              
102             The latest version of this module is available from the Comprehensive Perl
103             Archive Network (CPAN). Visit L to find a CPAN
104             site near you, or see L.
105              
106             The development version lives at L
107             and may be cloned from L.
108             Instead of sending patches, please fork this project using the standard
109             git and github infrastructure.
110              
111             =head1 SOURCE
112              
113             The development version is on github at L
114             and may be cloned from L
115              
116             =head1 BUGS AND LIMITATIONS
117              
118             No bugs have been reported.
119              
120             Please report any bugs or feature requests through the web interface at
121             L.
122              
123             =head1 AUTHOR
124              
125             Mike Doherty
126              
127             =head1 COPYRIGHT AND LICENSE
128              
129             This software is copyright (c) 2011 by Mike Doherty.
130              
131             This is free software; you can redistribute it and/or modify it under
132             the same terms as the Perl 5 programming language system itself.
133              
134             =cut
135              
136              
137             __END__